Source file HashSet.ml

# 1 "Table.cppo.ml"
(******************************************************************************)
(*                                                                            *)
(*                                   Hachis                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* This code can implement either a hash set or a hash map. We refer to this
   data structure in a neutral way as a "table". *)

(* If the table is a set, then we refer to the set's elements as keys. *)

(* If the table is a map, then we refer to the elements of the domain as
   keys, and we refer to the elements of the codomain as values. *)

# 1 "Signatures.cppo.ml"
(******************************************************************************)
(*                                                                            *)
(*                                   Hachis                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

module type HashedType = sig

  (**A type of elements (in a hash set) or keys (in a hash map). *)
  type t

  (**An equivalence test on keys. The function [equal x y] returns
     [true] if and only if the keys [x] and [y] are equivalent. It is
     up to the user to define an equivalence relation on keys. In the
     simplest and most common case, equivalence is just equality. *)
  val equal : t -> t -> bool

  (**A hash function on keys. This function must be compatible with
     equivalence: that is, it must be the case that [equiv x y] implies
     [hash x = hash y]. *)
  val hash  : t -> int

end

module type SENTINELS = sig

  (**A type of elements (in a hash set) or keys (in a hash map). *)
  type t

  (**A sentinel value is a special value that must never be supplied as an
     argument to an operation such as [add] or [find]. A non-sentinel value
     [x] satisfies [x != void && x != tomb]. The sentinel values [void] and
     [tomb] must be distinct: that is, [void != tomb] must hold. *)
  val void : t

  (**A sentinel value is a special value that must never be supplied as an
     argument to an operation such as [add] or [find]. A non-sentinel value
     [x] satisfies [x != void && x != tomb]. The sentinel values [void] and
     [tomb] must be distinct: that is, [void != tomb] must hold. *)
  val tomb : t

end

module type ARRAY = sig

  (**The type of elements. *)
  type element

  (**The type of arrays. *)
  type t

  (**[empty] is the empty array. *)
  val empty : t

  (**[make n x] returns a new array of length [n], where every slot contains
     the value [x]. *)
  val make : int -> element -> t

  (**[copy a] returns a new array whose length and content are those of
     the array [a]. *)
  val copy : t -> t

  (**[length a] returns the length of the array [a]. *)
  val length : t -> int

  (**[unsafe_get a i] returns the element found at index [i] in the array
     [a]. {b The index [i] must be valid}. *)
  val unsafe_get : t -> int -> element

  (**[unsafe_set a i x] writes the value [x] at index [i] in the array
     [a]. {b The index [i] must be valid}. *)
  val unsafe_set : t -> int -> element -> unit

  (**[fill a o k x] fills the array segment identified by array [a],
     offset [o], and length [k] with the value [x]. *)
  val fill : t -> int -> int -> element -> unit

end

module type SET = sig

  (**The type of the elements of a set. *)
  type element

  (**The type of sets. At all times, a set [s] contains at most one element of
     each equivalence class: that is, [mem s x] and [mem s y] and [equiv x y]
     imply [x = y]. *)
  type set

  (**[t] is a synonym for [set]. *)
  type t = set

  (** {2 Creation} *)

  (**[create()] creates a fresh empty set.

     Time complexity: {m O(1)}. *)
  val create : unit -> set

  (**[copy s] returns a new set whose elements are the elements of [s].

     Time complexity: {m O(c)},
     where {m c} is the capacity of the set [s]. *)
  val copy : set -> set

  (** {2 Insertion} *)

  (**We provide two insertion functions,
     namely {!add_if_absent} and {!replace}.

     If equivalence implies equality (that is, if [equal x y] implies that
     [x] and [y] cannot be distinguished) then {!add_if_absent} and
     {!replace} behave in the same way.

     Otherwise, {!add_if_absent} and {!replace} behave differently. Suppose
     that [x] and [y] are two distinct yet equivalent elements. If [y] is
     already present in the set [s], then [add_if_absent s x] has no effect,
     whereas [replace s x] replaces [y] with [x] in the set [s]. *)

  (**If [x] or some equivalent element is a member of the set [s], then
     [add_if_absent s x] has no effect and returns [false]. Otherwise,
     [add_if_absent s x] inserts the element [x] into the set [s] and
     returns [true].

     Thus, [add_if_absent s x] returns [true] if and only if the cardinality
     of the set [s] increases as a result of this operation.

     If necessary, the capacity of the set [s] is increased.

     Time complexity: the cost of an insertion operation is often {m O(1)};
     however, if the capacity of the set must be increased, it is {m O(n)}.
     Because this costly event is infrequent, the amortized complexity of
     insertion is {m O(\log n)}. *)
  val add_if_absent : set -> element -> bool

  (**If some element that is equivalent to [x] is present in the set [s],
     then [replace s x] removes this pre-existing element, inserts [x]
     into the set [s], and returns [false]. Otherwise, [replace s x]
     inserts [x] into the set [s] and returns [true].

     Thus, [replace s x] returns [true] if and only if the cardinality of
     the set [s] increases as a result of this operation.

     If necessary, the capacity of the set [s] is increased.

     Time complexity: the cost of an insertion operation is often {m O(1)};
     however, if the capacity of the set must be increased, it is {m O(n)}.
     Because this costly event is infrequent, the amortized complexity of
     insertion is {m O(\log n)}. *)
  val replace : set -> element -> bool

  (** {2 Lookup} *)

  (**[mem s x] determines whether the element [x], or some element [y] that
     is equivalent to [x], is a member of the set [s].

     Time complexity: {m O(1)}. *)
  val mem : set -> element -> bool

  (**[find s x] determines whether some element [y] that is equivalent to
     [x] is a member of the set [s]. If so, [y] is returned. Otherwise,
     [Not_found] is raised.

     Time complexity: {m O(1)}. *)
  val find : set -> element -> element

  (**If the set [s] has nonzero cardinality, then [choose s] returns
     an element of the set [s]. This element is chosen at random.
     Otherwise, [choose s] raises [Not_found].

     [choose] invokes [Random.int]. Two successive calls to [choose s]
     can return different results.

     Time complexity: {m O(c)} in the worst case
     and {m O(c/n)} in expectation,
     where {m c} is the capacity of the set [s]
     and {m n} is its cardinality.

     If the occupancy rate {m n/c} remains above a certain fixed
     threshold, then these bounds can be written under the form
     {m O(n)} in the worst case and {m O(1)} in expectation.

     If [choose] is used in a loop where elements are repeatedly removed
     then it is recommended to repeatedly call [tighten] so as to
     maintain a high occupancy rate. *)
  val choose : set -> element

  (** {2 Insertion and lookup} *)

  (**[find_else_add s x] determines whether some element [y] that is equivalent
     to [x] is a member of the set [s]. If so, [y] is returned. Otherwise, the
     element [x] is inserted into the set [s], and [Not_found] is raised.

     [find_else_add s x] is equivalent to
     [try find s x with Not_found -> ignore (add_if_absent s x); raise Not_found].

     Time complexity: the cost of an insertion operation is often {m O(1)};
     however, if the capacity of the set must be increased, it is {m O(n)}.
     Because this costly event is infrequent, the amortized complexity of
     insertion is {m O(\log n)}. *)
  val find_else_add : set -> element -> element

  (** {2 Deletion} *)

  (**If some element [y] that is equivalent to [x] is a member of the
     set [s], then [remove s x] removes [y] from the set [s].
     Otherwise, nothing happens.

     Time complexity: {m O(1)}. *)
  val remove : set -> element -> unit

  (**If some element [y] that is equivalent to [x] is a member of the set
     [s], then [find_and_remove s x] removes [y] from the set [s] and
     returns [y]. Otherwise, the set [s] is unaffected, and [Not_found] is
     raised.

     Time complexity: {m O(1)}. *)
  val find_and_remove : set -> element -> element

  (** {2 Iteration} *)

  (**[foreach_key f s] applies the user-supplied function [f] in turn to
     each element [x] of the set [s]. {b The function [f] must not
     modify the set [s]}: that is, no elements can be inserted or
     deleted while iteration is ongoing.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the set [s]. *)
  val foreach_key : (element -> unit) -> set -> unit

  (**[iter] is a synonym for [foreach_key]. *)
  val iter : (element -> unit) -> set -> unit

  (** {2 Cardinality} *)

  (**[cardinal s] returns the cardinality of the set [s],
     that is, the number of inhabitants of this set.

     Time complexity: {m O(1)}. *)
  val cardinal : set -> int

  (**[is_empty s] is equivalent to [cardinal s = 0].

     Time complexity: {m O(1)}. *)
  val is_empty : set -> bool

  (** {2 Cleanup} *)

  (**[clear s] empties the set [s]. The internal data array is retained,
     and is erased. Thus, the capacity of the set [s] is unchanged.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the set [s]. *)
  val clear : set -> unit

  (**[reset s] empties the set [s]. The internal data array is abandoned.
     Thus, the capacity of the set [s] is reset to a small constant.

     Time complexity: {m O(1)}. *)
  val reset : set -> unit

  (**[tighten s] decreases the capacity of the set [s], if necessary and if
     possible, so as to ensure that the occupancy rate {m n/c} is high enough.
     It guarantees either {m c = O(1)}, which means that the capacity is below
     a certain constant, or {m c = O(n)}, which means that the occupancy rate
     is above a certain constant.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the set [s].

     In the case where there is nothing to do, [tighten] has constant cost.
     Thus, the amortized complexity of a call to [tighten],
     in a loop where elements are repeatedly removed,
     is {m O(\log n)}. *)
  val tighten : set -> unit

  (**[cleanup s] invokes [tighten s] and eliminates the tombstones that
     earlier deletion operations may have created in the internal data array.
     This can speed up future insertions and lookups.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the set [s]. *)
  val cleanup : set -> unit

  (** {2 Display} *)

  (**[show show_key s] returns a textual representation of the set [s].
     This representation is delimited with curly braces. Two consecutive
     elements are separated with a comma and a space. The user-supplied
     function [show_key] is used to obtain a textual representation of
     each element.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the set [s]. *)
  val show : (element -> string) -> set -> string

  (** {2 Statistics} *)

  (**[capacity s] returns the current capacity of the set [s], that is,
     the current size of its internal array.

     Time complexity: {m O(1)}. *)
  val capacity : set -> int

  (**[occupation s] returns the current occupation of the set [s],
     that is, the number of occupied entries in its internal data
     array. This number may be greater than [cardinal s].

     Time complexity: {m O(1)}. *)
  val occupation : set -> int

  (**Assume that the element [x] is present in the set [s]. We say that this
     element has {i search length} {m k} if the function call [mem s x]
     requires reading {m k+1} successive slots in the internal data array of
     the set [s]. In the best case, an element has search length 0. If there
     are collisions, then some elements have search length greater than 0.

     A present-key histogram for the set [s] is a finite association map that
     maps a natural integer {m k} to the number of elements of the set [s]
     that have search length {m k}. The cardinality of this histogram is
     {m n}, the cardinality of the set [s].

     The average search length should be a good a predictor of the cost of
     searching for an element that is present in the set.

     We say that the slot at index [i] in an internal data array has insertion
     length {m k} if finding the first empty slot, beginning at index [i],
     requires reading {m k+1} successive slots. An empty slot has insertion
     length 0. A nonempty slot has insertion length greater than 0.

     An absent-key histogram for the set [s] is a finite association map that
     maps a natural integer {m k} to the number of slots in the data array of
     the set [s] that have insertion length {m k}. The cardinality of this
     histogram is {m c}, the capacity of the set [s].

     The average insertion length should be a good a predictor of the cost of
     inserting an element that is not present in the set. *)
  type histogram = int Map.Make(Int).t

  (**[present_key_histogram s] returns a present-key histogram for the set [s].

     Time complexity: {m O(c \log c)},
     where {m c} is the capacity of the set [s]. *)
  val present_key_histogram : set -> histogram

  (**[absent_key_histogram s] returns an absent-key histogram for the set [s].

     Time complexity: {m O(c \log c)},
     where {m c} is the capacity of the set [s]. *)
  val absent_key_histogram : set -> histogram

  (**[average h] returns the average value of the histogram [h].

     Time complexity: {m O(n)},
     where {m n} is the cardinality of the histogram [h]. *)
  val average : histogram -> float

  (**[statistics s] returns a string of information about the set [s]. This
     information includes the cardinality, capacity, occupancy rate, average
     search length, present-key histogram, average insertion length, and
     absent-key histogram.

     Time complexity: {m O(c \log c)},
     where {m c} is the capacity of the set [s]. *)
  val statistics : set -> string

  (**/**)
  (* In debug builds, [check s] checks that the set's internal invariant
     holds. In release builds, [check s] has no effect. *)
  val check : set -> unit

end

module type MAP = sig

  (**The type of keys. *)
  type key

  (**The type of values. *)
  type value

  (**The type of maps. A map can be viewed as a set of pairs [(x, v)] of a
     key [x] and a value [v]. When a pair [(x, v)] exists in the map [m],
     we say that {i the key [x] is present with value [v]} in the map [m].
     At all times, a map [m] contains at most one key of each equivalence
     class: that is, [mem m x] and [mem m y] and [equiv x y] imply [x = y]. *)
  type map

  (**[t] is a synonym for [map]. *)
  type t = map

  (** {2 Creation} *)

  (**[create()] creates a fresh empty map.

     Time complexity: {m O(1)}. *)
  val create : unit -> map

  (**[copy m] returns a new map whose key-value bindings are those of [m].

     Time complexity: {m O(c)},
     where {m c} is the capacity of the map [m]. *)
  val copy : map -> map

  (** {2 Insertion} *)

  (**We provide two insertion functions,
     namely {!add_if_absent} and {!replace}.

     If equivalence implies equality (that is, if [equal x y] implies that
     [x] and [y] cannot be distinguished) then {!add_if_absent} and
     {!replace} behave in the same way.

     Otherwise, {!add_if_absent} and {!replace} behave differently. Suppose
     that [x] and [y] are two distinct yet equivalent keys. If [y] is
     already present in the map [m], then [add_if_absent m x v] has no
     effect, whereas [replace m x v] removes the key [y] (and its value)
     and inserts the key [x] with value [v] in the map [m]. *)

  (**If [x] or some equivalent key is present in the map [m], then
     [add_if_absent m x v] has no effect and returns [false]. Otherwise,
     [add_if_absent m x v] inserts the key [x] with value [v] into the map
     [m] and returns [true].

     Thus, [add_if_absent m x v] returns [true] if and only if the
     cardinality of the map [m] increases as a result of this operation.

     If necessary, the capacity of the map [m] is increased.

     Time complexity: the cost of an insertion operation is often {m O(1)};
     however, if the capacity of the map must be increased, it is {m O(n)}.
     Because this costly event is infrequent, the amortized complexity of
     insertion is {m O(\log n)}. *)
  val add_if_absent : map -> key -> value -> bool

  (**If some key that is equivalent to [x] is present in the map [m], then
     [replace m x v] removes this pre-existing key and its value, inserts
     the key [x] with value [v] into the map [m], and returns [false].
     Otherwise, [replace m x v] inserts the key [x] with value [v] into
     the map [m] and returns [true].

     Thus, [replace m x v] returns [true] if and only if the cardinality
     of the map [m] increases as a result of this operation.

     If necessary, the capacity of the map [m] is increased.

     Time complexity: the cost of an insertion operation is often {m O(1)};
     however, if the capacity of the map must be increased, it is {m O(n)}.
     Because this costly event is infrequent, the amortized complexity of
     insertion is {m O(\log n)}. *)
  val replace : map -> key -> value -> bool

  (** {2 Lookup} *)

  (**[mem m x] determines whether the key [x], or some key [y] that is
     equivalent to [x], is present in the map [m].

     Time complexity: {m O(1)}. *)
  val mem : map -> key -> bool

  (**[find_key m x] determines whether some key [y] that is equivalent
     to [x] is present in the map [m]. If so, [y] is returned.
     Otherwise, [Not_found] is raised.

     Time complexity: {m O(1)}. *)
  val find_key : map -> key -> key

  (**[find_value m x] determines whether some key [y] that is equivalent
     to [x] is present with value [v] in the map [m]. If so, [v] is
     returned. Otherwise, [Not_found] is raised.

     Time complexity: {m O(1)}. *)
  val find_value : map -> key -> value

  (**[find] is a synonym for [find_value]. *)
  val find : map -> key -> value

  (**If the map [m] has nonzero cardinality, then [choose m] returns
     a key that is present in the map [m]. This key is chosen at random.
     Otherwise, [choose m] raises [Not_found].

     [choose] invokes [Random.int]. Two successive calls to [choose m]
     can return different results.

     Time complexity: {m O(c)} in the worst case
     and {m O(c/n)} in expectation,
     where {m c} is the capacity of the map [m]
     and {m n} is its cardinality.

     If the occupancy rate {m n/c} remains above a certain fixed
     threshold, then these bounds can be written under the form
     {m O(n)} in the worst case and {m O(1)} in expectation.

     If [choose] is used in a loop where entries are repeatedly removed
     then it is recommended to repeatedly call [tighten] so as to
     maintain a high occupancy rate. *)
  val choose : map -> key

  (** {2 Insertion and lookup} *)

  (**[find_key_else_add m x] determines whether some key [y] that is
     equivalent to [x] is present in the map [m]. If so, [y] is returned.
     Otherwise, the key [x] with value [v] is inserted into the map [m],
     and [Not_found] is raised.

     [find_key_else_add m x v] is equivalent to
     [try find_key m x v with Not_found -> ignore (add_if_absent m x v); raise Not_found].

     Time complexity: the cost of an insertion operation is often {m O(1)};
     however, if the capacity of the map must be increased, it is {m O(n)}.
     Because this costly event is infrequent, the amortized complexity of
     insertion is {m O(\log n)}. *)
  val find_key_else_add : map -> key -> value -> key

  (**[find_value_else_add m x] determines whether some key [y] that is
     equivalent to [x] is present in the map [m] with value [v]. If
     so, [v] is returned. Otherwise, the key [x] with value [v] is
     inserted into the map [m], and [Not_found] is raised.

     [find_value_else_add m x v] is equivalent to
     [try find_value m x v with Not_found -> ignore (add_if_absent m x v); raise Not_found].

     Time complexity: the cost of an insertion operation is often {m O(1)};
     however, if the capacity of the map must be increased, it is {m O(n)}.
     Because this costly event is infrequent, the amortized complexity of
     insertion is {m O(\log n)}. *)
  val find_value_else_add : map -> key -> value -> value

  (** {2 Deletion} *)

  (**If some key [y] that is equivalent to [x] is present in the map [m],
     then [remove m x] removes [y] from the map [m]. Otherwise, nothing
     happens.

     Time complexity: {m O(1)}. *)
  val remove : map -> key -> unit

  (**If some key [y] that is equivalent to [x] is present in the map [m],
     then [find_key_and_remove m x] removes [y] from the map [m] and returns
     [y]. Otherwise, the map [m] is unaffected, and [Not_found] is raised.

     Time complexity: {m O(1)}. *)
  val find_key_and_remove : map -> key -> key

  (**If some key [y] that is equivalent to [x] is present with value [v] in
     the map [m], then [find_value_and_remove m x] removes [y] from the map
     [m] and returns [v]. Otherwise, the map [m] is unaffected, and
     [Not_found] is raised.

     Time complexity: {m O(1)}. *)
  val find_value_and_remove : map -> key -> value

  (** {2 Iteration} *)

  (**[foreach_key f m] applies the user-supplied function [f] in turn to
     each key [x] in the map [m]. {b The function [f] must not modify
     the map [m]}: that is, no key-value pairs can be inserted or
     deleted while iteration is ongoing.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the map [m]. *)
  val foreach_key : (key -> unit) -> map -> unit

  (**[foreach_key_value f m] applies the user-supplied function [f] in
     turn to each pair of a key [x] and value [v] in the map [m]. {b The
     function [f] must not modify the map [m]}: that is, no key-value
     pairs can be inserted or deleted while iteration is ongoing.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the map [m]. *)
  val foreach_key_value : (key -> value -> unit) -> map -> unit

  (**[iter] is a synonym for [foreach_key_value]. *)
  val iter : (key -> value -> unit) -> map -> unit

  (** {2 Cardinality} *)

  (**[cardinal m] returns the cardinality of the map [m],
     that is, the number of inhabitants of this map.

     Time complexity: {m O(1)}. *)
  val cardinal : map -> int

  (**[is_empty m] is equivalent to [cardinal m = 0].

     Time complexity: {m O(1)}. *)
  val is_empty : map -> bool

  (** {2 Cleanup} *)

  (**[clear m] empties the map [m]. The internal data arrays are retained,
     and are erased. Thus, the capacity of the map [m] is unchanged.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the map [m]. *)
  val clear : map -> unit

  (**[reset m] empties the map [m]. The internal data arrays are abandoned.
     Thus, the capacity of the map [m] is reset to a small constant.

     Time complexity: {m O(1)}. *)
  val reset : map -> unit

  (**[tighten m] decreases the capacity of the map [m], if necessary and if
     possible, so as to ensure that the occupancy rate {m n/c} is high enough.
     It guarantees either {m c = O(1)}, which means that the capacity is below
     a certain constant, or {m c = O(n)}, which means that the occupancy rate
     is above a certain constant.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the set [s].

     In the case where there is nothing to do, [tighten] has constant cost.
     Thus, the amortized complexity of a call to [tighten],
     in a loop where entries are repeatedly removed,
     is {m O(\log n)}. *)
  val tighten : map -> unit

  (**[cleanup m] invokes [tighten m] and eliminates the tombstones that
     earlier deletion operations may have created in the internal data array.
     This can speed up future insertions and lookups.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the map [m]. *)
  val cleanup : map -> unit

  (** {2 Display} *)

  (**[show show_key show_value m] returns a textual representation of
     the map [m]. The user-supplied functions [show_key] and
     [show_value] are used to obtain textual representations of keys
     and values.

     Time complexity: {m O(c)},
     where {m c} is the capacity of the map [m]. *)
  val show : (key -> string) -> (value -> string) -> map -> string

  (** {2 Statistics} *)

  (**[capacity m] returns the current capacity of the map [m], that is,
     the current size of its internal data arrays.

     Time complexity: {m O(1)}. *)
  val capacity : map -> int

  (**[occupation m] returns the current occupation of the map [m],
     that is, the number of occupied entries in its internal data
     arrays. This number may be greater than [cardinal m].

     Time complexity: {m O(1)}. *)
  val occupation : map -> int

  (**Assume that the key [x] is present in the map [m]. We say that this key
     has {i search length} {m k} if the function call [mem m x] requires
     reading {m k+1} successive slots in the internal data array of the map
     [m]. In the best case, a key has search length 0. If there are
     collisions, then some keys have search length greater than 0.

     A present-key histogram for the map [m] is a finite association map that
     maps a natural integer {m k} to the number in keys of the map [m] that
     have search length {m k}. The cardinality of this histogram is {m n}, the
     cardinality of the map [m].

     The average search length should be a good a predictor of the cost of
     searching for a key that is present in the map.

     We say that the slot at index [i] in an internal data array has insertion
     length {m k} if finding the first empty slot, beginning at index [i],
     requires reading {m k+1} successive slots. An empty slot has insertion
     length 0. A nonempty slot has insertion length greater than 0.

     An absent-key histogram for the map [m] is a finite association map that
     maps a natural integer {m k} to the number of slots in the data array of
     the map [m] that have insertion length {m k}. The cardinality of this
     histogram is {m c}, the capacity of the map [m].

     The average insertion length should be a good a predictor of the cost of
     inserting a key that is not present in the map. *)
  type histogram = int Map.Make(Int).t

  (**[present_key_histogram m] returns a present-key histogram for the map [m].

     Time complexity: {m O(c\log c)},
     where {m c} is the capacity of the map [m]. *)
  val present_key_histogram : map -> histogram

  (**[absent_key_histogram m] returns an absent-key histogram for the map [m].

     Time complexity: {m O(c \log c)},
     where {m c} is the capacity of the set [s]. *)
  val absent_key_histogram : map -> histogram

  (**[average h] returns the average value of the histogram [h].

     Time complexity: {m O(n)},
     where {m n} is the cardinality of the histogram [h]. *)
  val average : histogram -> float

  (**[statistics m] returns a string of information about the map [m]. This
     information includes the cardinality, capacity, occupancy rate, average
     search length, present-key histogram, average insertion length, and
     absent-key histogram.

     Time complexity: {m O(c \log c)},
     where {m c} is the capacity of the map [m]. *)
  val statistics : map -> string

  (**/**)
  (* In debug builds, [check m] checks that the map's internal invariant
     holds. In release builds, [check m] has no effect. *)
  val check : map -> unit

end

# 23 "Table.cppo.ml"
module[@inline] Make_
(H : HashedType)
(S : SENTINELS with type t = H.t)
(K : ARRAY with type element = H.t)
# 30 "Table.cppo.ml"
= struct
open H
open S

type key =
  K.element


# 42 "Table.cppo.ml"
(* Although [equal] is traditionally named [equal], it is really
   an equivalence test. We rename it to [equiv] internally. *)

let equiv : key -> key -> bool =
  equal

(* [ov] stands for nothing if the table is a set,
    and stands for [v] if the table is a map. *)

(* [ovalue] stands for nothing if the table is a set,
   and stands for [value] if the table is a map. *)


# 62 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* In the main [key] array, the content of each slot can be:

   + [void],   an empty slot;
   + [tomb],   a slot that was once occupied, but is now empty; or
   + [x],      a slot that currently contains the key [x]. *)

(* The difference between [void] and [tomb] is that [void] stops a search,
   whereas [tomb] does not. In other words, when searching linearly for a
   key [x], if an empty slot is encountered, then the search stops, as the
   data structure's invariant guarantees that [x] cannot appear beyond this
   empty slot; whereas if a tombstone is encountered, then the search
   continues, as [x] could appear beyond this tombstone. In other words, we
   maintain the following invariant: if [x] is in the table then it must
   appear between the index [start s x] and the first [void] slot. *)

(* Furthermore (this is optional), we maintain the invariant that a [tomb]
   slot is never followed with a [void] slot. To achieve this, in [remove],
   if the key that is being removed is followed with [void], then this key
   and all preceding tombstones are overwritten with [void]. This makes
   [remove] more costly but allows us to maintain a lower occupancy. *)

let forbid_tomb_void =
  true

(* Instead of using an algebraic data type, as follows:

     type content =
       | Void
       | Tomb
       | Key of key

   we represent [void] and [tomb] as two sentinels, that is, two special
   keys that the user is not allowed to insert into the table. This allows
   us to allocate fewer memory blocks and to use just an array of keys.

   We assume that a sentinel can be recognized using [==]. *)

type content =
  key

let[@inline] is_sentinel (c : content) =
  c == void || c == tomb

let[@inline] is_not_sentinel (c : content) =
  not (is_sentinel c)

(* A table is represented as follows. *)

type table = {
  (* The number of keys in the [key] array. *)
  mutable population : int;
  (* The number of keys and tombstones in the [key] array. *)
  mutable occupation : int;
  (* The capacity of the [key] array, minus one. *)
  mutable mask       : int;
  (* The key array. The length of this array is a power of two. *)
  mutable key        : K.t;
# 127 "Table.cppo.ml"
}

(* A hash code is an arbitrary integer. *)

type hash =
  int

(* An index into the [key] array. *)

type index =
  int

(* An array size. *)

type capacity =
  int

(* -------------------------------------------------------------------------- *)

(* Accessors. *)

(* The definition of occupancy is based on [s.occupation], which counts both
   empty slots and tombstones. This is required to ensure that every linear
   search terminates.

   Indeed, imagine what could happen if occupancy counted empty slots only.
   Imagine that the [key] array is filled with tombstones. Then, occupancy
   would be zero, yet every search would diverge, as it would never find an
   empty slot. *)

let[@inline] population (s : table) =
  s.population

let[@inline] occupation (s : table) =
  s.occupation

let[@inline] capacity (s : table) : capacity =
  K.length s.key

let[@inline] occupancy (s : table) : float =
  float (occupation s) /. float (capacity s)

(* -------------------------------------------------------------------------- *)

(* [index s h] converts the hash code [h] to an index into the [key] array. *)

let[@inline] index (s : table) (h : hash) : index =
  (* Because the length of the [key] array is a power of two,
     the desired index can be computed by keeping just the least
     significant bits of the hash code [h], as follows. *)
  h land s.mask

(* [start s x] is the index where a search for [x] begins. *)

let[@inline] start (s : table) (x : key) : index =
  index s (hash x)

(* [next s i] increments the index [i] into the [key] array,
   while handling wrap-around. *)

let[@inline] next (s : table) (i : index) : index =
  (i + 1) land s.mask

(* [prev s i] decrements the index [i] into the [key] array,
   while handling wrap-around. *)

let[@inline] prev (s : table) (i : index) : index =
  (i - 1) land s.mask

(* [is_index s i] checks that [i] is valid index into the [key ]array. *)

let[@inline] is_index (s : table) (i : index) : bool =
  0 <= i && i < capacity s

(* -------------------------------------------------------------------------- *)

(* The functions [is_power_of_two] and [check] are used only during testing.  *)

let rec is_power_of_two c =
  c = 1 || is_power_of_two (c / 2)

let check s =
  assert begin
    (* The table's capacity is a power of two. *)
    let capacity = capacity s in
    assert (0 < capacity);
    assert (is_power_of_two capacity);
    (* [s.mask] is [capacity - 1]. *)
    assert (s.mask = capacity - 1);
    (* The table's population and occupation cannot exceed its capacity. *)
    assert (0 <= s.population && s.population <= capacity);
    assert (0 <= s.occupation && s.occupation <= capacity);
    (* The table's population, [s.population], is the number of non-sentinel
       slots in the [key] array. The table's occupation, [s.occupation], is
       the number of non-void slots in the [key] array. *)
    let pop, occ = ref 0, ref 0 in
    for k = 0 to capacity - 1 do
      let content = K.unsafe_get s.key k in
      if content == void then
        ()
      else if content == tomb then begin
        incr occ;
        if forbid_tomb_void then
          (* [tomb] is never followed with [void]. *)
          assert (K.unsafe_get s.key (next s k) != void)
      end
      else begin
        incr occ; incr pop
      end
    done;
    assert (s.population = !pop);
    assert (s.occupation = !occ);
    (* The [value] array either has length zero or has the same length
       as the [key] array. (It is lazily allocated.) If the population
       is nonzero then both arrays must have the same length. *)
    
# 246 "Table.cppo.ml"
    true
  end

(* -------------------------------------------------------------------------- *)

(* Two parameters: initial capacity and maximal occupancy. *)

let initial_capacity =
  8

(* To avoid floating-point computations, we express [max_occupancy] as an
   integer value, which we multiply by 1/128. *)

let max_occupancy =
  105 (* 105/128 = 0.82 *)

(* [crowded] determines whether the table's maximum occupancy rate has
   been exceeded. It is paremeterized by the table's current occupation
   and capacity. *)

let[@inline] crowded occupation capacity =
  128 * occupation > max_occupancy * capacity

(* [full] determines whether the table is full. A table is full when
   it contains no [void] slots, that is, when its occupation equals
   its capacity. *)

let[@inline] full occupation capacity =
  occupation = capacity

(* [crowded_or_full] is the disjunction of the previous two criteria.
   See [possibly_grow] for an explanation of why we use two separate
   criteria. *)

let[@inline] crowded_or_full occupation capacity =
  crowded occupation capacity || full occupation capacity

(* -------------------------------------------------------------------------- *)

(* The value array is lazily allocated. *)


# 311 "Table.cppo.ml"
(* When [MAP] is defined, [POSSIBLY_ALLOCATE_VALUE_ARRAY] expands to
   [possibly_allocate_value_array s v]. Otherwise, it expands to nothing. *)


# 322 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* [zap s j] zaps slot [j].

   Slot [j] must contain a key, as opposed to a sentinel. *)

(* To zap a slot means to overwrite this slot with [tomb] or [void]. *)

(* Overwriting a slot with [void] is correct only if the next slot is
   [void] already. *)

(* [s.population] is not affected. *)

(* [s.occupation] is decreased by the number of [void] slots that we create. *)

(* The [value] array is unaffected. We tolerate garbage in it. *)

let zap s j =
  assert (is_index s j);
  assert (is_not_sentinel (K.unsafe_get s.key j));
  (* Test whether the next slot is void. *)
  if forbid_tomb_void && K.unsafe_get s.key (next s j) == void then begin
    (* The next slot is void. In order to maintain the invariant
       that [tomb] is never followed with [void], we must replace
       [x], as well as all previous tombstones, with [void]. *)
    K.unsafe_set s.key j void;
    let k = ref (prev s j) in
    let count = ref 1 in
    while K.unsafe_get s.key !k == tomb do
      K.unsafe_set s.key !k void;
      k := prev s !k;
      count := !count + 1
    done;
    (* [s.occupation] is decreased by the number of [void] slots
       that we have been able to recreate. *)
    s.occupation <- s.occupation - !count
  end
  else begin
    (* The next slot is not void, or we do not forbid [tomb] followed
       with [void]. Write a tombstone at index [j]. *)
    K.unsafe_set s.key j tomb
    (* [s.occupation] is unchanged. *)
  end

(* -------------------------------------------------------------------------- *)

(* A template for a search function. *)

(* The macro [SEARCH_WITH_ACCU(SELF, ACCU, ABSENT, PRESENT, ACCU')]
   defines a search function.

   [SELF] is the name of the function.

   The parameters of this function are:
   - the table [s];
   - the desired key [x];
   - the current index [j] of the search;
   - the optional accumulator [ACCU].

   [ACCU] is a formal parameter, and can be empty.

   [ABSENT] is executed if the key [x] is absent (not found).
   This code can refer to [s], [x], [j], [ACCU].

   [PRESENT] is executed if a key [y] that is equivalent to [x] is found.
   This code can refer to [s], [x], [j], [ACCU], and [y].

   The updated accumulator [ACCU'] is passed to the recursive calls.
   This code can refer to [s], [x], [j], [ACCU]. *)


# 418 "Table.cppo.ml"
(* The macro [SEARCH(SELF, ABSENT, PRESENT)]
   defines a search function without an accumulator. *)


# 425 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* Lookup functions. *)

(* These functions perform read-only access to the table, so they can safely
   be called by several concurrent threads. This is documented. Therefore,
   these functions *must not* use the search template [SEARCH2], which moves
   elements within the table, therefore performs write accesses. *)

(* [mem] determines whether the key [x] (or some equivalent key) is present
   in the table. It returns a Boolean result. *)

# 437 "Table.cppo.ml"



let rec mem (s : table) (x : key) (j : int)  =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    ( 
  false)
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    mem s x (next s j) 
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      ( 
  true
)
    else
      (* Skip this slot and continue searching. *)
      mem s x (next s j) 

 
 

# 442 "Table.cppo.ml"
(* [find_key] is analogous to [mem], but returns the key [y] that is found,
   and raises an exception if no key that is equivalent to [x] is found. *)

# 445 "Table.cppo.ml"



let rec find_key (s : table) (x : key) (j : int)  =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    ( 
  raise Not_found)
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    find_key s x (next s j) 
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      ( 
  y
)
    else
      (* Skip this slot and continue searching. *)
      find_key s x (next s j) 

 
 

# 450 "Table.cppo.ml"
(* [find_value] is analogous to [find_key], but returns the value associated
   with the key [y], instead of the key [y] itself. *)


# 462 "Table.cppo.ml"
(* [length] is analogous to [mem], but measures the length of the linear
   scan that is required to find [x]. It is used by [statistics]. *)

# 465 "Table.cppo.ml"


let rec length (s : table) (x : key) (j : int)  accu =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    (
  accu)
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    length s x (next s j) 
accu + 1
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      (
  accu)
    else
      (* Skip this slot and continue searching. *)
      length s x (next s j) 
accu + 1

 

# 470 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* Deletion functions. *)

(* [remove] searches for the key [x] (or some equivalent key). If a key
   [y] is found, then this key is removed. Otherwise, nothing happens. *)
(* The fields [s.population] and [s.occupation] are updated. *)
(* The [value] array is unaffected. We tolerate garbage in it. *)

# 479 "Table.cppo.ml"



let rec remove (s : table) (x : key) (j : int)  =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    ( 
  ())
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    remove s x (next s j) 
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      ( 
  (* If a key [y] that is equivalent to [x] is found at index [j],
     then we decrease the population, zap slot [j], and return [y]. *)
  s.population <- s.population - 1; zap s j
)
    else
      (* Skip this slot and continue searching. *)
      remove s x (next s j) 

 
 

# 486 "Table.cppo.ml"
(* [find_key_and_remove] is analogous to [remove], except the key [y]
   is returned (if such a key is found). Otherwise, an exception is
   raised. *)

# 490 "Table.cppo.ml"



let rec find_key_and_remove (s : table) (x : key) (j : int)  =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    ( 
  raise Not_found)
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    find_key_and_remove s x (next s j) 
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      ( 
  (* If a key [y] that is equivalent to [x] is found at index [j],
     then we decrease the population, zap slot [j], and return [y]. *)
  s.population <- s.population - 1; zap s j; y
)
    else
      (* Skip this slot and continue searching. *)
      find_key_and_remove s x (next s j) 

 
 


# 509 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* [choose s j] searches the table linearly, from index [j], and returns
   the first key that it finds. *)

(* The table must be nonempty; that is, its population must be nonzero. *)

let rec choose (s : table) (j : int) : key =
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void || c == tomb then
    (* Skip this slot and continue searching. *)
    choose s (next s j)
  else
    let y = c in
    (* Return this key. *)
    y

(* -------------------------------------------------------------------------- *)

(* A template for a search function that remembers passing a tombstone,
   and comes back to this tombstone once the search ends. *)

(* Two functions are generated. They correspond to the two states of a
   simple state machine. In the initial state, which corresponds to the
   main function, no tombstone has been encountered yet. In the final
   state, which corresponds to the auxiliary function, a tombstone has
   been encountered, and its index [t] has been recorded. *)

(* In the final state, if the desired key is not found, then the search
   moves back to slot [t]. That is, [j] is set to [t] before [ABSENT] is
   executed. *)

(* In the final state, if the desired key is found, then the key [y] and
   its value are moved (copied) back to slot [t], and [j] is set to [t]
   before [PRESENT] is executed. *)

(* In either case, to an external observer, everything appears to work
   just as if the search had terminated at index [j]. The observer does
   not see that the search has gone further right and come back left. *)

(* The macro [SEARCH2(SELF, ABSENT, PRESENT)] defines a search function.

   [SELF] is the name of the main function.

   The parameters of this function are:
   - the table [s];
   - the desired key [x];
   - an optional value [ov];
   - the current index [j] of the search.

   [ABSENT] is executed if the key [x] is absent (not found).
   This code can refer to [s], [x], [ov], [j].
   This code can pretend that slot [j] in the [key] array contains [void]
   and *must* overwrite this slot with a key.
   This code must not update [s.occupation]; this is taken care of.
   This code can assume that the [value] array has been allocated.

   [PRESENT] is returned if a key [y] that is equivalent to [x] is found.
   This code can refer to [s], [x], [ov], [j], and [y].

   [CONCAT(SELF, _aux)] is the name of the auxiliary function.

   The parameters of this function are:
   - the table [s];
   - the desired key [x];
   - an optional value [ov];
   - the index [t] of the tombstone that has been encountered;
   - the current index [j] of the search. *)


# 654 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* The macro [WRITE] writes key [x] and value [v] at index [j]. *)

(* It assumes that the [value] array is allocated. *)


# 667 "Table.cppo.ml"
(* The macro [WRITE_AND_POPULATE] writes key [x] and value [v] at index [j]
   and increments [s.population]. *)

(* It assumes that the [value] array is allocated. *)


# 677 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* Insertion. *)

(* [add_if_absent] searches for the key [x] and inserts it if it is absent. *)
(* The Boolean result indicates whether [x] was inserted. *)
(* The fields [s.population] and [s.occupation] are updated. *)

(* If the table is a map, then the user supplies a value [v]
   in addition to the key [x], and this value is written to
   the [value] array. *)

# 689 "Table.cppo.ml"


let rec add_if_absent (s : table) (x : key)   (j : int) =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then begin
    (* This slot is void. *)
    (* [x] is not in the table. *)
    (* Update [s.occupation]. *)
    s.occupation <- s.occupation + 1;
    
    ()
 ;
    
  (* If [x] is not found, it is inserted at [j], and [true] is returned. *)
  
  s.population <- s.population + 1;
  
  K.unsafe_set s.key j x
 
 ; true
  end
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    (* Switch to the second state, where a tombstone at index [t]
       has been encountered. *)
    let t = j in
     add_if_absent_aux  s x   t (next s j)
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      (
  (* If [x] or an equivalent key is found, [false] is returned. *)
  ignore j; false
)
    else
      (* Skip this slot and continue searching. *)
      add_if_absent s x   (next s j)

and  add_if_absent_aux  (s : table) (x : key)   (t : int) (j : int) =
  assert (is_not_sentinel x);
  assert (is_index s t);
  assert (K.unsafe_get s.key t == tomb);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    (* Set [j] back down to [t]. *)
    (* Even though slot [t] still contains [tomb], it is now logically
       considered void. This slot will be overwritten by [ABSENT], so
       there is no need to actually write [void] into it. Also, there
       is no need to update [s.occupation], as [ABSENT] will overwrite
       the tombstone with a key. *)
    (* As we have seen a tombstone, the [value] array must be allocated. *)
    (let j = t in 
  (* If [x] is not found, it is inserted at [j], and [true] is returned. *)
  
  s.population <- s.population + 1;
  
  K.unsafe_set s.key j x
 
 ; true)
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
     add_if_absent_aux  s x   t (next s j)
  else
    let y = c in
    if equiv x y then begin
      (* We have found a key [y] that is equivalent to [x]. *)
      (* Move the key [y], and its value, from slot [j] down to slot [t],
         thereby overwriting the tombstone at [t]. Then, zap slot [j].
         Thus, the next search for [x] or [y] will be faster. Furthermore,
         this can turn one or more occupied slots back into void slots. *)
      K.unsafe_set s.key t y;
      zap s j;
      (* Move the index [j] back down to [t], and execute [PRESENT]. *)
      let j = t in 
  (* If [x] or an equivalent key is found, [false] is returned. *)
  ignore j; false

    end
    else
      (* Skip this slot and continue searching. *)
       add_if_absent_aux  s x   t (next s j)

 

# 696 "Table.cppo.ml"
(* In [add_if_absent], in case a tombstone is encountered, one might be
   tempted to always overwrite this tombstone with [x], then use [remove] to
   find and remove any key [y] that is equivalent to [x] and that is already
   a member of the table. However, this does not work. If the table already
   contains a key [y] that is equivalent to [x], then [add_if_absent] is
   expected to leave [y] in the table; it must not replace [y] with [x]. *)

(* [find_key_else_add] searches for [x] and inserts it if it is absent. *)
(* If [x] was absent then [Not_found] is raised after [x] is inserted. *)
(* If a key [y] is found then [y] is returned. *)

# 707 "Table.cppo.ml"


let rec find_key_else_add (s : table) (x : key)   (j : int) =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then begin
    (* This slot is void. *)
    (* [x] is not in the table. *)
    (* Update [s.occupation]. *)
    s.occupation <- s.occupation + 1;
    
    ()
 ;
    
  (* If [x] is not found, it is inserted at [j], and [Not_found] is raised. *)
  
  s.population <- s.population + 1;
  
  K.unsafe_set s.key j x
 
 ; raise Not_found
  end
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    (* Switch to the second state, where a tombstone at index [t]
       has been encountered. *)
    let t = j in
     find_key_else_add_aux  s x   t (next s j)
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      (
  (* If a key [y] that is equivalent to [x] is found, [y] is returned. *)
  ignore j; y
)
    else
      (* Skip this slot and continue searching. *)
      find_key_else_add s x   (next s j)

and  find_key_else_add_aux  (s : table) (x : key)   (t : int) (j : int) =
  assert (is_not_sentinel x);
  assert (is_index s t);
  assert (K.unsafe_get s.key t == tomb);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    (* Set [j] back down to [t]. *)
    (* Even though slot [t] still contains [tomb], it is now logically
       considered void. This slot will be overwritten by [ABSENT], so
       there is no need to actually write [void] into it. Also, there
       is no need to update [s.occupation], as [ABSENT] will overwrite
       the tombstone with a key. *)
    (* As we have seen a tombstone, the [value] array must be allocated. *)
    (let j = t in 
  (* If [x] is not found, it is inserted at [j], and [Not_found] is raised. *)
  
  s.population <- s.population + 1;
  
  K.unsafe_set s.key j x
 
 ; raise Not_found)
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
     find_key_else_add_aux  s x   t (next s j)
  else
    let y = c in
    if equiv x y then begin
      (* We have found a key [y] that is equivalent to [x]. *)
      (* Move the key [y], and its value, from slot [j] down to slot [t],
         thereby overwriting the tombstone at [t]. Then, zap slot [j].
         Thus, the next search for [x] or [y] will be faster. Furthermore,
         this can turn one or more occupied slots back into void slots. *)
      K.unsafe_set s.key t y;
      zap s j;
      (* Move the index [j] back down to [t], and execute [PRESENT]. *)
      let j = t in 
  (* If a key [y] that is equivalent to [x] is found, [y] is returned. *)
  ignore j; y

    end
    else
      (* Skip this slot and continue searching. *)
       find_key_else_add_aux  s x   t (next s j)

 

# 714 "Table.cppo.ml"
(* [find_value_else_add] searches for [x] and inserts it if it is absent. *)
(* If [x] was absent then [Not_found] is raised after [x] is inserted. *)
(* If a key is found then the corresponding value is returned. *)


# 730 "Table.cppo.ml"
(* [replace] always inserts the key [x] with value [v], possibly overwriting
   a previous key and value. Thus, if no key that is equivalent to [x]
   exists, then [x] and [v] are inserted; otherwise, the previous key and
   value are replaced with [x] and [v]. *)

# 735 "Table.cppo.ml"


let rec replace (s : table) (x : key)   (j : int) =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then begin
    (* This slot is void. *)
    (* [x] is not in the table. *)
    (* Update [s.occupation]. *)
    s.occupation <- s.occupation + 1;
    
    ()
 ;
    
  (* If [x] is not found, it is inserted at [j]. *)
  
  s.population <- s.population + 1;
  
  K.unsafe_set s.key j x
 
 ; true
  end
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
    (* Switch to the second state, where a tombstone at index [t]
       has been encountered. *)
    let t = j in
     replace_aux  s x   t (next s j)
  else
    let y = c in
    if equiv x y then
      (* We have found a key [y] that is equivalent to [x]. *)
      (
  (* If [x] or an equivalent key is found,
     [x] and the value [v] are written at [j]. *)
  
  K.unsafe_set s.key j x
 ; false
)
    else
      (* Skip this slot and continue searching. *)
      replace s x   (next s j)

and  replace_aux  (s : table) (x : key)   (t : int) (j : int) =
  assert (is_not_sentinel x);
  assert (is_index s t);
  assert (K.unsafe_get s.key t == tomb);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then
    (* This slot is void. *)
    (* [x] is not in the table. *)
    (* Set [j] back down to [t]. *)
    (* Even though slot [t] still contains [tomb], it is now logically
       considered void. This slot will be overwritten by [ABSENT], so
       there is no need to actually write [void] into it. Also, there
       is no need to update [s.occupation], as [ABSENT] will overwrite
       the tombstone with a key. *)
    (* As we have seen a tombstone, the [value] array must be allocated. *)
    (let j = t in 
  (* If [x] is not found, it is inserted at [j]. *)
  
  s.population <- s.population + 1;
  
  K.unsafe_set s.key j x
 
 ; true)
  else if c == tomb then
    (* This slot is a tombstone. *)
    (* [x] might appear in the table beyond this tombstone. *)
    (* Skip this slot and continue searching. *)
     replace_aux  s x   t (next s j)
  else
    let y = c in
    if equiv x y then begin
      (* We have found a key [y] that is equivalent to [x]. *)
      (* Move the key [y], and its value, from slot [j] down to slot [t],
         thereby overwriting the tombstone at [t]. Then, zap slot [j].
         Thus, the next search for [x] or [y] will be faster. Furthermore,
         this can turn one or more occupied slots back into void slots. *)
      K.unsafe_set s.key t y;
      zap s j;
      (* Move the index [j] back down to [t], and execute [PRESENT]. *)
      let j = t in 
  (* If [x] or an equivalent key is found,
     [x] and the value [v] are written at [j]. *)
  
  K.unsafe_set s.key j x
 ; false

    end
    else
      (* Skip this slot and continue searching. *)
       replace_aux  s x   t (next s j)

 

# 743 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* [add_absent_no_updates] is a special case of [add_if_absent], where:

   + we assume that [x] is not in the table;
   + we assume that there are no tombstones;
   + the fields [s.population] and [s.occupation] are NOT updated. *)

(* [x] is always inserted. No Boolean result is returned. *)

(* This auxiliary function is used by [resize] and by [elim]. *)

let rec add_absent_no_updates (s : table) (x : key) 
# 755 "Table.cppo.ml"
                                                      
# 755 "Table.cppo.ml"
                                                       (j : int) =
  assert (is_not_sentinel x);
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  assert (c != tomb);
  if c == void then begin
    
# 761 "Table.cppo.ml"
    
    ()
 
# 761 "Table.cppo.ml"
                                 ;
    
# 762 "Table.cppo.ml"
    
  K.unsafe_set s.key j x
 
  
# 763 "Table.cppo.ml"
  end
  else
    let y = c in
    assert (not (equiv x y));
    add_absent_no_updates s x 
# 767 "Table.cppo.ml"
                                
# 767 "Table.cppo.ml"
                                 (next s j)

(* -------------------------------------------------------------------------- *)

(* [resize s new_capacity] allocates a new key array whose capacity is
   [new_capacity]. Then, it copies the content of the old key array to
   the new one. All tombstones disappear in the process. *)

(* [new_capacity] must be a power of two, and must be large enough to
   ensure that (once all tombstones have disappeared) the table is not
   crowded. *)

(* The [value] array is resized in a similar way. *)

let resize (s : table) (new_capacity : capacity) =
  assert (is_power_of_two new_capacity);
  assert (not (crowded_or_full s.population new_capacity));
  let old_key = s.key in
  
# 788 "Table.cppo.ml"
  let old_capacity = capacity s in
  s.mask <- new_capacity - 1;
  (* Resize the [key] array. *)
  s.key <- K.make new_capacity void;
  (* Resize the [value] array, unless its length is zero. *)
  
# 801 "Table.cppo.ml"
  (* At this point, [s] is a valid empty table, except for the [population]
     and [occupation] fields. *)
  (* Every key of the old key array must now be inserted into [s]. Each
     insertion operation inserts a new key (one that is not already
     present), and no tombstones can be encountered. Also, the [population]
     and [occupation] fields need not be updated. Thus, [add_absent_no_updates]
     is used. *)
  for k = 0 to old_capacity - 1 do
    let c = K.unsafe_get old_key k in
    if is_not_sentinel c then
      let x = c in
      
# 817 "Table.cppo.ml"
      add_absent_no_updates s x 
# 817 "Table.cppo.ml"
                                  
# 817 "Table.cppo.ml"
                                   (start s x)
  done;
  (* The population is unchanged. There are no tombstones any more,
     so [s.occupation] now coincides with [s.population]. *)
  s.occupation <- s.population

(* -------------------------------------------------------------------------- *)

(* [find_void_slot] searches for a void slot (there always exists one) and
   returns its index. It is used by [elim] and by one of the histogram
   construction functions. *)

let rec find_void_slot (s : table) (j : index) : index =
  assert (is_index s j);
  let c = K.unsafe_get s.key j in
  if c == void then j else find_void_slot s (next s j)

let[@inline] find_void_slot (s : table) : index =
  (* We start at index 0, but could start anywhere. *)
  find_void_slot s 0

(* -------------------------------------------------------------------------- *)

(* Eliminating tombstones, in place, in the [key] array. *)

(* Roughly speaking, all tombstones are turned into [void] slots, and all
   keys that used to follow a tombstone must be relocated. *)

(* We use a state machine with two states, as follows:

   - In state [void], we have encountered a void slot, followed with zero,
     one, or more keys. These keys can remain where they are; we skip them.

   - In state [tomb], we have encountered a run of one or more tombstones,
     which we have changed into void slots. We have then encountered zero,
     one, or more keys, which we have relocated.

   In the beginning, we look for an empty slot and record its index: this
   is the [origin] index. Then, we execute the state machine, beginning in
   state [void]. Once we reach [origin] again, after scanning the entire
   circular array, we stop. *)

let rec elim_void (s : table) (origin : index) (j : index) : unit =
  assert (is_index s origin);
  assert (K.unsafe_get s.key origin == void);
  assert (is_index s j);
  if origin <> j then
    let c = K.unsafe_get s.key j in
    if c == tomb then
      (* Overwrite this tombstone and switch to state [tomb]. *)
      write_elim_tomb s origin j
    else
      (* Continue in state [void]. *)
      elim_void s origin (next s j)

and write_elim_tomb (s : table) (origin : index) (j : index) : unit =
  assert (is_index s origin);
  assert (K.unsafe_get s.key origin == void);
  assert (is_index s j);
  assert (K.unsafe_get s.key j == tomb);
  (* Overwrite the tombstone at [j] with [void]. *)
  K.unsafe_set s.key j void;
  (* Continue at the next slot in state [tomb]. *)
  elim_tomb s origin (next s j)

and elim_tomb (s : table) (origin : index) (j : index) : unit =
  assert (is_index s origin);
  assert (K.unsafe_get s.key origin == void);
  assert (is_index s j);
  if origin <> j then
    let c = K.unsafe_get s.key j in
    if c == void then
      (* Switch to state [void]. *)
      elim_void s origin (next s j)
    else if c == tomb then
      (* Overwrite this tombstone and continue in state [tomb]. *)
      write_elim_tomb s origin j
    else
      (* The key [x] must be relocated. *)
      let x = c in
      (* Overwrite this slot, effectively removing [x] from the table,
         without updating [s.population] or [s.occupation]. *)
      K.unsafe_set s.key j void;
      (* Read the value [v] that is associated with [x]. *)
      
# 904 "Table.cppo.ml"
      (* Now relocate this key-value pair: insert key [x] with value [v]. *)
      (* This insertion reads and updates a part of the table that we have
         already scanned and where we have already eliminated all tombstones,
         between [origin] (excluded) and [j] (included). *)
      assert (
         origin < j && origin < start s x && start s x <= j
      || j < origin && (origin < start s x || start s x <= j)
      );
      add_absent_no_updates s x 
# 912 "Table.cppo.ml"
                                  
# 912 "Table.cppo.ml"
                                   (start s x);
      (* Continue in state [tomb]. *)
      elim_tomb s origin (next s j)

(* [elim] is the main entry point for the above state machine. *)

(* [elim s] eliminates all tombstones, in linear time, in place. *)

(* The cost of [elim s] is the cost of scanning the entire [key] array plus
   the cost of relocating (re-inserting) all of the keys that follow a
   tombstone. The keys that follow a void slot are not relocated, so do not
   contribute to the second term in this sum. *)

(* A much simpler way of implementing [elim] would be [resize s (capacity s)],
   which relocates all keys into a fresh key array. This simpler way is less
   efficient because it requires allocating a fresh array and relocating *all*
   keys. *)

let[@inline] elim (s : table) =
  (* Execute the state machine. *)
  let origin = find_void_slot s in
  elim_void s origin (next s origin);
  (* All tombstones are now gone. *)
  s.occupation <- s.population

(* -------------------------------------------------------------------------- *)

(* Growing and shrinking a table. *)

let[@inline] possibly_grow (s : table) =
  (* If the maximum occupancy is now exceeded, then the capacity of the [key]
     array must be increased. This is heuristic: keeping occupancy low allows
     us to keep the expected length of a linear search low. *)
  (* Furthermore, to ensure that every linear search terminates, one must
     guarantee that there is always at least one [void] slot in the [key]
     array. This is not heuristic: it is a hard requirement. *)
  (* We could enforce both conditions at once by imposing the constraint
     [max_occupancy + 1/capacity <= 1]. Then, the maximum occupancy check,
     alone, would ensure the existence of at least one [void] slot. We prefer
     to remove this constraint, at the cost of performing two tests. *)
  let o = occupation s
  and c = capacity s in
  if crowded_or_full o c then
    (* Double the capacity of the [key] array. *)
    resize s (2 * c);
  (* There must always remain at least one empty slot. Otherwise, searches
     would diverge. *)
  assert (s.occupation < capacity s)

(* [possibly_shrink s new_capacity] shrinks the capacity of the table
   to [new_capacity] or to a lower capacity. *)

(* We never shrink a table below [initial_capacity], as that would be
   counter-productive. *)

(* To determine whether the capacity [new_capacity] can be safely divided
   by two, we use [crowded_or_full]. We apply this test to [s.population],
   as opposed to [s.occupation], because if the table is shrunk, then all
   tombstones will disappear. Hence, the current tombstones should not be
   taken into account when determining whether the shrunk table would be
   crowded. *)

let rec possibly_shrink (s : table) (new_capacity : capacity) =
  assert (is_power_of_two new_capacity);
  assert (initial_capacity <= new_capacity);
  assert (new_capacity <= capacity s);
  if new_capacity = initial_capacity
  || crowded_or_full s.population (new_capacity / 2) then begin
    (* The capacity cannot be divided by two. If it is less than the
       current capacity, then the table must be resized. Otherwise,
       there is nothing to do. *)
    if new_capacity < capacity s then
      resize s new_capacity
  end
  else
    (* The capacity can be divided by two. *)
    possibly_shrink s (new_capacity / 2)

(* -------------------------------------------------------------------------- *)

(* Public functions. *)

let create () =
  let capacity = initial_capacity in
  let population = 0
  and occupation = 0
  and mask = capacity - 1
  and key = K.make capacity void
  
# 1003 "Table.cppo.ml"
  in
  { population; occupation; mask; key; 
# 1004 "Table.cppo.ml"
                                         
# 1004 "Table.cppo.ml"
                                              }

let[@inline] validate (x : key) =
  assert (is_not_sentinel x)
    (* We use an assertion that is erased in release mode.
       If we wanted this module to be more defensive, we
       could keep a defensive test in release mode. *)

let[@inline] mem (s : table) (x : key) : bool =
  validate x;
  mem s x (start s x)

let[@inline] find_key (s : table) (x : key) : key =
  validate x;
  find_key s x (start s x)


# 1028 "Table.cppo.ml"
let choose (s : table) : key =
  if population s = 0 then
    raise Not_found
  else
    (* Pick an index at random, and search from there. *)
    let j = Random.int (capacity s) in
    choose s j

let[@inline] length (s : table) (x : key) : int =
  (* No need to validate [x]; this function is private. *)
  length s x (start s x) 0

let[@inline] tighten (s : table) =
  possibly_shrink s (capacity s)

let cleanup (s : table) =
  (* First, shrink the table, if its occupation is sufficiently low. *)
  tighten s;
  (* Then, if the table contains any tombstones (which can be the case
     only if the table was not shrunk above), scan the [key] array and
     eliminate all tombstones. *)
  if s.occupation > s.population then
    elim s

let add_if_absent (s : table) (x : key) 
# 1052 "Table.cppo.ml"
                                          
# 1052 "Table.cppo.ml"
                                           : bool =
  validate x;
  let was_added = add_if_absent s x 
# 1054 "Table.cppo.ml"
                                      
# 1054 "Table.cppo.ml"
                                       (start s x) in
  if was_added then possibly_grow s;
  was_added

let find_key_else_add (s : table) (x : key) 
# 1058 "Table.cppo.ml"
                                              
# 1058 "Table.cppo.ml"
                                               =
  validate x;
  try
    find_key_else_add s x 
# 1061 "Table.cppo.ml"
                            
# 1061 "Table.cppo.ml"
                             (start s x)
  with Not_found as e ->
    possibly_grow s;
    raise e


# 1078 "Table.cppo.ml"
let replace (s : table) (x : key) 
# 1078 "Table.cppo.ml"
                                    
# 1078 "Table.cppo.ml"
                                     : bool =
  validate x;
  let was_added = replace s x 
# 1080 "Table.cppo.ml"
                                
# 1080 "Table.cppo.ml"
                                 (start s x) in
  if was_added then possibly_grow s;
  was_added

let[@inline] remove (s : table) (x : key) : unit =
  validate x;
  remove s x (start s x)

let[@inline] find_key_and_remove (s : table) (x : key) : key =
  validate x;
  find_key_and_remove s x (start s x)


# 1100 "Table.cppo.ml"
let clear (s : table) =
  s.population <- 0;
  s.occupation <- 0;
  K.fill s.key 0 (capacity s) void
  (* The [value] array is unaffected. We tolerate garbage in it. *)

let reset (s : table) =
  let capacity = initial_capacity in
  let population = 0
  and occupation = 0
  and mask = capacity - 1
  and key = K.make capacity void in
  s.population <- population;
  s.occupation <- occupation;
  s.mask <- mask;
  s.key <- key;
  
# 1119 "Table.cppo.ml"
  ()

(* One might ask whether [copy] should return an identical copy or
   construct a fresh hash set that does not contain any tombstones. We
   choose the first option, because it is simpler and more efficient;
   it does not require hashing. *)

let copy (s : table) : table =
  { s with
    key = K.copy s.key
  
# 1132 "Table.cppo.ml"
  }

let foreach_key f (s : table) =
  if s.population > 0 then
    for i = 0 to K.length s.key - 1 do
      let c = K.unsafe_get s.key i in
      if is_not_sentinel c then
        let x = c in
        f x
    done



# 1175 "Table.cppo.ml"
let show show_key (s : table) =
  let b = Buffer.create 32 in
  Buffer.add_string b "{";
  let first = ref true in
  foreach_key (fun x ->
    if not !first then Buffer.add_string b ", ";
    Buffer.add_string b (show_key x);
    first := false
  ) s;
  Buffer.add_string b "}";
  Buffer.contents b


# 1189 "Table.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* Statistics. *)

(* An integer histogram is a multiset of integers, that is, a finite map of
   integer values to multiplicities. *)

module IntMap =
  Map.Make(Int)

type multiplicity = int

type histogram =
  multiplicity IntMap.t

let multiplicity l (h : histogram) : multiplicity =
  try IntMap.find l h with Not_found -> 0

let insert l (h : histogram) : histogram =
  IntMap.add l (multiplicity l h + 1) h

let total_length (h : histogram) =
  IntMap.fold (fun l m accu -> m * l + accu) h 0

let total_multiplicity (h : histogram) =
  IntMap.fold (fun _ m accu -> m + accu) h 0

let average (h : histogram) : float =
  float (total_length h) /. float (total_multiplicity h)

let present_key_histogram (s : table) : histogram =
  let h = ref IntMap.empty in
  foreach_key (fun x ->
    (* Measure the length [l] of the search for [x]. *)
    let l = length s x in
    (* Increment the multiplicity of [l] in the histogram. *)
    h := insert l !h
  ) s;
  assert (total_multiplicity !h = population s);
  !h

let absent_key_histogram (s : table) : histogram =
  let h = ref IntMap.empty in
  (* Start a void slot; this is our [origin] slot. *)
  let origin = find_void_slot s in
  (* [record_void j] records in the histogram [h] the fact that slot [j] has
     insertion length 0, then moves on to the next slot. *)
  let rec record_void j =
    assert (is_index s j);
    assert (K.unsafe_get s.key j == void);
    h := insert 0 !h;
    scan_void (next s j)
  (* [scan_void j] scans the slot at index [j], with the knowledge that the
     previous slot was void. *)
  and scan_void j =
    assert (is_index s j);
    if origin <> j then
      let c = K.unsafe_get s.key j in
      if c == void then
        record_void j
      else
        scan_occupied 1 (next s j)
  (* [scan_occupied count j] scans the slot at index [j], with the knowledge
     that the previous [count] slots were occupied. *)
  and scan_occupied count j =
    assert (is_index s j);
    let c = K.unsafe_get s.key j in
    if c != void then
      scan_occupied (count + 1) (next s j)
    else
      (* We have just identified a run of [count] consecutive occupied slots.
         For each of them, add an entry to the histogram. The corresponding
         lengths are 1, 2, ..., [count]. *)
      let () = for l = 1 to count do h := insert l !h done in
      if origin <> j then
        record_void j
  in
  record_void origin;
  assert (total_multiplicity !h = capacity s);
  !h

open Printf

let have c =
  if c > 1 then "s have" else "  has "

let statistics (s : table) : string =
  let b = Buffer.create 128 in
  bprintf b "Population: %9d\n" (population s);
  bprintf b "Tombstones: %9d\n" (occupation s - population s);
  bprintf b "Capacity  : %9d\n" (capacity s);
  bprintf b "Occupancy : %.3f\n" (occupancy s);
  let h = present_key_histogram s in
  bprintf b "Average search length (present keys): %.3f\n" (average h);
  bprintf b "Search length histogram (present keys):\n";
  IntMap.iter (fun l m ->
    bprintf b
      "  %9d key%s search length %3d.\n"
      m (have m) l
  ) h;
  let h = absent_key_histogram s in
  bprintf b "Average insertion length (absent keys): %.3f\n" (average h);
  bprintf b "Insertion length histogram (absent keys):\n";
  IntMap.iter (fun l m ->
    bprintf b
      "  %9d slot%s insertion length %3d.\n"
      m (have m) l
  ) h;
  Buffer.contents b

(* -------------------------------------------------------------------------- *)

(* Final packaging. *)

(* Common names: *)

type t = table

let cardinal = population

let[@inline] is_empty s =
  cardinal s = 0


# 1323 "Table.cppo.ml"
(* [set]-specific names: *)

type element = key
type set = table

let find = find_key
let find_else_add = find_key_else_add
let find_and_remove = find_key_and_remove
let iter = foreach_key


# 1335 "Table.cppo.ml"
end

(* -------------------------------------------------------------------------- *)

(* [MonoArray(X)] creates a copy of [Stdlib.Array] that is specialized for
   array elements of type [X.t]. *)

module[@inline] MonoArray
(X : sig type t end)
: sig
  include ARRAY with type element = X.t
# 1349 "Table.cppo.ml"
end
= struct
  type element = X.t
  type t = element array
  let empty = [||]
  let make = Array.make
  let copy = Array.copy
  let length = Array.length
  let[@inline] unsafe_get (a : t) i = Array.unsafe_get a i
  let[@inline] unsafe_set (a : t) i x = Array.unsafe_set a i x
  let fill = Array.fill
end

(* -------------------------------------------------------------------------- *)

(* For people who want to apply the functor [_Make] to [Stdlib.Array] (twice),
   we propose a functor, [Make], that is easier to use. *)

module[@inline] Make
(H : HashedType)
(S : SENTINELS with type t = H.t)
# 1373 "Table.cppo.ml"
=
  Make_
    (H)
    (S)
    (MonoArray(H))