Repository: coq/coq
Pull request #20344: Hashconsing try to avoid recomputing hashes
Author: login: SkySkimmer
Labels: name: kind: performance
description: Improvements to performance and efficiency.
Created: 2025-03-11T14:29:17Z | Merged: 2025-03-14T08:08:09Z

Depends:
- #20340 


Diff:
diff --git a/clib/cSet.ml b/clib/cSet.ml
index 468bcb2962a4..f568821f4b3e 100644
--- a/clib/cSet.ml
+++ b/clib/cSet.ml
@@ -64,17 +64,20 @@ struct
   let set_prj : set -> _set = Obj.magic
   let set_inj : _set -> set = Obj.magic
 
+  (* equivalent sets may have different structure, so we don't hash and compare by
+     the actual structure but only by the list of elements *)
   let rec spine s accu = match set_prj s with
   | SEmpty -> accu
   | SNode (l, v, r, _) -> spine l ((v, r) :: accu)
 
-  let rec umap s = match set_prj s with
-  | SEmpty -> set_inj SEmpty
+  let rec umap hacc s = match set_prj s with
+  | SEmpty -> hacc, set_inj SEmpty
   | SNode (l, v, r, h) ->
-    let l' = umap l in
-    let r' = umap r in
-    let v' = H.hcons v in
-    set_inj (SNode (l', v', r', h))
+    let hacc, l' = umap hacc l in
+    let hv, v' = H.hcons v in
+    let hacc = Hashset.Combine.combine hacc hv in
+    let hacc, r' = umap hacc r in
+    hacc, set_inj (SNode (l', v', r', h))
 
   let rec eqeq s1 s2 = match s1, s2 with
   | [], [] -> true
@@ -84,11 +87,9 @@ struct
 
   module Hashed =
   struct
-    open Hashset.Combine
     type t = set
     let eq s1 s2 = s1 == s2 || eqeq (spine s1 []) (spine s2 [])
-    let hash s = Set.fold (fun v accu -> combine (H.hash v) accu) s 0
-    let hashcons = umap
+    let hashcons v = umap 0 v
   end
 
   include Hashcons.Make(Hashed)
diff --git a/clib/cString.ml b/clib/cString.ml
index 492e8a16e869..ba395b4bfbe2 100644
--- a/clib/cString.ml
+++ b/clib/cString.ml
@@ -10,33 +10,6 @@
 
 module type S = module type of String
 
-module type ExtS =
-sig
-  include S
-  val hash : string -> int
-  val is_empty : string -> bool
-  val explode : string -> string list
-  val implode : string list -> string
-  val drop_simple_quotes : string -> string
-  val quote_coq_string : string -> string
-  val unquote_coq_string : string -> string option
-  val html_escape : string -> string
-  val string_index_from : string -> int -> string -> int
-  val string_contains : where:string -> what:string -> bool
-  val plural : int -> string -> string
-  val lplural : _ list -> string -> string
-  val conjugate_verb_to_be : int -> string
-  val ordinal : int -> string
-  val is_sub : string -> string -> int -> bool
-  val is_prefix : string -> string -> bool
-  val is_suffix : string -> string -> bool
-  module Set : CSet.ExtS with type elt = t
-  module Map : CMap.ExtS with type key = t and module Set := Set
-  module Pred : Predicate.S with type elt = t
-  module List : CList.MonoS with type elt = t
-  val hcons : string -> string
-end
-
 include String
 
 let rec hash len s i accu =
@@ -194,9 +167,8 @@ end
 
 module Hstring = Hashcons.Make(struct
     type t = string
-    let hashcons s = s
+    let hashcons s = hash s, s
     let eq = String.equal
-    let hash = hash
   end)
 
 let hcons = Hashcons.simple_hcons Hstring.generate Hstring.hcons ()
diff --git a/clib/cString.mli b/clib/cString.mli
index ca3685d68f54..3b93b97be481 100644
--- a/clib/cString.mli
+++ b/clib/cString.mli
@@ -11,84 +11,78 @@
 (** Module type [S] is the one from OCaml Stdlib. *)
 module type S = module type of String
 
-module type ExtS =
-sig
-  include S
-  (** We include the standard library *)
+include S
+(** We include the standard library *)
 
-  (** Equality on strings *)
+(** Equality on strings *)
 
-  val hash : string -> int
-  (** Hashing on strings. Should be compatible with generic one. *)
+val hash : string -> int
+(** Hashing on strings. Should be compatible with generic one. *)
 
-  val is_empty : string -> bool
-  (** Test whether a string is empty. *)
+val is_empty : string -> bool
+(** Test whether a string is empty. *)
 
-  val explode : string -> string list
-  (** [explode "x1...xn"] returns [["x1"; ...; "xn"]] *)
+val explode : string -> string list
+(** [explode "x1...xn"] returns [["x1"; ...; "xn"]] *)
 
-  val implode : string list -> string
-  (** [implode [s1; ...; sn]] returns [s1 ^ ... ^ sn] *)
+val implode : string list -> string
+(** [implode [s1; ...; sn]] returns [s1 ^ ... ^ sn] *)
 
-  val drop_simple_quotes : string -> string
-  (** Remove the eventual first surrounding simple quotes of a string. *)
+val drop_simple_quotes : string -> string
+(** Remove the eventual first surrounding simple quotes of a string. *)
 
-  val quote_coq_string : string -> string
-  (** Quote a string according to Rocq conventions (i.e. doubling
-      double quotes and surrounding by double quotes) *)
+val quote_coq_string : string -> string
+(** Quote a string according to Rocq conventions (i.e. doubling
+    double quotes and surrounding by double quotes) *)
 
-  val unquote_coq_string : string -> string option
-  (** Unquote a quoted string according to Rocq conventions
-      (i.e. removing surrounding double quotes and undoubling double
-      quotes); returns [None] if not a quoted string *)
+val unquote_coq_string : string -> string option
+(** Unquote a quoted string according to Rocq conventions
+    (i.e. removing surrounding double quotes and undoubling double
+    quotes); returns [None] if not a quoted string *)
 
-  val html_escape : string -> string
-  (** replace HTML reserved characters with escape sequences,
-      e.g. `&` -> "&#38;" *)
+val html_escape : string -> string
+(** replace HTML reserved characters with escape sequences,
+    e.g. `&` -> "&#38;" *)
 
-  val string_index_from : string -> int -> string -> int
-  (** As [index_from], but takes a string instead of a char as pattern argument *)
+val string_index_from : string -> int -> string -> int
+(** As [index_from], but takes a string instead of a char as pattern argument *)
 
-  val string_contains : where:string -> what:string -> bool
-  (** As [contains], but takes a string instead of a char as pattern argument *)
+val string_contains : where:string -> what:string -> bool
+(** As [contains], but takes a string instead of a char as pattern argument *)
 
-  val plural : int -> string -> string
-  (** [plural n s] adds a optional 's' to the [s] when [2 <= n]. *)
+val plural : int -> string -> string
+(** [plural n s] adds a optional 's' to the [s] when [2 <= n]. *)
 
-  val lplural : _ list -> string -> string
-  (** [lplural l s] is [plural (List.length l) s]. *)
+val lplural : _ list -> string -> string
+(** [lplural l s] is [plural (List.length l) s]. *)
 
-  val conjugate_verb_to_be : int -> string
-  (** [conjugate_verb_to_be] returns "is" when [n=1] and "are" otherwise *)
+val conjugate_verb_to_be : int -> string
+(** [conjugate_verb_to_be] returns "is" when [n=1] and "are" otherwise *)
 
-  val ordinal : int -> string
-  (** Generate the ordinal number in English. *)
+val ordinal : int -> string
+(** Generate the ordinal number in English. *)
 
-  val is_sub : string -> string -> int -> bool
-  (** [is_sub p s off] tests whether [s] contains [p] at offset [off]. *)
+val is_sub : string -> string -> int -> bool
+(** [is_sub p s off] tests whether [s] contains [p] at offset [off]. *)
 
-  val is_prefix : string -> string -> bool
-  (** [is_prefix p s] tests whether [p] is a prefix of [s]. *)
+val is_prefix : string -> string -> bool
+(** [is_prefix p s] tests whether [p] is a prefix of [s]. *)
 
-  val is_suffix : string -> string -> bool
-  (** [is_suffix suf s] tests whether [suf] is a suffix of [s]. *)
+val is_suffix : string -> string -> bool
+(** [is_suffix suf s] tests whether [suf] is a suffix of [s]. *)
 
-  (** {6 Generic operations} **)
+(** {6 Generic operations} **)
 
-  module Set : CSet.ExtS with type elt = t
-  (** Finite sets on [string] *)
+module Set : CSet.ExtS with type elt = t
+(** Finite sets on [string] *)
 
-  module Map : CMap.ExtS with type key = t and module Set := Set
-  (** Finite maps on [string] *)
+module Map : CMap.ExtS with type key = t and module Set := Set
+(** Finite maps on [string] *)
 
-  module Pred : Predicate.S with type elt = t
+module Pred : Predicate.S with type elt = t
 
-  module List : CList.MonoS with type elt = t
-  (** Association lists with [string] as keys *)
+module List : CList.MonoS with type elt = t
+(** Association lists with [string] as keys *)
 
-  val hcons : string -> string
-  (** Hashconsing on [string] *)
-
-end
-
-include ExtS
+val hcons : string Hashcons.f
+(** Hashconsing on [string] *)
diff --git a/clib/hashcons.ml b/clib/hashcons.ml
index 42ab1e491890..f7fbad304205 100644
--- a/clib/hashcons.ml
+++ b/clib/hashcons.ml
@@ -10,34 +10,28 @@
 
 (* Hash consing of datastructures *)
 
+type 'a f = 'a -> int * 'a
+
 (* [t] is the type of object to hash-cons
- * [u] is the type of hash-cons functions for the sub-structures
- *   of objects of type t (u usually has the form (t1->t1)*(t2->t2)*...).
- * [hashcons u x] is a function that hash-cons the sub-structures of x using
- *   the hash-consing functions u provides.
+ * [hashcons x] is a function that hash-cons the sub-structures of x
  * [eq] is a comparison function. It is allowed to use physical equality
  *   on the sub-terms hash-consed by the hashcons function.
- * [hash] is the hash function given to the Hashtbl.Make function
- *
- * Note that this module type coerces to the argument of Hashtbl.Make.
  *)
 
 module type HashconsedType =
   sig
     type t
-    val hashcons : t -> t
+    val hashcons : t f
     val eq : t -> t -> bool
-    val hash : t -> int
   end
 
 module type HashconsedRecType = sig
   type t
 
-  val hashcons : (t -> t) -> t -> t
+  val hashcons : t f -> t f
 
   val eq : t -> t -> bool
 
-  val hash : t -> int
 end
 
 (** The output is a function [generate] such that [generate args] creates a
@@ -50,7 +44,7 @@ module type S =
     type t
     type table
     val generate : unit -> table
-    val hcons : table -> t -> t
+    val hcons : table -> t f
     val stats : table -> Hashset.statistics
   end
 
@@ -72,8 +66,8 @@ module Make (X : HashconsedType) : (S with type t = X.t) =
       tab
 
     let hcons tab x =
-      let y = X.hashcons x in
-      Htbl.repr (X.hash y) y tab
+      let h, y = X.hashcons x in
+      h, Htbl.repr h y tab
 
     let stats = Htbl.stats
 
@@ -92,8 +86,8 @@ struct
     tab
 
   let rec hcons tab x =
-    let y = X.hashcons (hcons tab) x in
-    Htbl.repr (X.hash y) y tab
+    let h, y = X.hashcons (hcons tab) x in
+    h, Htbl.repr h y tab
 
   let stats = Htbl.stats
 
@@ -112,10 +106,13 @@ let simple_hcons h f u =
 (* Basic hashcons modules for string and obj. Integers do not need be
    hashconsed.  *)
 
-module type HashedType = sig type t val hash : t -> int val hcons : t -> t end
+module type HashedType = sig
+  type t
+  val hcons : t f
+end
 
 (* list *)
-module Hlist (D:HashedType) =
+module Hlist (D:HashedType) : S with type t = D.t list =
   struct
     module X =
     struct
@@ -142,14 +139,20 @@ module Hlist (D:HashedType) =
       let h, l = match l with
       | [] -> 0, []
       | x :: l ->
+        let hx, x = D.hcons x in
         let h, l = hcons tab l in
-        let h = Hashset.Combine.combine (D.hash x) h in
-        h, D.hcons x :: l
+        let h = Hashset.Combine.combine hx h in
+        h, x :: l
       in
       h, Htbl.repr h l tab
 
-    let hcons data l = snd (hcons data l)
-
     let stats = Htbl.stats
 
   end
+
+let hashcons_array hcons a =
+  CArray.Smart.fold_left_map (fun acc x ->
+      let hx, x = hcons x in
+      Hashset.Combine.combine acc hx, x)
+    0
+    a
diff --git a/clib/hashcons.mli b/clib/hashcons.mli
index c333442f186c..1ce6f4594099 100644
--- a/clib/hashcons.mli
+++ b/clib/hashcons.mli
@@ -12,6 +12,9 @@
 
 (** {6 Hashconsing functorial interface} *)
 
+type 'a f = 'a -> int * 'a
+(** Type of hashconsing function for ['a]. The returned int is the hash. *)
+
 module type HashconsedType =
   sig
     (** {6 Generic hashconsing signature}
@@ -30,30 +33,26 @@ module type HashconsedType =
     type t
     (** Type of objects to hashcons. *)
 
-    val hashcons : t -> t
-    (** The actual hashconsing function, using its first argument to recursively
-        hashcons substructures. It should be compatible with [eq], that is
-        [eq x (hashcons f x) = true]. *)
+    val hashcons : t f
+    (** The actual hashconsing function. It should be compatible with [eq], that is
+        [eq x (snd @@ hashcons f x) = true]. It also returns the hash. *)
 
     val eq : t -> t -> bool
     (** A comparison function. It is allowed to use physical equality
         on the sub-terms hashconsed by the [hashcons] function, but it should be
-        insensible to shallow copy of the compared object. *)
-
-    val hash : t -> int
-    (** A hash function passed to the underlying hashtable structure. [hash]
-        should be compatible with [eq], i.e. if [eq x y = true] then
-        [hash x = hash y]. *)
+        insensible to shallow copy of the compared object.
+        It should be compatible with the hash returned by [hashcons], ie
+        [eq x y] implies [fst @@ hashcons x = fst @@ hashcons y].
+    *)
   end
 
 module type HashconsedRecType = sig
   type t
 
-  val hashcons : (t -> t) -> t -> t
+  val hashcons : t f -> t f
+  (** Hashcons the given constructor, calling the provided function on children. *)
 
   val eq : t -> t -> bool
-
-  val hash : t -> int
 end
 
 module type S =
@@ -67,8 +66,8 @@ module type S =
     val generate : unit -> table
     (** This create a hashtable of the hashconsed objects. *)
 
-    val hcons : table -> t -> t
-    (** Perform the hashconsing of the given object within the table. *)
+    val hcons : table -> t f
+    (** Perform the hashconsing of the given object within the table, and returns the hash. *)
 
     val stats : table -> Hashset.statistics
     (** Recover statistics of the hashconsing table. *)
@@ -86,12 +85,20 @@ module MakeRec (X : HashconsedRecType) : (S with type t = X.t)
 (** These are intended to be used together with instances of the [Make]
     functor. *)
 
-val simple_hcons : ('u -> 'tab) -> ('tab -> 't -> 't) -> 'u -> 't -> 't
+val simple_hcons : ('u -> 'tab) -> ('tab -> 't -> 'v) -> 'u -> 't -> 'v
 (** Typically used as [let hcons = simple_hcons H.generate H.hcons ()] where [H] is of type [S]. *)
 
 (** {6 Hashconsing of usual structures} *)
 
-module type HashedType = sig type t val hash : t -> int val hcons : t -> t end
+module type HashedType = sig
+  type t
+  val hcons : t f
+end
 
 module Hlist (D:HashedType) : (S with type t = D.t list)
 (** Hashconsing of lists.  *)
+
+val hashcons_array : 'v f -> 'v array f
+(** Helper for array hashconsing. Shares the elements producing a new
+    array if needed, does not mutate the array, does not share the
+    array itself. *)
diff --git a/kernel/constr.ml b/kernel/constr.ml
index c1a2c0ec0c7a..7df472f07385 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -1285,15 +1285,6 @@ and hash_branches bl =
 module CaseinfoHash =
 struct
   type t = case_info
-  let hashcons ci = { ci with ci_ind = hcons_ind ci.ci_ind }
-  let pp_info_equal info1 info2 =
-    info1.style == info2.style
-  let eq ci ci' =
-    ci.ci_ind == ci'.ci_ind &&
-    Int.equal ci.ci_npar ci'.ci_npar &&
-    Array.equal Int.equal ci.ci_cstr_ndecls ci'.ci_cstr_ndecls && (* we use [Array.equal] on purpose *)
-    Array.equal Int.equal ci.ci_cstr_nargs ci'.ci_cstr_nargs && (* we use [Array.equal] on purpose *)
-    pp_info_equal ci.ci_pp_info ci'.ci_pp_info  (* we use (=) on purpose *)
   open Hashset.Combine
   let hash_pp_info info =
     let h1 = match info.style with
@@ -1303,27 +1294,37 @@ struct
     | MatchStyle -> 3
     | RegularStyle -> 4 in
     h1
-  let hash ci =
-    let h1 = Ind.CanOrd.hash ci.ci_ind in
+  let hash ~hind ci =
+    let h1 = hind in
     let h2 = Int.hash ci.ci_npar in
     let h3 = Array.fold_left combine 0 ci.ci_cstr_ndecls in
     let h4 = Array.fold_left combine 0 ci.ci_cstr_nargs in
     let h5 = hash_pp_info ci.ci_pp_info in
     combine5 h1 h2 h3 h4 h5
+  let hashcons ci =
+    let hind, ind = hcons_ind ci.ci_ind in
+    hash ~hind ci, { ci with ci_ind = ind }
+  let pp_info_equal info1 info2 =
+    info1.style == info2.style
+  let eq ci ci' =
+    ci.ci_ind == ci'.ci_ind &&
+    Int.equal ci.ci_npar ci'.ci_npar &&
+    Array.equal Int.equal ci.ci_cstr_ndecls ci'.ci_cstr_ndecls && (* we use [Array.equal] on purpose *)
+    Array.equal Int.equal ci.ci_cstr_nargs ci'.ci_cstr_nargs && (* we use [Array.equal] on purpose *)
+    pp_info_equal ci.ci_pp_info ci'.ci_pp_info  (* we use (=) on purpose *)
 end
 
 module Hcaseinfo = Hashcons.Make(CaseinfoHash)
 
-let case_info_hash = CaseinfoHash.hash
-
 let hcons_caseinfo = Hashcons.simple_hcons Hcaseinfo.generate Hcaseinfo.hcons ()
 
 module Hannotinfo = struct
     type t = Name.t binder_annot
-    let hash = hash_annot Name.hash
     let eq = eq_annot (fun na1 na2 -> na1 == na2) Sorts.relevance_equal
-    let hashcons {binder_name=na;binder_relevance} =
-      {binder_name=Name.hcons na;binder_relevance}
+    let hashcons {binder_name=na;binder_relevance=r} =
+      let hna, na = Name.hcons na in
+      let h = Hashset.Combine.combinesmall (Sorts.relevance_hash r) hna in
+      h, {binder_name=na;binder_relevance=r}
   end
 module Hannot = Hashcons.Make(Hannotinfo)
 
@@ -1340,127 +1341,134 @@ module GenHCons(C:sig
     val via_hconstr : bool
 
     module Tbl : sig
-      val find_opt : t -> (constr * int) option
-      val add : t -> constr * int -> unit
+      val find_opt : t -> (int * constr) option
+      val add : t -> int * constr -> unit
     end
   end) = struct
 open C
 
 let steps = ref 0
 
-let rec hash_term (t : t) =
+(* XXX don't hashcons in place? *)
+let hcons_in_place hcons a a' =
+  let fold i accu x =
+    let hx, x = hcons x in
+    Array.unsafe_set a i x;
+    combine hx accu
+  in
+  let h = Array.fold_left_i fold 0 a' in
+  h
+
+let rec hash_term (t : t) : int * (constr,constr,_,_,_) kind_of_term =
   match kind t with
   | Var i ->
-    (Var (Id.hcons i), combinesmall 1 (Id.hash i))
+    let hi, i = Id.hcons i in
+    (combinesmall 1 hi, Var i)
   | Sort s ->
-    (Sort (Sorts.hcons s), combinesmall 2 (Sorts.hash s))
+    let hs, s = Sorts.hcons s in
+    (combinesmall 2 hs, Sort s)
   | Cast (c, k, t) ->
-    let c, hc = sh_rec c in
-    let t, ht = sh_rec t in
-    (Cast (c, k, t), combinesmall 3 (combine3 hc (hash_cast_kind k) ht))
+    let hc, c = sh_rec c in
+    let ht, t = sh_rec t in
+    (combinesmall 3 (combine3 hc (hash_cast_kind k) ht), Cast (c, k, t))
   | Prod (na,t,c) ->
-    let t, ht = sh_rec t
-    and c, hc = sh_rec c in
-    (Prod (hcons_annot na, t, c), combinesmall 4 (combine3 (hash_annot Name.hash na) ht hc))
+    let hna, na = hcons_annot na
+    and ht, t = sh_rec t
+    and hc, c = sh_rec c in
+    (combinesmall 4 (combine3 hna ht hc), Prod (na, t, c))
   | Lambda (na,t,c) ->
-    let t, ht = sh_rec t
-    and c, hc = sh_rec c in
-    (Lambda (hcons_annot na, t, c), combinesmall 5 (combine3 (hash_annot Name.hash na) ht hc))
+    let hna, na = hcons_annot na
+    and ht, t = sh_rec t
+    and hc, c = sh_rec c in
+    (combinesmall 5 (combine3 hna ht hc), Lambda (na, t, c))
   | LetIn (na,b,t,c) ->
-    let b, hb = sh_rec b in
-    let t, ht = sh_rec t in
-    let c, hc = sh_rec c in
-    (LetIn (hcons_annot na, b, t, c), combinesmall 6 (combine4 (hash_annot Name.hash na) hb ht hc))
+    let hna, na = hcons_annot na
+    and hb, b = sh_rec b
+    and ht, t = sh_rec t
+    and hc, c = sh_rec c in
+    (combinesmall 6 (combine4 hna hb ht hc), LetIn (na, b, t, c))
   | App (c,l) ->
     let _, cl = destApp (self t) in
-    let c, hc = sh_rec c in
-    let l, hl = hash_term_array cl l in
-    (App (c,l), combinesmall 7 (combine hl hc))
+    let hc, c = sh_rec c in
+    let hl, l = hash_term_array cl l in
+    (combinesmall 7 (combine hl hc), App (c,l))
   | Evar _ -> assert false
   | Const (c,u) ->
-    let c' = hcons_con c in
-    let u', hu = Instance.share u in
-    (Const (c', u'), combinesmall 9 (combine (Constant.SyntacticOrd.hash c) hu))
+    let hc, c' = hcons_con c in
+    let hu, u' = Instance.hcons u in
+    (combinesmall 9 (combine hc hu), Const (c', u'))
   | Ind (ind,u) ->
-    let u', hu = Instance.share u in
-    (Ind (hcons_ind ind, u'),
-     combinesmall 10 (combine (Ind.SyntacticOrd.hash ind) hu))
+    let hind, ind' = hcons_ind ind in
+    let hu, u' = Instance.hcons u in
+    (combinesmall 10 (combine hind hu), Ind (ind', u'))
   | Construct (c,u) ->
-    let u', hu = Instance.share u in
-    (Construct (hcons_construct c, u'),
-     combinesmall 11 (combine (Construct.SyntacticOrd.hash c) hu))
+    let hc, c' = hcons_construct c in
+    let hu, u' = Instance.hcons u in
+    (combinesmall 11 (combine hc hu), Construct (c', u'))
   | Case (ci,u,pms,(p,r),iv,c,bl) ->
     (** FIXME: use a dedicated hashconsing structure *)
     let hcons_ctx (lna, c) =
-      let () = Array.iteri (fun i x -> Array.unsafe_set lna i (hcons_annot x)) lna in
-      let fold accu na = combine (hash_annot Name.hash na) accu in
-      let hna = Array.fold_left fold 0 lna in
-      let c, hc = sh_rec c in
-      (lna, c), combine hna hc
+      let hna = hcons_in_place hcons_annot lna lna in
+      let hc, c = sh_rec c in
+      combine hna hc, (lna, c)
     in
-    let u, hu = Instance.share u in
-    let _,_,cpms,_,civ,_,_ = destCase (self t) in
-    let pms,hpms = hash_term_array cpms pms in
-    let p, hp = hcons_ctx p in
-    let iv, hiv = sh_invert civ iv in
-    let c, hc = sh_rec c in
-    let fold accu c =
-      let c, h = hcons_ctx c in
-      combine accu h, c
-    in
-    let hbl, bl = Array.fold_left_map fold 0 bl in
+    (* XXX use hci? *)
+    let _hci, ci = hcons_caseinfo ci in
+    let hu, u = Instance.hcons u in
+    let _,_,cpms,_,civ,_,cbl = destCase (self t) in
+    let hpms,pms = hash_term_array cpms pms in
+    let hp, p = hcons_ctx p in
+    let hiv, iv = sh_invert civ iv in
+    let hc, c = sh_rec c in
+    let hbl = hcons_in_place hcons_ctx cbl bl in
     let hbl = combine (combine hc (combine hiv (combine hpms (combine hu hp)))) hbl in
-    (Case (hcons_caseinfo ci, u, pms, (p,r), iv, c, bl), combinesmall 12 hbl)
+    (combinesmall 12 hbl, Case (ci, u, pms, (p,r), iv, c, cbl))
   | Fix (ln,(lna,tl,bl)) ->
     let _, (_,ctl,cbl) = destFix (self t) in
-    let bl,hbl = hash_term_array cbl bl in
-    let tl,htl = hash_term_array ctl tl in
-    let () = Array.iteri (fun i x -> Array.unsafe_set lna i (hcons_annot x)) lna in
-    let fold accu na = combine (hash_annot Name.hash na) accu in
-    let hna = Array.fold_left fold 0 lna in
+    let hbl,bl = hash_term_array cbl bl in
+    let htl,tl = hash_term_array ctl tl in
+    let hna = hcons_in_place hcons_annot lna lna in
     let h = combine3 hna hbl htl in
-    (Fix (ln,(lna,tl,bl)), combinesmall 13 h)
+    (combinesmall 13 h, Fix (ln,(lna,tl,bl)))
   | CoFix(ln,(lna,tl,bl)) ->
     let _, (_,ctl,cbl) = destCoFix (self t) in
-    let bl,hbl = hash_term_array cbl bl in
-    let tl,htl = hash_term_array ctl tl in
-    let () = Array.iteri (fun i x -> Array.unsafe_set lna i (hcons_annot x)) lna in
-    let fold accu na = combine (hash_annot Name.hash na) accu in
-    let hna = Array.fold_left fold 0 lna in
+    let hbl,bl = hash_term_array cbl bl in
+    let htl,tl = hash_term_array ctl tl in
+    let hna = hcons_in_place hcons_annot lna lna in
     let h = combine3 hna hbl htl in
-    (CoFix (ln,(lna,tl,bl)), combinesmall 14 h)
+    (combinesmall 14 h, CoFix (ln,(lna,tl,bl)))
   | Meta n as t ->
-    (t, combinesmall 15 n)
+    (combinesmall 15 n, t)
   | Rel n as t ->
-    (t, combinesmall 16 n)
+    (combinesmall 16 n, t)
   | Proj (p,r,c) ->
-    let c, hc = sh_rec c in
-    let p' = Projection.hcons p in
-    (Proj (p', r, c), combinesmall 17 (combine (Projection.SyntacticOrd.hash p') hc))
+    let hc, c' = sh_rec c in
+    let hp, p' = Projection.hcons p in
+    (combinesmall 17 (combine hp hc), Proj (p', r, c'))
   | Int i as t ->
     let (h,l) = Uint63.to_int2 i in
-    (t, combinesmall 18 (combine h l))
-  | Float f as t -> (t, combinesmall 19 (Float64.hash f))
-  | String s as t -> (t, combinesmall 20 (Pstring.hash s))
+    (combinesmall 18 (combine h l), t)
+  | Float f as t -> (combinesmall 19 (Float64.hash f), t)
+  | String s as t -> (combinesmall 20 (Pstring.hash s), t)
   | Array (u,ar,def,ty) ->
     let _,car,_,_ = destArray (self t) in
-    let u, hu = Instance.share u in
-    let t, ht = hash_term_array car ar in
-    let def, hdef = sh_rec def in
-    let ty, hty = sh_rec ty in
+    let hu, u = Instance.hcons u in
+    let ht, t = hash_term_array car ar in
+    let hdef, def = sh_rec def in
+    let hty, ty = sh_rec ty in
     let h = combine4 hu ht hdef hty in
-    (Array(u,t,def,ty), combinesmall 21 h)
+    (combinesmall 21 h, Array(u,t,def,ty))
 
 and sh_invert civ iv = match civ, iv with
-  | NoInvert, NoInvert -> NoInvert, 0
+  | NoInvert, NoInvert -> 0, NoInvert
   | CaseInvert {indices=cindices}, CaseInvert {indices;} ->
-    let indices, ha = hash_term_array cindices indices in
-    CaseInvert {indices;}, combinesmall 1 ha
+    let ha, indices = hash_term_array cindices indices in
+    combinesmall 1 ha, CaseInvert {indices;}
   | (NoInvert | CaseInvert _), _ -> assert false
 
 and sh_rec_main t =
-  let (y, h) = hash_term t in
-  (HashsetTerm.repr h (T y) term_table, h)
+  let (h, y) = hash_term t in
+  (h, HashsetTerm.repr h (T y) term_table)
 
 and sh_rec t =
   incr steps;
@@ -1475,16 +1483,10 @@ and sh_rec t =
 (* Note : During hash-cons of arrays, we modify them *in place* *)
 
 and hash_term_array ct t =
-  let accu = ref 0 in
-  for i = 0 to Array.length t - 1 do
-    let x, h = sh_rec (Array.unsafe_get t i) in
-    accu := combine !accu h;
-    Array.unsafe_set ct i x
-  done;
-  let h = !accu in
-  (HashsetTermArray.repr h ct term_array_table, h)
-
-let hcons t = NewProfile.profile "Constr.hcons" (fun () -> fst (sh_rec t)) ()
+  let h = hcons_in_place sh_rec ct t in
+  (h, HashsetTermArray.repr h ct term_array_table)
+
+let hcons t = NewProfile.profile "Constr.hcons" (fun () -> sh_rec t) ()
 
 let hcons t =
   steps := 0;
diff --git a/kernel/constr.mli b/kernel/constr.mli
index 7ef92e209911..05889f505015 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -624,7 +624,6 @@ val eq_invert : ('a -> 'a -> bool)
 (** {6 Hashconsing} *)
 
 val hash : constr -> int
-val case_info_hash : case_info -> int
 
 (*********************************************************************)
 
@@ -637,15 +636,15 @@ module GenHCons(C:sig
     val via_hconstr : bool
 
     module Tbl : sig
-      val find_opt : t -> (constr * int) option
-      val add : t -> constr * int -> unit
+      val find_opt : t -> (int * constr) option
+      val add : t -> int * constr -> unit
     end
   end) : sig
-  val hcons : C.t -> constr
+  val hcons : C.t -> int * constr
 end
 
 
-val hcons : constr -> constr
+val hcons : constr Hashcons.f
 
 val hasheq_kind : (_ kind_of_term as 'k) -> 'k -> bool
 (** Checks physical equality of every immediate element (goes inside tuples and arrays) *)
@@ -662,8 +661,8 @@ val mkInd : inductive -> constr
 val mkConstruct : constructor -> constr
 [@@deprecated "(8.18) Use [mkConstructU] or if truly needed [UnsafeMonomorphic.mkConstruct]"]
 
-val hcons_annot : Name.t binder_annot -> Name.t binder_annot
+val hcons_annot : Name.t binder_annot Hashcons.f
 
-val hcons_caseinfo : case_info -> case_info
+val hcons_caseinfo : case_info Hashcons.f
 
 val hash_cast_kind : cast_kind -> int
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 377f22130588..b641d8bf6b2e 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -14,6 +14,8 @@ open Util
 
 module RelDecl = Context.Rel.Declaration
 
+let noh hcons x = snd (hcons x)
+
 (** Operations concernings types in [Declarations] :
     [constant_body], [mutual_inductive_body], [module_body] ... *)
 
@@ -34,10 +36,10 @@ let safe_flags oracle = {
 (** {6 Arities } *)
 
 let hcons_template_universe ar =
-  { template_param_arguments = List.Smart.map (Option.Smart.map Sorts.hcons) ar.template_param_arguments;
-    template_concl = Sorts.hcons ar.template_concl;
-    template_context = UVars.hcons_abstract_universe_context ar.template_context;
-    template_defaults = UVars.Instance.hcons ar.template_defaults;
+  { template_param_arguments = List.Smart.map (Option.Smart.map (noh Sorts.hcons)) ar.template_param_arguments;
+    template_concl = noh Sorts.hcons ar.template_concl;
+    template_context = noh UVars.hcons_abstract_universe_context ar.template_context;
+    template_defaults = noh UVars.Instance.hcons ar.template_defaults;
   }
 
 let universes_context = function
@@ -117,11 +119,11 @@ let subst_const_body subst cb =
     themselves. But would it really bring substantial gains ? *)
 
 let hcons_rel_decl =
-  RelDecl.map_name Names.Name.hcons %> RelDecl.map_value Constr.hcons %> RelDecl.map_type Constr.hcons
+  RelDecl.map_name (noh Names.Name.hcons) %> RelDecl.map_value (noh Constr.hcons) %> RelDecl.map_type (noh Constr.hcons)
 
 let hcons_rel_context l = List.Smart.map hcons_rel_decl l
 
-let hcons_const_def ?(hbody=Constr.hcons) = function
+let hcons_const_def ?(hbody=noh Constr.hcons) = function
   | Undef inl -> Undef inl
   | Primitive p -> Primitive p
   | Symbol r -> Symbol r
@@ -133,12 +135,12 @@ let hcons_universes cbu =
   match cbu with
   | Monomorphic -> Monomorphic
   | Polymorphic ctx ->
-    Polymorphic (UVars.hcons_abstract_universe_context ctx)
+    Polymorphic (noh UVars.hcons_abstract_universe_context ctx)
 
 let hcons_const_body ?hbody cb =
   { cb with
     const_body = hcons_const_def ?hbody cb.const_body;
-    const_type = Constr.hcons cb.const_type;
+    const_type = noh Constr.hcons cb.const_type;
     const_universes = hcons_universes cb.const_universes;
   }
 
@@ -301,15 +303,15 @@ let inductive_make_projections ind mib =
 (** Just as for constants, this hash-consing is quite partial *)
 
 let hcons_mind_packet oib =
-  let user = Array.Smart.map Constr.hcons oib.mind_user_lc in
-  let map (ctx, c) = Context.Rel.map Constr.hcons ctx, Constr.hcons c in
+  let user = Array.Smart.map (noh Constr.hcons) oib.mind_user_lc in
+  let map (ctx, c) = Context.Rel.map (noh Constr.hcons) ctx, noh Constr.hcons c in
   let nf = Array.Smart.map map oib.mind_nf_lc in
   { oib with
-    mind_typename = Names.Id.hcons oib.mind_typename;
+    mind_typename = noh Names.Id.hcons oib.mind_typename;
     mind_arity_ctxt = hcons_rel_context oib.mind_arity_ctxt;
-    mind_user_arity = Constr.hcons oib.mind_user_arity;
-    mind_sort = Sorts.hcons oib.mind_sort;
-    mind_consnames = Array.Smart.map Names.Id.hcons oib.mind_consnames;
+    mind_user_arity = noh Constr.hcons oib.mind_user_arity;
+    mind_sort = noh Sorts.hcons oib.mind_sort;
+    mind_consnames = Array.Smart.map (noh Names.Id.hcons) oib.mind_consnames;
     mind_user_lc = user;
     mind_nf_lc = nf }
 
diff --git a/kernel/hConstr.ml b/kernel/hConstr.ml
index 171146791be8..ca83fd030912 100644
--- a/kernel/hConstr.ml
+++ b/kernel/hConstr.ml
@@ -316,7 +316,7 @@ let kind_to_constr = function
   | String s -> mkString s
   | Array (u,t,def,ty) -> mkArray (u,Array.map self t,def.self,ty.self)
 
-let hcons_inplace f a = Array.iteri (fun i x -> Array.unsafe_set a i (f x)) a
+let hcons_inplace f a = Array.iteri (fun i x -> Array.unsafe_set a i (snd @@ f x)) a
 
 let of_kind_nohashcons = function
   | App (c, [||]) -> c
@@ -370,28 +370,28 @@ let rec of_constr henv c =
 and of_constr_aux henv c =
   match kind c with
   | Var i ->
-    let i = Id.hcons i in
+    let _, i = Id.hcons i in
     Var i
   | Rel _ as t -> t
   | Sort s ->
-    let s = Sorts.hcons s in
+    let _, s = Sorts.hcons s in
     Sort s
   | Cast (c,k,t) ->
     let c = of_constr henv c in
     let t = of_constr henv t in
     Cast (c, k, t)
   | Prod (na,t,c) ->
-    let na = hcons_annot na in
+    let _, na = hcons_annot na in
     let t = of_constr henv t in
     let c = of_constr (push_assum t henv) c in
     Prod (na, t, c)
   | Lambda (na, t, c) ->
-    let na = hcons_annot na in
+    let _, na = hcons_annot na in
     let t = of_constr henv t in
     let c = of_constr (push_assum t henv) c in
     Lambda (na,t,c)
   | LetIn (na,b,t,c) ->
-    let na = hcons_annot na in
+    let _, na = hcons_annot na in
     let b = of_constr henv b in
     let t = of_constr henv t in
     let c = of_constr (push_letin ~body:b ~typ:t henv) c in
@@ -403,16 +403,16 @@ and of_constr_aux henv c =
   | Evar _ -> CErrors.anomaly Pp.(str "evar in typeops")
   | Meta _ -> CErrors.anomaly Pp.(str "meta in typeops")
   | Const (c,u) ->
-    let c = hcons_con c in
-    let u = UVars.Instance.hcons u in
+    let _, c = hcons_con c in
+    let _, u = UVars.Instance.hcons u in
     Const (c,u)
   | Ind (ind,u) ->
-    let ind = hcons_ind ind in
-    let u = UVars.Instance.hcons u in
+    let _, ind = hcons_ind ind in
+    let _, u = UVars.Instance.hcons u in
     Ind (ind,u)
   | Construct (c,u) ->
-    let c = hcons_construct c in
-    let u = UVars.Instance.hcons u in
+    let _, c = hcons_construct c in
+    let _, u = UVars.Instance.hcons u in
     Construct (c,u)
   | Case (ci,u,pms,(p,r),iv,c,bl) ->
     let pctx, blctx =
@@ -427,8 +427,8 @@ and of_constr_aux henv c =
       let c = of_constr henv c in
       bnd, c
     in
-    let ci = hcons_caseinfo ci in
-    let u = UVars.Instance.hcons u in
+    let _, ci = hcons_caseinfo ci in
+    let _, u = UVars.Instance.hcons u in
     let pms = Array.map (of_constr henv) pms in
     let p = of_ctx p pctx in
     let iv = match iv with
@@ -451,14 +451,14 @@ and of_constr_aux henv c =
     let bl = Array.map (of_constr body_env) bl in
     CoFix (ln,(lna,tl,bl))
   | Proj (p,r,c) ->
-    let p = Projection.hcons p in
+    let _, p = Projection.hcons p in
     let c = of_constr henv c in
     Proj (p,r,c)
   | Int _ as t -> t
   | Float _ as t -> t
   | String _ as t -> t
   | Array (u,t,def,ty) ->
-    let u = UVars.Instance.hcons u in
+    let _, u = UVars.Instance.hcons u in
     let t = Array.map (of_constr henv) t in
     let def = of_constr henv def in
     let ty = of_constr henv ty in
diff --git a/kernel/hConstr.mli b/kernel/hConstr.mli
index ea11a72532d6..d5a0d142c504 100644
--- a/kernel/hConstr.mli
+++ b/kernel/hConstr.mli
@@ -58,4 +58,4 @@ module Tbl : sig
   val create : unit -> 'a t
 end
 
-val hcons : t -> Constr.t
+val hcons : t -> int * Constr.t
diff --git a/kernel/mod_declarations.ml b/kernel/mod_declarations.ml
index 9c9483a662cb..faf08fe225e7 100644
--- a/kernel/mod_declarations.ml
+++ b/kernel/mod_declarations.ml
@@ -188,7 +188,7 @@ let rec hcons_structure_field_body sb = match sb with
 and hcons_structure_body sb =
   (** FIXME *)
   let map (l, sfb as fb) =
-    let l' = Names.Label.hcons l in
+    let _, l' = Names.Label.hcons l in
     let sfb' = hcons_structure_field_body sfb in
     if l == l' && sfb == sfb' then fb else (l', sfb')
   in
diff --git a/kernel/names.ml b/kernel/names.ml
index 702721280979..3727778b0a98 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -51,15 +51,15 @@ struct
   let of_bytes s =
     let s = Bytes.to_string s in
     check_valid s;
-    String.hcons s
+    snd @@ String.hcons s
 
   let of_string s =
     let () = check_valid s in
-    String.hcons s
+    snd @@ String.hcons s
 
   let of_string_soft s =
     let () = check_valid ~strict:false s in
-    String.hcons s
+    snd @@ String.hcons s
 
   let to_string id = id
 
@@ -114,15 +114,16 @@ struct
     struct
       type nonrec t = t
       let hashcons = function
-        | Name id -> Name (Id.hcons id)
-        | n -> n
+        | Name id ->
+          let h, id = Id.hcons id in
+          h, Name id
+        | Anonymous -> 0, Anonymous
       let eq n1 n2 =
         n1 == n2 ||
         match (n1,n2) with
           | (Name id1, Name id2) -> id1 == id2
           | (Anonymous,Anonymous) -> true
           | _ -> false
-      let hash = hash
     end
 
   module Hname = Hashcons.Make(Self_Hashcons)
@@ -236,11 +237,13 @@ struct
   module Self_Hashcons =
     struct
       type nonrec t = t
-      let hashcons (n,s,dir) = (n,Id.hcons s,DirPath.hcons dir)
+      let hashcons (n,s,dir) =
+        let hs, s = Id.hcons s in
+        let hdir, dir = DirPath.hcons dir in
+        combine3 (Int.hash n) hs hdir, (n,s,dir)
       let eq ((n1,s1,dir1) as x) ((n2,s2,dir2) as y) =
         (x == y) ||
         (Int.equal n1 n2 && s1 == s2 && dir1 == dir2)
-      let hash = hash
     end
 
   module HashMBId = Hashcons.Make(Self_Hashcons)
@@ -336,9 +339,16 @@ module ModPath = struct
   module Self_Hashcons = struct
     type t = module_path
     let hashcons hcons = function
-      | MPfile dir -> MPfile (DirPath.hcons dir)
-      | MPbound m -> MPbound (MBId.hcons m)
-      | MPdot (md,l) -> MPdot (hcons md, Id.hcons l)
+      | MPfile dir ->
+        let hdir, dir = DirPath.hcons dir in
+        combinesmall 1 hdir, MPfile dir
+      | MPbound m ->
+        let hm, m = MBId.hcons m in
+        combinesmall 2 hm, MPbound m
+      | MPdot (md,l) ->
+        let hmd, md = hcons md in
+        let hl, l = Id.hcons l in
+        combinesmall 3 (combine hmd hl), MPdot (md, l)
     let eq d1 d2 =
       d1 == d2 ||
       match d1,d2 with
@@ -347,7 +357,6 @@ module ModPath = struct
       | MPdot (mod1,l1), MPdot (mod2,l2) -> l1 == l2 && equal mod1 mod2
       (* XXX use physical equality for mod1 = mod2 *)
       | _ -> false
-    let hash = hash
   end
 
   module HashMP = Hashcons.MakeRec(Self_Hashcons)
@@ -420,10 +429,11 @@ module KerName = struct
     type t = kernel_name
     let hashcons kn =
       let { modpath = mp; knlabel = l; refhash; } = kn in
-      { modpath = ModPath.hcons mp; knlabel = Id.hcons l; refhash; }
+      let _, mp = ModPath.hcons mp in
+      let _, l = Id.hcons l in
+      refhash, { modpath =  mp; knlabel = l; refhash; }
     let eq kn1 kn2 =
       kn1.modpath == kn2.modpath && kn1.knlabel == kn2.knlabel
-    let hash = hash
   end
 
   module HashKN = Hashcons.Make(Self_Hashcons)
@@ -563,8 +573,13 @@ module KerPair = struct
     struct
       type t = kernel_pair
       let hashcons = function
-        | Same kn -> Same (KerName.hcons kn)
-        | Dual (knu,knc) -> make (KerName.hcons knu) (KerName.hcons knc)
+        | Same kn ->
+          let hkn, kn = KerName.hcons kn in
+          hkn, Same kn
+        | Dual (knu,knc) ->
+          let hknu, knu = KerName.hcons knu in
+          let hknc, knc = KerName.hcons knc in
+          Hashset.Combine.combine hknu hknc, make knu knc
       let eq x y = (* physical comparison on subterms *)
         x == y ||
         match x,y with
@@ -575,11 +590,6 @@ module KerPair = struct
           the same canonical part is a logical invariant of the system, it
           is not necessarily an invariant in memory, so we treat kernel
           names as they are syntactically for hash-consing) *)
-
-      let hash = function
-      | Same kn -> KerName.hash kn
-      | Dual (knu, knc) ->
-        Hashset.Combine.combine (KerName.hash knu) (KerName.hash knc)
     end
 
   module HashKP = Hashcons.Make(Self_Hashcons)
@@ -740,9 +750,10 @@ module Constrmap_env = Map.Make(Construct.UserOrd)
 module Hind = Hashcons.Make(
   struct
     type t = inductive
-    let hashcons (mind, i) = (MutInd.hcons mind, i)
+    let hashcons (mind, i) =
+      let hmind, mind = MutInd.hcons mind in
+      Hashset.Combine.combine hmind (Int.hash i), (mind, i)
     let eq (mind1,i1) (mind2,i2) = mind1 == mind2 && Int.equal i1 i2
-    let hash = Ind.CanOrd.hash
   end)
 
 let hcons_con = Constant.hcons
@@ -752,9 +763,10 @@ let hcons_ind = Hashcons.simple_hcons Hind.generate Hind.hcons ()
 module Hconstruct = Hashcons.Make(
   struct
     type t = constructor
-    let hashcons (ind, j) = (hcons_ind ind, j)
+    let hashcons (ind, j) =
+      let hind, ind = hcons_ind ind in
+      Hashset.Combine.combine hind (Int.hash j), (ind, j)
     let eq (ind1, j1) (ind2, j2) = ind1 == ind2 && Int.equal j1 j2
-    let hash = Construct.CanOrd.hash
   end)
 
 let hcons_construct = Hashcons.simple_hcons Hconstruct.generate Hconstruct.hcons ()
@@ -895,13 +907,16 @@ struct
     module Self_Hashcons = struct
       type nonrec t = t
       let hashcons p =
-        { proj_ind = hcons_ind p.proj_ind;
+        let hind, ind = hcons_ind p.proj_ind in
+        let _, na = Constant.hcons p.proj_name in
+        Hashset.Combine.combinesmall p.proj_arg hind, {
+          proj_ind = ind;
           proj_npars = p.proj_npars;
           proj_arg = p.proj_arg;
-          proj_name = Constant.hcons p.proj_name }
+          proj_name = na;
+        }
       let eq p p' =
         p == p' || (p.proj_ind == p'.proj_ind && p.proj_npars == p'.proj_npars && p.proj_arg == p'.proj_arg && p.proj_name == p'.proj_name)
-      let hash = hash
     end
     module HashRepr = Hashcons.Make(Self_Hashcons)
     let hcons = Hashcons.simple_hcons HashRepr.generate HashRepr.hcons ()
@@ -975,10 +990,11 @@ struct
   module Self_Hashcons =
     struct
       type nonrec t = t
-      let hashcons (c,b) = (Repr.hcons c,b)
+      let hashcons (c,b) =
+        let hc, c = Repr.hcons c in
+        (if b then 0 else 1) + hc, (c,b)
       let eq ((c,b) as x) ((c',b') as y) =
         x == y || (c == c' && b == b')
-      let hash = hash
     end
 
   let canonize ((r, u) as p) =
diff --git a/kernel/names.mli b/kernel/names.mli
index b8e8310831b2..caa0a2e05203 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -74,7 +74,7 @@ sig
   module List : List.MonoS with type elt = t
   (** Operations over lists of identifiers. *)
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
   (** Hashconsing of identifiers. *)
 
 end
@@ -104,7 +104,7 @@ sig
   val hash : t -> int
   (** Hash over names. *)
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
   (** Hashconsing over names. *)
 
   val print : t -> Pp.t
@@ -155,7 +155,7 @@ sig
   val dummy : t
   (** Used in [Safe_typing.empty_environment] and similar *)
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
   (** Hashconsing of directory paths. *)
 
   val to_string : t -> string
@@ -201,7 +201,7 @@ sig
   module Set : Set.ExtS with type elt = t
   module Map : Map.ExtS with type key = t and module Set := Set
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
 
 end
 
@@ -547,10 +547,10 @@ val index_of_constructor : constructor -> int
 
 (** {6 Hash-consing } *)
 
-val hcons_con : Constant.t -> Constant.t
-val hcons_mind : MutInd.t -> MutInd.t
-val hcons_ind : inductive -> inductive
-val hcons_construct : constructor -> constructor
+val hcons_con : Constant.t Hashcons.f
+val hcons_mind : MutInd.t Hashcons.f
+val hcons_ind : inductive Hashcons.f
+val hcons_construct : constructor Hashcons.f
 
 (******)
 
@@ -630,7 +630,7 @@ module Projection : sig
   [@@ocaml.deprecated "(8.13) Use QProjection.equal"]
   val hash : t -> int
   [@@ocaml.deprecated "(8.13) Use QProjection.hash"]
-  val hcons : t -> t
+  val hcons : t Hashcons.f
   (** Hashconsing of projections. *)
 
   val repr_equal : t -> t -> bool
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index f906464c6dbe..8f33c64f2e45 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -732,7 +732,7 @@ let make_hbody = function
   | None -> None
   | Some hc -> Some (fun c ->
       assert (c == HConstr.self hc);
-      HConstr.hcons hc)
+      snd @@ HConstr.hcons hc)
 
 let add_constant_aux senv ?hbody (kn, cb) =
   let l = Constant.label kn in
@@ -969,7 +969,7 @@ let export_private_constants eff senv =
     | Monomorphic -> None
     | Polymorphic auctx -> Some (UVars.AbstractContext.size auctx)
     in
-    let body = Constr.hcons body in
+    let _, body = Constr.hcons body in
     let opaque = { exp_body = body; exp_handle = h; exp_univs = univs } in
     senv, (kn, { c with const_body = OpaqueDef o }, Some opaque)
   | Def _ | Undef _ | Primitive _ | Symbol _ as body ->
@@ -1040,15 +1040,15 @@ let check_opaque senv (i : Opaqueproof.opaque_handle) pf =
     body, uctx, trusted
   in
   let (hbody, c, ctx) = Constant_typing.check_delayed handle ty_ctx pf in
-  let c = match hbody with
+  let _, c = match hbody with
     | Some hbody -> assert (c == HConstr.self hbody); HConstr.hcons hbody
     | None -> Constr.hcons c
   in
   let ctx = match ctx with
   | Opaqueproof.PrivateMonomorphic u ->
-    Opaqueproof.PrivateMonomorphic (Univ.hcons_universe_context_set u)
+    Opaqueproof.PrivateMonomorphic (snd @@ Univ.hcons_universe_context_set u)
   | Opaqueproof.PrivatePolymorphic u ->
-    Opaqueproof.PrivatePolymorphic (Univ.hcons_universe_context_set u)
+    Opaqueproof.PrivatePolymorphic (snd @@ Univ.hcons_universe_context_set u)
   in
   { opq_body = c; opq_univs = ctx; opq_handle = i; opq_nonce = nonce }
 
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index f99940fb38e1..c4c8d3f954ba 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -37,19 +37,19 @@ struct
   module Hstruct = struct
     type nonrec t = t
 
+    open Hashset.Combine
+
     let hashcons = function
-      | Var _ as q -> q
+      | Var qv as q -> combinesmall 1 qv, q
       | Unif (s,i) as q ->
-        let s' = CString.hcons s in
-        if s == s' then q else Unif (s',i)
+        let hs, s' = CString.hcons s in
+        combinesmall 2 (combine hs i), if s == s' then q else Unif (s',i)
 
     let eq a b =
       match a, b with
       | Var a, Var b -> Int.equal a b
       | Unif (sa, ia), Unif (sb, ib) -> sa == sb && Int.equal ia ib
       | (Var _ | Unif _), _ -> false
-
-    let hash = hash
   end
 
   module Hasher = Hashcons.Make(Hstruct)
@@ -161,27 +161,25 @@ module Quality = struct
     type nonrec t = t
 
     let hashcons = function
-      | QConstant _ as q -> q
+      | QConstant c as q -> Constants.hash c, q
       | QVar qv as q ->
-        let qv' = QVar.hcons qv in
-        if qv == qv' then q else QVar qv'
+        let hqv, qv' = QVar.hcons qv in
+        Hashset.Combine.combinesmall 3 hqv, if qv == qv' then q else QVar qv'
 
     let eq a b =
       match a, b with
       | QVar a, QVar b -> a == b
       | QVar _, _ -> false
       | (QConstant _), _ -> equal a b
-
-    let hash = hash
   end
 
   module Hasher = Hashcons.Make(Hstruct)
 
   let hcons = Hashcons.simple_hcons Hasher.generate Hasher.hcons ()
 
-  let qsprop = hcons (QConstant QSProp)
-  let qprop = hcons (QConstant QProp)
-  let qtype = hcons (QConstant QType)
+  let qsprop = snd @@ hcons (QConstant QSProp)
+  let qprop = snd @@ hcons (QConstant QProp)
+  let qtype = snd @@ hcons (QConstant QType)
 
   module Self = struct type nonrec t = t let compare = compare end
   module Set = CSet.Make(Self)
@@ -409,19 +407,18 @@ module Hsorts =
 
       let hashcons = function
         | Type u as c ->
-          let u' = hcons_univ u in
-            if u' == u then c else Type u'
+          let hu, u' = hcons_univ u in
+          combinesmall 2 hu, if u' == u then c else Type u'
         | QSort (q, u) as c ->
-          let u' = hcons_univ u in
-          if u' == u then c else QSort (q, u)
-        | SProp | Prop | Set as s -> s
+          let hq, q' = QVar.hcons q in
+          let hu, u' = hcons_univ u in
+          combinesmall 3 (combine hu hq), if u' == u && q' == q then c else QSort (q', u')
+        | SProp | Prop | Set as s -> hash s, s
       let eq s1 s2 = match (s1,s2) with
         | SProp, SProp | Prop, Prop | Set, Set -> true
         | (Type u1, Type u2) -> u1 == u2
         | QSort (q1, u1), QSort (q2, u2) -> q1 == q2 && u1 == u2
         | (SProp | Prop | Set | Type _ | QSort _), _ -> false
-
-      let hash = hash
     end)
 
 let hcons = Hashcons.simple_hcons Hsorts.generate Hsorts.hcons ()
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index 75a7fdd03ed3..7f0d2797a26c 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -75,7 +75,7 @@ module Quality : sig
 
   val hash : t -> int
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
 
   (* XXX Inconsistent naming: this one should be subst_fn *)
   val subst : (QVar.t -> t) -> t -> t
@@ -155,7 +155,7 @@ val is_small : t -> bool
 val family : t -> family
 val quality : t -> Quality.t
 
-val hcons : t -> t
+val hcons : t Hashcons.f
 
 val family_compare : family -> family -> int
 val family_equal : family -> family -> bool
diff --git a/kernel/uVars.ml b/kernel/uVars.ml
index e707dee90d18..b5f1cb5f75fe 100644
--- a/kernel/uVars.ml
+++ b/kernel/uVars.ml
@@ -81,11 +81,9 @@ module Instance : sig
     val equal : t -> t -> bool
     val length : t -> int * int
 
-    val hcons : t -> t
+    val hcons : t -> int * t
     val hash : t -> int
 
-    val share : t -> t * int
-
     val subst_fn : (Sorts.QVar.t -> Quality.t) * (Level.t -> Level.t) -> t -> t
 
     val pr : (Sorts.QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
@@ -107,53 +105,55 @@ struct
     let hashcons (aq, au as a) =
       let qlen = Array.length aq in
       let ulen = Array.length au in
-        if Int.equal qlen 0 && Int.equal ulen 0 then empty
-        else begin
-          for i = 0 to qlen - 1 do
-            let x = Array.unsafe_get aq i in
-            let x' = Quality.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set aq i x'
-          done;
-          for i = 0 to ulen - 1 do
-            let x = Array.unsafe_get au i in
-            let x' = Level.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set au i x'
-          done;
-          a
-        end
+      if Int.equal qlen 0 && Int.equal ulen 0 then 0, empty
+      else begin
+        let h = ref 0 in
+        for i = 0 to qlen - 1 do
+          let x = Array.unsafe_get aq i in
+          let hx, x' = Quality.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set aq i x'
+        done;
+        for i = 0 to ulen - 1 do
+          let x = Array.unsafe_get au i in
+          let hx, x' = Level.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set au i x'
+        done;
+        (* [h] must be positive (XXX why?). *)
+        let h = !h land 0x3FFFFFFF in
+        h, a
+      end
 
     let eq t1 t2 =
       CArray.equal (==) (fst t1) (fst t2)
       && CArray.equal (==) (snd t1) (snd t2)
 
-    let hash (aq,au) =
-      let accu = ref 0 in
-        for i = 0 to Array.length aq - 1 do
-          let l = Array.unsafe_get aq i in
-          let h = Quality.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        for i = 0 to Array.length au - 1 do
-          let l = Array.unsafe_get au i in
-          let h = Level.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        (* [h] must be positive. *)
-        let h = !accu land 0x3FFFFFFF in
-          h
   end
 
   module HInstance = Hashcons.Make(HInstancestruct)
 
   let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons ()
 
-  let hash = HInstancestruct.hash
-
-  let share a = (hcons a, hash a)
-
-  let empty = hcons empty
+  let hash (aq,au) =
+    let accu = ref 0 in
+    for i = 0 to Array.length aq - 1 do
+      let l = Array.unsafe_get aq i in
+      let h = Quality.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    for i = 0 to Array.length au - 1 do
+      let l = Array.unsafe_get au i in
+      let h = Level.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    (* [h] must be positive (XXX why?). *)
+    let h = !accu land 0x3FFFFFFF in
+    h
+
+  let empty = snd @@ hcons empty
 
   let is_empty (x,y) = CArray.is_empty x && CArray.is_empty y
 
@@ -312,7 +312,11 @@ struct
       h (Instance.pr prq prl ?variance univs ++ str " |= ") ++ h (v 0 (Constraints.pr prl csts))
 
   let hcons ((qnames, unames), (univs, csts)) =
-    ((Array.map Names.Name.hcons qnames, Array.map Names.Name.hcons unames), (Instance.hcons univs, hcons_constraints csts))
+    let hqnames, qnames = Hashcons.hashcons_array Names.Name.hcons qnames in
+    let hunames, unames = Hashcons.hashcons_array Names.Name.hcons unames in
+    let hunivs, univs = Instance.hcons univs in
+    let hcsts, csts = hcons_constraints csts in
+    Hashset.Combine.combine4 hqnames hunames hunivs hcsts, ((qnames, unames), (univs, csts))
 
   let names ((names, _) : t) = names
   let instance (_, (univs, _csts)) = univs
@@ -374,9 +378,10 @@ struct
   let names (nas, _) = nas
 
   let hcons ((qnames,unames), cst) =
-    let qnames = Array.map Names.Name.hcons qnames in
-    let unames = Array.map Names.Name.hcons unames in
-    ((qnames, unames), hcons_constraints cst)
+    let hqnames, qnames = Hashcons.hashcons_array Names.Name.hcons qnames in
+    let hunames, unames = Hashcons.hashcons_array Names.Name.hcons unames in
+    let hcst, cst = hcons_constraints cst in
+    Hashset.Combine.combine3 hqnames hunames hcst, ((qnames, unames), cst)
 
   let empty = (([||],[||]), Constraints.empty)
 
diff --git a/kernel/uVars.mli b/kernel/uVars.mli
index a580b4015168..cf3c4639289b 100644
--- a/kernel/uVars.mli
+++ b/kernel/uVars.mli
@@ -59,15 +59,12 @@ sig
   val length : t -> int * int
   (** Instance length *)
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
   (** Hash-consing. *)
 
   val hash : t -> int
   (** Hash value *)
 
-  val share : t -> t * int
-  (** Simultaneous hash-consing and hash-value computation *)
-
   val pr : (QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
   (** Pretty-printing, no comments *)
 
@@ -241,5 +238,5 @@ val pr_abstract_universe_context : (QVar.t -> Pp.t) -> (Level.t -> Pp.t) -> ?var
 
 (** {6 Hash-consing } *)
 
-val hcons_universe_context : UContext.t -> UContext.t
-val hcons_abstract_universe_context : AbstractContext.t -> AbstractContext.t
+val hcons_universe_context : UContext.t Hashcons.f
+val hcons_abstract_universe_context : AbstractContext.t Hashcons.f
diff --git a/kernel/univ.ml b/kernel/univ.ml
index 6a37d0d66f4c..44081890b2ff 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -104,15 +104,16 @@ struct
       | Var n, Var n' -> n == n'
       | _ -> false
 
+  open Hashset.Combine
+
   let hcons = function
-    | Set as x -> x
+    | Set as x -> combinesmall 1 2, x
     | UGlobal.(Level { library = d; process = s; uid = n }) as x ->
-      let s' = CString.hcons s in
-      let d' = Names.DirPath.hcons d in
-        if s' == s && d' == d then x else Level (UGlobal.make d' s' n)
-    | Var _n as x -> x
-
-  open Hashset.Combine
+      let hs, s' = CString.hcons s in
+      let hd, d' = Names.DirPath.hcons d in
+      let x = if s' == s && d' == d then x else Level (UGlobal.make d' s' n) in
+      combinesmall 3 (combine3 n hs hd), x
+    | Var n as x -> combinesmall 2 n, x
 
   let hash = function
     | Set -> combinesmall 1 2
@@ -145,17 +146,16 @@ module Level = struct
   module Self = struct
     type nonrec t = t
     let eq x y = x.hash == y.hash && RawLevel.hequal x.data y.data
-    let hash x = x.hash
     let hashcons x =
-      let data' = RawLevel.hcons x.data in
-      if x.data == data' then x else { x with data = data' }
+      let _, data' = RawLevel.hcons x.data in
+      x.hash, if x.data == data' then x else { x with data = data' }
   end
 
   let hcons =
     let module H = Hashcons.Make(Self) in
     Hashcons.simple_hcons H.generate H.hcons ()
 
-  let make l = hcons { hash = RawLevel.hash l; data = l }
+  let make l = snd @@ hcons { hash = RawLevel.hash l; data = l }
 
   let set = make Set
 
@@ -262,8 +262,8 @@ struct
     struct
       type t = Level.t * int
       let hashcons (b,n as x) =
-        let b' = Level.hcons b in
-          if b' == b then x else (b',n)
+        let hb, b' = Level.hcons b in
+        n + hb, if b' == b then x else (b',n)
       let eq l1 l2 =
         l1 == l2 ||
         match l1,l2 with
@@ -288,8 +288,8 @@ struct
         if Int.equal 0 c then  Level.compare x x'
         else c
 
-    let set = hcons (Level.set, 0)
-    let type1 = hcons (Level.set, 1)
+    let _, set = hcons (Level.set, 0)
+    let _, type1 = hcons (Level.set, 1)
 
     let is_small = function
       | (l,0) -> Level.is_small l
@@ -299,8 +299,6 @@ struct
       (let (u,n) = x and (v,n') = y in
          Int.equal n n' && Level.equal u v)
 
-    let hash = ExprHash.hash
-
     let successor (u,n as e) =
       if is_small e then type1
       else (u, n + 1)
@@ -470,21 +468,27 @@ struct
 
 end
 
+let hash_constraint_type = function
+  | Lt -> 0
+  | Le -> 1
+  | Eq -> 2
+
 module Hconstraint =
   Hashcons.Make(
     struct
       type t = univ_constraint
-      let hashcons (l1,k,l2) = (Level.hcons l1, k, Level.hcons l2)
+      let hashcons (l1,k,l2) =
+        let hl1, l1 = Level.hcons l1 in
+        let hl2, l2 = Level.hcons l2 in
+        Hashset.Combine.(combinesmall (hash_constraint_type k) (combine hl1 hl2)), (l1, k, l2)
       let eq (l1,k,l2) (l1',k',l2') =
         l1 == l1' && k == k' && l2 == l2'
-      let hash = Hashtbl.hash (* XXX *)
     end)
 
 let hcons_constraint = Hashcons.simple_hcons Hconstraint.generate Hconstraint.hcons ()
 
 module Hconstraints = CSet.Hashcons(UConstraintOrd)(struct
     type t = UConstraintOrd.t
-    let hash = Hashtbl.hash (* XXX *)
     let hcons = hcons_constraint
   end)
 
@@ -623,16 +627,21 @@ module Huniverse_set =
     struct
       type t = universe_set
       let hashcons s =
-        Level.Set.fold (fun x -> Level.Set.add (Level.hcons x)) s Level.Set.empty
+        Level.Set.fold (fun x (h,acc) ->
+            let hx, x = Level.hcons x in
+            Hashset.Combine.combine h hx, Level.Set.add x acc)
+          s
+          (0,Level.Set.empty)
       let eq s s' =
         Level.Set.equal s s'
-      let hash = Hashtbl.hash (* XXX *)
     end)
 
 let hcons_universe_set =
   Hashcons.simple_hcons Huniverse_set.generate Huniverse_set.hcons ()
 
 let hcons_universe_context_set (v, c) =
-  (hcons_universe_set v, hcons_constraints c)
+  let hv, v = hcons_universe_set v in
+  let hc, c = hcons_constraints c in
+  Hashset.Combine.combine hv hc, (v, c)
 
 let hcons_univ x = Universe.hcons x
diff --git a/kernel/univ.mli b/kernel/univ.mli
index d4a0ceccaebc..9d5de5aa7d68 100644
--- a/kernel/univ.mli
+++ b/kernel/univ.mli
@@ -46,7 +46,7 @@ sig
 
   val hash : t -> int
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
 
   val make : UGlobal.t -> t
 
@@ -111,7 +111,7 @@ sig
   val hash : t -> int
   (** Hash function *)
 
-  val hcons : t -> t
+  val hcons : t Hashcons.f
 
   val make : Level.t -> t
   (** Create a universe representing the given level. *)
@@ -255,7 +255,7 @@ val pr_universe_level_subst : (Level.t -> Pp.t) -> universe_level_subst -> Pp.t
 
 (** {6 Hash-consing } *)
 
-val hcons_univ : Universe.t -> Universe.t
-val hcons_constraints : Constraints.t -> Constraints.t
-val hcons_universe_set : Level.Set.t -> Level.Set.t
-val hcons_universe_context_set : ContextSet.t -> ContextSet.t
+val hcons_univ : Universe.t Hashcons.f
+val hcons_constraints : Constraints.t Hashcons.f
+val hcons_universe_set : Level.Set.t Hashcons.f
+val hcons_universe_context_set : ContextSet.t Hashcons.f
diff --git a/kernel/vmemitcodes.ml b/kernel/vmemitcodes.ml
index 0024540a42eb..9dd6af4d5e2d 100644
--- a/kernel/vmemitcodes.ml
+++ b/kernel/vmemitcodes.ml
@@ -658,7 +658,7 @@ let to_memory fv code =
   } in
   emit env code [];
   let code = compress_code env.out_buffer env.out_position in
-  let code = CString.hcons code in
+  let _, code = CString.hcons code in
   let fold reloc id accu = (id, reloc) :: accu in
   let reloc = RelocTable.fold fold env.reloc_info [] in
   let reloc = List.sort (fun (id1, _) (id2, _) -> Int.compare id1 id2) reloc in
diff --git a/vernac/opaques.ml b/vernac/opaques.ml
index 8dfe7922d35b..d0997b906689 100644
--- a/vernac/opaques.ml
+++ b/vernac/opaques.ml
@@ -58,7 +58,7 @@ let set_opaque_disk i (c, priv) t =
   let i = Opaqueproof.repr_handle i in
   let () = assert (0 <= i && i < Array.length t) in
   let () = assert (Option.is_empty t.(i)) in
-  let c = Constr.hcons c in
+  let _, c = Constr.hcons c in
   t.(i) <- Some (c, priv)
 
 let current_opaques = Summary.state


Reviews:
user: login: silene
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-12T14:48:23Z
user: login: SkySkimmer
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-12T14:52:38Z
user: login: ppedrot
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-03-12T16:46:26Z
user: login: ppedrot
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-03-12T16:48:02Z
user: login: silene
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-12T18:11:29Z
user: login: silene
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-12T18:30:38Z
user: login: ppedrot
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-03-12T18:37:32Z
user: login: SkySkimmer
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-12T19:02:28Z
user: login: ppedrot
state: COMMENTED
author_association: MEMBER
submitted_at: 2025-03-13T05:40:31Z
user: login: SkySkimmer
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-13T14:01:57Z
user: login: silene
body: I think this patch is a chance to do some smart hashconsing as often as possible. It was already done in various places but not everywhere. (And I am not proposing that it should be done everywhere. But the more the better.)
state: COMMENTED
author_association: CONTRIBUTOR
submitted_at: 2025-03-13T14:43:16Z
user: login: ppedrot
state: APPROVED
author_association: MEMBER
submitted_at: 2025-03-14T08:07:57Z

Review comments:
diff_hunk: @@ -107,53 +105,55 @@ struct
     let hashcons (aq, au as a) =
       let qlen = Array.length aq in
       let ulen = Array.length au in
-        if Int.equal qlen 0 && Int.equal ulen 0 then empty
-        else begin
-          for i = 0 to qlen - 1 do
-            let x = Array.unsafe_get aq i in
-            let x' = Quality.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set aq i x'
-          done;
-          for i = 0 to ulen - 1 do
-            let x = Array.unsafe_get au i in
-            let x' = Level.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set au i x'
-          done;
-          a
-        end
+      if Int.equal qlen 0 && Int.equal ulen 0 then 0, empty
+      else begin
+        let h = ref 0 in
+        for i = 0 to qlen - 1 do
+          let x = Array.unsafe_get aq i in
+          let hx, x' = Quality.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set aq i x'
+        done;
+        for i = 0 to ulen - 1 do
+          let x = Array.unsafe_get au i in
+          let hx, x' = Level.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set au i x'
+        done;
+        (* [h] must be positive (XXX why?). *)
+        let h = !h land 0x3FFFFFFF in
+        h, a
+      end
 
     let eq t1 t2 =
       CArray.equal (==) (fst t1) (fst t2)
       && CArray.equal (==) (snd t1) (snd t2)
 
-    let hash (aq,au) =
-      let accu = ref 0 in
-        for i = 0 to Array.length aq - 1 do
-          let l = Array.unsafe_get aq i in
-          let h = Quality.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        for i = 0 to Array.length au - 1 do
-          let l = Array.unsafe_get au i in
-          let h = Level.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        (* [h] must be positive. *)
-        let h = !accu land 0x3FFFFFFF in
-          h
   end
 
   module HInstance = Hashcons.Make(HInstancestruct)
 
   let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons ()
 
-  let hash = HInstancestruct.hash
-
-  let share a = (hcons a, hash a)
-
-  let empty = hcons empty
+  let hash (aq,au) =
+    let accu = ref 0 in
+    for i = 0 to Array.length aq - 1 do
+      let l = Array.unsafe_get aq i in
+      let h = Quality.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    for i = 0 to Array.length au - 1 do
+      let l = Array.unsafe_get au i in
+      let h = Level.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    (* [h] must be positive (XXX why?). *)
+    let h = !accu land 0x3FFFFFFF in
path: kernel/uVars.ml
user: login: silene
body: This constraint is inherited from the OCaml runtime. If you do not force it to be positive, then it will be different on 32-bit and 64-bit platforms. (For example, while 0x4000000 is perfectly representable on both 32-bit and 64-bit worlds, it it is negative in one and positive in the other.) Whether such a property is actually useful in the Coq kernel, I am not sure.
created_at: 2025-03-12T14:48:22Z
author_association: CONTRIBUTOR
diff_hunk: @@ -107,53 +105,55 @@ struct
     let hashcons (aq, au as a) =
       let qlen = Array.length aq in
       let ulen = Array.length au in
-        if Int.equal qlen 0 && Int.equal ulen 0 then empty
-        else begin
-          for i = 0 to qlen - 1 do
-            let x = Array.unsafe_get aq i in
-            let x' = Quality.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set aq i x'
-          done;
-          for i = 0 to ulen - 1 do
-            let x = Array.unsafe_get au i in
-            let x' = Level.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set au i x'
-          done;
-          a
-        end
+      if Int.equal qlen 0 && Int.equal ulen 0 then 0, empty
+      else begin
+        let h = ref 0 in
+        for i = 0 to qlen - 1 do
+          let x = Array.unsafe_get aq i in
+          let hx, x' = Quality.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set aq i x'
+        done;
+        for i = 0 to ulen - 1 do
+          let x = Array.unsafe_get au i in
+          let hx, x' = Level.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set au i x'
+        done;
+        (* [h] must be positive (XXX why?). *)
+        let h = !h land 0x3FFFFFFF in
+        h, a
+      end
 
     let eq t1 t2 =
       CArray.equal (==) (fst t1) (fst t2)
       && CArray.equal (==) (snd t1) (snd t2)
 
-    let hash (aq,au) =
-      let accu = ref 0 in
-        for i = 0 to Array.length aq - 1 do
-          let l = Array.unsafe_get aq i in
-          let h = Quality.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        for i = 0 to Array.length au - 1 do
-          let l = Array.unsafe_get au i in
-          let h = Level.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        (* [h] must be positive. *)
-        let h = !accu land 0x3FFFFFFF in
-          h
   end
 
   module HInstance = Hashcons.Make(HInstancestruct)
 
   let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons ()
 
-  let hash = HInstancestruct.hash
-
-  let share a = (hcons a, hash a)
-
-  let empty = hcons empty
+  let hash (aq,au) =
+    let accu = ref 0 in
+    for i = 0 to Array.length aq - 1 do
+      let l = Array.unsafe_get aq i in
+      let h = Quality.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    for i = 0 to Array.length au - 1 do
+      let l = Array.unsafe_get au i in
+      let h = Level.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    (* [h] must be positive (XXX why?). *)
+    let h = !accu land 0x3FFFFFFF in
path: kernel/uVars.ml
user: login: SkySkimmer
body: It is probably not useful as many of our hashes don't try to respect it, so it probably isn't respected (although I didn't check) and we've had no complaints
created_at: 2025-03-12T14:52:38Z
author_association: CONTRIBUTOR
diff_hunk: @@ -107,53 +105,55 @@ struct
     let hashcons (aq, au as a) =
       let qlen = Array.length aq in
       let ulen = Array.length au in
-        if Int.equal qlen 0 && Int.equal ulen 0 then empty
-        else begin
-          for i = 0 to qlen - 1 do
-            let x = Array.unsafe_get aq i in
-            let x' = Quality.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set aq i x'
-          done;
-          for i = 0 to ulen - 1 do
-            let x = Array.unsafe_get au i in
-            let x' = Level.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set au i x'
-          done;
-          a
-        end
+      if Int.equal qlen 0 && Int.equal ulen 0 then 0, empty
+      else begin
+        let h = ref 0 in
+        for i = 0 to qlen - 1 do
+          let x = Array.unsafe_get aq i in
+          let hx, x' = Quality.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set aq i x'
+        done;
+        for i = 0 to ulen - 1 do
+          let x = Array.unsafe_get au i in
+          let hx, x' = Level.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set au i x'
+        done;
+        (* [h] must be positive (XXX why?). *)
+        let h = !h land 0x3FFFFFFF in
+        h, a
+      end
 
     let eq t1 t2 =
       CArray.equal (==) (fst t1) (fst t2)
       && CArray.equal (==) (snd t1) (snd t2)
 
-    let hash (aq,au) =
-      let accu = ref 0 in
-        for i = 0 to Array.length aq - 1 do
-          let l = Array.unsafe_get aq i in
-          let h = Quality.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        for i = 0 to Array.length au - 1 do
-          let l = Array.unsafe_get au i in
-          let h = Level.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        (* [h] must be positive. *)
-        let h = !accu land 0x3FFFFFFF in
-          h
   end
 
   module HInstance = Hashcons.Make(HInstancestruct)
 
   let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons ()
 
-  let hash = HInstancestruct.hash
-
-  let share a = (hcons a, hash a)
-
-  let empty = hcons empty
+  let hash (aq,au) =
+    let accu = ref 0 in
+    for i = 0 to Array.length aq - 1 do
+      let l = Array.unsafe_get aq i in
+      let h = Quality.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    for i = 0 to Array.length au - 1 do
+      let l = Array.unsafe_get au i in
+      let h = Level.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    (* [h] must be positive (XXX why?). *)
+    let h = !accu land 0x3FFFFFFF in
path: kernel/uVars.ml
user: login: ppedrot
body: The vo files are already different depending on the word size (e.g. because of the representation of uint63) , so there is no point in trying to be clever there.
created_at: 2025-03-12T16:46:26Z
author_association: MEMBER
diff_hunk: @@ -107,53 +105,55 @@ struct
     let hashcons (aq, au as a) =
       let qlen = Array.length aq in
       let ulen = Array.length au in
-        if Int.equal qlen 0 && Int.equal ulen 0 then empty
-        else begin
-          for i = 0 to qlen - 1 do
-            let x = Array.unsafe_get aq i in
-            let x' = Quality.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set aq i x'
-          done;
-          for i = 0 to ulen - 1 do
-            let x = Array.unsafe_get au i in
-            let x' = Level.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set au i x'
-          done;
-          a
-        end
+      if Int.equal qlen 0 && Int.equal ulen 0 then 0, empty
+      else begin
+        let h = ref 0 in
+        for i = 0 to qlen - 1 do
+          let x = Array.unsafe_get aq i in
+          let hx, x' = Quality.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set aq i x'
+        done;
+        for i = 0 to ulen - 1 do
+          let x = Array.unsafe_get au i in
+          let hx, x' = Level.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set au i x'
+        done;
+        (* [h] must be positive (XXX why?). *)
+        let h = !h land 0x3FFFFFFF in
+        h, a
+      end
 
     let eq t1 t2 =
       CArray.equal (==) (fst t1) (fst t2)
       && CArray.equal (==) (snd t1) (snd t2)
 
-    let hash (aq,au) =
-      let accu = ref 0 in
-        for i = 0 to Array.length aq - 1 do
-          let l = Array.unsafe_get aq i in
-          let h = Quality.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        for i = 0 to Array.length au - 1 do
-          let l = Array.unsafe_get au i in
-          let h = Level.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        (* [h] must be positive. *)
-        let h = !accu land 0x3FFFFFFF in
-          h
   end
 
   module HInstance = Hashcons.Make(HInstancestruct)
 
   let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons ()
 
-  let hash = HInstancestruct.hash
-
-  let share a = (hcons a, hash a)
-
-  let empty = hcons empty
+  let hash (aq,au) =
+    let accu = ref 0 in
+    for i = 0 to Array.length aq - 1 do
+      let l = Array.unsafe_get aq i in
+      let h = Quality.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    for i = 0 to Array.length au - 1 do
+      let l = Array.unsafe_get au i in
+      let h = Level.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    (* [h] must be positive (XXX why?). *)
+    let h = !accu land 0x3FFFFFFF in
path: kernel/uVars.ml
user: login: ppedrot
body: That said, this *may* change the folding order of some maps between architectures and maybe we do care about that, e.g. for some proof search.
created_at: 2025-03-12T16:48:02Z
author_association: MEMBER
diff_hunk: @@ -107,53 +105,55 @@ struct
     let hashcons (aq, au as a) =
       let qlen = Array.length aq in
       let ulen = Array.length au in
-        if Int.equal qlen 0 && Int.equal ulen 0 then empty
-        else begin
-          for i = 0 to qlen - 1 do
-            let x = Array.unsafe_get aq i in
-            let x' = Quality.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set aq i x'
-          done;
-          for i = 0 to ulen - 1 do
-            let x = Array.unsafe_get au i in
-            let x' = Level.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set au i x'
-          done;
-          a
-        end
+      if Int.equal qlen 0 && Int.equal ulen 0 then 0, empty
+      else begin
+        let h = ref 0 in
+        for i = 0 to qlen - 1 do
+          let x = Array.unsafe_get aq i in
+          let hx, x' = Quality.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set aq i x'
+        done;
+        for i = 0 to ulen - 1 do
+          let x = Array.unsafe_get au i in
+          let hx, x' = Level.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set au i x'
+        done;
+        (* [h] must be positive (XXX why?). *)
+        let h = !h land 0x3FFFFFFF in
+        h, a
+      end
 
     let eq t1 t2 =
       CArray.equal (==) (fst t1) (fst t2)
       && CArray.equal (==) (snd t1) (snd t2)
 
-    let hash (aq,au) =
-      let accu = ref 0 in
-        for i = 0 to Array.length aq - 1 do
-          let l = Array.unsafe_get aq i in
-          let h = Quality.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        for i = 0 to Array.length au - 1 do
-          let l = Array.unsafe_get au i in
-          let h = Level.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        (* [h] must be positive. *)
-        let h = !accu land 0x3FFFFFFF in
-          h
   end
 
   module HInstance = Hashcons.Make(HInstancestruct)
 
   let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons ()
 
-  let hash = HInstancestruct.hash
-
-  let share a = (hcons a, hash a)
-
-  let empty = hcons empty
+  let hash (aq,au) =
+    let accu = ref 0 in
+    for i = 0 to Array.length aq - 1 do
+      let l = Array.unsafe_get aq i in
+      let h = Quality.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    for i = 0 to Array.length au - 1 do
+      let l = Array.unsafe_get au i in
+      let h = Level.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    (* [h] must be positive (XXX why?). *)
+    let h = !accu land 0x3FFFFFFF in
path: kernel/uVars.ml
user: login: silene
body: I don't think we ever use maps indexed by these hash values, do we? If we don't, I would just remove the whole masking.
created_at: 2025-03-12T18:11:29Z
author_association: CONTRIBUTOR
diff_hunk: @@ -370,28 +370,28 @@ let rec of_constr henv c =
 and of_constr_aux henv c =
   match kind c with
   | Var i ->
-    let i = Id.hcons i in
+    let _, i = Id.hcons i in
     Var i
   | Rel _ as t -> t
   | Sort s ->
-    let s = Sorts.hcons s in
+    let _, s = Sorts.hcons s in
path: kernel/hConstr.ml
user: login: silene
body: This feels like a missed chance. You are dropping the hash value, which will be immediately recomputed in `HConstr.of_constr`. Was there a reason not to apply this patch philosophy to this file too, that is, merge `hash_kind` and `of_constr_aux`? (Or perhaps you intend to do it in a subsequent patch?)
created_at: 2025-03-12T18:30:38Z
author_association: CONTRIBUTOR
diff_hunk: @@ -107,53 +105,55 @@ struct
     let hashcons (aq, au as a) =
       let qlen = Array.length aq in
       let ulen = Array.length au in
-        if Int.equal qlen 0 && Int.equal ulen 0 then empty
-        else begin
-          for i = 0 to qlen - 1 do
-            let x = Array.unsafe_get aq i in
-            let x' = Quality.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set aq i x'
-          done;
-          for i = 0 to ulen - 1 do
-            let x = Array.unsafe_get au i in
-            let x' = Level.hcons x in
-              if x == x' then ()
-              else Array.unsafe_set au i x'
-          done;
-          a
-        end
+      if Int.equal qlen 0 && Int.equal ulen 0 then 0, empty
+      else begin
+        let h = ref 0 in
+        for i = 0 to qlen - 1 do
+          let x = Array.unsafe_get aq i in
+          let hx, x' = Quality.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set aq i x'
+        done;
+        for i = 0 to ulen - 1 do
+          let x = Array.unsafe_get au i in
+          let hx, x' = Level.hcons x in
+          h := Hashset.Combine.combine !h hx;
+          if x == x' then ()
+          else Array.unsafe_set au i x'
+        done;
+        (* [h] must be positive (XXX why?). *)
+        let h = !h land 0x3FFFFFFF in
+        h, a
+      end
 
     let eq t1 t2 =
       CArray.equal (==) (fst t1) (fst t2)
       && CArray.equal (==) (snd t1) (snd t2)
 
-    let hash (aq,au) =
-      let accu = ref 0 in
-        for i = 0 to Array.length aq - 1 do
-          let l = Array.unsafe_get aq i in
-          let h = Quality.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        for i = 0 to Array.length au - 1 do
-          let l = Array.unsafe_get au i in
-          let h = Level.hash l in
-            accu := Hashset.Combine.combine !accu h;
-        done;
-        (* [h] must be positive. *)
-        let h = !accu land 0x3FFFFFFF in
-          h
   end
 
   module HInstance = Hashcons.Make(HInstancestruct)
 
   let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons ()
 
-  let hash = HInstancestruct.hash
-
-  let share a = (hcons a, hash a)
-
-  let empty = hcons empty
+  let hash (aq,au) =
+    let accu = ref 0 in
+    for i = 0 to Array.length aq - 1 do
+      let l = Array.unsafe_get aq i in
+      let h = Quality.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    for i = 0 to Array.length au - 1 do
+      let l = Array.unsafe_get au i in
+      let h = Level.hash l in
+      accu := Hashset.Combine.combine !accu h;
+    done;
+    (* [h] must be positive (XXX why?). *)
+    let h = !accu land 0x3FFFFFFF in
path: kernel/uVars.ml
user: login: ppedrot
body: We do, there are a few maps that are internally binary-tree-based hash tables.
created_at: 2025-03-12T18:37:32Z
author_association: MEMBER
diff_hunk: @@ -370,28 +370,28 @@ let rec of_constr henv c =
 and of_constr_aux henv c =
   match kind c with
   | Var i ->
-    let i = Id.hcons i in
+    let _, i = Id.hcons i in
     Var i
   | Rel _ as t -> t
   | Sort s ->
-    let s = Sorts.hcons s in
+    let _, s = Sorts.hcons s in
path: kernel/hConstr.ml
user: login: SkySkimmer
body: I may try it sometime but not right now
created_at: 2025-03-12T19:02:28Z
author_association: CONTRIBUTOR
diff_hunk: @@ -30,30 +30,25 @@ module type HashconsedType =
     type t
     (** Type of objects to hashcons. *)
 
-    val hashcons : t -> t
-    (** The actual hashconsing function, using its first argument to recursively
-        hashcons substructures. It should be compatible with [eq], that is
-        [eq x (hashcons f x) = true]. *)
+    val hashcons : t -> int * t
+    (** The actual hashconsing function. It should be compatible with [eq], that is
+        [eq x (snd @@ hashcons f x) = true]. It also returns the hash. *)
 
     val eq : t -> t -> bool
     (** A comparison function. It is allowed to use physical equality
         on the sub-terms hashconsed by the [hashcons] function, but it should be
-        insensible to shallow copy of the compared object. *)
-
-    val hash : t -> int
-    (** A hash function passed to the underlying hashtable structure. [hash]
-        should be compatible with [eq], i.e. if [eq x y = true] then
-        [hash x = hash y]. *)
+        insensible to shallow copy of the compared object.
+        It should be compatible with the hash returned by [hashcons], ie
+        [eq x y] implies [fst @@ hashcons x = fst @@ hashcons y].
+    *)
   end
 
 module type HashconsedRecType = sig
   type t
 
-  val hashcons : (t -> t) -> t -> t
+  val hashcons : (t -> int * t) -> t -> int * t
path: clib/hashcons.mli
user: login: ppedrot
body: For readability, I think you could introduce a `type 'a hcons = 'a -> int * 'a` and use this in every API that is tweaked by this PR.
created_at: 2025-03-13T05:40:30Z
author_association: MEMBER
diff_hunk: @@ -30,30 +30,25 @@ module type HashconsedType =
     type t
     (** Type of objects to hashcons. *)
 
-    val hashcons : t -> t
-    (** The actual hashconsing function, using its first argument to recursively
-        hashcons substructures. It should be compatible with [eq], that is
-        [eq x (hashcons f x) = true]. *)
+    val hashcons : t -> int * t
+    (** The actual hashconsing function. It should be compatible with [eq], that is
+        [eq x (snd @@ hashcons f x) = true]. It also returns the hash. *)
 
     val eq : t -> t -> bool
     (** A comparison function. It is allowed to use physical equality
         on the sub-terms hashconsed by the [hashcons] function, but it should be
-        insensible to shallow copy of the compared object. *)
-
-    val hash : t -> int
-    (** A hash function passed to the underlying hashtable structure. [hash]
-        should be compatible with [eq], i.e. if [eq x y = true] then
-        [hash x = hash y]. *)
+        insensible to shallow copy of the compared object.
+        It should be compatible with the hash returned by [hashcons], ie
+        [eq x y] implies [fst @@ hashcons x = fst @@ hashcons y].
+    *)
   end
 
 module type HashconsedRecType = sig
   type t
 
-  val hashcons : (t -> t) -> t -> t
+  val hashcons : (t -> int * t) -> t -> int * t
path: clib/hashcons.mli
user: login: SkySkimmer
body: changed
created_at: 2025-03-13T14:01:57Z
author_association: CONTRIBUTOR
diff_hunk: @@ -1303,27 +1294,37 @@ struct
     | MatchStyle -> 3
     | RegularStyle -> 4 in
     h1
-  let hash ci =
-    let h1 = Ind.CanOrd.hash ci.ci_ind in
+  let hash ~hind ci =
+    let h1 = hind in
     let h2 = Int.hash ci.ci_npar in
     let h3 = Array.fold_left combine 0 ci.ci_cstr_ndecls in
     let h4 = Array.fold_left combine 0 ci.ci_cstr_nargs in
     let h5 = hash_pp_info ci.ci_pp_info in
     combine5 h1 h2 h3 h4 h5
+  let hashcons ci =
+    let hind, ind = hcons_ind ci.ci_ind in
+    hash ~hind ci, { ci with ci_ind = ind }
path: kernel/constr.ml
user: login: silene
body: ```suggestion
    hash ~hind ci, if ci.ci_ind == ind then ci else { ci with ci_ind = ind }
```
created_at: 2025-03-13T14:13:07Z
author_association: CONTRIBUTOR
diff_hunk: @@ -236,11 +237,13 @@ struct
   module Self_Hashcons =
     struct
       type nonrec t = t
-      let hashcons (n,s,dir) = (n,Id.hcons s,DirPath.hcons dir)
+      let hashcons (n,s,dir) =
+        let hs, s = Id.hcons s in
+        let hdir, dir = DirPath.hcons dir in
+        combine3 (Int.hash n) hs hdir, (n,s,dir)
path: kernel/names.ml
user: login: silene
body: ```suggestion
      let hashcons ((n,s,dir) as nsd) =
        let hs, s' = Id.hcons s in
        let hdir, dir' = DirPath.hcons dir in
        combine3 (Int.hash n) hs hdir, if s == s' && dir == dir' then nsd else (n,s',dir')
```
created_at: 2025-03-13T14:19:48Z
author_association: CONTRIBUTOR
diff_hunk: @@ -420,10 +429,11 @@ module KerName = struct
     type t = kernel_name
     let hashcons kn =
       let { modpath = mp; knlabel = l; refhash; } = kn in
-      { modpath = ModPath.hcons mp; knlabel = Id.hcons l; refhash; }
+      let _, mp = ModPath.hcons mp in
+      let _, l = Id.hcons l in
+      refhash, { modpath =  mp; knlabel = l; refhash; }
path: kernel/names.ml
user: login: silene
body: ```suggestion
      let _, mp' = ModPath.hcons mp in
      let _, l' = Id.hcons l in
      refhash, if mp == mp' && l == l' then kn else { modpath = mp'; knlabel = l'; refhash; }
```
created_at: 2025-03-13T14:21:30Z
author_association: CONTRIBUTOR
diff_hunk: @@ -336,9 +339,16 @@ module ModPath = struct
   module Self_Hashcons = struct
     type t = module_path
     let hashcons hcons = function
-      | MPfile dir -> MPfile (DirPath.hcons dir)
-      | MPbound m -> MPbound (MBId.hcons m)
-      | MPdot (md,l) -> MPdot (hcons md, Id.hcons l)
+      | MPfile dir ->
+        let hdir, dir = DirPath.hcons dir in
+        combinesmall 1 hdir, MPfile dir
+      | MPbound m ->
+        let hm, m = MBId.hcons m in
+        combinesmall 2 hm, MPbound m
+      | MPdot (md,l) ->
+        let hmd, md = hcons md in
+        let hl, l = Id.hcons l in
+        combinesmall 3 (combine hmd hl), MPdot (md, l)
path: kernel/names.ml
user: login: silene
body: ```suggestion
      | MPfile dir as mp ->
        let hdir, dir' = DirPath.hcons dir in
        combinesmall 1 hdir, if dir == dir' then mp else MPfile dir'
      | MPbound m as mp ->
        let hm, m' = MBId.hcons m in
        combinesmall 2 hm, if m == m' then mp else MPbound m'
      | MPdot (md,l) as mp ->
        let hmd, md' = hcons md in
        let hl, l' = Id.hcons l in
        combinesmall 3 (combine hmd hl), if md == md' && l == l' then mp else MPdot (md', l')
```
created_at: 2025-03-13T14:23:49Z
author_association: CONTRIBUTOR
diff_hunk: @@ -975,10 +990,11 @@ struct
   module Self_Hashcons =
     struct
       type nonrec t = t
-      let hashcons (c,b) = (Repr.hcons c,b)
+      let hashcons (c,b) =
+        let hc, c = Repr.hcons c in
+        (if b then 0 else 1) + hc, (c,b)
path: kernel/names.ml
user: login: silene
body: ```suggestion
        (if b then 1 else 0) + hc, (c,b)
```
The OCaml compiler knows that `if b then 1 else 0` is actually a trivial transmutation (contrarily to `if b then 0 else 1`) and turns it into plain `b`.
created_at: 2025-03-13T14:32:44Z
author_association: CONTRIBUTOR

PR comments:
user: login: SkySkimmer
created_at: 2025-03-11T14:29:27Z
body: @coqbot bench
author_association: CONTRIBUTOR
user: login: coqbot-app[bot]
created_at: 2025-03-12T03:06:35Z
body: :checkered_flag: Bench results:
```
┌─────────────────────────────────────┬─────────────────────────┬───────────────────────────────────────┬─────────────────────────┐
│                                     │      user time [s]      │           CPU instructions            │  max resident mem [KB]  │
│                                     │                         │                                       │                         │
│            package_name             │   NEW      OLD    PDIFF │      NEW             OLD        PDIFF │   NEW      OLD    PDIFF │
├─────────────────────────────────────┼─────────────────────────┼───────────────────────────────────────┼─────────────────────────┤
│                        rocq-bignums │   30.18    30.49  -1.02 │   194490345726    194858755995  -0.19 │  478940   480580  -0.34 │
│               coq-mathcomp-solvable │   79.75    80.46  -0.88 │   546500880757    547541535488  -0.19 │  902848   896972   0.66 │
│                            coq-hott │  155.18   156.55  -0.88 │  1083876190601   1096233047123  -1.13 │  469908   480572  -2.22 │
│                    coq-math-classes │   85.23    85.95  -0.84 │   525148636799    525837568497  -0.13 │  505420   505552  -0.03 │
│                 coq-category-theory │  591.98   596.74  -0.80 │  4370395663421   4437560335502  -1.51 │  963460   958368   0.53 │
│                        coq-compcert │  307.67   309.70  -0.66 │  2023007747527   2027141512777  -0.20 │ 1096140  1099040  -0.26 │
│               coq-mathcomp-fingroup │   22.94    23.07  -0.56 │   148580936854    148813385410  -0.16 │  500252   500956  -0.14 │
│                      coq-verdi-raft │  532.20   535.12  -0.55 │  3697515076474   3699699443807  -0.06 │  834624   827196   0.90 │
│                           coq-color │  243.71   244.98  -0.52 │  1532963985493   1539864708306  -0.45 │ 1142568  1049312   8.89 │
│         coq-rewriter-perf-SuperFast │  479.45   481.70  -0.47 │  3739029810638   3744155120001  -0.14 │ 1234128  1230896   0.26 │
│             coq-metacoq-safechecker │  341.59   343.14  -0.45 │  2590569154330   2603999345111  -0.52 │ 1668832  1667184   0.10 │
│                  coq-metacoq-common │   64.64    64.93  -0.45 │   419758105771    420344964139  -0.14 │  904880   912596  -0.85 │
│                   coq-iris-examples │  391.51   393.23  -0.44 │  2638024061736   2641942221886  -0.15 │ 1114120  1100368   1.25 │
│              coq-mathcomp-character │   69.68    69.96  -0.40 │   480315403457    479704242943   0.13 │ 1151560  1147816   0.33 │
│                      coq-coquelicot │   37.49    37.64  -0.40 │   227878905055    227829840237   0.02 │  817144   821484  -0.53 │
│                coq-metacoq-template │  144.97   145.51  -0.37 │   976704269690    979096213720  -0.24 │  958692   948096   1.12 │
│ coq-neural-net-interp-computed-lite │  233.36   234.18  -0.35 │  2247370366651   2248214799678  -0.04 │  872924   869256   0.42 │
│        coq-fiat-crypto-with-bedrock │ 6103.53  6123.86  -0.33 │ 49708187205375  49779947717454  -0.14 │ 3160720  3148636   0.38 │
│                           rocq-elpi │   12.73    12.77  -0.31 │    91332518108     91387208256  -0.06 │  485784   479160   1.38 │
│            coq-metacoq-translations │   16.54    16.59  -0.30 │   119744031190    119948828336  -0.17 │  745984   752260  -0.83 │
│          coq-performance-tests-lite │  897.64   900.32  -0.30 │  7281754238438   7285742996992  -0.05 │ 2474808  2474600   0.01 │
│                         coq-coqutil │   43.94    44.05  -0.25 │   279424898584    279784153877  -0.13 │  555316   557792  -0.44 │
│                            coq-corn │  673.19   674.85  -0.25 │  4645191620904   4648815718195  -0.08 │  716156   727168  -1.51 │
│                             coq-vst │  867.91   869.92  -0.23 │  6550564056413   6565289217201  -0.22 │ 2222192  2201484   0.94 │
│                        coq-rewriter │  335.08   335.68  -0.18 │  2503793143028   2505882402564  -0.08 │ 1331952  1326828   0.39 │
│                 coq-metacoq-erasure │  515.05   515.79  -0.14 │  3553788027397   3555789208714  -0.06 │ 1794744  1784548   0.57 │
│              coq-mathcomp-odd-order │  483.48   484.17  -0.14 │  3484431964555   3488231120685  -0.11 │ 1657420  1667848  -0.63 │
│                        coq-coqprime │   51.80    51.86  -0.12 │   358419015737    357937353951   0.13 │  787572   792072  -0.57 │
│                         coq-unimath │ 2284.19  2286.31  -0.09 │ 18135139796287  18192840318898  -0.32 │ 1119460  1084512   3.22 │
│                    coq-fiat-parsers │  271.82   271.83  -0.00 │  2107001070229   2114432138603  -0.35 │ 2295404  2287108   0.36 │
│                         rocq-stdlib │  210.43   210.40   0.01 │  1325712717064   1324653619996   0.08 │  598028   596748   0.21 │
│               coq-mathcomp-analysis │  571.80   571.55   0.04 │  4181823143103   4175021628665   0.16 │ 1523764  1493808   2.01 │
│              coq-mathcomp-ssreflect │   84.03    83.99   0.05 │   568753163417    569761296654  -0.18 │ 1474236  1503980  -1.98 │
│                   coq-metacoq-pcuic │  648.32   647.91   0.06 │  4169658970582   4174347623024  -0.11 │ 2248412  2239948   0.38 │
│                  coq-mathcomp-field │   93.05    92.96   0.10 │   668216213883    668145339059   0.01 │ 1331260  1326464   0.36 │
│               coq-engine-bench-lite │  124.74   124.57   0.14 │   936422994533    933424824731   0.32 │ 1069192  1077428  -0.76 │
│                       coq-fourcolor │ 1316.01  1313.08   0.22 │ 12222417977885  12221020105247   0.01 │  770548   764268   0.82 │
│                coq-mathcomp-algebra │  170.16   169.64   0.31 │  1200292486464   1200978840851  -0.06 │ 1091288  1088264   0.28 │
│                       coq-fiat-core │   56.80    56.59   0.37 │   346668705936    346555188160   0.03 │  477800   472260   1.17 │
│                   coq-metacoq-utils │   22.92    22.82   0.44 │   150319193827    150092459239   0.15 │  580596   578312   0.39 │
│                           coq-verdi │   44.16    43.93   0.52 │   294426128241    294390169821   0.01 │  529460   518976   2.02 │
│                        rocq-runtime │   74.07    73.52   0.75 │   536466843829    536949230657  -0.09 │  483236   482868   0.08 │
│                      rocq-equations │    9.05     8.92   1.46 │    62460822518     62559729364  -0.16 │  399944   395660   1.08 │
│                           rocq-core │    6.49     6.39   1.56 │    40856998785     40941412551  -0.21 │  435780   435868  -0.02 │
│                            coq-core │    2.87     2.70   6.30 │    19455702609     19483058139  -0.14 │   91772    91708   0.07 │
└─────────────────────────────────────┴─────────────────────────┴───────────────────────────────────────┴─────────────────────────┘

```


INFO: failed to install 
coq-bedrock2 (in NEW)

<details>
<summary>:turtle: Top 25 slow downs</summary>

<pre>┌───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│                                                               TOP 25 SLOW DOWNS                                                               │
│                                                                                                                                               │
│  OLD     NEW    DIFF    %DIFF    Ln                      FILE                                                                                 │
├───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│    175    177  2.0700    1.18%   233  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/rupicola/bedrock2/deps/riscv-coq/src/riscv/Proofs/DecodeByExtension.v.html#L233">coq-fiat-crypto-with-bedrock/rupicola/bedrock2/deps/riscv-coq/src/riscv/Proofs/DecodeByExtension.v.html</a> │
│   14.7   15.5  0.8335    5.68%   841  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Curves/Weierstrass/Jacobian/CoZ.v.html#L841">coq-fiat-crypto-with-bedrock/src/Curves/Weierstrass/Jacobian/CoZ.v.html</a>                                 │
│   43.1   43.8  0.7388    1.71%   579  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/rupicola/bedrock2/compiler/src/compiler/MMIO.v.html#L579">coq-fiat-crypto-with-bedrock/rupicola/bedrock2/compiler/src/compiler/MMIO.v.html</a>                        │
│   23.9   24.6  0.7143    2.99%   558  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/rupicola/bedrock2/bedrock2/src/bedrock2Examples/insertionsort.v.html#L558">coq-fiat-crypto-with-bedrock/rupicola/bedrock2/bedrock2/src/bedrock2Examples/insertionsort.v.html</a>       │
│   39.3   40.0  0.7137    1.82%  1423  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/rupicola/bedrock2/compiler/src/compiler/FlatToRiscvFunctions.v.html#L1423">coq-fiat-crypto-with-bedrock/rupicola/bedrock2/compiler/src/compiler/FlatToRiscvFunctions.v.html</a>        │
│   17.6   18.2  0.6152    3.50%    31  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-engine-bench-lite/coq/PerformanceDemos/pattern.v.html#L31">coq-engine-bench-lite/coq/PerformanceDemos/pattern.v.html</a>                                               │
│   45.6   46.2  0.5867    1.29%   110  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/rupicola/bedrock2/bedrock2/src/bedrock2Examples/full_mul.v.html#L110">coq-fiat-crypto-with-bedrock/rupicola/bedrock2/bedrock2/src/bedrock2Examples/full_mul.v.html</a>            │
│   24.9   25.5  0.5320    2.13%   345  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Curves/Montgomery/XZProofs.v.html#L345">coq-fiat-crypto-with-bedrock/src/Curves/Montgomery/XZProofs.v.html</a>                                      │
│   48.4   48.8  0.4593    0.95%   376  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-unimath/UniMath/ModelCategories/Generated/LNWFSMonoidalStructure.v.html#L376">coq-unimath/UniMath/ModelCategories/Generated/LNWFSMonoidalStructure.v.html</a>                             │
│   26.0   26.4  0.4428    1.71%   375  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-unimath/UniMath/ModelCategories/Generated/LNWFSMonoidalStructure.v.html#L375">coq-unimath/UniMath/ModelCategories/Generated/LNWFSMonoidalStructure.v.html</a>                             │
│   25.6   26.1  0.4358    1.70%    62  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Assembly/Parse/TestAsm.v.html#L62">coq-fiat-crypto-with-bedrock/src/Assembly/Parse/TestAsm.v.html</a>                                          │
│   26.0   26.4  0.4333    1.67%   374  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-unimath/UniMath/ModelCategories/Generated/LNWFSMonoidalStructure.v.html#L374">coq-unimath/UniMath/ModelCategories/Generated/LNWFSMonoidalStructure.v.html</a>                             │
│   29.5   29.9  0.3797    1.29%    12  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fourcolor/theories/proof/job165to189.v.html#L12">coq-fourcolor/theories/proof/job165to189.v.html</a>                                                         │
│   27.6   28.0  0.3633    1.32%    12  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fourcolor/theories/proof/job107to164.v.html#L12">coq-fourcolor/theories/proof/job107to164.v.html</a>                                                         │
│   11.9   12.3  0.3532    2.96%   194  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Fancy/Barrett256.v.html#L194">coq-fiat-crypto-with-bedrock/src/Fancy/Barrett256.v.html</a>                                                │
│   8.99   9.32  0.3331    3.71%   434  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-mathcomp-odd-order/theories/PFsection12.v.html#L434">coq-mathcomp-odd-order/theories/PFsection12.v.html</a>                                                      │
│   36.4   36.7  0.3282    0.90%     2  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/ExtractionJsOfOCaml/fiat_crypto.v.html#L2">coq-fiat-crypto-with-bedrock/src/ExtractionJsOfOCaml/fiat_crypto.v.html</a>                                 │
│   26.1   26.4  0.3091    1.18%    12  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fourcolor/theories/proof/job190to206.v.html#L12">coq-fourcolor/theories/proof/job190to206.v.html</a>                                                         │
│   36.6   36.9  0.3079    0.84%   974  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Bedrock/Secp256k1/JoyeLadder.v.html#L974">coq-fiat-crypto-with-bedrock/src/Bedrock/Secp256k1/JoyeLadder.v.html</a>                                    │
│   18.0   18.3  0.2912    1.61%    32  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-performance-tests-lite/src/pattern.v.html#L32">coq-performance-tests-lite/src/pattern.v.html</a>                                                           │
│   30.0   30.3  0.2761    0.92%   673  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Bedrock/Secp256k1/JoyeLadder.v.html#L673">coq-fiat-crypto-with-bedrock/src/Bedrock/Secp256k1/JoyeLadder.v.html</a>                                    │
│   13.7   13.9  0.2703    1.98%   216  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Fancy/Barrett256.v.html#L216">coq-fiat-crypto-with-bedrock/src/Fancy/Barrett256.v.html</a>                                                │
│   18.2   18.4  0.2485    1.37%    77  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Assembly/Parse/TestAsm.v.html#L77">coq-fiat-crypto-with-bedrock/src/Assembly/Parse/TestAsm.v.html</a>                                          │
│ 0.0618  0.308  0.2465  398.49%  1207  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-unimath/UniMath/CategoryTheory/DisplayedCats/Examples/StrictTwoSidedDispCat.v.html#L1207">coq-unimath/UniMath/CategoryTheory/DisplayedCats/Examples/StrictTwoSidedDispCat.v.html</a>                  │
│   20.9   21.1  0.2430    1.16%    12  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fourcolor/theories/proof/job511to516.v.html#L12">coq-fourcolor/theories/proof/job511to516.v.html</a>                                                         │
└───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘</pre>


</details>

<details>
<summary>:rabbit2: Top 25 speed ups</summary>

<pre>┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│                                                           TOP 25 SPEED UPS                                                           │
│                                                                                                                                      │
│  OLD     NEW    DIFF     %DIFF    Ln                    FILE                                                                         │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│   26.9   23.3  -3.5615  -13.25%   129  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Curves/Weierstrass/Projective.v.html#L129">coq-fiat-crypto-with-bedrock/src/Curves/Weierstrass/Projective.v.html</a>                         │
│   65.0   62.2  -2.7685   -4.26%   609  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/rupicola/bedrock2/bedrock2/src/bedrock2Examples/lightbulb.v.html#L609">coq-fiat-crypto-with-bedrock/rupicola/bedrock2/bedrock2/src/bedrock2Examples/lightbulb.v.html</a> │
│   60.6   58.7  -1.9467   -3.21%    27  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ToFancyWithCasts.v.html#L27">coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ToFancyWithCasts.v.html</a>                      │
│   4.95   3.58  -1.3705  -27.70%    22  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ArithWithCasts.v.html#L22">coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ArithWithCasts.v.html</a>                        │
│   3.21   2.36  -0.8500  -26.51%    34  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ArithWithCasts.v.html#L34">coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ArithWithCasts.v.html</a>                        │
│   22.3   21.5  -0.8003   -3.60%    49  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Curves/Weierstrass/AffineProofs.v.html#L49">coq-fiat-crypto-with-bedrock/src/Curves/Weierstrass/AffineProofs.v.html</a>                       │
│    236    235  -0.7936   -0.34%   141  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/UnsaturatedSolinasHeuristics/Tests.v.html#L141">coq-fiat-crypto-with-bedrock/src/UnsaturatedSolinasHeuristics/Tests.v.html</a>                    │
│    200    200  -0.7185   -0.36%     8  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-neural-net-interp-computed-lite/theories/MaxOfTwoNumbersSimpler/Computed/AllLogits.v.html#L8">coq-neural-net-interp-computed-lite/theories/MaxOfTwoNumbersSimpler/Computed/AllLogits.v.html</a> │
│    120    119  -0.6910   -0.58%    22  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ArithWithCasts.v.html#L22">coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ArithWithCasts.v.html</a>                        │
│ 42.877  42.21  -0.6670   -1.56%   834  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-vst/veric/binop_lemmas4.v.html#L834">coq-vst/veric/binop_lemmas4.v.html</a>                                                            │
│   5.74   5.11  -0.6227  -10.86%   130  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-category-theory/Functor/Strong/Product.v.html#L130">coq-category-theory/Functor/Strong/Product.v.html</a>                                             │
│   5.41  4.813  -0.5970  -11.04%    84  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-vst/veric/binop_lemmas2.v.html#L84">coq-vst/veric/binop_lemmas2.v.html</a>                                                            │
│   2.06   1.50  -0.5604  -27.20%    42  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ToFancyWithCasts.v.html#L42">coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/ToFancyWithCasts.v.html</a>                      │
│    100   99.5  -0.5496   -0.55%   999  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-performance-tests-lite/src/fiat_crypto_via_setoid_rewrite_standalone.v.html#L999">coq-performance-tests-lite/src/fiat_crypto_via_setoid_rewrite_standalone.v.html</a>               │
│   35.3   34.9  -0.4535   -1.28%   120  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-unimath/UniMath/CategoryTheory/Hyperdoctrines/PartialEqRels/ExponentialEqs.v.html#L120">coq-unimath/UniMath/CategoryTheory/Hyperdoctrines/PartialEqRels/ExponentialEqs.v.html</a>         │
│   18.9   18.5  -0.4192   -2.22%   481  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-verdi-raft/theories/RaftProofs/EndToEndLinearizability.v.html#L481">coq-verdi-raft/theories/RaftProofs/EndToEndLinearizability.v.html</a>                             │
│  100.0   99.6  -0.4008   -0.40%   968  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-performance-tests-lite/src/fiat_crypto_via_setoid_rewrite_standalone.v.html#L968">coq-performance-tests-lite/src/fiat_crypto_via_setoid_rewrite_standalone.v.html</a>               │
│  6.681  6.305  -0.3760   -5.63%   192  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-vst/veric/binop_lemmas5.v.html#L192">coq-vst/veric/binop_lemmas5.v.html</a>                                                            │
│   21.6   21.2  -0.3253   -1.51%    23  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/Arith.v.html#L23">coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/Arith.v.html</a>                                 │
│   9.30   8.99  -0.3151   -3.39%   345  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Bedrock/End2End/X25519/EdwardsXYZT.v.html#L345">coq-fiat-crypto-with-bedrock/src/Bedrock/End2End/X25519/EdwardsXYZT.v.html</a>                    │
│   14.8   14.5  -0.3076   -2.08%    24  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/MulSplit.v.html#L24">coq-fiat-crypto-with-bedrock/src/Rewriter/Passes/MulSplit.v.html</a>                              │
│   21.1   20.8  -0.3016   -1.43%   213  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Curves/EdwardsMontgomery.v.html#L213">coq-fiat-crypto-with-bedrock/src/Curves/EdwardsMontgomery.v.html</a>                              │
│   23.6   23.3  -0.3004   -1.27%    12  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fourcolor/theories/proof/job554to562.v.html#L12">coq-fourcolor/theories/proof/job554to562.v.html</a>                                               │
│   42.5   42.2  -0.2998   -0.71%    50  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-fiat-crypto-with-bedrock/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v.html#L50">coq-fiat-crypto-with-bedrock/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v.html</a>          │
│   4.39   4.10  -0.2867   -6.54%  1827  <a href="https://coq.gitlabpages.inria.fr/-/coq/-/jobs/5448682/artifacts/_bench/html/coq-metacoq-safechecker/safechecker/theories/PCUICSafeReduce.v.html#L1827">coq-metacoq-safechecker/safechecker/theories/PCUICSafeReduce.v.html</a>                           │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘</pre>


</details>

- [:chair: GitLab Bench Job](https://gitlab.inria.fr/coq/coq/-/jobs/5448682)
author_association: CONTRIBUTOR
user: login: SkySkimmer
created_at: 2025-03-13T14:44:47Z
body: >I think this patch is a chance to do some smart hashconsing as often as possible.

I'd rather do that in a separate PR.
author_association: CONTRIBUTOR
user: login: ppedrot
created_at: 2025-03-14T08:06:38Z
body: As per the discussions, this looks like it is already fine as-is, so @coqbot merge now
author_association: MEMBER
user: login: coqbot-app[bot]
created_at: 2025-03-14T08:06:40Z
body: @ppedrot: You can't merge the PR because it hasn't been approved yet.
author_association: CONTRIBUTOR
user: login: ppedrot
created_at: 2025-03-14T08:08:06Z
body: @coqbot merge now
author_association: MEMBER