diff --git a/manifest/product_octez.ml b/manifest/product_octez.ml index fed5cdc316a9633de9b45b6b501a3d267981cbd8..7bb91857dfeb3be77f8756705f09a964b058db15 100644 --- a/manifest/product_octez.ml +++ b/manifest/product_octez.ml @@ -1907,6 +1907,7 @@ let _octez_base_tests = "test_p2p_addr"; "test_sized"; "test_skip_list"; + "test_bitset"; ] ~path:"src/lib_base/test" ~opam:"octez-libs" @@ -5630,7 +5631,6 @@ end = struct ("test_script_comparison", true); ("test_script_roundtrip", N.(number >= 019)); ("test_tez_repr", true); - ("test_bitset", N.(number >= 013)); ("test_sc_rollup_tick_repr", N.(number >= 016)); ("test_sc_rollup_encoding", N.(number >= 016)); ("test_sc_rollup_inbox", N.(number >= 017)); diff --git a/src/lib_base/bitset.ml b/src/lib_base/bitset.ml index 1efff8a62a9891ab1d8845c907a08341c86944b3..2f4e179682fb2c92615d166a6304845c39b96942 100644 --- a/src/lib_base/bitset.ml +++ b/src/lib_base/bitset.ml @@ -9,9 +9,30 @@ open Error_monad type t = Z.t -type error += Invalid_position of int +let encoding = Data_encoding.z -let encoding = Data_encoding.n +type error += Invalid_position of int | Invalid_input of string + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"bitfield_invalid_position" + ~title:"Invalid bitfield’s position" + ~description:"Bitfields do not accept negative positions" + (obj1 (req "position" int31)) + (function Invalid_position i -> Some i | _ -> None) + (fun i -> Invalid_position i) ; + register_error_kind + `Permanent + ~id:"bitfield_invalid_input" + ~title:"Invalid argument" + ~description:"A bitset function was provided an invalid input" + ~pp:(fun ppf name -> + Format.fprintf ppf "Invalid input for function %s" name) + (obj1 (req "function_name" string)) + (function Invalid_input f -> Some f | _ -> None) + (fun f -> Invalid_input f) let empty = Z.zero @@ -47,33 +68,22 @@ let to_list field = let fill ~length = let open Result_syntax in - let* () = error_when Compare.Int.(length < 0) (Invalid_position length) in + let* () = error_when Compare.Int.(length < 0) (Invalid_input "fill") in return Z.(pred (shift_left one length)) let inter = Z.logand let diff b1 b2 = Z.logand b1 (Z.lognot b2) -let () = - let open Data_encoding in - register_error_kind - `Permanent - ~id:"bitfield_invalid_position" - ~title:"Invalid bitfield’s position" - ~description:"Bitfields does not accept negative positions" - (obj1 (req "position" int31)) - (function Invalid_position i -> Some i | _ -> None) - (fun i -> Invalid_position i) - let occupied_size_in_bits = Z.numbits let cardinal = - (* Cardinal of bitset is the hamming weight, i.e. the number of ones. *) + (* The cardinal of a bitset is its hamming weight, i.e. the number of ones. *) Z.popcount let to_z z = z let from_z z = - if Z.sign z < 0 then - error_with "Bitset.from_z: argument %a is negative" Z.pp_print z - else Ok z + let open Result_syntax in + let+ () = error_when (Z.sign z < 0) (Invalid_input "from_z") in + z diff --git a/src/lib_base/bitset.mli b/src/lib_base/bitset.mli index 3ba9fb04103390c19dc21090e880cc5959f7402a..26e6247ef55651d50fb73e7e24106a007833664d 100644 --- a/src/lib_base/bitset.mli +++ b/src/lib_base/bitset.mli @@ -10,7 +10,7 @@ open Error_monad (** A bitset is a compact structure to store a set of integers. *) type t -type error += Invalid_position of int +type error += Invalid_position of int | Invalid_input of string val encoding : t Data_encoding.t @@ -23,37 +23,37 @@ val is_empty : t -> bool (** [equal i j] is [true] if [i] and [j] are identical. *) val equal : t -> t -> bool -(** [mem field i] returns [true] iff [i] has been added in [field]. +(** [mem bitset i] returns [true] iff [i] has been added in [bitset]. - This functions returns [Invalid_input i] if [i] is negative. *) + This functions returns [Invalid_position i] if [i] is negative. *) val mem : t -> int -> bool tzresult -(** [add field i] returns a new bitset which contains [i] in - addition to the previous integers of [field]. +(** [add bitset i] returns a new bitset which contains [i] in + addition to the previous integers of [bitset]. - This functions returns [Invalid_input i] if [i] is negative. *) + This functions returns [Invalid_position i] if [i] is negative. *) val add : t -> int -> t tzresult -(** [remove field i] returns a new bitset in which [i] is - removed from [field]. +(** [remove bitset i] returns a new bitset in which [i] is + removed from [bitset]. - This functions returns [Invalid_input i] if [i] is negative. *) + This functions returns [Invalid_position i] if [i] is negative. *) val remove : t -> int -> t tzresult (** [from_list positions] folds [add] over the [positions] starting from [empty]. - This function returns [Invalid_input i] if [i] is negative and appears in + This function returns [Invalid_position i] if [i] is negative and appears in [positions]. *) val from_list : int list -> t tzresult -(** [to_list t] returns the list of int in the bitset. *) +(** [to_list t] returns the list of integers in the bitset. *) val to_list : t -> int list -(** [fill ~length] is equivalent to setting all bits for positions in - [0, length - 1] to [one]. i.e., to [from_list (0 -- size -1)] or to - [(2 ^ length) - 1]. But it's more efficient than folding on individual - positions to set them. +(** [fill ~length] is equivalent to setting all bits for positions in [0, length + - 1] to one, or to [from_list (0 -- size-1)], or to [from_z ((2 ^ length) - + 1)]. But it's more efficient than folding on individual positions to set + them. - The function returns [Invalid_position length] if [length] is negative. + The function returns [Invalid_input "fill"] if [length] is negative. *) val fill : length:int -> t tzresult @@ -61,8 +61,8 @@ val fill : length:int -> t tzresult intersection of [set_l] and [set_r]. *) val inter : t -> t -> t -(** [diff set_l set_r] returns a [set] containing fiels in [set_l] - that are not in [set_r]. *) +(** [diff set_l set_r] returns a bitset containing integers in [set_l] that are + not in [set_r]. *) val diff : t -> t -> t (** [occupied_size_in_bits bitset] returns the current number of bits @@ -72,9 +72,10 @@ val occupied_size_in_bits : t -> int (** [cardinat bitset] returns the number of elements in the [bitsest]. *) val cardinal : t -> int -(** [to_z t] Returns the sum of powers of two of the given bitset. *) +(** [to_z t] returns the sum of powers of two of the integers in the given + bitset. *) val to_z : t -> Z.t -(** [from_z i] builds a bitset from its integer representation (partial - function). *) +(** [from_z] builds a bitset from its integer representation. Returns + [Invalid_input "from_z"] if the given argument is negative. *) val from_z : Z.t -> t tzresult diff --git a/src/lib_base/test/dune b/src/lib_base/test/dune index 4f64020746fe4f1a9e6758b99d6fe4c6683aa6cc..7068656dfb74aeea66a60985fb4320b88357883d 100644 --- a/src/lib_base/test/dune +++ b/src/lib_base/test/dune @@ -29,7 +29,8 @@ test_protocol test_p2p_addr test_sized - test_skip_list)) + test_skip_list + test_bitset)) (executable (name main) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_bitset.ml b/src/lib_base/test/test_bitset.ml similarity index 95% rename from src/proto_alpha/lib_protocol/test/pbt/test_bitset.ml rename to src/lib_base/test/test_bitset.ml index ac34d01c00012ea36aad1cecd78f392a493f1d8c..bdd954766b5be8b86e9809d22376bce018a575a8 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_bitset.ml +++ b/src/lib_base/test/test_bitset.ml @@ -26,13 +26,14 @@ (** Testing ------- Component: Protocol Library - Invocation: dune exec src/proto_alpha/lib_protocol/test/pbt/main.exe \ - -- --file test_bitset.ml + Invocation: dune exec src/lib_base/test/main.exe -- --file test_bitset.ml Subject: Bitset structure *) open Qcheck2_helpers -open Protocol.Bitset +open Bitset +open Tezos_stdlib.Utils.Infix +open Error_monad let gen_ofs = QCheck2.Gen.int_bound (64 * 10) @@ -42,7 +43,7 @@ let value_of res = | Error e -> Alcotest.failf "An unxpected error %a occurred when generating Bitset.t" - Environment.Error_monad.pp_trace + pp_print_trace e let gen_storage = @@ -53,7 +54,7 @@ let gen_storage = let test_get_set (c, ofs) = List.for_all (fun ofs' -> - let open Result_syntax in + let open Error_monad.Result_syntax in value_of @@ let* c' = add c ofs in let* v = mem c ofs' in @@ -104,7 +105,7 @@ let test_fill = let () = Alcotest.run ~__FILE__ - Protocol.name + "Bitset" [ ( "quantity", qcheck_wrap diff --git a/src/lib_protocol_environment/environment_V14.ml b/src/lib_protocol_environment/environment_V14.ml index a945f1245d12e3a47299fc24e10b72df8f14861f..ca27e2dfd5ce9b496274e03a838ecba2050f74a9 100644 --- a/src/lib_protocol_environment/environment_V14.ml +++ b/src/lib_protocol_environment/environment_V14.ml @@ -92,6 +92,7 @@ module type T = sig and type 'a Micheline.canonical = 'a Micheline.canonical and type Z.t = Z.t and type Q.t = Q.t + and type Bitset.t = Tezos_base.Bitset.t and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node and type Data_encoding.json_schema = Data_encoding.json_schema and type ('a, 'b) RPC_path.t = ('a, 'b) Tezos_rpc.Path.t @@ -787,6 +788,56 @@ struct let wrap_tzresult r = Result.map_error wrap_tztrace r + module Bitset = struct + include Tezos_base.Bitset + + (* Redefine the shell errors as a protocol errors. *) + type Error_core.error += + | Bitset_invalid_position of int + | Bitset_invalid_input of string + + let () = + let open Data_encoding in + Error_core.register_error_kind + `Permanent + ~id:"env.bitfield_invalid_position" + ~title:"Invalid bitfield’s position" + ~description:"Bitfields do not accept negative positions" + (obj1 (req "position" int31)) + (function Bitset_invalid_position i -> Some i | _ -> None) + (fun i -> Bitset_invalid_position i) ; + Error_core.register_error_kind + `Permanent + ~id:"bitfield_invalid_input" + ~title:"Invalid argument" + ~description:"A bitset function was provided an invalid input" + ~pp:(fun ppf name -> + Format.fprintf ppf "Invalid input for function %s" name) + (obj1 (req "function_name" (string Plain))) + (function Bitset_invalid_input f -> Some f | _ -> None) + (fun f -> Bitset_invalid_input f) + + let wrap_error = function + | Ok v -> Ok v + | Error (Tezos_base.Bitset.Invalid_position i :: _) -> + Error [Bitset_invalid_position i] + | Error (Tezos_base.Bitset.Invalid_input f :: _) -> + Error [Bitset_invalid_input f] + | _ -> (* unreachable *) assert false + + let mem t i = wrap_error @@ mem t i + + let add t i = wrap_error @@ add t i + + let remove t i = wrap_error @@ remove t i + + let from_list l = wrap_error @@ from_list l + + let fill ~length = wrap_error @@ fill ~length + + let from_z z = wrap_error @@ from_z z + end + module Chain_id = Chain_id module Block_hash = Block_hash module Operation_hash = Operation_hash diff --git a/src/lib_protocol_environment/environment_V14.mli b/src/lib_protocol_environment/environment_V14.mli index ad0ca9325de3f019c6e9cbc29ac5e15fe69187e6..87f305f7bd32d34e9e660e5feb2a73a4bcea8470 100644 --- a/src/lib_protocol_environment/environment_V14.mli +++ b/src/lib_protocol_environment/environment_V14.mli @@ -92,6 +92,7 @@ module type T = sig and type 'a Micheline.canonical = 'a Micheline.canonical and type Z.t = Z.t and type Q.t = Q.t + and type Bitset.t = Tezos_base.Bitset.t and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node and type Data_encoding.json_schema = Data_encoding.json_schema and type ('a, 'b) RPC_path.t = ('a, 'b) Tezos_rpc.Path.t diff --git a/src/lib_protocol_environment/sigs/v14.in.ml b/src/lib_protocol_environment/sigs/v14.in.ml index 754862dee8923098252b3fb0e977f368613c2b27..03049abae6e81db2499250b45203db8fe74caec3 100644 --- a/src/lib_protocol_environment/sigs/v14.in.ml +++ b/src/lib_protocol_environment/sigs/v14.in.ml @@ -61,6 +61,8 @@ module type T = sig module Map : [%sig "v14/map.mli"] + module Bitset : [%sig "v14/bitset.mli"] + module Option : [%sig "v14/option.mli"] module Result : [%sig "v14/result.mli"] diff --git a/src/lib_protocol_environment/sigs/v14.ml b/src/lib_protocol_environment/sigs/v14.ml index 1a0c58043a1af21baf16c9fc65dd745664297b90..59d033c61e99453958e6ee9e996c2eb041ee8efd 100644 --- a/src/lib_protocol_environment/sigs/v14.ml +++ b/src/lib_protocol_environment/sigs/v14.ml @@ -8155,6 +8155,93 @@ end # 62 "v14.in.ml" + module Bitset : sig +# 1 "v14/bitset.mli" +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +open Error_monad + +(** A bitset is a compact structure to store a set of integers. *) +type t + +type error += Bitset_invalid_position of int | Bitset_invalid_input of string + +val encoding : t Data_encoding.t + +(** A bitset encoding the empty set. *) +val empty : t + +(** [is_empty i] is [true] if [i] is empty. *) +val is_empty : t -> bool + +(** [equal i j] is [true] if [i] and [j] are identical. *) +val equal : t -> t -> bool + +(** [mem bitset i] returns [true] iff [i] has been added in [bitset]. + + This functions returns [Invalid_position i] if [i] is negative. *) +val mem : t -> int -> bool tzresult + +(** [add bitset i] returns a new bitset which contains [i] in + addition to the previous integers of [bitset]. + + This functions returns [Invalid_position i] if [i] is negative. *) +val add : t -> int -> t tzresult + +(** [remove bitset i] returns a new bitset in which [i] is + removed from [bitset]. + + This functions returns [Invalid_position i] if [i] is negative. *) +val remove : t -> int -> t tzresult + +(** [from_list positions] folds [add] over the [positions] starting from [empty]. + This function returns [Invalid_position i] if [i] is negative and appears in + [positions]. *) +val from_list : int list -> t tzresult + +(** [to_list t] returns the list of integers in the bitset. *) +val to_list : t -> int list + +(** [fill ~length] is equivalent to setting all bits for positions in [0, length + - 1] to one, or to [from_list (0 -- size-1)], or to [from_z ((2 ^ length) - + 1)]. But it's more efficient than folding on individual positions to set + them. + + The function returns [Invalid_input "fill"] if [length] is negative. +*) +val fill : length:int -> t tzresult + +(** [inter set_l set_r] returns [set] which is result of the + intersection of [set_l] and [set_r]. *) +val inter : t -> t -> t + +(** [diff set_l set_r] returns a bitset containing integers in [set_l] that are + not in [set_r]. *) +val diff : t -> t -> t + +(** [occupied_size_in_bits bitset] returns the current number of bits + occupied by the [bitset]. *) +val occupied_size_in_bits : t -> int + +(** [cardinat bitset] returns the number of elements in the [bitsest]. *) +val cardinal : t -> int + +(** [to_z t] returns the sum of powers of two of the integers in the given + bitset. *) +val to_z : t -> Z.t + +(** [from_z] builds a bitset from its integer representation. Returns + [Invalid_input "from_z"] if the given argument is negative. *) +val from_z : Z.t -> t tzresult +end +# 64 "v14.in.ml" + + module Option : sig # 1 "v14/option.mli" (*****************************************************************************) @@ -8300,7 +8387,7 @@ val catch : ?catch_only:(exn -> bool) -> (unit -> 'a) -> 'a option val catch_s : ?catch_only:(exn -> bool) -> (unit -> 'a Lwt.t) -> 'a option Lwt.t end -# 64 "v14.in.ml" +# 66 "v14.in.ml" module Result : sig @@ -8466,7 +8553,7 @@ val catch_f : val catch_s : ?catch_only:(exn -> bool) -> (unit -> 'a Lwt.t) -> ('a, exn) result Lwt.t end -# 66 "v14.in.ml" +# 68 "v14.in.ml" module RPC_arg : sig @@ -8536,7 +8623,7 @@ type ('a, 'b) eq = Eq : ('a, 'a) eq val eq : 'a arg -> 'b arg -> ('a, 'b) eq option end -# 68 "v14.in.ml" +# 70 "v14.in.ml" module RPC_path : sig @@ -8592,7 +8679,7 @@ val add_final_args : val ( /:* ) : ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path end -# 70 "v14.in.ml" +# 72 "v14.in.ml" module RPC_query : sig @@ -8664,7 +8751,7 @@ exception Invalid of string val parse : 'a query -> untyped -> 'a end -# 72 "v14.in.ml" +# 74 "v14.in.ml" module RPC_service : sig @@ -8741,7 +8828,7 @@ val put_service : ('prefix, 'params) RPC_path.t -> ([`PUT], 'prefix, 'params, 'query, 'input, 'output) service end -# 74 "v14.in.ml" +# 76 "v14.in.ml" module RPC_answer : sig @@ -8802,7 +8889,7 @@ val not_found : 'o t Lwt.t val fail : error list -> 'a t Lwt.t end -# 76 "v14.in.ml" +# 78 "v14.in.ml" module RPC_directory : sig @@ -9072,7 +9159,7 @@ val register_dynamic_directory : ('a -> 'a directory Lwt.t) -> 'prefix directory end -# 78 "v14.in.ml" +# 80 "v14.in.ml" module Base58 : sig @@ -9137,7 +9224,7 @@ val check_encoded_prefix : 'a encoding -> string -> int -> unit not start with a registered prefix. *) val decode : string -> data option end -# 80 "v14.in.ml" +# 82 "v14.in.ml" module S : sig @@ -9514,7 +9601,7 @@ module type CURVE = sig val mul : t -> Scalar.t -> t end end -# 82 "v14.in.ml" +# 84 "v14.in.ml" module Blake2B : sig @@ -9579,7 +9666,7 @@ end module Make (Register : Register) (Name : PrefixedName) : S.HASH end -# 84 "v14.in.ml" +# 86 "v14.in.ml" module Bls : sig @@ -9625,7 +9712,7 @@ module Primitive : sig val pairing_check : (G1.t * G2.t) list -> bool end end -# 86 "v14.in.ml" +# 88 "v14.in.ml" module Ed25519 : sig @@ -9659,7 +9746,7 @@ end include S.SIGNATURE with type watermark := bytes end -# 88 "v14.in.ml" +# 90 "v14.in.ml" module Secp256k1 : sig @@ -9693,7 +9780,7 @@ end include S.SIGNATURE with type watermark := bytes end -# 90 "v14.in.ml" +# 92 "v14.in.ml" module P256 : sig @@ -9727,7 +9814,7 @@ end include S.SIGNATURE with type watermark := bytes end -# 92 "v14.in.ml" +# 94 "v14.in.ml" module Chain_id : sig @@ -9759,7 +9846,7 @@ end include S.HASH end -# 94 "v14.in.ml" +# 96 "v14.in.ml" module Signature : sig @@ -9827,7 +9914,7 @@ include val size : t -> int end -# 96 "v14.in.ml" +# 98 "v14.in.ml" module Block_hash : sig @@ -9860,7 +9947,7 @@ end (** Blocks hashes / IDs. *) include S.HASH end -# 98 "v14.in.ml" +# 100 "v14.in.ml" module Operation_hash : sig @@ -9893,7 +9980,7 @@ end (** Operations hashes / IDs. *) include S.HASH end -# 100 "v14.in.ml" +# 102 "v14.in.ml" module Operation_list_hash : sig @@ -9926,7 +10013,7 @@ end (** Blocks hashes / IDs. *) include S.MERKLE_TREE with type elt = Operation_hash.t end -# 102 "v14.in.ml" +# 104 "v14.in.ml" module Operation_list_list_hash : sig @@ -9959,7 +10046,7 @@ end (** Blocks hashes / IDs. *) include S.MERKLE_TREE with type elt = Operation_list_hash.t end -# 104 "v14.in.ml" +# 106 "v14.in.ml" module Protocol_hash : sig @@ -9992,7 +10079,7 @@ end (** Protocol hashes / IDs. *) include S.HASH end -# 106 "v14.in.ml" +# 108 "v14.in.ml" module Context_hash : sig @@ -10045,7 +10132,7 @@ end type version = Version.t end -# 108 "v14.in.ml" +# 110 "v14.in.ml" module Sapling : sig @@ -10193,7 +10280,7 @@ module Verification : sig val final_check : t -> UTXO.transaction -> string -> bool end end -# 110 "v14.in.ml" +# 112 "v14.in.ml" module Timelock : sig @@ -10250,7 +10337,7 @@ val open_chest : chest -> chest_key -> time:int -> opening_result Used for gas accounting*) val get_plaintext_size : chest -> int end -# 112 "v14.in.ml" +# 114 "v14.in.ml" module Vdf : sig @@ -10338,7 +10425,7 @@ val prove : discriminant -> challenge -> difficulty -> result * proof @raise Invalid_argument when inputs are invalid *) val verify : discriminant -> challenge -> difficulty -> result -> proof -> bool end -# 114 "v14.in.ml" +# 116 "v14.in.ml" module Micheline : sig @@ -10398,7 +10485,7 @@ val annotations : ('l, 'p) node -> string list val strip_locations : (_, 'p) node -> 'p canonical end -# 116 "v14.in.ml" +# 118 "v14.in.ml" module Block_header : sig @@ -10455,7 +10542,7 @@ type t = {shell : shell_header; protocol_data : bytes} include S.HASHABLE with type t := t and type hash := Block_hash.t end -# 118 "v14.in.ml" +# 120 "v14.in.ml" module Bounded : sig @@ -10604,7 +10691,7 @@ module Int8 (B : BOUNDS with type ocaml_type := int) : module Uint8 (B : BOUNDS with type ocaml_type := int) : S with type ocaml_type := int end -# 120 "v14.in.ml" +# 122 "v14.in.ml" module Fitness : sig @@ -10638,7 +10725,7 @@ end compared in a lexicographical order (longer list are greater). *) include S.T with type t = bytes list end -# 122 "v14.in.ml" +# 124 "v14.in.ml" module Operation : sig @@ -10682,7 +10769,7 @@ type t = {shell : shell_header; proto : bytes} include S.HASHABLE with type t := t and type hash := Operation_hash.t end -# 124 "v14.in.ml" +# 126 "v14.in.ml" module Context : sig @@ -11319,7 +11406,7 @@ module Cache : and type key = cache_key and type value = cache_value end -# 126 "v14.in.ml" +# 128 "v14.in.ml" module Updater : sig @@ -11848,7 +11935,7 @@ end not complete until [init] in invoked. *) val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t end -# 128 "v14.in.ml" +# 130 "v14.in.ml" module RPC_context : sig @@ -12002,7 +12089,7 @@ val make_opt_call3 : 'i -> 'o option shell_tzresult Lwt.t end -# 130 "v14.in.ml" +# 132 "v14.in.ml" module Context_binary : sig @@ -12045,7 +12132,7 @@ module Tree : val make_empty_context : ?root:string -> unit -> t end -# 132 "v14.in.ml" +# 134 "v14.in.ml" module Wasm_2_0_0 : sig @@ -12119,7 +12206,7 @@ module Make val get_info : Tree.tree -> info Lwt.t end end -# 134 "v14.in.ml" +# 136 "v14.in.ml" module Plonk : sig @@ -12238,7 +12325,7 @@ val scalar_array_encoding : scalar array Data_encoding.t on the given [inputs] according to the [public_parameters]. *) val verify : public_parameters -> verifier_inputs -> proof -> bool end -# 136 "v14.in.ml" +# 138 "v14.in.ml" module Dal : sig @@ -12387,7 +12474,7 @@ val verify_shard : | `Shard_index_out_of_range of string ] ) Result.t end -# 138 "v14.in.ml" +# 140 "v14.in.ml" module Skip_list : sig @@ -12619,7 +12706,7 @@ module Make (_ : sig val basis : int end) : S end -# 140 "v14.in.ml" +# 142 "v14.in.ml" module Smart_rollup : sig @@ -12676,6 +12763,6 @@ module Inbox_hash : S.HASH (** Smart rollup merkelized payload hashes' hash *) module Merkelized_payload_hashes_hash : S.HASH end -# 142 "v14.in.ml" +# 144 "v14.in.ml" end diff --git a/src/lib_protocol_environment/sigs/v14/bitset.mli b/src/lib_protocol_environment/sigs/v14/bitset.mli new file mode 100644 index 0000000000000000000000000000000000000000..5acb09d0f0c477d57ec7f9a76771eb9f696707a4 --- /dev/null +++ b/src/lib_protocol_environment/sigs/v14/bitset.mli @@ -0,0 +1,81 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +open Error_monad + +(** A bitset is a compact structure to store a set of integers. *) +type t + +type error += Bitset_invalid_position of int | Bitset_invalid_input of string + +val encoding : t Data_encoding.t + +(** A bitset encoding the empty set. *) +val empty : t + +(** [is_empty i] is [true] if [i] is empty. *) +val is_empty : t -> bool + +(** [equal i j] is [true] if [i] and [j] are identical. *) +val equal : t -> t -> bool + +(** [mem bitset i] returns [true] iff [i] has been added in [bitset]. + + This functions returns [Invalid_position i] if [i] is negative. *) +val mem : t -> int -> bool tzresult + +(** [add bitset i] returns a new bitset which contains [i] in + addition to the previous integers of [bitset]. + + This functions returns [Invalid_position i] if [i] is negative. *) +val add : t -> int -> t tzresult + +(** [remove bitset i] returns a new bitset in which [i] is + removed from [bitset]. + + This functions returns [Invalid_position i] if [i] is negative. *) +val remove : t -> int -> t tzresult + +(** [from_list positions] folds [add] over the [positions] starting from [empty]. + This function returns [Invalid_position i] if [i] is negative and appears in + [positions]. *) +val from_list : int list -> t tzresult + +(** [to_list t] returns the list of integers in the bitset. *) +val to_list : t -> int list + +(** [fill ~length] is equivalent to setting all bits for positions in [0, length + - 1] to one, or to [from_list (0 -- size-1)], or to [from_z ((2 ^ length) - + 1)]. But it's more efficient than folding on individual positions to set + them. + + The function returns [Invalid_input "fill"] if [length] is negative. +*) +val fill : length:int -> t tzresult + +(** [inter set_l set_r] returns [set] which is result of the + intersection of [set_l] and [set_r]. *) +val inter : t -> t -> t + +(** [diff set_l set_r] returns a bitset containing integers in [set_l] that are + not in [set_r]. *) +val diff : t -> t -> t + +(** [occupied_size_in_bits bitset] returns the current number of bits + occupied by the [bitset]. *) +val occupied_size_in_bits : t -> int + +(** [cardinat bitset] returns the number of elements in the [bitsest]. *) +val cardinal : t -> int + +(** [to_z t] returns the sum of powers of two of the integers in the given + bitset. *) +val to_z : t -> Z.t + +(** [from_z] builds a bitset from its integer representation. Returns + [Invalid_input "from_z"] if the given argument is negative. *) +val from_z : Z.t -> t tzresult diff --git a/src/proto_020_PsParisC/lib_protocol/test/pbt/dune b/src/proto_020_PsParisC/lib_protocol/test/pbt/dune index c40fe06e083d06890854fdba20d9838595b8fc1b..b9f8b326215a654814f6586a4b619231120e6d67 100644 --- a/src/proto_020_PsParisC/lib_protocol/test/pbt/dune +++ b/src/proto_020_PsParisC/lib_protocol/test/pbt/dune @@ -51,7 +51,6 @@ test_script_comparison test_script_roundtrip test_tez_repr - test_bitset test_sc_rollup_tick_repr test_sc_rollup_encoding test_sc_rollup_inbox diff --git a/src/proto_020_PsParisC/lib_protocol/test/pbt/test_bitset.ml b/src/proto_020_PsParisC/lib_protocol/test/pbt/test_bitset.ml deleted file mode 100644 index a3a5e86b8cce33988758c20cade5b428c14c52ea..0000000000000000000000000000000000000000 --- a/src/proto_020_PsParisC/lib_protocol/test/pbt/test_bitset.ml +++ /dev/null @@ -1,125 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Testing - ------- - Component: Protocol Library - Invocation: dune exec src/proto_020_PsParisC/lib_protocol/test/pbt/main.exe \ - -- --file test_bitset.ml - Subject: Bitset structure -*) - -open Qcheck2_helpers -open Protocol.Bitset - -let gen_ofs = QCheck2.Gen.int_bound (64 * 10) - -let value_of res = - match res with - | Ok v -> v - | Error e -> - Alcotest.failf - "An unxpected error %a occurred when generating Bitset.t" - Environment.Error_monad.pp_trace - e - -let gen_storage = - let open QCheck2.Gen in - let* int_vector = list @@ int_bound 64 in - from_list int_vector |> value_of |> return - -let test_get_set (c, ofs) = - List.for_all - (fun ofs' -> - let open Result_syntax in - value_of - @@ let* c' = add c ofs in - let* v = mem c ofs' in - let* v' = mem c' ofs' in - return (if ofs = ofs' then v' = true else v = v')) - (0 -- 63) - -let test_inter (c1, c2) = - let c3 = inter c1 c2 in - List.for_all - (fun ofs -> - let open Result_syntax in - value_of - @@ let* v1 = mem c1 ofs in - let* v2 = mem c2 ofs in - let* v3 = mem c3 ofs in - return ((v1 && v2) = v3)) - (0 -- 63) - -let test_diff (c1, c2) = - let c3 = diff c1 c2 in - List.for_all - (fun ofs -> - let open Result_syntax in - value_of - @@ let* v1 = mem c1 ofs in - let* v2 = mem c2 ofs in - let* v3 = mem c3 ofs in - return ((v1 && not v2) = v3)) - (0 -- 63) - -let test_fill = - let two = Z.of_int 2 in - fun length -> - let f1 = fill ~length |> value_of |> to_z in - let f2 = from_list (0 -- (length - 1)) |> value_of |> to_z in - let f3 = Z.(pow two length |> pred) in - Z.equal f1 f2 && Z.equal f2 f3 - -let () = - Alcotest.run - ~__FILE__ - Protocol.name - [ - ( "quantity", - qcheck_wrap - [ - QCheck2.Test.make - ~count:10000 - ~name:"get set" - QCheck2.Gen.(pair gen_storage gen_ofs) - test_get_set; - QCheck2.Test.make - ~count:10000 - ~name:"inter" - QCheck2.Gen.(pair gen_storage gen_storage) - test_inter; - QCheck2.Test.make - ~count:10000 - ~name:"diff" - QCheck2.Gen.(pair gen_storage gen_storage) - test_diff; - QCheck2.Test.make - ~count:10000 - ~name:"fill" - QCheck2.Gen.(small_nat) - test_fill; - ] ); - ] diff --git a/src/proto_021_PsQuebec/lib_protocol/test/pbt/dune b/src/proto_021_PsQuebec/lib_protocol/test/pbt/dune index 95457df148fb44895800b05bf52930eedffa540b..d255e0aa89133c9c5a60c9e2e308b12c980cbba6 100644 --- a/src/proto_021_PsQuebec/lib_protocol/test/pbt/dune +++ b/src/proto_021_PsQuebec/lib_protocol/test/pbt/dune @@ -51,7 +51,6 @@ test_script_comparison test_script_roundtrip test_tez_repr - test_bitset test_sc_rollup_tick_repr test_sc_rollup_encoding test_sc_rollup_inbox diff --git a/src/proto_021_PsQuebec/lib_protocol/test/pbt/test_bitset.ml b/src/proto_021_PsQuebec/lib_protocol/test/pbt/test_bitset.ml deleted file mode 100644 index 8a82f19f889ad16f1dc71b888c098e76f84627a3..0000000000000000000000000000000000000000 --- a/src/proto_021_PsQuebec/lib_protocol/test/pbt/test_bitset.ml +++ /dev/null @@ -1,133 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Testing - ------- - Component: Protocol Library - Invocation: dune exec src/proto_021_PsQuebec/lib_protocol/test/pbt/main.exe \ - -- --file test_bitset.ml - Subject: Bitset structure -*) - -open Qcheck2_helpers -open Protocol.Bitset - -let gen_ofs = QCheck2.Gen.int_bound (64 * 10) - -let value_of res = - match res with - | Ok v -> v - | Error e -> - Alcotest.failf - "An unxpected error %a occurred when generating Bitset.t" - Environment.Error_monad.pp_trace - e - -let gen_storage = - let open QCheck2.Gen in - let* int_vector = list @@ int_bound 64 in - from_list int_vector |> value_of |> return - -let test_get_set (c, ofs) = - List.for_all - (fun ofs' -> - let open Result_syntax in - value_of - @@ let* c' = add c ofs in - let* v = mem c ofs' in - let* v' = mem c' ofs' in - return (if ofs = ofs' then v' = true else v = v')) - (0 -- 63) - -let test_inter (c1, c2) = - let c3 = inter c1 c2 in - List.for_all - (fun ofs -> - let open Result_syntax in - value_of - @@ let* v1 = mem c1 ofs in - let* v2 = mem c2 ofs in - let* v3 = mem c3 ofs in - return ((v1 && v2) = v3)) - (0 -- 63) - -let test_diff (c1, c2) = - let c3 = diff c1 c2 in - List.for_all - (fun ofs -> - let open Result_syntax in - value_of - @@ let* v1 = mem c1 ofs in - let* v2 = mem c2 ofs in - let* v3 = mem c3 ofs in - return ((v1 && not v2) = v3)) - (0 -- 63) - -let test_fill = - let two = Z.of_int 2 in - fun length -> - let all_pos = 0 -- (length - 1) in - let f1 = fill ~length |> value_of |> to_z in - let f2_t = from_list all_pos |> value_of in - let all_pos_found = to_list f2_t in - let f2 = to_z f2_t in - let f3 = Z.(pow two length |> pred) in - Check.( - (List.sort Int.compare all_pos = List.sort Int.compare all_pos_found) - (list int) - ~__LOC__ - ~error_msg:"Expected %L, Found %R") ; - Z.equal f1 f2 && Z.equal f2 f3 - -let () = - Alcotest.run - ~__FILE__ - Protocol.name - [ - ( "quantity", - qcheck_wrap - [ - QCheck2.Test.make - ~count:10000 - ~name:"get set" - QCheck2.Gen.(pair gen_storage gen_ofs) - test_get_set; - QCheck2.Test.make - ~count:10000 - ~name:"inter" - QCheck2.Gen.(pair gen_storage gen_storage) - test_inter; - QCheck2.Test.make - ~count:10000 - ~name:"diff" - QCheck2.Gen.(pair gen_storage gen_storage) - test_diff; - QCheck2.Test.make - ~count:10000 - ~name:"fill" - QCheck2.Gen.(small_nat) - test_fill; - ] ); - ] diff --git a/src/proto_alpha/lib_dal/dal_plugin_registration.ml b/src/proto_alpha/lib_dal/dal_plugin_registration.ml index 6dccd347025d9373a121a20f0156380871abf636..fcaa9588658fe0619b6d7a612b585ac5741552b9 100644 --- a/src/proto_alpha/lib_dal/dal_plugin_registration.ml +++ b/src/proto_alpha/lib_dal/dal_plugin_registration.ml @@ -33,7 +33,7 @@ module Plugin = struct type block_info = Protocol_client_context.Alpha_block_services.block_info - type dal_attestation = Bitset.t + type dal_attestation = Environment.Bitset.t let parametric_constants chain block ctxt = let cpctxt = new Protocol_client_context.wrap_rpc_context ctxt in @@ -143,7 +143,7 @@ module Plugin = struct ( Slot.to_int consensus_content.slot, delegate_opt, (Option.map (fun d -> d.attestation) dal_content - :> Bitset.t option) ) + :> Environment.Bitset.t option) ) | _ -> None) consensus_ops @@ -168,10 +168,12 @@ module Plugin = struct ~none: (TzTrace.make @@ Layer1_services.Cannot_read_block_metadata block.hash) in - return (metadata.protocol_data.dal_attestation :> Bitset.t) + return (metadata.protocol_data.dal_attestation :> Environment.Bitset.t) let is_attested attestation slot_index = - match Bitset.mem attestation slot_index with Ok b -> b | Error _ -> false + match Environment.Bitset.mem attestation slot_index with + | Ok b -> b + | Error _ -> false (* Section of helpers for Skip lists *) diff --git a/src/proto_alpha/lib_delegate/baking_actions.ml b/src/proto_alpha/lib_delegate/baking_actions.ml index 827a64e16fdf9dcb779372591aac832471af392a..617def10e474ee566bd51bb375d1d34dd7aa1187 100644 --- a/src/proto_alpha/lib_delegate/baking_actions.ml +++ b/src/proto_alpha/lib_delegate/baking_actions.ml @@ -499,7 +499,9 @@ let process_dal_rpc_result state delegate level round = slots in let*! () = - let bitset_int = Bitset.to_z (dal_attestation :> Bitset.t) in + let bitset_int = + Environment.Bitset.to_z (dal_attestation :> Environment.Bitset.t) + in Events.( emit attach_dal_attestation diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index d311c93e36a1b74472a592c606efa9ba72ae7f80..42da71c8808d8230e413c7ffc59417c87378eb48 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -15,7 +15,6 @@ "Block_payload_hash", "Sc_rollup_reveal_hash", "Merkle_list", - "Bitset", "Bounded_history_repr", "Context_binary_proof", "Ratio_repr", diff --git a/src/proto_alpha/lib_protocol/bitset.ml b/src/proto_alpha/lib_protocol/bitset.ml deleted file mode 100644 index 9d803d7f1a154060d2fa6e7f3925256557a478bd..0000000000000000000000000000000000000000 --- a/src/proto_alpha/lib_protocol/bitset.ml +++ /dev/null @@ -1,79 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 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. *) -(* *) -(*****************************************************************************) - -type t = Z.t - -type error += Invalid_position of int - -let encoding = Data_encoding.z - -let empty = Z.zero - -let mem field pos = - let open Result_syntax in - let* () = error_when Compare.Int.(pos < 0) (Invalid_position pos) in - return @@ Z.testbit field pos - -let add field pos = - let open Result_syntax in - let* () = error_when Compare.Int.(pos < 0) (Invalid_position pos) in - return @@ Z.logor field Z.(shift_left one pos) - -let from_list positions = List.fold_left_e add empty positions - -let to_list field = - let[@tailrec] rec to_list pos acc field = - if Z.equal Z.zero field then acc - else - let acc = if Z.testbit field 0 then pos :: acc else acc in - to_list (pos + 1) acc (Z.shift_right field 1) - in - to_list 0 [] field - -let fill ~length = - let open Result_syntax in - let* () = error_when Compare.Int.(length < 0) (Invalid_position length) in - return Z.(pred (shift_left one length)) - -let inter = Z.logand - -let diff b1 b2 = Z.logand b1 (Z.lognot b2) - -let () = - let open Data_encoding in - register_error_kind - `Permanent - ~id:"bitfield_invalid_position" - ~title:"Invalid bitfield’s position" - ~description:"Bitfields does not accept negative positions" - (obj1 (req "position" int31)) - (function Invalid_position i -> Some i | _ -> None) - (fun i -> Invalid_position i) - -let occupied_size_in_bits = Z.numbits - -let hamming_weight = Z.popcount - -let to_z z = z diff --git a/src/proto_alpha/lib_protocol/bitset.mli b/src/proto_alpha/lib_protocol/bitset.mli deleted file mode 100644 index 1872caa6e576a5f878e8a2b4606360634986bb49..0000000000000000000000000000000000000000 --- a/src/proto_alpha/lib_protocol/bitset.mli +++ /dev/null @@ -1,80 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 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. *) -(* *) -(*****************************************************************************) - -(** A bitset is a compact structure to store a set of integers. *) -type t - -type error += Invalid_position of int - -val encoding : t Data_encoding.t - -(** A bitset encoding the empty set. *) -val empty : t - -(** [mem field i] returns [true] iff [i] has been added in [field]. - - This functions returns [Invalid_input i] if [i] is negative. *) -val mem : t -> int -> bool tzresult - -(** [add field i] returns a new bitset which contains [i] in - addition to the previous integers of [field]. - - This functions returns [Invalid_input i] if [i] is negative. *) -val add : t -> int -> t tzresult - -(** [from_list positions] folds [add] over the [positions] starting from [empty]. - This function returns [Invalid_input i] if [i] is negative and appears in - [positions]. *) -val from_list : int list -> t tzresult - -(** [to_list t] returns the list of int in the bitset. *) -val to_list : t -> int list - -(** [fill ~length] is equivalent to setting all bits for positions in - [0, length - 1] to [one]. i.e., to [from_list (0 -- size -1)] or to - [(2 ^ length) - 1]. But it's more efficient than folding on individual - positions to set them. - - The function returns [Invalid_position length] if [length] is negative. -*) -val fill : length:int -> t tzresult - -(** [inter set_l set_r] returns [set] which is result of the - intersection of [set_l] and [set_r]. *) -val inter : t -> t -> t - -(** [diff set_l set_r] returns a [set] containing fiels in [set_l] - that are not in [set_r]. *) -val diff : t -> t -> t - -(** [occupied_size_in_bits bitset] returns the current number of bits - occupied by the [bitset]. *) -val occupied_size_in_bits : t -> int - -(** [hamming_weight bitset] returns the Hamming weight of [bitset]. *) -val hamming_weight : t -> int - -(** [to_z t] Returns the sum of powers of two of the given bitset. *) -val to_z : t -> Z.t diff --git a/src/proto_alpha/lib_protocol/dal_attestation_repr.ml b/src/proto_alpha/lib_protocol/dal_attestation_repr.ml index 9472193bc912b66a6ca725c00129c7dc101c07ce..0daa88ff0fd3ff2a69825673b9a87ac963c5d749 100644 --- a/src/proto_alpha/lib_protocol/dal_attestation_repr.ml +++ b/src/proto_alpha/lib_protocol/dal_attestation_repr.ml @@ -78,7 +78,7 @@ let expected_size_in_bits ~max_index = | Error _ -> (* Happens if max_index < 1 *) 0 | Ok t -> occupied_size_in_bits t -let number_of_attested_slots = Bitset.hamming_weight +let number_of_attested_slots = Bitset.cardinal let intersection = Bitset.inter diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index 778020f50f67db380627e1fde94e9c41a3dd8ac9..9b62165e09d7ae33c50b2843a88bbb40aed51a50 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -45,7 +45,6 @@ Block_payload_hash Sc_rollup_reveal_hash Merkle_list - Bitset Bounded_history_repr Context_binary_proof Ratio_repr @@ -339,7 +338,6 @@ block_payload_hash.ml block_payload_hash.mli sc_rollup_reveal_hash.ml sc_rollup_reveal_hash.mli merkle_list.ml merkle_list.mli - bitset.ml bitset.mli bounded_history_repr.ml bounded_history_repr.mli context_binary_proof.ml context_binary_proof.mli ratio_repr.ml ratio_repr.mli @@ -638,7 +636,6 @@ block_payload_hash.ml block_payload_hash.mli sc_rollup_reveal_hash.ml sc_rollup_reveal_hash.mli merkle_list.ml merkle_list.mli - bitset.ml bitset.mli bounded_history_repr.ml bounded_history_repr.mli context_binary_proof.ml context_binary_proof.mli ratio_repr.ml ratio_repr.mli @@ -921,7 +918,6 @@ block_payload_hash.ml block_payload_hash.mli sc_rollup_reveal_hash.ml sc_rollup_reveal_hash.mli merkle_list.ml merkle_list.mli - bitset.ml bitset.mli bounded_history_repr.ml bounded_history_repr.mli context_binary_proof.ml context_binary_proof.mli ratio_repr.ml ratio_repr.mli diff --git a/src/proto_alpha/lib_protocol/test/pbt/dune b/src/proto_alpha/lib_protocol/test/pbt/dune index 63db6b9e6d8583fd3e3b1835c909b124b2156903..c8ac5b5342076ca4d07bd207fb14bf5fefeb9fc1 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/dune +++ b/src/proto_alpha/lib_protocol/test/pbt/dune @@ -51,7 +51,6 @@ test_script_comparison test_script_roundtrip test_tez_repr - test_bitset test_sc_rollup_tick_repr test_sc_rollup_encoding test_sc_rollup_inbox diff --git a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml index 58dd7b5f0768202bf329f03a843fbafccfc2c912..e31201bd2a53810a9881c0516bf6526053d7e466 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml @@ -2221,7 +2221,7 @@ module Stake_storage_tests = struct match level_and_bitset_opt with | Some (existing_level, bitset) when Raw_level_repr.(existing_level = level) -> - let*?@ is_set = Bitset.mem bitset message_index in + let*?@ is_set = Environment.Bitset.mem bitset message_index in Assert.equal_bool ~loc is_set true | _ -> Stdlib.failwith "Expected a bitset and a matching level." diff --git a/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml b/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml index eb4198d69171504a27d4b6ba44ca0aa0e2edc213..00e77dac8784dc13a97930af4e027f60f9ea5db6 100644 --- a/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml +++ b/src/proto_alpha/lib_sc_rollup_node/dal_slots_tracker.ml @@ -106,10 +106,9 @@ let slots_info constants node_ctxt (Layer1.{hash; _} as head) = published_slots_indexes) in let*? confirmed_slots_indexes = - Environment.wrap_tzresult - (confirmed_slots_indexes_list - |> List.map Dal.Slot_index.to_int - |> Bitset.from_list) + confirmed_slots_indexes_list + |> List.map Dal.Slot_index.to_int + |> Bitset.from_list in return @@ Some {published_block_hash; confirmed_slots_indexes} @@ -129,17 +128,12 @@ let download_and_save_slots constants (node_context : _ Node_context.t) let open Lwt_result_syntax in let*? all_slots = Bitset.fill ~length:constants.Rollup_constants.dal.number_of_slots - |> Environment.wrap_tzresult in let*? not_confirmed = - Environment.wrap_tzresult - @@ to_slot_index_list constants + to_slot_index_list constants @@ Bitset.diff all_slots confirmed_slots_indexes in - let*? confirmed = - Environment.wrap_tzresult - @@ to_slot_index_list constants confirmed_slots_indexes - in + let*? confirmed = to_slot_index_list constants confirmed_slots_indexes in (* The contents of each slot index are written to a different location on disk, therefore calls to store contents for different slot indexes can be parallelized. *)