opam

-opam-version: "1.2"
-name: "coq-stdpp"
-version: "dev"
-maintainer: "Robbert Krebbers"
-authors: "Robbert Krebbers"
-bug-reports: "https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp/issues"
-license: "BSD"
-dev-repo: "https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp.git"
-build: [
-  [make "-j%{jobs}%"]
-]
-install: [make "install"]
-remove: [ "sh" "-c" "rm -rf '%{lib}%/coq/user-contrib/coq-stdpp'" ]
-depends: [
-  "coq" { ((>= "8.6" & < "8.7~") | (= "dev"))}
-]

stdpp/base.v

+(** This file collects type class interfaces, notations, and general theorems
+that are used throughout the whole development. Most importantly it contains
+abstract interfaces for ordered structures, sets, and various other data
+structures. *)
+
+(* We want to ensure that [le] and [lt] refer to operations on [nat].
+These two functions being defined both in [Coq.Bool] and in [Coq.Peano],
+we must export [Coq.Peano] later than any export of [Coq.Bool]. *)
+(* We also want to ensure that notations from [Coq.Utf8] take precedence
+over the ones of [Coq.Peano] (see Coq PR#12950), so we import [Utf8] last. *)
+From Coq Require Export Morphisms RelationClasses List Bool Setoid Peano Utf8.
+From Coq Require Import Permutation.
+Export ListNotations.
+From Coq.Program Require Export Basics Syntax.
+
+(* notations _.1 and _.2 below, TODO: remove when requiring Coq > 8.19 *)
+From Coq.ssr Require Import (notations) ssrfun.
+
+From stdpp Require Import options.
+
+(** This notation is necessary to prevent [length] from being printed
+as [strings.length] if strings.v is imported and later base.v. See
+also strings.v and
+https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/144 and
+https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/129. *)
+Notation length := Datatypes.length.
+
+(** * Enable implicit generalization. *)
+(** This option enables implicit generalization in arguments of the form
+   [`{...}] (i.e., anonymous arguments).  Unfortunately, it also enables
+   implicit generalization in [Instance].  We think that the fact that both
+   behaviors are coupled together is a [bug in
+   Coq](https://github.com/coq/coq/issues/6030). *)
+Global Generalizable All Variables.
+
+(** * Tweak program *)
+(** 1. Since we only use Program to solve logical side-conditions, they should
+always be made Opaque, otherwise we end up with performance problems due to
+Coq blindly unfolding them.
+
+Note that in most cases we use [Next Obligation. (* ... *) Qed.], for which
+this option does not matter. However, sometimes we write things like
+[Solve Obligations with naive_solver (* ... *)], and then the obligations
+should surely be opaque. *)
+Global Unset Transparent Obligations.
+
+(** 2. Do not let Program automatically simplify obligations. The default
+obligation tactic is [Tactics.program_simpl], which, among other things,
+introduces all variables and gives them fresh names. As such, it becomes
+impossible to refer to hypotheses in a robust way. *)
+Global Obligation Tactic := idtac.
+
+(** 3. Hide obligations and unsealing lemmas from the results of the [Search]
+commands. *)
+Add Search Blacklist "_obligation_".
+Add Search Blacklist "_unseal".
+
+(** * Sealing off definitions *)
+#[projections(primitive=yes)]
+Record seal {A} (f : A) := { unseal : A; seal_eq : unseal = f }.
+Global Arguments unseal {_ _} _ : assert.
+Global Arguments seal_eq {_ _} _ : assert.
+
+(** * Solving type class instances *)
+(** The tactic [tc_solve] is used to solve type class goals by invoking type
+class search. It is similar to [apply _], but it is more robust since it does
+not affect unrelated goals/evars due to https://github.com/coq/coq/issues/6583.
+
+The tactic [tc_solve] is particularly useful when building custom tactics that
+need tight control over when type class search is invoked. In Iris, many of the
+proof mode tactics make use of [notypeclasses refine] and use [tc_solve] to
+manually invoke type class search.
+
+Note that [typeclasses eauto] is multi-success. That means, whenever subsequent
+tactics fail, it will backtrack to [typeclasses eauto] to try the next type
+class instance. This is almost always undesired and can lead to poor performance
+and horrible error messages. Hence, we wrap it in a [once]. *)
+Ltac tc_solve :=
+  solve [once (typeclasses eauto)].
+
+(** * Non-backtracking type classes *)
+(** The type class [TCNoBackTrack P] can be used to establish [P] without ever
+backtracking on the instance of [P] that has been found. Backtracking may
+normally happen when [P] contains evars that could be instanciated in different
+ways depending on which instance is picked, and type class search somewhere else
+depends on this evar.
+
+The proper way of handling this would be by setting Coq's option
+`Typeclasses Unique Instances`. However, this option seems to be broken, see Coq
+issue #6714.
+
+See https://gitlab.mpi-sws.org/FP/iris-coq/merge_requests/112 for a rationale
+of this type class. *)
+Class TCNoBackTrack (P : Prop) := TCNoBackTrack_intro { tc_no_backtrack : P }.
+Global Hint Extern 0 (TCNoBackTrack _) =>
+  notypeclasses refine (TCNoBackTrack_intro _ _); tc_solve : typeclass_instances.
+
+(* A conditional at the type class level. Note that [TCIf P Q R] is not the same
+as [TCOr (TCAnd P Q) R]: the latter will backtrack to [R] if it fails to
+establish [Q], i.e. does not have the behavior of a conditional. Furthermore,
+note that [TCOr (TCAnd P Q) (TCAnd (TCNot P) R)] would not work; we generally
+would not be able to prove the negation of [P]. *)
+Inductive TCIf (P Q R : Prop) : Prop :=
+  | TCIf_true : P → Q → TCIf P Q R
+  | TCIf_false : R → TCIf P Q R.
+Existing Class TCIf.
+
+Global Hint Extern 0 (TCIf _ _ _) =>
+  first [notypeclasses refine (TCIf_true _ _ _ _ _); [tc_solve|]
+        |notypeclasses refine (TCIf_false _ _ _ _)] : typeclass_instances.
+
+(** * Typeclass opaque definitions *)
+(** The constant [tc_opaque] is used to make definitions opaque for just type
+class search. Note that [simpl] is set up to always unfold [tc_opaque]. *)
+Definition tc_opaque {A} (x : A) : A := x.
+Global Typeclasses Opaque tc_opaque.
+Global Arguments tc_opaque {_} _ /.
+
+(** Below we define type class versions of the common logical operators. It is
+important to note that we duplicate the definitions, and do not declare the
+existing logical operators as type classes. That is, we do not say:
+
+  Existing Class or.
+  Existing Class and.
+
+If we could define the existing logical operators as classes, there is no way
+of disambiguating whether a premise of a lemma should be solved by type class
+resolution or not.
+
+These classes are useful for two purposes: writing complicated type class
+premises in a more concise way, and for efficiency. For example, using the [Or]
+class, instead of defining two instances [P → Q1 → R] and [P → Q2 → R] we could
+have one instance [P → Or Q1 Q2 → R]. When we declare the instance that way, we
+avoid the need to derive [P] twice. *)
+Inductive TCOr (P1 P2 : Prop) : Prop :=
+  | TCOr_l : P1 → TCOr P1 P2
+  | TCOr_r : P2 → TCOr P1 P2.
+Existing Class TCOr.
+Global Existing Instance TCOr_l | 9.
+Global Existing Instance TCOr_r | 10.
+Global Hint Mode TCOr ! ! : typeclass_instances.
+
+Inductive TCAnd (P1 P2 : Prop) : Prop := TCAnd_intro : P1 → P2 → TCAnd P1 P2.
+Existing Class TCAnd.
+Global Existing Instance TCAnd_intro.
+Global Hint Mode TCAnd ! ! : typeclass_instances.
+
+Inductive TCTrue : Prop := TCTrue_intro : TCTrue.
+Existing Class TCTrue.
+Global Existing Instance TCTrue_intro.
+
+(** The class [TCFalse] is not stricly necessary as one could also use
+[False]. However, users might expect that TCFalse exists and if it
+does not, it can cause hard to diagnose bugs due to automatic
+generalization. *)
+Inductive TCFalse : Prop :=.
+Existing Class TCFalse.
+
+(** The class [TCUnless] can be used to check that search for [P]
+fails. This is useful as a guard for certain instances together with
+classes like [TCFastDone] (see [tactics.v]) to prevent infinite loops
+(e.g. when saturating the context). *)
+Notation TCUnless P := (TCIf P TCFalse TCTrue).
+
+Inductive TCForall {A} (P : A → Prop) : list A → Prop :=
+  | TCForall_nil : TCForall P []
+  | TCForall_cons x xs : P x → TCForall P xs → TCForall P (x :: xs).
+Existing Class TCForall.
+Global Existing Instance TCForall_nil.
+Global Existing Instance TCForall_cons.
+Global Hint Mode TCForall ! ! ! : typeclass_instances.
+
+(** The class [TCForall2 P l k] is commonly used to transform an input list [l]
+into an output list [k], or the converse. Therefore there are two modes, either
+[l] input and [k] output, or [k] input and [l] input. *)
+Inductive TCForall2 {A B} (P : A → B → Prop) : list A → list B → Prop :=
+  | TCForall2_nil : TCForall2 P [] []
+  | TCForall2_cons x y xs ys :
+     P x y → TCForall2 P xs ys → TCForall2 P (x :: xs) (y :: ys).
+Existing Class TCForall2.
+Global Existing Instance TCForall2_nil.
+Global Existing Instance TCForall2_cons.
+Global Hint Mode TCForall2 ! ! ! ! - : typeclass_instances.
+Global Hint Mode TCForall2 ! ! ! - ! : typeclass_instances.
+
+Inductive TCExists {A} (P : A → Prop) : list A → Prop :=
+  | TCExists_cons_hd x l : P x → TCExists P (x :: l)
+  | TCExists_cons_tl x l: TCExists P l → TCExists P (x :: l).
+Existing Class TCExists.
+Global Existing Instance TCExists_cons_hd | 10.
+Global Existing Instance TCExists_cons_tl | 20.
+Global Hint Mode TCExists ! ! ! : typeclass_instances.
+
+Inductive TCElemOf {A} (x : A) : list A → Prop :=
+  | TCElemOf_here xs : TCElemOf x (x :: xs)
+  | TCElemOf_further y xs : TCElemOf x xs → TCElemOf x (y :: xs).
+Existing Class TCElemOf.
+Global Existing Instance TCElemOf_here.
+Global Existing Instance TCElemOf_further.
+Global Hint Mode TCElemOf ! ! ! : typeclass_instances.
+
+(** The intended use of [TCEq x y] is to use [x] as input and [y] as output, but
+this is not enforced. We use output mode [-] (instead of [!]) for [x] to ensure
+that type class search succeed on goals like [TCEq (if ? then e1 else e2) ?y],
+see https://gitlab.mpi-sws.org/iris/iris/merge_requests/391 for a use case.
+Mode [-] is harmless, the only instance of [TCEq] is [TCEq_refl] below, so we
+cannot create loops. *)
+Inductive TCEq {A} (x : A) : A → Prop := TCEq_refl : TCEq x x.
+Existing Class TCEq.
+Global Existing Instance TCEq_refl.
+Global Hint Mode TCEq ! - - : typeclass_instances.
+
+Lemma TCEq_eq {A} (x1 x2 : A) : TCEq x1 x2 ↔ x1 = x2.
+Proof. split; destruct 1; reflexivity. Qed.
+
+(** The [TCSimpl x y] type class is similar to [TCEq] but performs [simpl]
+before proving the goal by reflexivity. Similar to [TCEq], the argument [x]
+is the input and [y] the output. When solving [TCEq x y], the argument [x]
+should be a concrete term and [y] an evar for the [simpl]ed result. *)
+Class TCSimpl {A} (x x' : A) := TCSimpl_TCEq : TCEq x x'.
+Global Hint Extern 0 (TCSimpl _ _) =>
+  (* Since the second argument should be an evar, we can call [simpl] on the
+  whole goal. *)
+  simpl; notypeclasses refine (TCEq_refl _) : typeclass_instances.
+Global Hint Mode TCSimpl ! - - : typeclass_instances.
+
+Lemma TCSimpl_eq {A} (x1 x2 : A) : TCSimpl x1 x2 ↔ x1 = x2.
+Proof. apply TCEq_eq. Qed.
+
+Inductive TCDiag {A} (C : A → Prop) : A → A → Prop :=
+  | TCDiag_diag x : C x → TCDiag C x x.
+Existing Class TCDiag.
+Global Existing Instance TCDiag_diag.
+Global Hint Mode TCDiag ! ! ! - : typeclass_instances.
+Global Hint Mode TCDiag ! ! - ! : typeclass_instances.
+
+(** Given a proposition [P] that is a type class, [tc_to_bool P] will return
+[true] iff there is an instance of [P]. It is often useful in Ltac programming,
+where one can do [lazymatch tc_to_bool P with true => .. | false => .. end]. *)
+Definition tc_to_bool (P : Prop)
+  {p : bool} `{TCIf P (TCEq p true) (TCEq p false)} : bool := p.
+
+(** Throughout this development we use [stdpp_scope] for all general purpose
+notations that do not belong to a more specific scope. *)
+Declare Scope stdpp_scope.
+Delimit Scope stdpp_scope with stdpp.
+Global Open Scope stdpp_scope.
+
+(** Change [True] and [False] into notations in order to enable overloading.
+We will use this to give [True] and [False] a different interpretation for
+embedded logics. *)
+Notation "'True'" := True (format "True") : type_scope.
+Notation "'False'" := False (format "False") : type_scope.
+
+(** Change [forall] into a notation in order to enable overloading. *)
+Notation "'forall' x .. y , P" := (forall x, .. (forall y, P) ..)
+  (at level 200, x binder, y binder, right associativity,
+   only parsing) : type_scope.
+
+
+(** * Equality *)
+(** Introduce some Haskell style like notations. *)
+Notation "(=)" := eq (only parsing) : stdpp_scope.
+Notation "( x =.)" := (eq x) (only parsing) : stdpp_scope.
+Notation "(.= x )" := (λ y, eq y x) (only parsing) : stdpp_scope.
+Notation "(≠)" := (λ x y, x ≠ y) (only parsing) : stdpp_scope.
+Notation "( x ≠.)" := (λ y, x ≠ y) (only parsing) : stdpp_scope.
+Notation "(.≠ x )" := (λ y, y ≠ x) (only parsing) : stdpp_scope.
+
+Infix "=@{ A }" := (@eq A)
+  (at level 70, only parsing, no associativity) : stdpp_scope.
+Notation "(=@{ A } )" := (@eq A) (only parsing) : stdpp_scope.
+Notation "(≠@{ A } )" := (λ X Y, ¬X =@{A} Y) (only parsing) : stdpp_scope.
+Notation "X ≠@{ A } Y":= (¬X =@{ A } Y)
+  (at level 70, only parsing, no associativity) : stdpp_scope.
+
+Global Hint Extern 0 (_ = _) => reflexivity : core.
+Global Hint Extern 100 (_ ≠ _) => discriminate : core.
+
+Global Instance: ∀ A, PreOrder (=@{A}).
+Proof. split; repeat intro; congruence. Qed.
+
+(** ** Setoid equality *)
+(** We define an operational type class for setoid equality, i.e., the
+"canonical" equivalence for a type. The typeclass is tied to the \equiv
+symbol. This is based on (Spitters/van der Weegen, 2011). *)
+Class Equiv A := equiv: relation A.
+Global Hint Mode Equiv ! : typeclass_instances.
+
+(** We instruct setoid rewriting to infer [equiv] as a relation on
+type [A] when needed. This allows setoid_rewrite to solve constraints
+of shape [Proper (eq ==> ?R) f] using [Proper (eq ==> (equiv (A:=A))) f]
+when an equivalence relation is available on type [A]. We put this instance
+at level 150 so it does not take precedence over Coq's stdlib instances,
+favoring inference of [eq] (all Coq functions are automatically morphisms
+for [eq]). We have [eq] (at 100) < [≡] (at 150) < [⊑] (at 200). *)
+Global Instance equiv_rewrite_relation `{Equiv A} :
+  RewriteRelation (@equiv A _) | 150 := {}.
+
+Infix "≡" := equiv (at level 70, no associativity) : stdpp_scope.
+Infix "≡@{ A }" := (@equiv A _)
+  (at level 70, only parsing, no associativity) : stdpp_scope.
+
+Notation "(≡)" := equiv (only parsing) : stdpp_scope.
+Notation "( X ≡.)" := (equiv X) (only parsing) : stdpp_scope.
+Notation "(.≡ X )" := (λ Y, Y ≡ X) (only parsing) : stdpp_scope.
+Notation "(≢)" := (λ X Y, ¬X ≡ Y) (only parsing) : stdpp_scope.
+Notation "X ≢ Y":= (¬X ≡ Y) (at level 70, no associativity) : stdpp_scope.
+Notation "( X ≢.)" := (λ Y, X ≢ Y) (only parsing) : stdpp_scope.
+Notation "(.≢ X )" := (λ Y, Y ≢ X) (only parsing) : stdpp_scope.
+
+Notation "(≡@{ A } )" := (@equiv A _) (only parsing) : stdpp_scope.
+Notation "(≢@{ A } )" := (λ X Y, ¬X ≡@{A} Y) (only parsing) : stdpp_scope.
+Notation "X ≢@{ A } Y":= (¬X ≡@{ A } Y)
+  (at level 70, only parsing, no associativity) : stdpp_scope.
+
+(** The type class [LeibnizEquiv] collects setoid equalities that coincide
+with Leibniz equality. We provide the tactic [fold_leibniz] to transform such
+setoid equalities into Leibniz equalities, and [unfold_leibniz] for the
+reverse.
+
+Various std++ tactics assume that this class is only instantiated if [≡]
+is an equivalence relation. *)
+Class LeibnizEquiv A `{Equiv A} :=
+  leibniz_equiv (x y : A) : x ≡ y → x = y.
+Global Hint Mode LeibnizEquiv ! ! : typeclass_instances.
+
+Lemma leibniz_equiv_iff `{LeibnizEquiv A, !Reflexive (≡@{A})} (x y : A) :
+  x ≡ y ↔ x = y.
+Proof. split; [apply leibniz_equiv|]. intros ->; reflexivity. Qed.
+
+Ltac fold_leibniz := repeat
+  match goal with
+  | H : context [ _ ≡@{?A} _ ] |- _ =>
+    setoid_rewrite (leibniz_equiv_iff (A:=A)) in H
+  | |- context [ _ ≡@{?A} _ ] =>
+    setoid_rewrite (leibniz_equiv_iff (A:=A))
+  end.
+Ltac unfold_leibniz := repeat
+  match goal with
+  | H : context [ _ =@{?A} _ ] |- _ =>
+    setoid_rewrite <-(leibniz_equiv_iff (A:=A)) in H
+  | |- context [ _ =@{?A} _ ] =>
+    setoid_rewrite <-(leibniz_equiv_iff (A:=A))
+  end.
+
+Definition equivL {A} : Equiv A := (=).
+
+(** A [Params f n] instance forces the setoid rewriting mechanism not to
+rewrite in the first [n] arguments of the function [f]. We will declare such
+instances for all operational type classes in this development. *)
+Global Instance: Params (@equiv) 2 := {}.
+
+(** The following instance forces [setoid_replace] to use setoid equality
+(for types that have an [Equiv] instance) rather than the standard Leibniz
+equality. *)
+Global Instance equiv_default_relation `{Equiv A} :
+  DefaultRelation (≡@{A}) | 3 := {}.
+Global Hint Extern 0 (_ ≡ _) => reflexivity : core.
+Global Hint Extern 0 (_ ≡ _) => symmetry; assumption : core.
+
+
+(** * Type classes *)
+(** ** Decidable propositions *)
+(** This type class by (Spitters/van der Weegen, 2011) collects decidable
+propositions. *)
+Class Decision (P : Prop) := decide : {P} + {¬P}.
+Global Hint Mode Decision ! : typeclass_instances.
+Global Arguments decide _ {_} : simpl never, assert.
+
+(** Although [RelDecision R] is just [∀ x y, Decision (R x y)], we make this
+an explicit class instead of a notation for two reasons:
+
+- It allows us to control [Hint Mode] more precisely. In particular, if it were
+  defined as a notation, the above [Hint Mode] for [Decision] would not prevent
+  diverging instance search when looking for [RelDecision (@eq ?A)], which would
+  result in it looking for [Decision (@eq ?A x y)], i.e. an instance where the
+  head position of [Decision] is not en evar.
+- We use it to avoid inefficient computation due to eager evaluation of
+  propositions by [vm_compute]. This inefficiency arises for example if
+  [(x = y) := (f x = f y)]. Since [decide (x = y)] evaluates to
+  [decide (f x = f y)], this would then lead to evaluation of [f x] and [f y].
+  Using the [RelDecision], the [f] is hidden under a lambda, which prevents
+  unnecessary evaluation. *)
+Class RelDecision {A B} (R : A → B → Prop) :=
+  decide_rel x y :: Decision (R x y).
+Global Hint Mode RelDecision ! ! ! : typeclass_instances.
+Global Arguments decide_rel {_ _} _ {_} _ _ : simpl never, assert.
+Notation EqDecision A := (RelDecision (=@{A})).
+
+(** ** Inhabited types *)
+(** This type class collects types that are inhabited. *)
+Class Inhabited (A : Type) : Type := populate { inhabitant : A }.
+Global Hint Mode Inhabited ! : typeclass_instances.
+Global Arguments populate {_} _ : assert.
+
+(** ** Proof irrelevant types *)
+(** This type class collects types that are proof irrelevant. That means, all
+elements of the type are equal. We use this notion only used for propositions,
+but by universe polymorphism we can generalize it. *)
+Class ProofIrrel (A : Type) : Prop := proof_irrel (x y : A) : x = y.
+Global Hint Mode ProofIrrel ! : typeclass_instances.
+
+(** ** Common properties *)
+(** These operational type classes allow us to refer to common mathematical
+properties in a generic way. For example, for injectivity of [(k ++.)] it
+allows us to write [inj (k ++.)] instead of [app_inv_head k]. *)
+Class Inj {A B} (R : relation A) (S : relation B) (f : A → B) : Prop :=
+  inj x y : S (f x) (f y) → R x y.
+Class Inj2 {A B C} (R1 : relation A) (R2 : relation B)
+    (S : relation C) (f : A → B → C) : Prop :=
+  inj2 x1 x2 y1 y2 : S (f x1 x2) (f y1 y2) → R1 x1 y1 ∧ R2 x2 y2.
+Class Cancel {A B} (S : relation B) (f : A → B) (g : B → A) : Prop :=
+  cancel x : S (f (g x)) x.
+Class Surj {A B} (R : relation B) (f : A → B) :=
+  surj y : ∃ x, R (f x) y.
+Class IdemP {A} (R : relation A) (f : A → A → A) : Prop :=
+  idemp x : R (f x x) x.
+Class Comm {A B} (R : relation A) (f : B → B → A) : Prop :=
+  comm x y : R (f x y) (f y x).
+Class LeftId {A} (R : relation A) (i : A) (f : A → A → A) : Prop :=
+  left_id x : R (f i x) x.
+Class RightId {A} (R : relation A) (i : A) (f : A → A → A) : Prop :=
+  right_id x : R (f x i) x.
+Class Assoc {A} (R : relation A) (f : A → A → A) : Prop :=
+  assoc x y z : R (f x (f y z)) (f (f x y) z).
+Class LeftAbsorb {A} (R : relation A) (i : A) (f : A → A → A) : Prop :=
+  left_absorb x : R (f i x) i.
+Class RightAbsorb {A} (R : relation A) (i : A) (f : A → A → A) : Prop :=
+  right_absorb x : R (f x i) i.
+Class AntiSymm {A} (R S : relation A) : Prop :=
+  anti_symm x y : S x y → S y x → R x y.
+Class Total {A} (R : relation A) := total x y : R x y ∨ R y x.
+Class Trichotomy {A} (R : relation A) :=
+  trichotomy x y : R x y ∨ x = y ∨ R y x.
+Class TrichotomyT {A} (R : relation A) :=
+  trichotomyT x y : {R x y} + {x = y} + {R y x}.
+
+Notation Involutive R f := (Cancel R f f).
+Lemma involutive {A} {R : relation A} (f : A → A) `{Involutive R f} x :
+  R (f (f x)) x.
+Proof. auto. Qed.
+
+Global Arguments irreflexivity {_} _ {_} _ _ : assert.
+Global Arguments inj {_ _ _ _} _ {_} _ _ _ : assert.
+Global Arguments inj2 {_ _ _ _ _ _} _ {_} _ _ _ _ _: assert.
+Global Arguments cancel {_ _ _} _ _ {_} _ : assert.
+Global Arguments surj {_ _ _} _ {_} _ : assert.
+Global Arguments idemp {_ _} _ {_} _ : assert.
+Global Arguments comm {_ _ _} _ {_} _ _ : assert.
+Global Arguments left_id {_ _} _ _ {_} _ : assert.
+Global Arguments right_id {_ _} _ _ {_} _ : assert.
+Global Arguments assoc {_ _} _ {_} _ _ _ : assert.
+Global Arguments left_absorb {_ _} _ _ {_} _ : assert.
+Global Arguments right_absorb {_ _} _ _ {_} _ : assert.
+Global Arguments anti_symm {_ _} _ {_} _ _ _ _ : assert.
+Global Arguments total {_} _ {_} _ _ : assert.
+Global Arguments trichotomy {_} _ {_} _ _ : assert.
+Global Arguments trichotomyT {_} _ {_} _ _ : assert.
+
+Lemma not_symmetry `{R : relation A, !Symmetric R} x y : ¬R x y → ¬R y x.
+Proof. intuition. Qed.
+Lemma symmetry_iff `(R : relation A) `{!Symmetric R} x y : R x y ↔ R y x.
+Proof. intuition. Qed.
+
+Lemma not_inj `{Inj A B R R' f} x y : ¬R x y → ¬R' (f x) (f y).
+Proof. intuition. Qed.
+Lemma not_inj2_1 `{Inj2 A B C R R' R'' f} x1 x2 y1 y2 :
+  ¬R x1 x2 → ¬R'' (f x1 y1) (f x2 y2).
+Proof. intros HR HR''. destruct (inj2 f x1 y1 x2 y2); auto. Qed.
+Lemma not_inj2_2 `{Inj2 A B C R R' R'' f} x1 x2 y1 y2 :
+  ¬R' y1 y2 → ¬R'' (f x1 y1) (f x2 y2).
+Proof. intros HR' HR''. destruct (inj2 f x1 y1 x2 y2); auto. Qed.
+
+Lemma inj_iff {A B} {R : relation A} {S : relation B} (f : A → B)
+  `{!Inj R S f} `{!Proper (R ==> S) f} x y : S (f x) (f y) ↔ R x y.
+Proof. firstorder. Qed.
+Global Instance inj2_inj_1 `{Inj2 A B C R1 R2 R3 f} y : Inj R1 R3 (λ x, f x y).
+Proof. repeat intro; edestruct (inj2 f); eauto. Qed.
+Global Instance inj2_inj_2 `{Inj2 A B C R1 R2 R3 f} x : Inj R2 R3 (f x).
+Proof. repeat intro; edestruct (inj2 f); eauto. Qed.
+
+Lemma cancel_inj `{Cancel A B R1 f g, !Equivalence R1, !Proper (R2 ==> R1) f} :
+  Inj R1 R2 g.
+Proof.
+  intros x y E. rewrite <-(cancel f g x), <-(cancel f g y), E. reflexivity.
+Qed.
+Lemma cancel_surj `{Cancel A B R1 f g} : Surj R1 f.
+Proof. intros y. exists (g y). auto. Qed.
+
+(** The following lemmas are specific versions of the projections of the above
+type classes for Leibniz equality. These lemmas allow us to enforce Coq not to
+use the setoid rewriting mechanism. *)
+Lemma idemp_L {A} f `{!@IdemP A (=) f} x : f x x = x.
+Proof. auto. Qed.
+Lemma comm_L {A B} f `{!@Comm A B (=) f} x y : f x y = f y x.
+Proof. auto. Qed.
+Lemma left_id_L {A} i f `{!@LeftId A (=) i f} x : f i x = x.
+Proof. auto. Qed.
+Lemma right_id_L {A} i f `{!@RightId A (=) i f} x : f x i = x.
+Proof. auto. Qed.
+Lemma assoc_L {A} f `{!@Assoc A (=) f} x y z : f x (f y z) = f (f x y) z.
+Proof. auto. Qed.
+Lemma left_absorb_L {A} i f `{!@LeftAbsorb A (=) i f} x : f i x = i.
+Proof. auto. Qed.
+Lemma right_absorb_L {A} i f `{!@RightAbsorb A (=) i f} x : f x i = i.
+Proof. auto. Qed.
+
+(** ** Generic orders *)
+(** The classes [PreOrder], [PartialOrder], and [TotalOrder] use an arbitrary
+relation [R] instead of [⊆] to support multiple orders on the same type. *)
+Definition strict {A} (R : relation A) : relation A := λ X Y, R X Y ∧ ¬R Y X.
+Global Instance: Params (@strict) 2 := {}.
+
+Class PartialOrder {A} (R : relation A) : Prop := {
+  partial_order_pre :: PreOrder R;
+  partial_order_anti_symm :: AntiSymm (=) R
+}.
+Global Hint Mode PartialOrder ! ! : typeclass_instances.
+
+Class TotalOrder {A} (R : relation A) : Prop := {
+  total_order_partial :: PartialOrder R;
+  total_order_trichotomy :: Trichotomy (strict R)
+}.
+Global Hint Mode TotalOrder ! ! : typeclass_instances.
+
+(** * Logic *)
+Global Instance prop_inhabited : Inhabited Prop := populate True.
+
+Notation "(∧)" := and (only parsing) : stdpp_scope.
+Notation "( A ∧.)" := (and A) (only parsing) : stdpp_scope.
+Notation "(.∧ B )" := (λ A, A ∧ B) (only parsing) : stdpp_scope.
+
+Notation "(∨)" := or (only parsing) : stdpp_scope.
+Notation "( A ∨.)" := (or A) (only parsing) : stdpp_scope.
+Notation "(.∨ B )" := (λ A, A ∨ B) (only parsing) : stdpp_scope.
+
+Notation "(↔)" := iff (only parsing) : stdpp_scope.
+Notation "( A ↔.)" := (iff A) (only parsing) : stdpp_scope.
+Notation "(.↔ B )" := (λ A, A ↔ B) (only parsing) : stdpp_scope.
+
+Global Hint Extern 0 (_ ↔ _) => reflexivity : core.
+Global Hint Extern 0 (_ ↔ _) => symmetry; assumption : core.
+
+Lemma or_l P Q : ¬Q → P ∨ Q ↔ P.
+Proof. tauto. Qed.
+Lemma or_r P Q : ¬P → P ∨ Q ↔ Q.
+Proof. tauto. Qed.
+Lemma and_wlog_l (P Q : Prop) : (Q → P) → Q → (P ∧ Q).
+Proof. tauto. Qed.
+Lemma and_wlog_r (P Q : Prop) : P → (P → Q) → (P ∧ Q).
+Proof. tauto. Qed.
+Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R).
+Proof. tauto. Qed.
+Lemma forall_proper {A} (P Q : A → Prop) :
+  (∀ x, P x ↔ Q x) → (∀ x, P x) ↔ (∀ x, Q x).
+Proof. firstorder. Qed.
+Lemma exist_proper {A} (P Q : A → Prop) :
+  (∀ x, P x ↔ Q x) → (∃ x, P x) ↔ (∃ x, Q x).
+Proof. firstorder. Qed.
+
+Global Instance eq_comm {A} : Comm (↔) (=@{A}).
+Proof. red; intuition. Qed.
+Global Instance flip_eq_comm {A} : Comm (↔) (λ x y, y =@{A} x).
+Proof. red; intuition. Qed.
+Global Instance iff_comm : Comm (↔) (↔).
+Proof. red; intuition. Qed.
+Global Instance and_comm : Comm (↔) (∧).
+Proof. red; intuition. Qed.
+Global Instance and_assoc : Assoc (↔) (∧).
+Proof. red; intuition. Qed.
+Global Instance and_idemp : IdemP (↔) (∧).
+Proof. red; intuition. Qed.
+Global Instance or_comm : Comm (↔) (∨).
+Proof. red; intuition. Qed.
+Global Instance or_assoc : Assoc (↔) (∨).
+Proof. red; intuition. Qed.
+Global Instance or_idemp : IdemP (↔) (∨).
+Proof. red; intuition. Qed.
+Global Instance True_and : LeftId (↔) True (∧).
+Proof. red; intuition. Qed.
+Global Instance and_True : RightId (↔) True (∧).
+Proof. red; intuition. Qed.
+Global Instance False_and : LeftAbsorb (↔) False (∧).
+Proof. red; intuition. Qed.
+Global Instance and_False : RightAbsorb (↔) False (∧).
+Proof. red; intuition. Qed.
+Global Instance False_or : LeftId (↔) False (∨).
+Proof. red; intuition. Qed.
+Global Instance or_False : RightId (↔) False (∨).
+Proof. red; intuition. Qed.
+Global Instance True_or : LeftAbsorb (↔) True (∨).
+Proof. red; intuition. Qed.
+Global Instance or_True : RightAbsorb (↔) True (∨).
+Proof. red; intuition. Qed.
+Global Instance True_impl : LeftId (↔) True impl.
+Proof. unfold impl. red; intuition. Qed.
+Global Instance impl_True : RightAbsorb (↔) True impl.
+Proof. unfold impl. red; intuition. Qed.
+
+
+(** * Common data types *)
+(** ** Functions *)
+Notation "(→)" := (λ A B, A → B) (only parsing) : stdpp_scope.
+Notation "( A →.)" := (λ B, A → B) (only parsing) : stdpp_scope.
+Notation "(.→ B )" := (λ A, A → B) (only parsing) : stdpp_scope.
+
+Notation "t $ r" := (t r)
+  (at level 65, right associativity, only parsing) : stdpp_scope.
+Notation "($)" := (λ f x, f x) (only parsing) : stdpp_scope.
+Notation "(.$ x )" := (λ f, f x) (only parsing) : stdpp_scope.
+
+Infix "∘" := compose : stdpp_scope.
+Notation "(∘)" := compose (only parsing) : stdpp_scope.
+Notation "( f ∘.)" := (compose f) (only parsing) : stdpp_scope.
+Notation "(.∘ f )" := (λ g, compose g f) (only parsing) : stdpp_scope.
+
+Global Instance impl_inhabited {A} `{Inhabited B} : Inhabited (A → B) :=
+  populate (λ _, inhabitant).
+
+(** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully
+applied. *)
+Global Arguments id _ _ / : assert.
+Global Arguments compose _ _ _ _ _ _ / : assert.
+Global Arguments flip _ _ _ _ _ _ / : assert.
+Global Arguments const _ _ _ _ / : assert.
+Global Typeclasses Transparent id compose flip const.
+
+Definition fun_map {A A' B B'} (f: A' → A) (g: B → B') (h : A → B) : A' → B' :=
+  g ∘ h ∘ f.
+
+Global Instance const_proper `{R1 : relation A, R2 : relation B} (x : B) :
+  Reflexive R2 → Proper (R1 ==> R2) (λ _, x).
+Proof. intros ? y1 y2; reflexivity. Qed.
+
+Global Instance id_inj {A} : Inj (=) (=) (@id A).
+Proof. intros ??; auto. Qed.
+Global Instance compose_inj {A B C} R1 R2 R3 (f : A → B) (g : B → C) :
+  Inj R1 R2 f → Inj R2 R3 g → Inj R1 R3 (g ∘ f).
+Proof. red; intuition. Qed.
+
+Global Instance id_surj {A} : Surj (=) (@id A).
+Proof. intros y; exists y; reflexivity. Qed.
+Global Instance compose_surj {A B C} R (f : A → B) (g : B → C) :
+  Surj (=) f → Surj R g → Surj R (g ∘ f).
+Proof.
+  intros ?? x. unfold compose. destruct (surj g x) as [y ?].
+  destruct (surj f y) as [z ?]. exists z. congruence.
+Qed.
+
+Global Instance const2_comm {A B} (x : B) : Comm (=) (λ _ _ : A, x).
+Proof. intros ?; reflexivity. Qed.
+Global Instance const2_assoc {A} (x : A) : Assoc (=) (λ _ _ : A, x).
+Proof. intros ???; reflexivity. Qed.
+Global Instance id1_assoc {A} : Assoc (=) (λ x _ : A, x).
+Proof. intros ???; reflexivity. Qed.
+Global Instance id2_assoc {A} : Assoc (=) (λ _ x : A, x).
+Proof. intros ???; reflexivity. Qed.
+Global Instance id1_idemp {A} : IdemP (=) (λ x _ : A, x).
+Proof. intros ?; reflexivity. Qed.
+Global Instance id2_idemp {A} : IdemP (=) (λ _ x : A, x).
+Proof. intros ?; reflexivity. Qed.
+
+(** ** Lists *)
+Global Instance list_inhabited {A} : Inhabited (list A) := populate [].
+
+Definition zip_with {A B C} (f : A → B → C) : list A → list B → list C :=
+  fix go l1 l2 :=
+  match l1, l2 with x1 :: l1, x2 :: l2 => f x1 x2 :: go l1 l2 | _ , _ => [] end.
+Notation zip := (zip_with pair).
+
+(** ** Booleans *)
+(** The following coercion allows us to use Booleans as propositions. *)
+Coercion Is_true : bool >-> Sortclass.
+Global Hint Unfold Is_true : core.
+Global Hint Immediate Is_true_eq_left : core.
+Global Hint Resolve orb_prop_intro andb_prop_intro : core.
+Notation "(&&)" := andb (only parsing).
+Notation "(||)" := orb (only parsing).
+Infix "&&*" := (zip_with (&&)) (at level 40).
+Infix "||*" := (zip_with (||)) (at level 50).
+
+Global Instance bool_inhabated : Inhabited bool := populate true.
+
+Definition bool_le (β1 β2 : bool) : Prop := negb β1 || β2.
+Infix "=.>" := bool_le (at level 70).
+Infix "=.>*" := (Forall2 bool_le) (at level 70).
+Global Instance: PartialOrder bool_le.
+Proof. repeat split; repeat intros [|]; compute; tauto. Qed.
+
+Lemma andb_True b1 b2 : b1 && b2 ↔ b1 ∧ b2.
+Proof. destruct b1, b2; simpl; tauto. Qed.
+Lemma orb_True b1 b2 : b1 || b2 ↔ b1 ∨ b2.
+Proof. destruct b1, b2; simpl; tauto. Qed.
+Lemma negb_True b : negb b ↔ ¬b.
+Proof. destruct b; simpl; tauto. Qed.
+Lemma Is_true_true (b : bool) : b ↔ b = true.
+Proof. now destruct b. Qed.
+Lemma Is_true_true_1 (b : bool) : b → b = true.
+Proof. apply Is_true_true. Qed.
+Lemma Is_true_true_2 (b : bool) : b = true → b.
+Proof. apply Is_true_true. Qed.
+Lemma Is_true_false (b : bool) : ¬ b ↔ b = false.
+Proof. now destruct b; simpl. Qed.
+Lemma Is_true_false_1 (b : bool) : ¬b → b = false.
+Proof. apply Is_true_false. Qed.
+Lemma Is_true_false_2 (b : bool) : b = false → ¬b.
+Proof. apply Is_true_false. Qed.
+
+(** ** Unit *)
+Global Instance unit_equiv : Equiv unit := λ _ _, True.
+Global Instance unit_equivalence : Equivalence (≡@{unit}).
+Proof. repeat split. Qed.
+Global Instance unit_leibniz : LeibnizEquiv unit.
+Proof. intros [] []; reflexivity. Qed.
+Global Instance unit_inhabited: Inhabited unit := populate ().
+
+(** ** Empty *)
+Global Instance Empty_set_equiv : Equiv Empty_set := λ _ _, True.
+Global Instance Empty_set_equivalence : Equivalence (≡@{Empty_set}).
+Proof. repeat split. Qed.
+Global Instance Empty_set_leibniz : LeibnizEquiv Empty_set.
+Proof. intros [] []; reflexivity. Qed.
+
+(** ** Products *)
+Notation "( x ,.)" := (pair x) (only parsing) : stdpp_scope.
+Notation "(., y )" := (λ x, (x,y)) (only parsing) : stdpp_scope.
+
+Notation "p .1" := (fst p).
+Notation "p .2" := (snd p).
+
+Global Instance: Params (@pair) 2 := {}.
+Global Instance: Params (@fst) 2 := {}.
+Global Instance: Params (@snd) 2 := {}.
+
+Global Instance: Params (@curry) 3 := {}.
+Global Instance: Params (@uncurry) 3 := {}.
+
+Definition uncurry3 {A B C D} (f : A → B → C → D) (p : A * B * C) : D :=
+  let '(a,b,c) := p in f a b c.
+Global Instance: Params (@uncurry3) 4 := {}.
+Definition uncurry4 {A B C D E} (f : A → B → C → D → E) (p : A * B * C * D) : E :=
+  let '(a,b,c,d) := p in f a b c d.
+Global Instance: Params (@uncurry4) 5 := {}.
+
+Definition curry3 {A B C D} (f : A * B * C → D) (a : A) (b : B) (c : C) : D :=
+  f (a, b, c).
+Global Instance: Params (@curry3) 4 := {}.
+Definition curry4 {A B C D E} (f : A * B * C * D → E)
+  (a : A) (b : B) (c : C) (d : D) : E := f (a, b, c, d).
+Global Instance: Params (@curry4) 5 := {}.
+
+Definition prod_map {A A' B B'} (f: A → A') (g: B → B') (p : A * B) : A' * B' :=
+  (f (p.1), g (p.2)).
+Global Instance: Params (@prod_map) 4 := {}.
+Global Arguments prod_map {_ _ _ _} _ _ !_ / : assert.
+
+Definition prod_zip {A A' A'' B B' B''} (f : A → A' → A'') (g : B → B' → B'')
+    (p : A * B) (q : A' * B') : A'' * B'' := (f (p.1) (q.1), g (p.2) (q.2)).
+Global Instance: Params (@prod_zip) 6 := {}.
+Global Arguments prod_zip {_ _ _ _ _ _} _ _ !_ !_ / : assert.
+
+Definition prod_swap {A B} (p : A * B) : B * A := (p.2, p.1).
+Global Arguments prod_swap {_ _} !_ /.
+Global Instance: Params (@prod_swap) 2 := {}.
+
+Global Instance prod_inhabited {A B} (iA : Inhabited A)
+    (iB : Inhabited B) : Inhabited (A * B) :=
+  match iA, iB with populate x, populate y => populate (x,y) end.
+
+(** Note that we need eta for products for the [uncurry_curry] lemmas to hold
+in non-applied form ([uncurry (curry f) = f]). *)
+Lemma curry_uncurry {A B C} (f : A → B → C) : curry (uncurry f) = f.
+Proof. reflexivity. Qed.
+Lemma uncurry_curry {A B C} (f : A * B → C) p : uncurry (curry f) p = f p.
+Proof. destruct p; reflexivity. Qed.
+Lemma curry3_uncurry3 {A B C D} (f : A → B → C → D) : curry3 (uncurry3 f) = f.
+Proof. reflexivity. Qed.
+Lemma uncurry3_curry3 {A B C D} (f : A * B * C → D) p :
+  uncurry3 (curry3 f) p = f p.
+Proof. destruct p as [[??] ?]; reflexivity. Qed.
+Lemma curry4_uncurry4 {A B C D E} (f : A → B → C → D → E) :
+  curry4 (uncurry4 f) = f.
+Proof. reflexivity. Qed.
+Lemma uncurry4_curry4 {A B C D E} (f : A * B * C * D → E) p :
+  uncurry4 (curry4 f) p = f p.
+Proof. destruct p as [[[??] ?] ?]; reflexivity. Qed.
+
+(** [pair_eq] as a name is more consistent with our usual naming. *)
+Lemma pair_eq {A B} (a1 a2 : A) (b1 b2 : B) :
+  (a1, b1) = (a2, b2) ↔ a1 = a2 ∧ b1 = b2.
+Proof. apply pair_equal_spec. Qed.
+
+Global Instance pair_inj {A B} : Inj2 (=) (=) (=) (@pair A B).
+Proof. injection 1; auto. Qed.
+Global Instance prod_map_inj {A A' B B'} (f : A → A') (g : B → B') :
+  Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (prod_map f g).
+Proof.
+  intros ?? [??] [??] ?; simpl in *; f_equal;
+    [apply (inj f)|apply (inj g)]; congruence.
+Qed.
+
+Global Instance prod_swap_cancel {A B} :
+  Cancel (=) (@prod_swap A B) (@prod_swap B A).
+Proof. intros [??]; reflexivity. Qed.
+Global Instance prod_swap_inj {A B} : Inj (=) (=) (@prod_swap A B).
+Proof. apply cancel_inj. Qed.
+Global Instance prod_swap_surj {A B} : Surj (=) (@prod_swap A B).
+Proof. apply cancel_surj. Qed.
+
+Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) :
+  relation (A * B) := λ x y, R1 (x.1) (y.1) ∧ R2 (x.2) (y.2).
+
+Section prod_relation.
+  Context `{RA : relation A, RB : relation B}.
+
+  Global Instance prod_relation_refl :
+    Reflexive RA → Reflexive RB → Reflexive (prod_relation RA RB).
+  Proof. firstorder eauto. Qed.
+  Global Instance prod_relation_sym :
+    Symmetric RA → Symmetric RB → Symmetric (prod_relation RA RB).
+  Proof. firstorder eauto. Qed.
+  Global Instance prod_relation_trans :
+    Transitive RA → Transitive RB → Transitive (prod_relation RA RB).
+  Proof. firstorder eauto. Qed.
+  Global Instance prod_relation_equiv :
+    Equivalence RA → Equivalence RB → Equivalence (prod_relation RA RB).
+  Proof. split; apply _. Qed.
+
+  Global Instance pair_proper' : Proper (RA ==> RB ==> prod_relation RA RB) pair.
+  Proof. firstorder eauto. Qed.
+  Global Instance pair_inj' : Inj2 RA RB (prod_relation RA RB) pair.
+  Proof. inversion_clear 1; eauto. Qed.
+  Global Instance fst_proper' : Proper (prod_relation RA RB ==> RA) fst.
+  Proof. firstorder eauto. Qed.
+  Global Instance snd_proper' : Proper (prod_relation RA RB ==> RB) snd.
+  Proof. firstorder eauto. Qed.
+
+  Global Instance prod_swap_proper' :
+    Proper (prod_relation RA RB ==> prod_relation RB RA) prod_swap.
+  Proof. firstorder eauto. Qed.
+
+  Global Instance curry_proper' `{RC : relation C} :
+    Proper ((prod_relation RA RB ==> RC) ==> RA ==> RB ==> RC) curry.
+  Proof. firstorder eauto. Qed.
+  Global Instance uncurry_proper' `{RC : relation C} :
+    Proper ((RA ==> RB ==> RC) ==> prod_relation RA RB ==> RC) uncurry.
+  Proof. intros f1 f2 Hf [x1 y1] [x2 y2] []; apply Hf; assumption. Qed.
+
+  Global Instance curry3_proper' `{RC : relation C, RD : relation D} :
+    Proper ((prod_relation (prod_relation RA RB) RC ==> RD) ==>
+            RA ==> RB ==> RC ==> RD) curry3.
+  Proof. firstorder eauto. Qed.
+  Global Instance uncurry3_proper' `{RC : relation C, RD : relation D} :
+    Proper ((RA ==> RB ==> RC ==> RD) ==>
+            prod_relation (prod_relation RA RB) RC ==> RD) uncurry3.
+  Proof. intros f1 f2 Hf [[??] ?] [[??] ?] [[??] ?]; apply Hf; assumption. Qed.
+
+  Global Instance curry4_proper' `{RC : relation C, RD : relation D, RE : relation E} :
+    Proper ((prod_relation (prod_relation (prod_relation RA RB) RC) RD ==> RE) ==>
+            RA ==> RB ==> RC ==> RD ==> RE) curry4.
+  Proof. firstorder eauto. Qed.
+  Global Instance uncurry4_proper' `{RC : relation C, RD : relation D, RE : relation E} :
+    Proper ((RA ==> RB ==> RC ==> RD ==> RE) ==>
+            prod_relation (prod_relation (prod_relation RA RB) RC) RD ==> RE) uncurry4.
+  Proof.
+    intros f1 f2 Hf [[[??] ?] ?] [[[??] ?] ?] [[[??] ?] ?]; apply Hf; assumption.
+  Qed.
+End prod_relation.
+
+Global Instance prod_equiv `{Equiv A,Equiv B} : Equiv (A * B) :=
+  prod_relation (≡) (≡).
+
+(** Below we make [prod_equiv] type class opaque, so we first lift all
+instances *)
+Section prod_setoid.
+  Context `{Equiv A, Equiv B}.
+
+  Global Instance prod_equivalence :
+    Equivalence (≡@{A}) → Equivalence (≡@{B}) → Equivalence (≡@{A * B}) := _.
+
+  Global Instance pair_proper : Proper ((≡) ==> (≡) ==> (≡@{A*B})) pair := _.
+  Global Instance pair_equiv_inj : Inj2 (≡) (≡) (≡@{A*B}) pair := _.
+  Global Instance fst_proper : Proper ((≡@{A*B}) ==> (≡)) fst := _.
+  Global Instance snd_proper : Proper ((≡@{A*B}) ==> (≡)) snd := _.
+
+  Global Instance prod_swap_proper :
+    Proper ((≡@{A*B}) ==> (≡@{B*A})) prod_swap := _.
+
+  Global Instance curry_proper `{Equiv C} :
+    Proper (((≡@{A*B}) ==> (≡@{C})) ==> (≡) ==> (≡) ==> (≡)) curry := _.
+  Global Instance uncurry_proper `{Equiv C} :
+    Proper (((≡) ==> (≡) ==> (≡)) ==> (≡@{A*B}) ==> (≡@{C})) uncurry := _.
+
+  Global Instance curry3_proper `{Equiv C, Equiv D} :
+    Proper (((≡@{A*B*C}) ==> (≡@{D})) ==>
+            (≡) ==> (≡) ==> (≡) ==> (≡)) curry3 := _.
+  Global Instance uncurry3_proper `{Equiv C, Equiv D} :
+    Proper (((≡) ==> (≡) ==> (≡) ==> (≡)) ==>
+            (≡@{A*B*C}) ==> (≡@{D})) uncurry3 := _.
+
+  Global Instance curry4_proper `{Equiv C, Equiv D, Equiv E} :
+    Proper (((≡@{A*B*C*D}) ==> (≡@{E})) ==>
+            (≡) ==> (≡) ==> (≡) ==> (≡) ==> (≡)) curry4 := _.
+  Global Instance uncurry4_proper `{Equiv C, Equiv D, Equiv E} :
+    Proper (((≡) ==> (≡) ==> (≡) ==> (≡) ==> (≡)) ==>
+            (≡@{A*B*C*D}) ==> (≡@{E})) uncurry4 := _.
+
+  Lemma pair_equiv (a1 a2 : A) (b1 b2 : B) :
+    (a1, b1) ≡ (a2, b2) ↔ a1 ≡ a2 ∧ b1 ≡ b2.
+  Proof. reflexivity. Qed.
+End prod_setoid.
+
+Global Typeclasses Opaque prod_equiv.
+
+Global Instance prod_leibniz `{LeibnizEquiv A, LeibnizEquiv B} :
+  LeibnizEquiv (A * B).
+Proof. intros [??] [??] [??]; f_equal; apply leibniz_equiv; auto. Qed.
+
+(** ** Sums *)
+Definition sum_map {A A' B B'} (f: A → A') (g: B → B') (xy : A + B) : A' + B' :=
+  match xy with inl x => inl (f x) | inr y => inr (g y) end.
+Global Arguments sum_map {_ _ _ _} _ _ !_ / : assert.
+
+Global Instance sum_inhabited_l {A B} (iA : Inhabited A) : Inhabited (A + B) :=
+  match iA with populate x => populate (inl x) end.
+Global Instance sum_inhabited_r {A B} (iB : Inhabited B) : Inhabited (A + B) :=
+  match iB with populate y => populate (inr y) end.
+
+Global Instance inl_inj {A B} : Inj (=) (=) (@inl A B).
+Proof. injection 1; auto. Qed.
+Global Instance inr_inj {A B} : Inj (=) (=) (@inr A B).
+Proof. injection 1; auto. Qed.
+
+Global Instance sum_map_inj {A A' B B'} (f : A → A') (g : B → B') :
+  Inj (=) (=) f → Inj (=) (=) g → Inj (=) (=) (sum_map f g).
+Proof. intros ?? [?|?] [?|?] [=]; f_equal; apply (inj _); auto. Qed.
+
+Inductive sum_relation {A B}
+     (RA : relation A) (RB : relation B) : relation (A + B) :=
+  | inl_related x1 x2 : RA x1 x2 → sum_relation RA RB (inl x1) (inl x2)
+  | inr_related y1 y2 : RB y1 y2 → sum_relation RA RB (inr y1) (inr y2).
+
+Section sum_relation.
+  Context `{RA : relation A, RB : relation B}.
+  Global Instance sum_relation_refl :
+    Reflexive RA → Reflexive RB → Reflexive (sum_relation RA RB).
+  Proof. intros ?? [?|?]; constructor; reflexivity. Qed.
+  Global Instance sum_relation_sym :
+    Symmetric RA → Symmetric RB → Symmetric (sum_relation RA RB).
+  Proof. destruct 3; constructor; eauto. Qed.
+  Global Instance sum_relation_trans :
+    Transitive RA → Transitive RB → Transitive (sum_relation RA RB).
+  Proof. destruct 3; inversion_clear 1; constructor; eauto. Qed.
+  Global Instance sum_relation_equiv :
+    Equivalence RA → Equivalence RB → Equivalence (sum_relation RA RB).
+  Proof. split; apply _. Qed.
+  Global Instance inl_proper' : Proper (RA ==> sum_relation RA RB) inl.
+  Proof. constructor; auto. Qed.
+  Global Instance inr_proper' : Proper (RB ==> sum_relation RA RB) inr.
+  Proof. constructor; auto. Qed.
+  Global Instance inl_inj' : Inj RA (sum_relation RA RB) inl.
+  Proof. inversion_clear 1; auto. Qed.
+  Global Instance inr_inj' : Inj RB (sum_relation RA RB) inr.
+  Proof. inversion_clear 1; auto. Qed.
+End sum_relation.
+
+Global Instance sum_equiv `{Equiv A, Equiv B} : Equiv (A + B) := sum_relation (≡) (≡).
+Global Instance inl_proper `{Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@inl A B) := _.
+Global Instance inr_proper `{Equiv A, Equiv B} : Proper ((≡) ==> (≡)) (@inr A B) := _.
+Global Instance inl_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inl A B) := _.
+Global Instance inr_equiv_inj `{Equiv A, Equiv B} : Inj (≡) (≡) (@inr A B) := _.
+Global Typeclasses Opaque sum_equiv.
+
+(** ** Option *)
+Global Instance option_inhabited {A} : Inhabited (option A) := populate None.
+
+(** ** Sigma types *)
+Global Arguments existT {_ _} _ _ : assert.
+Global Arguments projT1 {_ _} _ : assert.
+Global Arguments projT2 {_ _} _ : assert.
+
+Global Arguments exist {_} _ _ _ : assert.
+Global Arguments proj1_sig {_ _} _ : assert.
+Global Arguments proj2_sig {_ _} _ : assert.
+Notation "x ↾ p" := (exist _ x p) (at level 20) : stdpp_scope.
+Notation "` x" := (proj1_sig x) (at level 10, format "` x") : stdpp_scope.
+
+Lemma proj1_sig_inj {A} (P : A → Prop) x (Px : P x) y (Py : P y) :
+  x↾Px = y↾Py → x = y.
+Proof. injection 1; trivial. Qed.
+
+Section sig_map.
+  Context `{P : A → Prop} `{Q : B → Prop} (f : A → B) (Hf : ∀ x, P x → Q (f x)).
+  Definition sig_map (x : sig P) : sig Q := f (`x) ↾ Hf _ (proj2_sig x).
+  Global Instance sig_map_inj:
+    (∀ x, ProofIrrel (P x)) → Inj (=) (=) f → Inj (=) (=) sig_map.
+  Proof.
+    intros ?? [x Hx] [y Hy]. injection 1. intros Hxy.
+    apply (inj f) in Hxy; subst. rewrite (proof_irrel _ Hy). auto.
+  Qed.
+End sig_map.
+Global Arguments sig_map _ _ _ _ _ _ !_ / : assert.
+
+Definition proj1_ex {P : Prop} {Q : P → Prop} (p : ∃ x, Q x) : P :=
+  let '(ex_intro _ x _) := p in x.
+Definition proj2_ex {P : Prop} {Q : P → Prop} (p : ∃ x, Q x) : Q (proj1_ex p) :=
+  let '(ex_intro _ x H) := p in H.
+
+(** * Operations on sets *)
+(** We define operational type classes for the traditional operations and
+relations on sets: the empty set [∅], the union [(∪)],
+intersection [(∩)], and difference [(∖)], the singleton [{[_]}], the subset
+[(⊆)] and element of [(∈)] relation, and disjointess [(##)]. *)
+Class Empty A := empty: A.
+Global Hint Mode Empty ! : typeclass_instances.
+Notation "∅" := empty (format "∅") : stdpp_scope.
+
+Global Instance empty_inhabited `(Empty A) : Inhabited A := populate ∅.
+
+Class Union A := union: A → A → A.
+Global Hint Mode Union ! : typeclass_instances.
+Global Instance: Params (@union) 2 := {}.
+Infix "∪" := union (at level 50, left associativity) : stdpp_scope.
+Notation "(∪)" := union (only parsing) : stdpp_scope.
+Notation "( x ∪.)" := (union x) (only parsing) : stdpp_scope.
+Notation "(.∪ x )" := (λ y, union y x) (only parsing) : stdpp_scope.
+Infix "∪*" := (zip_with (∪)) (at level 50, left associativity) : stdpp_scope.
+Notation "(∪*)" := (zip_with (∪)) (only parsing) : stdpp_scope.
+
+Definition union_list `{Empty A} `{Union A} : list A → A := fold_right (∪) ∅.
+Global Arguments union_list _ _ _ !_ / : assert.
+Notation "⋃ l" := (union_list l) (at level 20, format "⋃  l") : stdpp_scope.
+
+Class Intersection A := intersection: A → A → A.
+Global Hint Mode Intersection ! : typeclass_instances.
+Global Instance: Params (@intersection) 2 := {}.
+Infix "∩" := intersection (at level 40) : stdpp_scope.
+Notation "(∩)" := intersection (only parsing) : stdpp_scope.
+Notation "( x ∩.)" := (intersection x) (only parsing) : stdpp_scope.
+Notation "(.∩ x )" := (λ y, intersection y x) (only parsing) : stdpp_scope.
+
+Class Difference A := difference: A → A → A.
+Global Hint Mode Difference ! : typeclass_instances.
+Global Instance: Params (@difference) 2 := {}.
+Infix "∖" := difference (at level 40, left associativity) : stdpp_scope.
+Notation "(∖)" := difference (only parsing) : stdpp_scope.
+Notation "( x ∖.)" := (difference x) (only parsing) : stdpp_scope.
+Notation "(.∖ x )" := (λ y, difference y x) (only parsing) : stdpp_scope.
+Infix "∖*" := (zip_with (∖)) (at level 40, left associativity) : stdpp_scope.
+Notation "(∖*)" := (zip_with (∖)) (only parsing) : stdpp_scope.
+
+(** The operation [cprod X Y] gives the Cartesian product of set-like structures
+[X] and [Y], i.e., [cprod X Y := { (x,y) | x ∈ X, y ∈ Y }]. The implementation/
+instance depends on the representation of the set. *)
+Class CProd A B C := cprod : A → B → C.
+Global Hint Mode CProd ! ! - : typeclass_instances.
+Global Instance: Params (@cprod) 4 := {}.
+(** We do not have a notation for [cprod] (yet) since this operation seems
+not commonly enough used. *)
+
+Class Singleton A B := singleton: A → B.
+Global Hint Mode Singleton - ! : typeclass_instances.
+Global Instance: Params (@singleton) 3 := {}.
+Notation "{[ x ]}" := (singleton x) (at level 1) : stdpp_scope.
+Notation "{[ x ; y ; .. ; z ]}" :=
+  (union .. (union (singleton x) (singleton y)) .. (singleton z))
+  (at level 1) : stdpp_scope.
+
+Class SubsetEq A := subseteq: relation A.
+Global Hint Mode SubsetEq ! : typeclass_instances.
+Global Instance: Params (@subseteq) 2 := {}.
+Infix "⊆" := subseteq (at level 70) : stdpp_scope.
+Notation "(⊆)" := subseteq (only parsing) : stdpp_scope.
+Notation "( X ⊆.)" := (subseteq X) (only parsing) : stdpp_scope.
+Notation "(.⊆ X )" := (λ Y, Y ⊆ X) (only parsing) : stdpp_scope.
+Notation "X ⊈ Y" := (¬X ⊆ Y) (at level 70) : stdpp_scope.
+Notation "(⊈)" := (λ X Y, X ⊈ Y) (only parsing) : stdpp_scope.
+Notation "( X ⊈.)" := (λ Y, X ⊈ Y) (only parsing) : stdpp_scope.
+Notation "(.⊈ X )" := (λ Y, Y ⊈ X) (only parsing) : stdpp_scope.
+
+Infix "⊆@{ A }" := (@subseteq A _) (at level 70, only parsing) : stdpp_scope.
+Notation "(⊆@{ A } )" := (@subseteq A _) (only parsing) : stdpp_scope.
+
+Infix "⊆*" := (Forall2 (⊆)) (at level 70) : stdpp_scope.
+Notation "(⊆*)" := (Forall2 (⊆)) (only parsing) : stdpp_scope.
+
+Global Hint Extern 0 (_ ⊆ _) => reflexivity : core.
+Global Hint Extern 0 (_ ⊆* _) => reflexivity : core.
+
+Infix "⊂" := (strict (⊆)) (at level 70) : stdpp_scope.
+Notation "(⊂)" := (strict (⊆)) (only parsing) : stdpp_scope.
+Notation "( X ⊂.)" := (strict (⊆) X) (only parsing) : stdpp_scope.
+Notation "(.⊂ X )" := (λ Y, Y ⊂ X) (only parsing) : stdpp_scope.
+Notation "X ⊄ Y" := (¬X ⊂ Y) (at level 70) : stdpp_scope.
+Notation "(⊄)" := (λ X Y, X ⊄ Y) (only parsing) : stdpp_scope.
+Notation "( X ⊄.)" := (λ Y, X ⊄ Y) (only parsing) : stdpp_scope.
+Notation "(.⊄ X )" := (λ Y, Y ⊄ X) (only parsing) : stdpp_scope.
+
+Infix "⊂@{ A }" := (strict (⊆@{A})) (at level 70, only parsing) : stdpp_scope.
+Notation "(⊂@{ A } )" := (strict (⊆@{A})) (only parsing) : stdpp_scope.
+
+Notation "X ⊆ Y ⊆ Z" := (X ⊆ Y ∧ Y ⊆ Z) (at level 70, Y at next level) : stdpp_scope.
+Notation "X ⊆ Y ⊂ Z" := (X ⊆ Y ∧ Y ⊂ Z) (at level 70, Y at next level) : stdpp_scope.
+Notation "X ⊂ Y ⊆ Z" := (X ⊂ Y ∧ Y ⊆ Z) (at level 70, Y at next level) : stdpp_scope.
+Notation "X ⊂ Y ⊂ Z" := (X ⊂ Y ∧ Y ⊂ Z) (at level 70, Y at next level) : stdpp_scope.
+
+(** We define type classes for multisets: disjoint union [⊎] and the multiset
+singleton [{[+ _ +]}]. Multiset literals [{[+ x1; ..; xn +]}] are defined in
+terms of iterated disjoint union [{[+ x1 +]} ⊎ .. ⊎ {[+ xn +]}], and are thus
+different from set literals [{[ x1; ..; xn ]}], which use [∪].
+
+Note that in principle we could reuse the set singleton [{[ _ ]}] for multisets,
+and define [{[+ x1; ..; xn +]}] as [{[ x1 ]} ⊎ .. ⊎ {[ xn ]}]. However, this
+would risk accidentally using [{[ x1; ..; xn ]}] for multisets (leading to
+unexpected results) and lead to ambigious pretty printing for [{[+ x +]}]. *)
+Class DisjUnion A := disj_union: A → A → A.
+Global Hint Mode DisjUnion ! : typeclass_instances.
+Global Instance: Params (@disj_union) 2 := {}.
+Infix "⊎" := disj_union (at level 50, left associativity) : stdpp_scope.
+Notation "(⊎)" := disj_union (only parsing) : stdpp_scope.
+Notation "( x ⊎.)" := (disj_union x) (only parsing) : stdpp_scope.
+Notation "(.⊎ x )" := (λ y, disj_union y x) (only parsing) : stdpp_scope.
+
+Definition disj_union_list `{Empty A} `{DisjUnion A} : list A → A := fold_right (⊎) ∅.
+Global Arguments disj_union_list _ _ _ !_ / : assert.
+(* There is no "big" version of [⊎] in unicode, we thus use [⋃+]. *)
+Notation "⋃+ l" := (disj_union_list l) (at level 20, format "⋃+  l") : stdpp_scope.
+
+Class SingletonMS A B := singletonMS: A → B.
+Global Hint Mode SingletonMS - ! : typeclass_instances.
+Global Instance: Params (@singletonMS) 3 := {}.
+Notation "{[+ x +]}" := (singletonMS x)
+  (at level 1, format "{[+  x  +]}") : stdpp_scope.
+Notation "{[+ x ; y ; .. ; z +]}" :=
+  (disj_union .. (disj_union (singletonMS x) (singletonMS y)) .. (singletonMS z))
+  (at level 1, format "{[+  x ;  y ;  .. ;  z  +]}") : stdpp_scope.
+
+Definition option_to_set `{Singleton A C, Empty C} (mx : option A) : C :=
+  match mx with None => ∅ | Some x => {[ x ]} end.
+Fixpoint list_to_set `{Singleton A C, Empty C, Union C} (l : list A) : C :=
+  match l with [] => ∅ | x :: l => {[ x ]} ∪ list_to_set l end.
+Fixpoint list_to_set_disj `{SingletonMS A C, Empty C, DisjUnion C} (l : list A) : C :=
+  match l with [] => ∅ | x :: l => {[+ x +]} ⊎ list_to_set_disj l end.
+
+Class ScalarMul N A := scalar_mul : N → A → A.
+Global Hint Mode ScalarMul - ! : typeclass_instances.
+(** The [N] arguments is typically [nat] or [Z], so we do not want to rewrite
+in that. Hence, the value of [Params] is 3. *)
+Global Instance: Params (@scalar_mul) 3 := {}.
+(** The notation [*:] and level is taken from ssreflect, see
+https://github.com/math-comp/math-comp/blob/master/mathcomp/ssreflect/ssrnotations.v *)
+Infix "*:" := scalar_mul (at level 40) : stdpp_scope.
+Notation "(*:)" :=  scalar_mul (only parsing) : stdpp_scope.
+Notation "( x *:.)" := (scalar_mul x) (only parsing) : stdpp_scope.
+Notation "(.*: x )" := (λ y, scalar_mul y x) (only parsing) : stdpp_scope.
+
+(** The class [Lexico A] is used for the lexicographic order on [A]. This order
+is used to create finite maps, finite sets, etc, and is typically different from
+the order [(⊆)]. *)
+Class Lexico A := lexico: relation A.
+Global Hint Mode Lexico ! : typeclass_instances.
+
+Class ElemOf A B := elem_of: A → B → Prop.
+Global Hint Mode ElemOf - ! : typeclass_instances.
+Global Instance: Params (@elem_of) 3 := {}.
+Infix "∈" := elem_of (at level 70) : stdpp_scope.
+Notation "(∈)" := elem_of (only parsing) : stdpp_scope.
+Notation "( x ∈.)" := (elem_of x) (only parsing) : stdpp_scope.
+Notation "(.∈ X )" := (λ x, elem_of x X) (only parsing) : stdpp_scope.
+Notation "x ∉ X" := (¬x ∈ X) (at level 80) : stdpp_scope.
+Notation "(∉)" := (λ x X, x ∉ X) (only parsing) : stdpp_scope.
+Notation "( x ∉.)" := (λ X, x ∉ X) (only parsing) : stdpp_scope.
+Notation "(.∉ X )" := (λ x, x ∉ X) (only parsing) : stdpp_scope.
+
+Infix "∈@{ B }" := (@elem_of _ B _) (at level 70, only parsing) : stdpp_scope.
+Notation "(∈@{ B } )" := (@elem_of _ B _) (only parsing) : stdpp_scope.
+
+Notation "x ∉@{ B } X" := (¬x ∈@{B} X) (at level 80, only parsing) : stdpp_scope.
+Notation "(∉@{ B } )" := (λ x X, x ∉@{B} X) (only parsing) : stdpp_scope.
+
+Class Disjoint A := disjoint : A → A → Prop.
+Global Hint Mode Disjoint ! : typeclass_instances.
+Global Instance: Params (@disjoint) 2 := {}.
+Infix "##" := disjoint (at level 70) : stdpp_scope.
+Notation "(##)" := disjoint (only parsing) : stdpp_scope.
+Notation "( X ##.)" := (disjoint X) (only parsing) : stdpp_scope.
+Notation "(.## X )" := (λ Y, Y ## X) (only parsing) : stdpp_scope.
+
+Infix "##@{ A }" := (@disjoint A _) (at level 70, only parsing) : stdpp_scope.
+Notation "(##@{ A } )" := (@disjoint A _) (only parsing) : stdpp_scope.
+
+Infix "##*" := (Forall2 (##)) (at level 70) : stdpp_scope.
+Notation "(##*)" := (Forall2 (##)) (only parsing) : stdpp_scope.
+
+Global Hint Extern 0 (_ ## _) => symmetry; eassumption : core.
+Global Hint Extern 0 (_ ##* _) => symmetry; eassumption : core.
+
+Class Filter A B := filter: ∀ (P : A → Prop) `{∀ x, Decision (P x)}, B → B.
+Global Hint Mode Filter - ! : typeclass_instances.
+
+Class UpClose A B := up_close : A → B.
+Global Hint Mode UpClose - ! : typeclass_instances.
+Notation "↑ x" := (up_close x) (at level 20, format "↑ x").
+
+(** * Monadic operations *)
+(** We define operational type classes for the monadic operations bind, join
+and fmap. We use these type classes merely for convenient overloading of
+notations and do not formalize any theory on monads (we do not even define a
+class with the monad laws). *)
+Class MRet (M : Type → Type) := mret: ∀ {A}, A → M A.
+Global Arguments mret {_ _ _} _ : assert.
+Global Instance: Params (@mret) 3 := {}.
+Global Hint Mode MRet ! : typeclass_instances.
+
+Class MBind (M : Type → Type) := mbind : ∀ {A B}, (A → M B) → M A → M B.
+Global Arguments mbind {_ _ _ _} _ !_ / : assert.
+Global Instance: Params (@mbind) 4 := {}.
+Global Hint Mode MBind ! : typeclass_instances.
+
+Class MJoin (M : Type → Type) := mjoin: ∀ {A}, M (M A) → M A.
+Global Arguments mjoin {_ _ _} !_ / : assert.
+Global Instance: Params (@mjoin) 3 := {}.
+Global Hint Mode MJoin ! : typeclass_instances.
+
+Class FMap (M : Type → Type) := fmap : ∀ {A B}, (A → B) → M A → M B.
+Global Arguments fmap {_ _ _ _} _ !_ / : assert.
+Global Instance: Params (@fmap) 4 := {}.
+Global Hint Mode FMap ! : typeclass_instances.
+
+Class OMap (M : Type → Type) := omap: ∀ {A B}, (A → option B) → M A → M B.
+Global Arguments omap {_ _ _ _} _ !_ / : assert.
+Global Instance: Params (@omap) 4 := {}.
+Global Hint Mode OMap ! : typeclass_instances.
+
+Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : stdpp_scope.
+Notation "( m ≫=.)" := (λ f, mbind f m) (only parsing) : stdpp_scope.
+Notation "(.≫= f )" := (mbind f) (only parsing) : stdpp_scope.
+Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : stdpp_scope.
+
+Notation "x ← y ; z" := (y ≫= (λ x : _, z))
+  (at level 20, y at level 100, z at level 200, only parsing) : stdpp_scope.
+
+Notation "' x ← y ; z" := (y ≫= (λ x : _, z))
+  (at level 20, x pattern, y at level 100, z at level 200, only parsing) : stdpp_scope.
+
+Infix "<$>" := fmap (at level 61, left associativity) : stdpp_scope.
+
+Notation "x ;; z" := (x ≫= λ _, z)
+  (at level 100, z at level 200, only parsing, right associativity): stdpp_scope.
+
+Notation "ps .*1" := (fmap (M:=list) fst ps)
+  (at level 2, left associativity, format "ps .*1").
+Notation "ps .*2" := (fmap (M:=list) snd ps)
+  (at level 2, left associativity, format "ps .*2").
+
+(** For any monad that has a builtin way to throw an exception/error *)
+Class MThrow (E : Type) (M : Type → Type) := mthrow : ∀ {A}, E → M A.
+Global Arguments mthrow {_ _ _ _} _ : assert.
+Global Instance: Params (@mthrow) 4 := {}.
+Global Hint Mode MThrow ! ! : typeclass_instances.
+
+(** We use unit as the error content for monads that can only report an error
+    without any payload like an option *)
+Global Notation MFail := (MThrow ()).
+Global Notation mfail := (mthrow ()).
+
+Definition guard_or {E} (e : E) `{MThrow E M, MRet M} P `{Decision P} : M P :=
+  match decide P with
+  | left H => mret H
+  | right _ => mthrow e
+  end.
+Global Notation guard := (guard_or ()).
+
+
+(** * Operations on maps *)
+(** In this section we define operational type classes for the operations
+on maps. In the file [fin_maps] we will axiomatize finite maps.
+The function look up [m !! k] should yield the element at key [k] in [m]. *)
+Class Lookup (K A M : Type) := lookup: K → M → option A.
+Global Hint Mode Lookup - - ! : typeclass_instances.
+Global Instance: Params (@lookup) 5 := {}.
+Notation "m !! i" := (lookup i m) (at level 20) : stdpp_scope.
+Notation "(!!)" := lookup (only parsing) : stdpp_scope.
+Notation "( m !!.)" := (λ i, m !! i) (only parsing) : stdpp_scope.
+Notation "(.!! i )" := (lookup i) (only parsing) : stdpp_scope.
+Global Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch, assert.
+
+(** The function [lookup_total] should be the total over-approximation
+of the partial [lookup] function. *)
+Class LookupTotal (K A M : Type) := lookup_total : K → M → A.
+Global Hint Mode LookupTotal - - ! : typeclass_instances.
+Global Instance: Params (@lookup_total) 5 := {}.
+Notation "m !!! i" := (lookup_total i m) (at level 20) : stdpp_scope.
+Notation "(!!!)" := lookup_total (only parsing) : stdpp_scope.
+Notation "( m !!!.)" := (λ i, m !!! i) (only parsing) : stdpp_scope.
+Notation "(.!!! i )" := (lookup_total i) (only parsing) : stdpp_scope.
+Global Arguments lookup_total _ _ _ _ !_ !_ / : simpl nomatch, assert.
+
+(** The singleton map *)
+Class SingletonM K A M := singletonM: K → A → M.
+Global Hint Mode SingletonM - - ! : typeclass_instances.
+Global Instance: Params (@singletonM) 5 := {}.
+Notation "{[ k := a ]}" := (singletonM k a) (at level 1) : stdpp_scope.
+
+(** The function insert [<[k:=a]>m] should update the element at key [k] with
+value [a] in [m]. *)
+Class Insert (K A M : Type) := insert: K → A → M → M.
+Global Hint Mode Insert - - ! : typeclass_instances.
+Global Instance: Params (@insert) 5 := {}.
+Notation "<[ k := a ]>" := (insert k a)
+  (at level 5, right associativity, format "<[ k := a ]>") : stdpp_scope.
+Global Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch, assert.
+
+(** Notation for more elements (up to 13) *)
+(* Defining a generic notation does not seem possible with Coq's
+   recursive notation system, so we define individual notations
+   for some cases relevant in practice. *)
+(* The "format" makes sure that linebreaks are placed after the separating semicolons [;] when printing. *)
+(* TODO : we are using parentheses in the "de-sugaring" of the notation instead of [$] because Coq 8.12
+   and earlier have trouble with using the notation for printing otherwise.
+   Once support for Coq 8.12 is dropped, this can be replaced with [$]. *)
+Notation "{[ k1 := a1 ; k2 := a2 ]}" :=
+  (<[ k1 := a1 ]>{[ k2 := a2 ]})
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]>{[ k3 := a3 ]}))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]>{[ k4 := a4 ]})))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]>{[ k5 := a5 ]}))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]>{[ k6 := a6 ]})))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]> ( <[ k6 := a6 ]>{[ k7 := a7 ]}))))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ; ']'  '/' '[' k7  :=  a7 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]>{[ k8 := a8 ]})))))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ; ']'  '/' '[' k7  :=  a7 ; ']'  '/' '[' k8  :=  a8 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]>{[ k9 := a9 ]}))))))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ; ']'  '/' '[' k7  :=  a7 ; ']'  '/' '[' k8  :=  a8 ; ']'  '/' '[' k9  :=  a9 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> (
+    <[ k9 := a9 ]>{[ k10 := a10 ]})))))))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ; ']'  '/' '[' k7  :=  a7 ; ']'  '/' '[' k8  :=  a8 ; ']'  '/' '[' k9  :=  a9 ; ']'  '/' '[' k10  :=  a10 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ; k11 := a11 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> (
+    <[ k9 := a9 ]> ( <[ k10 := a10 ]>{[ k11 := a11 ]}))))))))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ; ']'  '/' '[' k7  :=  a7 ; ']'  '/' '[' k8  :=  a8 ; ']'  '/' '[' k9  :=  a9 ; ']'  '/' '[' k10  :=  a10 ; ']'  '/' '[' k11  :=  a11 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ; k11 := a11 ; k12 := a12 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> (
+    <[ k9 := a9 ]> ( <[ k10 := a10 ]> ( <[ k11 := a11 ]>{[ k12 := a12 ]})))))))))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ; ']'  '/' '[' k7  :=  a7 ; ']'  '/' '[' k8  :=  a8 ; ']'  '/' '[' k9  :=  a9 ; ']'  '/' '[' k10  :=  a10 ; ']'  '/' '[' k11  :=  a11 ; ']'  '/' '[' k12  :=  a12 ']' ']' ]}") : stdpp_scope.
+Notation "{[ k1 := a1 ; k2 := a2 ; k3 := a3 ; k4 := a4 ; k5 := a5 ; k6 := a6 ; k7 := a7 ; k8 := a8 ; k9 := a9 ; k10 := a10 ; k11 := a11 ; k12 := a12 ; k13 := a13 ]}" :=
+  (<[ k1 := a1 ]> ( <[ k2 := a2 ]> ( <[ k3 := a3 ]> ( <[ k4 := a4 ]> (
+    <[ k5 := a5 ]> ( <[ k6 := a6 ]> ( <[ k7 := a7 ]> ( <[ k8 := a8 ]> (
+    <[ k9 := a9 ]> ( <[ k10 := a10 ]> ( <[ k11 := a11 ]> ( <[ k12 := a12 ]>{[ k13 := a13 ]}))))))))))))
+  (at level 1, format
+  "{[ '[hv' '[' k1  :=  a1 ; ']'  '/' '[' k2  :=  a2 ; ']'  '/' '[' k3  :=  a3 ; ']'  '/' '[' k4  :=  a4 ; ']'  '/' '[' k5  :=  a5 ; ']'  '/' '[' k6  :=  a6 ; ']'  '/' '[' k7  :=  a7 ; ']'  '/' '[' k8  :=  a8 ; ']'  '/' '[' k9  :=  a9 ; ']'  '/' '[' k10  :=  a10 ; ']'  '/' '[' k11  :=  a11 ; ']'  '/' '[' k12  :=  a12 ; ']'  '/' '[' k13  :=  a13 ']' ']' ]}") : stdpp_scope.
+
+(** The function delete [delete k m] should delete the value at key [k] in
+[m]. If the key [k] is not a member of [m], the original map should be
+returned. *)
+Class Delete (K M : Type) := delete: K → M → M.
+Global Hint Mode Delete - ! : typeclass_instances.
+Global Instance: Params (@delete) 4 := {}.
+Global Arguments delete _ _ _ !_ !_ / : simpl nomatch, assert.
+
+(** The function [alter f k m] should update the value at key [k] using the
+function [f], which is called with the original value. *)
+Class Alter (K A M : Type) := alter: (A → A) → K → M → M.
+Global Hint Mode Alter - - ! : typeclass_instances.
+Global Instance: Params (@alter) 4 := {}.
+Global Arguments alter {_ _ _ _} _ !_ !_ / : simpl nomatch, assert.
+
+(** The function [partial_alter f k m] should update the value at key [k] using the
+function [f], which is called with the original value at key [k] or [None]
+if [k] is not a member of [m]. The value at [k] should be deleted if [f]
+yields [None]. *)
+Class PartialAlter (K A M : Type) :=
+  partial_alter: (option A → option A) → K → M → M.
+Global Hint Mode PartialAlter - - ! : typeclass_instances.
+Global Instance: Params (@partial_alter) 4 := {}.
+Global Arguments partial_alter _ _ _ _ _ !_ !_ / : simpl nomatch, assert.
+
+(** The function [dom m] should yield the domain of [m]. That is a finite
+set of type [D] that contains the keys that are a member of [m].
+[D] is an output of the typeclass, i.e., there can be only one instance per map
+type [M]. *)
+Class Dom (M D : Type) := dom: M → D.
+Global Hint Mode Dom ! - : typeclass_instances.
+Global Instance: Params (@dom) 3 := {}.
+Global Arguments dom : clear implicits.
+Global Arguments dom {_ _ _} !_ / : simpl nomatch, assert.
+
+(** The function [merge f m1 m2] should merge the maps [m1] and [m2] by
+constructing a new map whose value at key [k] is [f (m1 !! k) (m2 !! k)].*)
+Class Merge (M : Type → Type) :=
+  merge: ∀ {A B C}, (option A → option B → option C) → M A → M B → M C.
+Global Hint Mode Merge ! : typeclass_instances.
+Global Instance: Params (@merge) 4 := {}.
+Global Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch, assert.
+
+(** The function [union_with f m1 m2] is supposed to yield the union of [m1]
+and [m2] using the function [f] to combine values of members that are in
+both [m1] and [m2]. *)
+Class UnionWith (A M : Type) :=
+  union_with: (A → A → option A) → M → M → M.
+Global Hint Mode UnionWith - ! : typeclass_instances.
+Global Instance: Params (@union_with) 3 := {}.
+Global Arguments union_with {_ _ _} _ !_ !_ / : simpl nomatch, assert.
+
+(** Similarly for intersection and difference. *)
+Class IntersectionWith (A M : Type) :=
+  intersection_with: (A → A → option A) → M → M → M.
+Global Hint Mode IntersectionWith - ! : typeclass_instances.
+Global Instance: Params (@intersection_with) 3 := {}.
+Global Arguments intersection_with {_ _ _} _ !_ !_ / : simpl nomatch, assert.
+
+Class DifferenceWith (A M : Type) :=
+  difference_with: (A → A → option A) → M → M → M.
+Global Hint Mode DifferenceWith - ! : typeclass_instances.
+Global Instance: Params (@difference_with) 3 := {}.
+Global Arguments difference_with {_ _ _} _ !_ !_ / : simpl nomatch, assert.
+
+Definition intersection_with_list `{IntersectionWith A M}
+  (f : A → A → option A) : M → list M → M := fold_right (intersection_with f).
+Global Arguments intersection_with_list _ _ _ _ _ !_ / : assert.
+
+(** * Notations for lattices. *)
+(** SqSubsetEq registers the "canonical" partial order for a type, and is used
+for the \sqsubseteq symbol. *)
+Class SqSubsetEq A := sqsubseteq: relation A.
+Global Hint Mode SqSubsetEq ! : typeclass_instances.
+Global Instance: Params (@sqsubseteq) 2 := {}.
+Infix "⊑" := sqsubseteq (at level 70) : stdpp_scope.
+Notation "(⊑)" := sqsubseteq (only parsing) : stdpp_scope.
+Notation "( x ⊑.)" := (sqsubseteq x) (only parsing) : stdpp_scope.
+Notation "(.⊑ y )" := (λ x, sqsubseteq x y) (only parsing) : stdpp_scope.
+
+Infix "⊑@{ A }" := (@sqsubseteq A _) (at level 70, only parsing) : stdpp_scope.
+Notation "(⊑@{ A } )" := (@sqsubseteq A _) (only parsing) : stdpp_scope.
+
+(** [sqsubseteq] does not take precedence over the stdlib's instances (like [eq],
+[impl], [iff]) or std++'s [equiv].
+We have [eq] (at 100) < [≡] (at 150) < [⊑] (at 200). *)
+Global Instance sqsubseteq_rewrite `{SqSubsetEq A} : RewriteRelation (⊑@{A}) | 200 := {}.
+
+Global Hint Extern 0 (_ ⊑ _) => reflexivity : core.
+
+Class Meet A := meet: A → A → A.
+Global Hint Mode Meet ! : typeclass_instances.
+Global Instance: Params (@meet) 2 := {}.
+Infix "⊓" := meet (at level 40) : stdpp_scope.
+Notation "(⊓)" := meet (only parsing) : stdpp_scope.
+Notation "( x ⊓.)" := (meet x) (only parsing) : stdpp_scope.
+Notation "(.⊓ y )" := (λ x, meet x y) (only parsing) : stdpp_scope.
+
+Class Join A := join: A → A → A.
+Global Hint Mode Join ! : typeclass_instances.
+Global Instance: Params (@join) 2 := {}.
+Infix "⊔" := join (at level 50) : stdpp_scope.
+Notation "(⊔)" := join (only parsing) : stdpp_scope.
+Notation "( x ⊔.)" := (join x) (only parsing) : stdpp_scope.
+Notation "(.⊔ y )" := (λ x, join x y) (only parsing) : stdpp_scope.
+
+Class Top A := top : A.
+Global Hint Mode Top ! : typeclass_instances.
+Notation "⊤" := top (format "⊤") : stdpp_scope.
+
+Class Bottom A := bottom : A.
+Global Hint Mode Bottom ! : typeclass_instances.
+Notation "⊥" := bottom (format "⊥") : stdpp_scope.
+
+
+(** * Axiomatization of sets *)
+(** The classes [SemiSet A C], [Set_ A C], and [TopSet A C] axiomatize sets of
+type [C] with elements of type [A]. The first class, [SemiSet] does not include
+intersection and difference. It is useful for the case of lists, where decidable
+equality is needed to implement intersection and difference, but not union.
+
+Note that we cannot use the name [Set] since that is a reserved keyword. Hence
+we use [Set_]. *)
+Class SemiSet A C `{ElemOf A C,
+    Empty C, Singleton A C, Union C} : Prop := {
+  not_elem_of_empty (x : A) : x ∉@{C} ∅; (* We prove
+  [elem_of_empty : x ∈@{C} ∅ ↔ False] in [sets.v], which is more convenient for
+  rewriting. *)
+  elem_of_singleton (x y : A) : x ∈@{C} {[ y ]} ↔ x = y;
+  elem_of_union (X Y : C) (x : A) : x ∈ X ∪ Y ↔ x ∈ X ∨ x ∈ Y
+}.
+Global Hint Mode SemiSet - ! - - - - : typeclass_instances.
+
+Class Set_ A C `{ElemOf A C, Empty C, Singleton A C,
+    Union C, Intersection C, Difference C} : Prop := {
+  set_semi_set :: SemiSet A C;
+  elem_of_intersection (X Y : C) (x : A) : x ∈ X ∩ Y ↔ x ∈ X ∧ x ∈ Y;
+  elem_of_difference (X Y : C) (x : A) : x ∈ X ∖ Y ↔ x ∈ X ∧ x ∉ Y
+}.
+Global Hint Mode Set_ - ! - - - - - - : typeclass_instances.
+
+Class TopSet A C `{ElemOf A C, Empty C, Top C, Singleton A C,
+    Union C, Intersection C, Difference C} : Prop := {
+  top_set_set :: Set_ A C;
+  elem_of_top' (x : A) : x ∈@{C} ⊤; (* We prove [elem_of_top : x ∈@{C} ⊤ ↔ True]
+  in [sets.v], which is more convenient for rewriting. *)
+}.
+Global Hint Mode TopSet - ! - - - - - - - : typeclass_instances.
+
+(** We axiomative a finite set as a set whose elements can be
+enumerated as a list. These elements, given by the [elements] function, may be
+in any order and should not contain duplicates. *)
+Class Elements A C := elements: C → list A.
+Global Hint Mode Elements - ! : typeclass_instances.
+Global Instance: Params (@elements) 3 := {}.
+
+(** We redefine the standard library's [In] and [NoDup] using type classes. *)
+Inductive elem_of_list {A} : ElemOf A (list A) :=
+  | elem_of_list_here (x : A) l : x ∈ x :: l
+  | elem_of_list_further (x y : A) l : x ∈ l → x ∈ y :: l.
+Global Existing Instance elem_of_list.
+
+Lemma elem_of_list_In {A} (l : list A) x : x ∈ l ↔ In x l.
+Proof.
+  split.
+  - induction 1; simpl; auto.
+  - induction l; destruct 1; subst; constructor; auto.
+Qed.
+
+Inductive NoDup {A} : list A → Prop :=
+  | NoDup_nil_2 : NoDup []
+  | NoDup_cons_2 x l : x ∉ l → NoDup l → NoDup (x :: l).
+
+Lemma NoDup_ListNoDup {A} (l : list A) : NoDup l ↔ List.NoDup l.
+Proof.
+  split.
+  - induction 1; constructor; rewrite <-?elem_of_list_In; auto.
+  - induction 1; constructor; rewrite ?elem_of_list_In; auto.
+Qed.
+
+(** Decidability of equality of the carrier set is admissible, but we add it
+anyway so as to avoid cycles in type class search. *)
+Class FinSet A C `{ElemOf A C, Empty C, Singleton A C, Union C,
+    Intersection C, Difference C, Elements A C, EqDecision A} : Prop := {
+  fin_set_set :: Set_ A C;
+  elem_of_elements (X : C) x : x ∈ elements X ↔ x ∈ X;
+  NoDup_elements (X : C) : NoDup (elements X)
+}.
+Global Hint Mode FinSet - ! - - - - - - - - : typeclass_instances.
+
+Class Size C := size: C → nat.
+Global Hint Mode Size ! : typeclass_instances.
+Global Arguments size {_ _} !_ / : simpl nomatch, assert.
+Global Instance: Params (@size) 2 := {}.
+
+(** The class [MonadSet M] axiomatizes a type constructor [M] that can be
+used to construct a set [M A] with elements of type [A]. The advantage
+of this class, compared to [Set_], is that it also axiomatizes the
+the monadic operations. The disadvantage is that not many inhabitants are
+possible: we will only provide as inhabitants [propset] and [listset], which are
+represented respectively using Boolean functions and lists with duplicates.
+
+More interesting implementations typically need
+decidable equality, or a total order on the elements, which do not fit
+in a type constructor of type [Type → Type]. *)
+Class MonadSet M `{∀ A, ElemOf A (M A),
+    ∀ A, Empty (M A), ∀ A, Singleton A (M A), ∀ A, Union (M A),
+    !MBind M, !MRet M, !FMap M, !MJoin M} : Prop := {
+  monad_set_semi_set A :: SemiSet A (M A);
+  elem_of_bind {A B} (f : A → M B) (X : M A) (x : B) :
+    x ∈ X ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ X;
+  elem_of_ret {A} (x y : A) : x ∈@{M A} mret y ↔ x = y;
+  elem_of_fmap {A B} (f : A → B) (X : M A) (x : B) :
+    x ∈ f <$> X ↔ ∃ y, x = f y ∧ y ∈ X;
+  elem_of_join {A} (X : M (M A)) (x : A) :
+    x ∈ mjoin X ↔ ∃ Y : M A, x ∈ Y ∧ Y ∈ X
+}.
+
+(** The [Infinite A] class axiomatizes types [A] with infinitely many elements.
+It contains a function [fresh : list A → A] that, given a list [xs], gives an
+element [fresh xs ∉ xs].
+
+We do not directly make [fresh] a field of the [Infinite] class, but use a
+separate operational type class [Fresh] for it. That way we can overload [fresh]
+to pick fresh elements from other data structures like sets. See the file
+[fin_sets], where we define [fresh : C → A] for any finite set implementation
+[FinSet C A].
+
+Note: we require [fresh] to respect permutations, which is needed to define the
+aforementioned [fresh] function on finite sets that respect set equality.
+
+Instead of instantiating [Infinite] directly, consider using [max_infinite] or
+[inj_infinite] from the [infinite] module. *)
+Class Fresh A C := fresh: C → A.
+Global Hint Mode Fresh - ! : typeclass_instances.
+Global Instance: Params (@fresh) 3 := {}.
+Global Arguments fresh : simpl never.
+
+Class Infinite A := {
+  infinite_fresh :: Fresh A (list A);
+  infinite_is_fresh (xs : list A) : fresh xs ∉ xs;
+  infinite_fresh_Permutation :: Proper (@Permutation A ==> (=)) fresh;
+}.
+Global Hint Mode Infinite ! : typeclass_instances.
+Global Arguments infinite_fresh : simpl never.
+
+(** * Miscellaneous *)
+Class Half A := half: A → A.
+Global Hint Mode Half ! : typeclass_instances.
+Notation "½" := half (format "½") : stdpp_scope.
+Notation "½*" := (fmap (M:=list) half) : stdpp_scope.

stdpp/binders.v

+(** This file implements a type [binder] with elements [BAnon] for the
+anonymous binder, and [BNamed] for named binders. This type is isomorphic to
+[option string], but we use a special type so that we can define [BNamed] as
+a coercion.
+
+This library is used in various Iris developments, like heap-lang, LambdaRust,
+Iron, Fairis. *)
+From stdpp Require Export strings.
+From stdpp Require Import sets countable finite fin_maps.
+From stdpp Require Import options.
+
+(* Pick up extra assumptions from section parameters. *)
+Set Default Proof Using "Type*".
+
+Declare Scope binder_scope.
+Delimit Scope binder_scope with binder.
+
+Inductive binder := BAnon | BNamed :> string → binder.
+Bind Scope binder_scope with binder.
+Notation "<>" := BAnon : binder_scope.
+
+(** [binder_list] matches [option_list]. *)
+Definition binder_list (b : binder) : list string :=
+  match b with
+  | BAnon => []
+  | BNamed s => [s]
+  end.
+
+Global Instance binder_dec_eq : EqDecision binder.
+Proof. solve_decision. Defined.
+Global Instance binder_inhabited : Inhabited binder := populate BAnon.
+Global Instance binder_countable : Countable binder.
+Proof.
+ refine (inj_countable'
+   (λ b, match b with BAnon => None | BNamed s => Some s end)
+   (λ b, match b with None => BAnon | Some s => BNamed s end) _); by intros [].
+Qed.
+
+(** The functions [cons_binder b ss] and [app_binder bs ss] are typically used
+to collect the free variables of an expression. Here [ss] is the current list of
+free variables, and [b], respectively [bs], are the binders that are being
+added. *)
+Definition cons_binder (b : binder) (ss : list string) : list string :=
+  match b with BAnon => ss | BNamed s => s :: ss end.
+Infix ":b:" := cons_binder (at level 60, right associativity).
+Fixpoint app_binder (bs : list binder) (ss : list string) : list string :=
+  match bs with [] => ss | b :: bs => b :b: app_binder bs ss end.
+Infix "+b+" := app_binder (at level 60, right associativity).
+
+Global Instance set_unfold_cons_binder s b ss P :
+  SetUnfoldElemOf s ss P → SetUnfoldElemOf s (b :b: ss) (BNamed s = b ∨ P).
+Proof.
+  constructor. rewrite <-(set_unfold (s ∈ ss) P).
+  destruct b; simpl; rewrite ?elem_of_cons; naive_solver.
+Qed.
+Global Instance set_unfold_app_binder s bs ss P Q :
+  SetUnfoldElemOf (BNamed s) bs P → SetUnfoldElemOf s ss Q →
+  SetUnfoldElemOf s (bs +b+ ss) (P ∨ Q).
+Proof.
+  intros HinP HinQ.
+  constructor. rewrite <-(set_unfold (s ∈ ss) Q), <-(set_unfold (BNamed s ∈ bs) P).
+  clear HinP HinQ.
+  induction bs; set_solver.
+Qed.
+
+Lemma app_binder_named ss1 ss2 : (BNamed <$> ss1) +b+ ss2 = ss1 ++ ss2.
+Proof. induction ss1; by f_equal/=. Qed.
+
+Lemma app_binder_snoc bs s ss : bs +b+ (s :: ss) = (bs ++ [BNamed s]) +b+ ss.
+Proof. induction bs; by f_equal/=. Qed.
+
+Global Instance cons_binder_Permutation b : Proper ((≡ₚ) ==> (≡ₚ)) (cons_binder b).
+Proof. intros ss1 ss2 Hss. destruct b; csimpl; by rewrite Hss. Qed.
+
+Global Instance app_binder_Permutation : Proper ((≡ₚ) ==> (≡ₚ) ==> (≡ₚ)) app_binder.
+Proof.
+  assert (∀ bs, Proper ((≡ₚ) ==> (≡ₚ)) (app_binder bs)).
+  { intros bs. induction bs as [|[]]; intros ss1 ss2; simpl; by intros ->. }
+  induction 1 as [|[]|[] []|]; intros ss1 ss2 Hss; simpl;
+    first [by eauto using perm_trans|by rewrite 1?perm_swap, Hss].
+Qed.
+
+Definition binder_delete `{Delete string M} (b : binder) (m : M) : M :=
+  match b with BAnon => m | BNamed s => delete s m end.
+Definition binder_insert `{Insert string A M} (b : binder) (x : A) (m : M) : M :=
+  match b with BAnon => m | BNamed s => <[s:=x]> m end.
+Global Instance: Params (@binder_insert) 4 := {}.
+
+Section binder_delete_insert.
+  Context `{FinMap string M}.
+
+  Global Instance binder_insert_proper `{Equiv A} b :
+    Proper ((≡) ==> (≡) ==> (≡@{M A})) (binder_insert b).
+  Proof. destruct b; solve_proper. Qed.
+
+  Lemma binder_delete_empty {A} b : binder_delete b ∅ =@{M A} ∅.
+  Proof. destruct b; simpl; eauto using delete_empty. Qed.
+
+  Lemma lookup_binder_delete_None {A} (m : M A) b s :
+    binder_delete b m !! s = None ↔ b = BNamed s ∨ m !! s = None.
+  Proof. destruct b; simpl; by rewrite ?lookup_delete_None; naive_solver. Qed.
+  Lemma binder_insert_fmap {A B} (f : A → B) (x : A) b (m : M A) :
+    f <$> binder_insert b x m = binder_insert b (f x) (f <$> m).
+  Proof. destruct b; simpl; by rewrite ?fmap_insert. Qed.
+
+  Lemma binder_delete_insert {A} b s x (m : M A) :
+    b ≠ BNamed s → binder_delete b (<[s:=x]> m) = <[s:=x]> (binder_delete b m).
+  Proof. intros. destruct b; simpl; by rewrite ?delete_insert_ne by congruence. Qed.
+  Lemma binder_delete_delete {A} b s (m : M A) :
+    binder_delete b (delete s m) = delete s (binder_delete b m).
+  Proof. destruct b; simpl; by rewrite 1?delete_commute. Qed.
+End binder_delete_insert.

stdpp/boolset.v

+(** This file implements boolsets as functions into Prop. *)
+From stdpp Require Export prelude.
+From stdpp Require Import options.
+
+Record boolset (A : Type) : Type := BoolSet { boolset_car : A → bool }.
+Global Arguments BoolSet {_} _ : assert.
+Global Arguments boolset_car {_} _ _ : assert.
+
+Global Instance boolset_top {A} : Top (boolset A) := BoolSet (λ _, true).
+Global Instance boolset_empty {A} : Empty (boolset A) := BoolSet (λ _, false).
+Global Instance boolset_singleton `{EqDecision A} : Singleton A (boolset A) := λ x,
+  BoolSet (λ y, bool_decide (y = x)).
+Global Instance boolset_elem_of {A} : ElemOf A (boolset A) := λ x X, boolset_car X x.
+Global Instance boolset_union {A} : Union (boolset A) := λ X1 X2,
+  BoolSet (λ x, boolset_car X1 x || boolset_car X2 x).
+Global Instance boolset_intersection {A} : Intersection (boolset A) := λ X1 X2,
+  BoolSet (λ x, boolset_car X1 x && boolset_car X2 x).
+Global Instance boolset_difference {A} : Difference (boolset A) := λ X1 X2,
+  BoolSet (λ x, boolset_car X1 x && negb (boolset_car X2 x)).
+Global Instance boolset_cprod {A B} :
+  CProd (boolset A) (boolset B) (boolset (A * B)) := λ X1 X2,
+  BoolSet (λ x, boolset_car X1 x.1 && boolset_car X2 x.2).
+
+Global Instance boolset_top_set `{EqDecision A} : TopSet A (boolset A).
+Proof.
+  split; [split; [split| |]|].
+  - by intros x ?.
+  - by intros x y; rewrite <-(bool_decide_spec (x = y)).
+  - split; [apply orb_prop_elim | apply orb_prop_intro].
+  - split; [apply andb_prop_elim | apply andb_prop_intro].
+  - intros X Y x; unfold elem_of, boolset_elem_of; simpl.
+    destruct (boolset_car X x), (boolset_car Y x); simpl; tauto.
+  - done.
+Qed.
+Global Instance boolset_elem_of_dec {A} : RelDecision (∈@{boolset A}).
+Proof. refine (λ x X, cast_if (decide (boolset_car X x))); done. Defined.
+
+Lemma elem_of_boolset_cprod {A B} (X1 : boolset A) (X2 : boolset B) (x : A * B) :
+  x ∈ cprod X1 X2 ↔ x.1 ∈ X1 ∧ x.2 ∈ X2.
+Proof. apply andb_True. Qed.
+
+Global Instance set_unfold_boolset_cprod {A B} (X1 : boolset A) (X2 : boolset B) x P Q :
+  SetUnfoldElemOf x.1 X1 P → SetUnfoldElemOf x.2 X2 Q →
+  SetUnfoldElemOf x (cprod X1 X2) (P ∧ Q).
+Proof.
+  intros ??; constructor.
+  by rewrite elem_of_boolset_cprod, (set_unfold_elem_of x.1 X1 P),
+    (set_unfold_elem_of x.2 X2 Q).
+Qed.
+
+Global Typeclasses Opaque boolset_elem_of.
+Global Opaque boolset_empty boolset_singleton boolset_union
+  boolset_intersection boolset_difference boolset_cprod.

stdpp/coGset.v

+(** This file implements the type [coGset A] of finite/cofinite sets
+of elements of any countable type [A].
+
+Note that [coGset positive] cannot represent all elements of [coPset]
+(e.g., [coPset_suffixes], [coPset_l], and [coPset_r] construct
+infinite sets that cannot be represented). *)
+From stdpp Require Export sets countable.
+From stdpp Require Import decidable finite gmap coPset.
+From stdpp Require Import options.
+
+(* Pick up extra assumptions from section parameters. *)
+Set Default Proof Using "Type*".
+
+Inductive coGset `{Countable A} :=
+  | FinGSet (X : gset A)
+  | CoFinGset (X : gset A).
+Global Arguments coGset _ {_ _} : assert.
+
+Global Instance coGset_eq_dec `{Countable A} : EqDecision (coGset A).
+Proof. solve_decision. Defined.
+Global Instance coGset_countable `{Countable A} : Countable (coGset A).
+Proof.
+  apply (inj_countable'
+    (λ X, match X with FinGSet X => inl X | CoFinGset X => inr X end)
+    (λ s, match s with inl X => FinGSet X | inr X => CoFinGset X end)).
+  by intros [].
+Qed.
+
+Section coGset.
+  Context `{Countable A}.
+
+  Global Instance coGset_elem_of : ElemOf A (coGset A) := λ x X,
+    match X with FinGSet X => x ∈ X | CoFinGset X => x ∉ X end.
+  Global Instance coGset_empty : Empty (coGset A) := FinGSet ∅.
+  Global Instance coGset_top : Top (coGset A) := CoFinGset ∅.
+  Global Instance coGset_singleton : Singleton A (coGset A) := λ x,
+    FinGSet {[x]}.
+  Global Instance coGset_union : Union (coGset A) := λ X Y,
+    match X, Y with
+    | FinGSet X, FinGSet Y => FinGSet (X ∪ Y)
+    | CoFinGset X, CoFinGset Y => CoFinGset (X ∩ Y)
+    | FinGSet X, CoFinGset Y => CoFinGset (Y ∖ X)
+    | CoFinGset X, FinGSet Y => CoFinGset (X ∖ Y)
+    end.
+  Global Instance coGset_intersection : Intersection (coGset A) := λ X Y,
+    match X, Y with
+    | FinGSet X, FinGSet Y => FinGSet (X ∩ Y)
+    | CoFinGset X, CoFinGset Y => CoFinGset (X ∪ Y)
+    | FinGSet X, CoFinGset Y => FinGSet (X ∖ Y)
+    | CoFinGset X, FinGSet Y => FinGSet (Y ∖ X)
+    end.
+  Global Instance coGset_difference : Difference (coGset A) := λ X Y,
+    match X, Y with
+    | FinGSet X, FinGSet Y => FinGSet (X ∖ Y)
+    | CoFinGset X, CoFinGset Y => FinGSet (Y ∖ X)
+    | FinGSet X, CoFinGset Y => FinGSet (X ∩ Y)
+    | CoFinGset X, FinGSet Y => CoFinGset (X ∪ Y)
+    end.
+
+  Global Instance coGset_set : TopSet A (coGset A).
+  Proof.
+    split; [split; [split| |]|].
+    - by intros ??.
+    - intros x y. unfold elem_of, coGset_elem_of; simpl.
+      by rewrite elem_of_singleton.
+    - intros [X|X] [Y|Y] x; unfold elem_of, coGset_elem_of, coGset_union; simpl.
+      + set_solver.
+      + by rewrite not_elem_of_difference, (comm (∨)).
+      + by rewrite not_elem_of_difference.
+      + by rewrite not_elem_of_intersection.
+    - intros [] [];
+      unfold elem_of, coGset_elem_of, coGset_intersection; set_solver.
+    - intros [X|X] [Y|Y] x;
+      unfold elem_of, coGset_elem_of, coGset_difference; simpl.
+      + set_solver.
+      + rewrite elem_of_intersection. destruct (decide (x ∈ Y)); tauto.
+      + set_solver.
+      + rewrite elem_of_difference. destruct (decide (x ∈ Y)); tauto.
+    - done.
+  Qed.
+End coGset.
+
+Global Instance coGset_elem_of_dec `{Countable A} : RelDecision (∈@{coGset A}) :=
+  λ x X,
+  match X with
+  | FinGSet X => decide_rel elem_of x X
+  | CoFinGset X => not_dec (decide_rel elem_of x X)
+  end.
+
+Section infinite.
+  Context `{Countable A, Infinite A}.
+
+  Global Instance coGset_leibniz : LeibnizEquiv (coGset A).
+  Proof.
+    intros [X|X] [Y|Y]; rewrite set_equiv;
+    unfold elem_of, coGset_elem_of; simpl; intros HXY.
+    - f_equal. by apply leibniz_equiv.
+    - by destruct (exist_fresh (X ∪ Y)) as [? [? ?%HXY]%not_elem_of_union].
+    - by destruct (exist_fresh (X ∪ Y)) as [? [?%HXY ?]%not_elem_of_union].
+    - f_equal. apply leibniz_equiv; intros x. by apply not_elem_of_iff.
+  Qed.
+
+  Global Instance coGset_equiv_dec : RelDecision (≡@{coGset A}).
+  Proof.
+    refine (λ X Y, cast_if (decide (X = Y))); abstract (by fold_leibniz).
+  Defined.
+
+  Global Instance coGset_disjoint_dec : RelDecision (##@{coGset A}).
+  Proof.
+    refine (λ X Y, cast_if (decide (X ∩ Y = ∅)));
+      abstract (by rewrite disjoint_intersection_L).
+  Defined.
+
+  Global Instance coGset_subseteq_dec : RelDecision (⊆@{coGset A}).
+  Proof.
+    refine (λ X Y, cast_if (decide (X ∪ Y = Y)));
+      abstract (by rewrite subseteq_union_L).
+  Defined.
+
+  Definition coGset_finite (X : coGset A) : bool :=
+    match X with FinGSet _ => true | CoFinGset _ => false end.
+  Lemma coGset_finite_spec X : set_finite X ↔ coGset_finite X.
+  Proof.
+    destruct X as [X|X];
+    unfold set_finite, elem_of at 1, coGset_elem_of; simpl.
+    - split; [done|intros _]. exists (elements X). set_solver.
+    - split; [intros [Y HXY]%(pred_finite_set(C:=gset A))|done].
+      by destruct (exist_fresh (X ∪ Y)) as [? [?%HXY ?]%not_elem_of_union].
+  Qed.
+  Global Instance coGset_finite_dec (X : coGset A) : Decision (set_finite X).
+  Proof.
+    refine (cast_if (decide (coGset_finite X)));
+      abstract (by rewrite coGset_finite_spec).
+  Defined.
+End infinite.
+
+(** * Pick elements from infinite sets *)
+Definition coGpick `{Countable A, Infinite A} (X : coGset A) : A :=
+  fresh (match X with FinGSet _ => ∅ | CoFinGset X => X end).
+
+Lemma coGpick_elem_of `{Countable A, Infinite A} (X : coGset A) :
+  ¬set_finite X → coGpick X ∈ X.
+Proof.
+  unfold coGpick.
+  destruct X as [X|X]; rewrite coGset_finite_spec; simpl; [done|].
+  by intros _; apply is_fresh.
+Qed.
+
+(** * Conversion to and from gset *)
+Definition coGset_to_gset `{Countable A} (X : coGset A) : gset A :=
+  match X with FinGSet X => X | CoFinGset _ => ∅ end.
+Definition gset_to_coGset `{Countable A} : gset A → coGset A := FinGSet.
+
+Section to_gset.
+  Context `{Countable A}.
+
+  Lemma elem_of_gset_to_coGset (X : gset A) x : x ∈ gset_to_coGset X ↔ x ∈ X.
+  Proof. done. Qed.
+
+  Context `{Infinite A}.
+
+  Lemma elem_of_coGset_to_gset (X : coGset A) x :
+    set_finite X → x ∈ coGset_to_gset X ↔ x ∈ X.
+  Proof. rewrite coGset_finite_spec. by destruct X. Qed.
+  Lemma gset_to_coGset_finite (X : gset A) : set_finite (gset_to_coGset X).
+  Proof. by rewrite coGset_finite_spec. Qed.
+End to_gset.
+
+(** * Conversion to coPset *)
+Definition coGset_to_coPset (X : coGset positive) : coPset :=
+  match X with
+  | FinGSet X => gset_to_coPset X
+  | CoFinGset X => ⊤ ∖ gset_to_coPset X
+  end.
+Lemma elem_of_coGset_to_coPset X x : x ∈ coGset_to_coPset X ↔ x ∈ X.
+Proof.
+  destruct X as [X|X]; simpl.
+  - by rewrite elem_of_gset_to_coPset.
+  - by rewrite elem_of_difference, elem_of_gset_to_coPset, (left_id True (∧)).
+Qed.
+
+(** * Inefficient conversion to arbitrary sets with a top element *)
+(** This shows that, when [A] is countable, [coGset A] is initial
+among sets with [∪], [∩], [∖], [∅], [{[_]}], and [⊤]. *)
+Definition coGset_to_top_set `{Countable A, Empty C, Singleton A C, Union C,
+    Top C, Difference C} (X : coGset A) : C :=
+  match X with
+  | FinGSet X => list_to_set (elements X)
+  | CoFinGset X => ⊤ ∖ list_to_set (elements X)
+  end.
+Lemma elem_of_coGset_to_top_set `{Countable A, TopSet A C} X x :
+  x ∈@{C} coGset_to_top_set X ↔ x ∈ X.
+Proof. destruct X; set_solver. Qed.
+
+Global Typeclasses Opaque coGset_elem_of coGset_empty coGset_top coGset_singleton.
+Global Typeclasses Opaque coGset_union coGset_intersection coGset_difference.

theories/coPset.v → stdpp/coPset.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This files implements the type [coPset] of efficient finite/cofinite sets
 of positive binary naturals [positive]. These sets are:
 
@@ -11,16 +9,16 @@ membership, as well as extensional equality (i.e. [X = Y ↔ ∀ x, x ∈ X ↔
 
 Since [positive]s are bitstrings, we encode [coPset]s as trees that correspond
 to the decision function that map bitstrings to bools. *)
-From stdpp Require Export collections.
+From stdpp Require Export sets.
 From stdpp Require Import pmap gmap mapset.
-Set Default Proof Using "Type".
+From stdpp Require Import options.
 Local Open Scope positive_scope.
 
 (** * The tree data structure *)
 Inductive coPset_raw :=
   | coPLeaf : bool → coPset_raw
   | coPNode : bool → coPset_raw → coPset_raw → coPset_raw.
-Instance coPset_raw_eq_dec : EqDecision coPset_raw.
+Global Instance coPset_raw_eq_dec : EqDecision coPset_raw.
 Proof. solve_decision. Defined.
 
 Fixpoint coPset_wf (t : coPset_raw) : bool :=
@@ -28,15 +26,22 @@ Fixpoint coPset_wf (t : coPset_raw) : bool :=
   | coPLeaf _ => true
   | coPNode true (coPLeaf true) (coPLeaf true) => false
   | coPNode false (coPLeaf false) (coPLeaf false) => false
-  | coPNode b l r => coPset_wf l && coPset_wf r
+  | coPNode _ l r => coPset_wf l && coPset_wf r
   end.
-Arguments coPset_wf !_ / : simpl nomatch.
+Global Arguments coPset_wf !_ / : simpl nomatch, assert.
+
+Lemma coPNode_wf b l r :
+  coPset_wf l → coPset_wf r →
+  (l = coPLeaf true → r = coPLeaf true → b = true → False) →
+  (l = coPLeaf false → r = coPLeaf false → b = false → False) →
+  coPset_wf (coPNode b l r).
+Proof. destruct b, l as [[]|], r as [[]|]; naive_solver. Qed.
 
 Lemma coPNode_wf_l b l r : coPset_wf (coPNode b l r) → coPset_wf l.
 Proof. destruct b, l as [[]|],r as [[]|]; simpl; rewrite ?andb_True; tauto. Qed.
 Lemma coPNode_wf_r b l r : coPset_wf (coPNode b l r) → coPset_wf r.
 Proof. destruct b, l as [[]|],r as [[]|]; simpl; rewrite ?andb_True; tauto. Qed.
-Local Hint Immediate coPNode_wf_l coPNode_wf_r.
+Local Hint Immediate coPNode_wf_l coPNode_wf_r : core.
 
 Definition coPNode' (b : bool) (l r : coPset_raw) : coPset_raw :=
   match b, l, r with
@@ -44,10 +49,10 @@ Definition coPNode' (b : bool) (l r : coPset_raw) : coPset_raw :=
   | false, coPLeaf false, coPLeaf false => coPLeaf false
   | _, _, _ => coPNode b l r
   end.
-Arguments coPNode' _ _ _ : simpl never.
-Lemma coPNode_wf b l r : coPset_wf l → coPset_wf r → coPset_wf (coPNode' b l r).
+Global Arguments coPNode' : simpl never.
+Lemma coPNode'_wf b l r : coPset_wf l → coPset_wf r → coPset_wf (coPNode' b l r).
 Proof. destruct b, l as [[]|], r as [[]|]; simpl; auto. Qed.
-Hint Resolve coPNode_wf.
+Global Hint Resolve coPNode'_wf : core.
 
 Fixpoint coPset_elem_of_raw (p : positive) (t : coPset_raw) {struct t} : bool :=
   match t, p with
@@ -57,7 +62,7 @@ Fixpoint coPset_elem_of_raw (p : positive) (t : coPset_raw) {struct t} : bool :=
   | coPNode _ _ r, p~1 => coPset_elem_of_raw p r
   end.
 Local Notation e_of := coPset_elem_of_raw.
-Arguments coPset_elem_of_raw _ !_ / : simpl nomatch.
+Global Arguments coPset_elem_of_raw _ !_ / : simpl nomatch, assert.
 Lemma coPset_elem_of_node b l r p :
   e_of p (coPNode' b l r) = e_of p (coPNode b l r).
 Proof. by destruct p, b, l as [[]|], r as [[]|]. Qed.
@@ -89,7 +94,7 @@ Fixpoint coPset_singleton_raw (p : positive) : coPset_raw :=
   | p~0 => coPNode' false (coPset_singleton_raw p) (coPLeaf false)
   | p~1 => coPNode' false (coPLeaf false) (coPset_singleton_raw p)
   end.
-Instance coPset_union_raw : Union coPset_raw :=
+Global Instance coPset_union_raw : Union coPset_raw :=
   fix go t1 t2 := let _ : Union _ := @go in
   match t1, t2 with
   | coPLeaf false, coPLeaf false => coPLeaf false
@@ -99,8 +104,8 @@ Instance coPset_union_raw : Union coPset_raw :=
   | coPLeaf false, coPNode b l r => coPNode b l r
   | coPNode b1 l1 r1, coPNode b2 l2 r2 => coPNode' (b1||b2) (l1 ∪ l2) (r1 ∪ r2)
   end.
-Local Arguments union _ _!_ !_ /.
-Instance coPset_intersection_raw : Intersection coPset_raw :=
+Local Arguments union _ _!_ !_ / : assert.
+Global Instance coPset_intersection_raw : Intersection coPset_raw :=
   fix go t1 t2 := let _ : Intersection _ := @go in
   match t1, t2 with
   | coPLeaf true, coPLeaf true => coPLeaf true
@@ -110,7 +115,7 @@ Instance coPset_intersection_raw : Intersection coPset_raw :=
   | coPLeaf true, coPNode b l r => coPNode b l r
   | coPNode b1 l1 r1, coPNode b2 l2 r2 => coPNode' (b1&&b2) (l1 ∩ l2) (r1 ∩ r2)
   end.
-Local Arguments intersection _ _!_ !_ /.
+Local Arguments intersection _ _!_ !_ / : assert.
 Fixpoint coPset_opp_raw (t : coPset_raw) : coPset_raw :=
   match t with
   | coPLeaf b => coPLeaf (negb b)
@@ -126,26 +131,26 @@ Lemma coPset_intersection_wf t1 t2 :
 Proof. revert t2; induction t1 as [[]|[]]; intros [[]|[] ??]; simpl; eauto. Qed.
 Lemma coPset_opp_wf t : coPset_wf (coPset_opp_raw t).
 Proof. induction t as [[]|[]]; simpl; eauto. Qed.
-Lemma elem_to_Pset_singleton p q : e_of p (coPset_singleton_raw q) ↔ p = q.
+Lemma coPset_elem_of_singleton p q : e_of p (coPset_singleton_raw q) ↔ p = q.
 Proof.
   split; [|by intros <-; induction p; simpl; rewrite ?coPset_elem_of_node].
   by revert q; induction p; intros [?|?|]; simpl;
     rewrite ?coPset_elem_of_node; intros; f_equal/=; auto.
 Qed.
-Lemma elem_to_Pset_union t1 t2 p : e_of p (t1 ∪ t2) = e_of p t1 || e_of p t2.
+Lemma coPset_elem_of_union t1 t2 p : e_of p (t1 ∪ t2) = e_of p t1 || e_of p t2.
 Proof.
   by revert t2 p; induction t1 as [[]|[]]; intros [[]|[] ??] [?|?|]; simpl;
     rewrite ?coPset_elem_of_node; simpl;
     rewrite ?orb_true_l, ?orb_false_l, ?orb_true_r, ?orb_false_r.
 Qed.
-Lemma elem_to_Pset_intersection t1 t2 p :
+Lemma coPset_elem_of_intersection t1 t2 p :
   e_of p (t1 ∩ t2) = e_of p t1 && e_of p t2.
 Proof.
   by revert t2 p; induction t1 as [[]|[]]; intros [[]|[] ??] [?|?|]; simpl;
     rewrite ?coPset_elem_of_node; simpl;
     rewrite ?andb_true_l, ?andb_false_l, ?andb_true_r, ?andb_false_r.
 Qed.
-Lemma elem_to_Pset_opp t p : e_of p (coPset_opp_raw t) = negb (e_of p t).
+Lemma coPset_elem_of_opp t p : e_of p (coPset_opp_raw t) = negb (e_of p t).
 Proof.
   by revert p; induction t as [[]|[]]; intros [?|?|]; simpl;
     rewrite ?coPset_elem_of_node; simpl.
@@ -154,60 +159,61 @@ Qed.
 (** * Packed together + set operations *)
 Definition coPset := { t | coPset_wf t }.
 
-Instance coPset_singleton : Singleton positive coPset := λ p,
+Global Instance coPset_singleton : Singleton positive coPset := λ p,
   coPset_singleton_raw p ↾ coPset_singleton_wf _.
-Instance coPset_elem_of : ElemOf positive coPset := λ p X, e_of p (`X).
-Instance coPset_empty : Empty coPset := coPLeaf false ↾ I.
-Instance coPset_top : Top coPset := coPLeaf true ↾ I.
-Instance coPset_union : Union coPset := λ X Y,
+Global Instance coPset_elem_of : ElemOf positive coPset := λ p X, e_of p (`X).
+Global Instance coPset_empty : Empty coPset := coPLeaf false ↾ I.
+Global Instance coPset_top : Top coPset := coPLeaf true ↾ I.
+Global Instance coPset_union : Union coPset := λ X Y,
   let (t1,Ht1) := X in let (t2,Ht2) := Y in
   (t1 ∪ t2) ↾ coPset_union_wf _ _ Ht1 Ht2.
-Instance coPset_intersection : Intersection coPset := λ X Y,
+Global Instance coPset_intersection : Intersection coPset := λ X Y,
   let (t1,Ht1) := X in let (t2,Ht2) := Y in
   (t1 ∩ t2) ↾ coPset_intersection_wf _ _ Ht1 Ht2.
-Instance coPset_difference : Difference coPset := λ X Y,
+Global Instance coPset_difference : Difference coPset := λ X Y,
   let (t1,Ht1) := X in let (t2,Ht2) := Y in
   (t1 ∩ coPset_opp_raw t2) ↾ coPset_intersection_wf _ _ Ht1 (coPset_opp_wf _).
 
-Instance coPset_collection : Collection positive coPset.
+Global Instance coPset_top_set : TopSet positive coPset.
 Proof.
-  split; [split| |].
+  split; [split; [split| |]|].
   - by intros ??.
-  - intros p q. apply elem_to_Pset_singleton.
+  - intros p q. apply coPset_elem_of_singleton.
   - intros [t] [t'] p; unfold elem_of, coPset_elem_of, coPset_union; simpl.
-    by rewrite elem_to_Pset_union, orb_True.
+    by rewrite coPset_elem_of_union, orb_True.
   - intros [t] [t'] p; unfold elem_of,coPset_elem_of,coPset_intersection; simpl.
-    by rewrite elem_to_Pset_intersection, andb_True.
+    by rewrite coPset_elem_of_intersection, andb_True.
   - intros [t] [t'] p; unfold elem_of, coPset_elem_of, coPset_difference; simpl.
-    by rewrite elem_to_Pset_intersection,
-      elem_to_Pset_opp, andb_True, negb_True.
+    by rewrite coPset_elem_of_intersection,
+      coPset_elem_of_opp, andb_True, negb_True.
+  - done.
 Qed.
 
-Instance coPset_leibniz : LeibnizEquiv coPset.
+(** Iris and specifically [solve_ndisj] heavily rely on this hint. *)
+Local Definition coPset_top_subseteq := top_subseteq (C:=coPset).
+Global Hint Resolve coPset_top_subseteq : core.
+
+Global Instance coPset_leibniz : LeibnizEquiv coPset.
 Proof.
-  intros X Y; rewrite elem_of_equiv; intros HXY.
-  apply (sig_eq_pi _), coPset_eq; try apply proj2_sig.
+  intros X Y; rewrite set_equiv; intros HXY.
+  apply (sig_eq_pi _), coPset_eq; try apply @proj2_sig.
   intros p; apply eq_bool_prop_intro, (HXY p).
 Qed.
 
-Instance coPset_elem_of_dec (p : positive) (X : coPset) : Decision (p ∈ X) := _.
-Instance coPset_equiv_dec (X Y : coPset) : Decision (X ≡ Y).
-Proof. refine (cast_if (decide (X = Y))); abstract (by fold_leibniz). Defined.
-Instance mapset_disjoint_dec (X Y : coPset) : Decision (X ⊥ Y).
+Global Instance coPset_elem_of_dec : RelDecision (∈@{coPset}).
+Proof. solve_decision. Defined.
+Global Instance coPset_equiv_dec : RelDecision (≡@{coPset}).
+Proof. refine (λ X Y, cast_if (decide (X = Y))); abstract (by fold_leibniz). Defined.
+Global Instance mapset_disjoint_dec : RelDecision (##@{coPset}).
 Proof.
- refine (cast_if (decide (X ∩ Y = ∅)));
+ refine (λ X Y, cast_if (decide (X ∩ Y = ∅)));
   abstract (by rewrite disjoint_intersection_L).
 Defined.
-Instance mapset_subseteq_dec (X Y : coPset) : Decision (X ⊆ Y).
+Global Instance mapset_subseteq_dec : RelDecision (⊆@{coPset}).
 Proof.
- refine (cast_if (decide (X ∪ Y = Y))); abstract (by rewrite subseteq_union_L).
+ refine (λ X Y, cast_if (decide (X ∪ Y = Y))); abstract (by rewrite subseteq_union_L).
 Defined.
 
-(** * Top *)
-Lemma coPset_top_subseteq (X : coPset) : X ⊆ ⊤.
-Proof. done. Qed.
-Hint Resolve coPset_top_subseteq.
-
 (** * Finite sets *)
 Fixpoint coPset_finite (t : coPset_raw) : bool :=
   match t with
@@ -222,7 +228,7 @@ Proof.
   unfold set_finite, elem_of at 1, coPset_elem_of; simpl; clear Ht; split.
   - induction t as [b|b l IHl r IHr]; simpl.
     { destruct b; simpl; [intros [l Hl]|done].
-      by apply (is_fresh (of_list l : Pset)), elem_of_of_list, Hl. }
+      by apply (infinite_is_fresh l), Hl. }
     intros [ll Hll]; rewrite andb_True; split.
     + apply IHl; exists (omap (maybe (~0)) ll); intros i.
       rewrite elem_of_list_omap; intros; exists (i~0); auto.
@@ -233,14 +239,17 @@ Proof.
     exists ([1] ++ ((~0) <$> ll) ++ ((~1) <$> rl))%list; intros [i|i|]; simpl;
       rewrite elem_of_cons, elem_of_app, !elem_of_list_fmap; naive_solver.
 Qed.
-Instance coPset_finite_dec (X : coPset) : Decision (set_finite X).
+Global Instance coPset_finite_dec (X : coPset) : Decision (set_finite X).
 Proof.
   refine (cast_if (decide (coPset_finite (`X)))); by rewrite coPset_finite_spec.
 Defined.
 
 (** * Pick element from infinite sets *)
-(* Implemented using depth-first search, which results in very unbalanced
-trees. *)
+(* The function [coPpick X] gives an element that is in the set [X], provided
+that the set [X] is infinite. Note that [coPpick] function is implemented by
+depth-first search, so using it repeatedly to obtain elements [x], and
+inserting these elements [x] into the set [X], will give rise to a very
+unbalanced tree. *)
 Fixpoint coPpick_raw (t : coPset_raw) : option positive :=
   match t with
   | coPLeaf true | coPNode true _ _ => Some 1
@@ -250,7 +259,7 @@ Fixpoint coPpick_raw (t : coPset_raw) : option positive :=
      | Some i => Some (i~0) | None => (~1) <$> coPpick_raw r
      end
   end.
-Definition coPpick (X : coPset) : positive := from_option id 1 (coPpick_raw (`X)).
+Definition coPpick (X : coPset) : positive := default 1 (coPpick_raw (`X)).
 
 Lemma coPpick_raw_elem_of t i : coPpick_raw t = Some i → e_of i t.
 Proof.
@@ -270,89 +279,109 @@ Proof.
 Qed.
 
 (** * Conversion to psets *)
-Fixpoint to_Pset_raw (t : coPset_raw) : Pmap_raw () :=
+Fixpoint coPset_to_Pset_raw (t : coPset_raw) : Pmap () :=
   match t with
-  | coPLeaf _ => PLeaf
-  | coPNode false l r => PNode' None (to_Pset_raw l) (to_Pset_raw r)
-  | coPNode true l r => PNode (Some ()) (to_Pset_raw l) (to_Pset_raw r)
+  | coPLeaf _ => PEmpty
+  | coPNode false l r => pmap.PNode (coPset_to_Pset_raw l) None (coPset_to_Pset_raw r)
+  | coPNode true l r => pmap.PNode (coPset_to_Pset_raw l) (Some ()) (coPset_to_Pset_raw r)
   end.
-Lemma to_Pset_wf t : coPset_wf t → Pmap_wf (to_Pset_raw t).
-Proof. induction t as [|[]]; simpl; eauto using PNode_wf. Qed.
-Definition to_Pset (X : coPset) : Pset :=
-  let (t,Ht) := X in Mapset (PMap (to_Pset_raw t) (to_Pset_wf _ Ht)).
-Lemma elem_of_to_Pset X i : set_finite X → i ∈ to_Pset X ↔ i ∈ X.
+Definition coPset_to_Pset (X : coPset) : Pset :=
+  let (t,Ht) := X in Mapset (coPset_to_Pset_raw t).
+Lemma elem_of_coPset_to_Pset X i : set_finite X → i ∈ coPset_to_Pset X ↔ i ∈ X.
 Proof.
   rewrite coPset_finite_spec; destruct X as [t Ht].
-  change (coPset_finite t → to_Pset_raw t !! i = Some () ↔ e_of i t).
+  change (coPset_finite t → coPset_to_Pset_raw t !! i = Some () ↔ e_of i t).
   clear Ht; revert i; induction t as [[]|[] l IHl r IHr]; intros [i|i|];
-    simpl; rewrite ?andb_True, ?PNode_lookup; naive_solver.
+    simpl; rewrite ?andb_True, ?pmap.Pmap_lookup_PNode; naive_solver.
 Qed.
 
 (** * Conversion from psets *)
-Fixpoint of_Pset_raw (t : Pmap_raw ()) : coPset_raw :=
-  match t with
-  | PLeaf => coPLeaf false
-  | PNode None l r => coPNode false (of_Pset_raw l) (of_Pset_raw r)
-  | PNode (Some _) l r => coPNode true (of_Pset_raw l) (of_Pset_raw r)
-  end.
-Lemma of_Pset_wf t : Pmap_wf t → coPset_wf (of_Pset_raw t).
+Definition Pset_to_coPset_raw_aux (go : Pmap_ne () → coPset_raw)
+    (mt : Pmap ()) : coPset_raw :=
+  match mt with PNodes t => go t | PEmpty => coPLeaf false end.
+Fixpoint Pset_ne_to_coPset_raw (t : Pmap_ne ()) : coPset_raw :=
+  pmap.Pmap_ne_case t $ λ ml mx mr,
+    coPNode match mx with Some _ => true | None => false end
+      (Pset_to_coPset_raw_aux Pset_ne_to_coPset_raw ml)
+      (Pset_to_coPset_raw_aux Pset_ne_to_coPset_raw mr).
+Definition Pset_to_coPset_raw : Pmap () → coPset_raw :=
+  Pset_to_coPset_raw_aux Pset_ne_to_coPset_raw.
+
+Lemma Pset_to_coPset_raw_PNode ml mx mr :
+  pmap.PNode_valid ml mx mr →
+  Pset_to_coPset_raw (pmap.PNode ml mx mr) =
+    coPNode match mx with Some _ => true | None => false end
+    (Pset_to_coPset_raw ml) (Pset_to_coPset_raw mr).
+Proof. by destruct ml, mx, mr. Qed.
+Lemma Pset_to_coPset_raw_wf t : coPset_wf (Pset_to_coPset_raw t).
+Proof.
+  induction t as [|ml mx mr] using pmap.Pmap_ind; [done|].
+  rewrite Pset_to_coPset_raw_PNode by done.
+  apply coPNode_wf; [done|done|..];
+    destruct mx; destruct ml using pmap.Pmap_ind; destruct mr using pmap.Pmap_ind;
+    rewrite ?Pset_to_coPset_raw_PNode by done; naive_solver.
+Qed.
+Lemma elem_of_Pset_to_coPset_raw i t : e_of i (Pset_to_coPset_raw t) ↔ t !! i = Some ().
 Proof.
-  induction t as [|[] l IHl r IHr]; simpl; rewrite ?andb_True; auto.
-  - intros [??]; destruct l as [|[]], r as [|[]]; simpl in *; auto.
-  - destruct l as [|[]], r as [|[]]; simpl in *; rewrite ?andb_true_r;
-      rewrite ?andb_True; rewrite ?andb_True in IHl, IHr; intuition.
+  revert i. induction t as [|ml mx mr] using pmap.Pmap_ind; [done|].
+  intros []; rewrite Pset_to_coPset_raw_PNode,
+    pmap.Pmap_lookup_PNode by done; destruct mx as [[]|]; naive_solver.
 Qed.
-Lemma elem_of_of_Pset_raw i t : e_of i (of_Pset_raw t) ↔ t !! i = Some ().
-Proof. by revert i; induction t as [|[[]|]]; intros []; simpl; auto; split. Qed.
-Lemma of_Pset_raw_finite t : coPset_finite (of_Pset_raw t).
-Proof. induction t as [|[[]|]]; simpl; rewrite ?andb_True; auto. Qed.
-
-Definition of_Pset (X : Pset) : coPset :=
-  let 'Mapset (PMap t Ht) := X in of_Pset_raw t ↾ of_Pset_wf _ Ht.
-Lemma elem_of_of_Pset X i : i ∈ of_Pset X ↔ i ∈ X.
-Proof. destruct X as [[t ?]]; apply elem_of_of_Pset_raw. Qed.
-Lemma of_Pset_finite X : set_finite (of_Pset X).
-Proof.
-  apply coPset_finite_spec; destruct X as [[t ?]]; apply of_Pset_raw_finite.
+Lemma Pset_to_coPset_raw_finite t : coPset_finite (Pset_to_coPset_raw t).
+Proof.
+  induction t as [|ml mx mr] using pmap.Pmap_ind; [done|].
+  rewrite Pset_to_coPset_raw_PNode by done. destruct mx; naive_solver.
 Qed.
 
+Definition Pset_to_coPset (X : Pset) : coPset :=
+  let 'Mapset t := X in Pset_to_coPset_raw t ↾ Pset_to_coPset_raw_wf _.
+Lemma elem_of_Pset_to_coPset X i : i ∈ Pset_to_coPset X ↔ i ∈ X.
+Proof. destruct X; apply elem_of_Pset_to_coPset_raw. Qed.
+Lemma Pset_to_coPset_finite X : set_finite (Pset_to_coPset X).
+Proof. apply coPset_finite_spec; destruct X; apply Pset_to_coPset_raw_finite. Qed.
+
 (** * Conversion to and from gsets of positives *)
-Lemma to_gset_wf (m : Pmap ()) : gmap_wf (K:=positive) m.
-Proof. done. Qed.
-Definition to_gset (X : coPset) : gset positive :=
-  let 'Mapset m := to_Pset X in
-  Mapset (GMap m (bool_decide_pack _ (to_gset_wf m))).
+Definition coPset_to_gset (X : coPset) : gset positive :=
+  let 'Mapset m := coPset_to_Pset X in
+  Mapset (pmap_to_gmap m).
 
-Definition of_gset (X : gset positive) : coPset :=
-  let 'Mapset (GMap (PMap t Ht) _) := X in of_Pset_raw t ↾ of_Pset_wf _ Ht.
+Definition gset_to_coPset (X : gset positive) : coPset :=
+  let 'Mapset m := X in
+  Pset_to_coPset_raw (gmap_to_pmap m) ↾ Pset_to_coPset_raw_wf _.
 
-Lemma elem_of_to_gset X i : set_finite X → i ∈ to_gset X ↔ i ∈ X.
+Lemma elem_of_coPset_to_gset X i : set_finite X → i ∈ coPset_to_gset X ↔ i ∈ X.
 Proof.
-  intros ?. rewrite <-elem_of_to_Pset by done.
-  unfold to_gset. by destruct (to_Pset X).
+  intros ?. rewrite <-elem_of_coPset_to_Pset by done. destruct X as [X ?].
+  unfold elem_of, gset_elem_of, mapset_elem_of, coPset_to_gset; simpl.
+  by rewrite lookup_pmap_to_gmap.
 Qed.
 
-Lemma elem_of_of_gset X i : i ∈ of_gset X ↔ i ∈ X.
-Proof. destruct X as [[[t ?]]]; apply elem_of_of_Pset_raw. Qed.
-Lemma of_gset_finite X : set_finite (of_gset X).
+Lemma elem_of_gset_to_coPset X i : i ∈ gset_to_coPset X ↔ i ∈ X.
 Proof.
-  apply coPset_finite_spec; destruct X as [[[t ?]]]; apply of_Pset_raw_finite.
+  destruct X as [m]. unfold elem_of, coPset_elem_of; simpl.
+  by rewrite elem_of_Pset_to_coPset_raw, lookup_gmap_to_pmap.
 Qed.
-
-(** * Domain of finite maps *)
-Instance Pmap_dom_coPset {A} : Dom (Pmap A) coPset := λ m, of_Pset (dom _ m).
-Instance Pmap_dom_coPset_spec: FinMapDom positive Pmap coPset.
+Lemma gset_to_coPset_finite X : set_finite (gset_to_coPset X).
 Proof.
-  split; try apply _; intros A m i; unfold dom, Pmap_dom_coPset.
-  by rewrite elem_of_of_Pset, elem_of_dom.
+  apply coPset_finite_spec; destruct X as [[?]]; apply Pset_to_coPset_raw_finite.
 Qed.
-Instance gmap_dom_coPset {A} : Dom (gmap positive A) coPset := λ m,
-  of_gset (dom _ m).
-Instance gmap_dom_coPset_spec: FinMapDom positive (gmap positive) coPset.
+
+(** * Infinite sets *)
+Lemma coPset_infinite_finite (X : coPset) : set_infinite X ↔ ¬set_finite X.
 Proof.
-  split; try apply _; intros A m i; unfold dom, gmap_dom_coPset.
-  by rewrite elem_of_of_gset, elem_of_dom.
+  split; [intros ??; by apply (set_not_infinite_finite X)|].
+  intros Hfin xs. exists (coPpick (X ∖ list_to_set xs)).
+  cut (coPpick (X ∖ list_to_set xs) ∈ X ∖ list_to_set xs); [set_solver|].
+  apply coPpick_elem_of; intros Hfin'.
+  apply Hfin, (difference_finite_inv _ (list_to_set xs)), Hfin'.
+  apply list_to_set_finite.
 Qed.
+Lemma coPset_finite_infinite (X : coPset) : set_finite X ↔ ¬set_infinite X.
+Proof. rewrite coPset_infinite_finite. split; [tauto|apply dec_stable]. Qed.
+Global Instance coPset_infinite_dec (X : coPset) : Decision (set_infinite X).
+Proof.
+  refine (cast_if (decide (¬set_finite X))); by rewrite coPset_infinite_finite.
+Defined.
 
 (** * Suffix sets *)
 Fixpoint coPset_suffixes_raw (p : positive) : coPset_raw :=
@@ -404,15 +433,15 @@ Definition coPset_r (X : coPset) : coPset :=
 Lemma coPset_lr_disjoint X : coPset_l X ∩ coPset_r X = ∅.
 Proof.
   apply elem_of_equiv_empty_L; intros p; apply Is_true_false.
-  destruct X as [t Ht]; simpl; clear Ht; rewrite elem_to_Pset_intersection.
+  destruct X as [t Ht]; simpl; clear Ht; rewrite coPset_elem_of_intersection.
   revert p; induction t as [[]|[]]; intros [?|?|]; simpl;
     rewrite ?coPset_elem_of_node; simpl;
     rewrite ?orb_true_l, ?orb_false_l, ?orb_true_r, ?orb_false_r; auto.
 Qed.
 Lemma coPset_lr_union X : coPset_l X ∪ coPset_r X = X.
 Proof.
-  apply elem_of_equiv_L; intros p; apply eq_bool_prop_elim.
-  destruct X as [t Ht]; simpl; clear Ht; rewrite elem_to_Pset_union.
+  apply set_eq; intros p; apply eq_bool_prop_elim.
+  destruct X as [t Ht]; simpl; clear Ht; rewrite coPset_elem_of_union.
   revert p; induction t as [[]|[]]; intros [?|?|]; simpl;
     rewrite ?coPset_elem_of_node; simpl;
     rewrite ?orb_true_l, ?orb_false_l, ?orb_true_r, ?orb_false_r; auto.
@@ -427,10 +456,17 @@ Proof.
   rewrite !coPset_finite_spec; destruct X as [t Ht]; simpl; clear Ht.
   induction t as [[]|]; simpl; rewrite ?coPset_finite_node, ?andb_True; tauto.
 Qed.
-Lemma coPset_split X :
+Lemma coPset_split (X : coPset) :
   ¬set_finite X →
   ∃ X1 X2, X = X1 ∪ X2 ∧ X1 ∩ X2 = ∅ ∧ ¬set_finite X1 ∧ ¬set_finite X2.
 Proof.
   exists (coPset_l X), (coPset_r X); eauto 10 using coPset_lr_union,
     coPset_lr_disjoint, coPset_l_finite, coPset_r_finite.
 Qed.
+Lemma coPset_split_infinite (X : coPset) :
+  set_infinite X →
+  ∃ X1 X2, X = X1 ∪ X2 ∧ X1 ∩ X2 = ∅ ∧ set_infinite X1 ∧ set_infinite X2.
+Proof.
+  setoid_rewrite coPset_infinite_finite.
+  eapply coPset_split.
+Qed.

theories/countable.v → stdpp/countable.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
-From stdpp Require Export list.
-Set Default Proof Using "Type".
+From Coq.QArith Require Import QArith_base Qcanon.
+From stdpp Require Export list numbers list_numbers fin.
+From stdpp Require Import well_founded.
+From stdpp Require Import options.
 Local Open Scope positive.
 
+(** Note that [Countable A] gives rise to [EqDecision A] by checking equality of
+the results of [encode]. This instance of [EqDecision A] is very inefficient, so
+the native decider is typically preferred for actual computation. To avoid
+overlapping instances, we include [EqDecision A] explicitly as a parameter of
+[Countable A]. *)
 Class Countable A `{EqDecision A} := {
   encode : A → positive;
   decode : positive → option A;
   decode_encode x : decode (encode x) = Some x
 }.
-Arguments encode : simpl never.
-Arguments decode : simpl never.
+Global Hint Mode Countable ! - : typeclass_instances.
+Global Arguments encode : simpl never.
+Global Arguments decode : simpl never.
 
-Definition encode_nat `{Countable A} (x : A) : nat :=
-  pred (Pos.to_nat (encode x)).
-Definition decode_nat `{Countable A} (i : nat) : option A :=
-  decode (Pos.of_nat (S i)).
-Instance encode_inj `{Countable A} : Inj (=) (=) encode.
+Global Instance encode_inj `{Countable A} : Inj (=) (=) (encode (A:=A)).
 Proof.
   intros x y Hxy; apply (inj Some).
   by rewrite <-(decode_encode x), Hxy, decode_encode.
 Qed.
-Instance encode_nat_inj `{Countable A} : Inj (=) (=) encode_nat.
+
+Definition encode_nat `{Countable A} (x : A) : nat :=
+  pred (Pos.to_nat (encode x)).
+Definition decode_nat `{Countable A} (i : nat) : option A :=
+  decode (Pos.of_nat (S i)).
+Global Instance encode_nat_inj `{Countable A} : Inj (=) (=) (encode_nat (A:=A)).
 Proof. unfold encode_nat; intros x y Hxy; apply (inj encode); lia. Qed.
-Lemma decode_encode_nat `{Countable A} x : decode_nat (encode_nat x) = Some x.
+Lemma decode_encode_nat `{Countable A} (x : A) : decode_nat (encode_nat x) = Some x.
 Proof.
   pose proof (Pos2Nat.is_pos (encode x)).
   unfold decode_nat, encode_nat. rewrite Nat.succ_pred by lia.
   by rewrite Pos2Nat.id, decode_encode.
 Qed.
 
+Definition encode_Z `{Countable A} (x : A) : Z :=
+  Zpos (encode x).
+Definition decode_Z `{Countable A} (i : Z) : option A :=
+  match i with Zpos i => decode i | _ => None end.
+Global Instance encode_Z_inj `{Countable A} : Inj (=) (=) (encode_Z (A:=A)).
+Proof. unfold encode_Z; intros x y Hxy; apply (inj encode); lia. Qed.
+Lemma decode_encode_Z `{Countable A} (x : A) : decode_Z (encode_Z x) = Some x.
+Proof. apply decode_encode. Qed.
+
 (** * Choice principles *)
 Section choice.
   Context `{Countable A} (P : A → Prop).
 
   Inductive choose_step: relation positive :=
-    | choose_step_None {p} : decode p = None → choose_step (Psucc p) p
-    | choose_step_Some {p x} :
-       decode p = Some x → ¬P x → choose_step (Psucc p) p.
+    | choose_step_None {p} : decode (A:=A) p = None → choose_step (Pos.succ p) p
+    | choose_step_Some {p} {x : A} :
+       decode p = Some x → ¬P x → choose_step (Pos.succ p) p.
   Lemma choose_step_acc : (∃ x, P x) → Acc choose_step 1%positive.
   Proof.
     intros [x Hx]. cut (∀ i p,
       i ≤ encode x → 1 + encode x = p + i → Acc choose_step p).
     { intros help. by apply (help (encode x)). }
-    induction i as [|i IH] using Pos.peano_ind; intros p ??.
+    intros i. induction i as [|i IH] using Pos.peano_ind; intros p ??.
     { constructor. intros j. assert (p = encode x) by lia; subst.
-      inversion 1 as [? Hd|?? Hd]; subst;
-        rewrite decode_encode in Hd; congruence. }
+      inv 1 as [? Hd|?? Hd]; rewrite decode_encode in Hd; congruence. }
     constructor. intros j.
-    inversion 1 as [? Hd|? y Hd]; subst; auto with lia.
+    inv 1 as [? Hd|? y Hd]; auto with lia.
   Qed.
 
   Context `{∀ x, Decision (P x)}.
@@ -74,6 +89,25 @@ Section choice.
   Definition choice (HA : ∃ x, P x) : { x | P x } := _↾choose_correct HA.
 End choice.
 
+Section choice_proper.
+  Context `{Countable A}.
+  Context (P1 P2 : A → Prop) `{∀ x, Decision (P1 x)} `{∀ x, Decision (P2 x)}.
+  Context (Heq : ∀ x, P1 x ↔ P2 x).
+
+  Lemma choose_go_proper {i} (acc1 acc2 : Acc (choose_step _) i) :
+    choose_go P1 acc1 = choose_go P2 acc2.
+  Proof using Heq.
+    induction acc1 as [i a1 IH] using Acc_dep_ind;
+      destruct acc2 as [acc2]; simpl.
+    destruct (Some_dec _) as [[x Hx]|]; [|done].
+    do 2 case_decide; done || exfalso; naive_solver.
+  Qed.
+
+  Lemma choose_proper p1 p2 :
+    choose P1 p1 = choose P2 p2.
+  Proof using Heq. apply choose_go_proper. Qed.
+End choice_proper.
+
 Lemma surj_cancel `{Countable A} `{EqDecision B}
   (f : A → B) `{!Surj (=) f} : { g : B → A & Cancel (=) f g }.
 Proof.
@@ -83,17 +117,42 @@ Qed.
 
 (** * Instances *)
 (** ** Injection *)
-Section injective_countable.
+Section inj_countable.
   Context `{Countable A, EqDecision B}.
   Context (f : B → A) (g : A → option B) (fg : ∀ x, g (f x) = Some x).
 
-  Program Instance injective_countable : Countable B :=
+  Program Definition inj_countable : Countable B :=
     {| encode y := encode (f y); decode p := x ← decode p; g x |}.
   Next Obligation. intros y; simpl; rewrite decode_encode; eauto. Qed.
-End injective_countable.
+End inj_countable.
+
+Section inj_countable'.
+  Context `{Countable A, EqDecision B}.
+  Context (f : B → A) (g : A → B) (fg : ∀ x, g (f x) = x).
+
+  Program Definition inj_countable' : Countable B := inj_countable f (Some ∘ g) _.
+  Next Obligation. intros x. by f_equal/=. Qed.
+End inj_countable'.
+
+(** ** Empty *)
+Global Program Instance Empty_set_countable : Countable Empty_set :=
+  {| encode u := 1; decode p := None |}.
+Next Obligation. by intros []. Qed.
+
+(** ** Unit *)
+Global Program Instance unit_countable : Countable unit :=
+  {| encode u := 1; decode p := Some () |}.
+Next Obligation. by intros []. Qed.
+
+(** ** Bool *)
+Global Program Instance bool_countable : Countable bool := {|
+  encode b := if b then 1 else 2;
+  decode p := Some match p return bool with 1 => true | _ => false end
+|}.
+Next Obligation. by intros []. Qed.
 
 (** ** Option *)
-Program Instance option_countable `{Countable A} : Countable (option A) := {|
+Global Program Instance option_countable `{Countable A} : Countable (option A) := {|
   encode o := match o with None => 1 | Some x => Pos.succ (encode x) end;
   decode p := if decide (p = 1) then Some None else Some <$> decode (Pos.pred p)
 |}.
@@ -103,7 +162,7 @@ Next Obligation.
 Qed.
 
 (** ** Sums *)
-Program Instance sum_countable `{Countable A} `{Countable B} :
+Global Program Instance sum_countable `{Countable A} `{Countable B} :
   Countable (A + B)%type := {|
     encode xy :=
       match xy with inl x => (encode x)~0 | inr y => (encode y)~1 end;
@@ -176,7 +235,7 @@ Proof.
   { intros p'. by induction p'; simplify_option_eq. }
   revert q. by induction p; intros [?|?|]; simplify_option_eq.
 Qed.
-Program Instance prod_countable `{Countable A} `{Countable B} :
+Global Program Instance prod_countable `{Countable A} `{Countable B} :
   Countable (A * B)%type := {|
     encode xy := prod_encode (encode (xy.1)) (encode (xy.2));
     decode p :=
@@ -190,81 +249,139 @@ Next Obligation.
 Qed.
 
 (** ** Lists *)
-(* Lists are encoded as 1 separated sequences of 0s corresponding to the unary
-representation of the elements. *)
-Fixpoint list_encode `{Countable A} (acc : positive) (l : list A) : positive :=
-  match l with
-  | [] => acc
-  | x :: l => list_encode (Nat.iter (encode_nat x) (~0) (acc~1)) l
-  end.
-Fixpoint list_decode `{Countable A} (acc : list A)
-    (n : nat) (p : positive) : option (list A) :=
-  match p with
-  | 1 => Some acc
-  | p~0 => list_decode acc (S n) p
-  | p~1 => x ← decode_nat n; list_decode (x :: acc) O p
-  end.
-Lemma x0_iter_x1 n acc : Nat.iter n (~0) acc~1 = acc ++ Nat.iter n (~0) 3.
-Proof. by induction n; f_equal/=. Qed.
-Lemma list_encode_app' `{Countable A} (l1 l2 : list A) acc :
-  list_encode acc (l1 ++ l2) = list_encode acc l1 ++ list_encode 1 l2.
-Proof.
-  revert acc; induction l1; simpl; auto.
-  induction l2 as [|x l IH]; intros acc; simpl; [by rewrite ?(left_id_L _ _)|].
-  by rewrite !(IH (Nat.iter _ _ _)), (assoc_L _), x0_iter_x1.
-Qed.
-Program Instance list_countable `{Countable A} : Countable (list A) :=
-  {| encode := list_encode 1; decode := list_decode [] 0 |}.
+Global Program Instance list_countable `{Countable A} : Countable (list A) :=
+  {| encode xs := positives_flatten (encode <$> xs);
+     decode p := positives ← positives_unflatten p;
+                 mapM decode positives; |}.
 Next Obligation.
-  intros A ??; simpl.
-  assert (∀ m acc n p, list_decode acc n (Nat.iter m (~0) p)
-    = list_decode acc (n + m) p) as decode_iter.
-  { induction m as [|m IH]; intros acc n p; simpl; [by rewrite Nat.add_0_r|].
-    by rewrite IH, Nat.add_succ_r. }
-  cut (∀ l acc, list_decode acc 0 (list_encode 1 l) = Some (l ++ acc))%list.
-  { by intros help l; rewrite help, (right_id_L _ _). }
-  induction l as [|x l IH] using @rev_ind; intros acc; [done|].
-  rewrite list_encode_app'; simpl; rewrite <-x0_iter_x1, decode_iter; simpl.
-  by rewrite decode_encode_nat; simpl; rewrite IH, <-(assoc_L _).
-Qed.
-Lemma list_encode_app `{Countable A} (l1 l2 : list A) :
-  encode (l1 ++ l2)%list = encode l1 ++ encode l2.
-Proof. apply list_encode_app'. Qed.
-Lemma list_encode_cons `{Countable A} x (l : list A) :
-  encode (x :: l) = Nat.iter (encode_nat x) (~0) 3 ++ encode l.
-Proof. apply (list_encode_app' [_]). Qed.
-Lemma list_encode_suffix `{Countable A} (l k : list A) :
-  l `suffix_of` k → ∃ q, encode k = q ++ encode l.
-Proof. intros [l' ->]; exists (encode l'); apply list_encode_app. Qed.
-Lemma list_encode_suffix_eq `{Countable A} q1 q2 (l1 l2 : list A) :
-  length l1 = length l2 → q1 ++ encode l1 = q2 ++ encode l2 → l1 = l2.
-Proof.
-  revert q1 q2 l2; induction l1 as [|a1 l1 IH];
-    intros q1 q2 [|a2 l2] ?; simplify_eq/=; auto.
-  rewrite !list_encode_cons, !(assoc _); intros Hl.
-  assert (l1 = l2) as <- by eauto; clear IH; f_equal.
-  apply (inj encode_nat); apply (inj (++ encode l1)) in Hl; revert Hl; clear.
-  generalize (encode_nat a2).
-  induction (encode_nat a1); intros [|?] ?; naive_solver.
+  intros A EqA CA xs.
+  simpl.
+  rewrite positives_unflatten_flatten.
+  simpl.
+  apply (mapM_fmap_Some _ _ _ decode_encode).
 Qed.
 
 (** ** Numbers *)
-Instance pos_countable : Countable positive :=
+Global Instance pos_countable : Countable positive :=
   {| encode := id; decode := Some; decode_encode x := eq_refl |}.
-Program Instance N_countable : Countable N := {|
+Global Program Instance N_countable : Countable N := {|
   encode x := match x with N0 => 1 | Npos p => Pos.succ p end;
   decode p := if decide (p = 1) then Some 0%N else Some (Npos (Pos.pred p))
 |}.
 Next Obligation.
-  by intros [|p];simpl;[|rewrite decide_False,Pos.pred_succ by (by destruct p)].
+  intros [|p]; simpl; [done|].
+  by rewrite decide_False, Pos.pred_succ by (by destruct p).
 Qed.
-Program Instance Z_countable : Countable Z := {|
+Global Program Instance Z_countable : Countable Z := {|
   encode x := match x with Z0 => 1 | Zpos p => p~0 | Zneg p => p~1 end;
   decode p := Some match p with 1 => Z0 | p~0 => Zpos p | p~1 => Zneg p end
 |}.
 Next Obligation. by intros [|p|p]. Qed.
-Program Instance nat_countable : Countable nat :=
+Global Program Instance nat_countable : Countable nat :=
   {| encode x := encode (N.of_nat x); decode p := N.to_nat <$> decode p |}.
 Next Obligation.
   by intros x; lazy beta; rewrite decode_encode; csimpl; rewrite Nat2N.id.
 Qed.
+
+Global Program Instance Qc_countable : Countable Qc :=
+  inj_countable
+    (λ p : Qc, let 'Qcmake (x # y) _ := p return _ in (x,y))
+    (λ q : Z * positive, let '(x,y) := q return _ in Some (Q2Qc (x # y))) _.
+Next Obligation.
+  intros [[x y] Hcan]. f_equal. apply Qc_is_canon. simpl. by rewrite Hcan.
+Qed.
+
+Global Program Instance Qp_countable : Countable Qp :=
+  inj_countable
+    Qp_to_Qc
+    (λ p : Qc, Hp ← guard (0 < p)%Qc; Some (mk_Qp p Hp)) _.
+Next Obligation.
+  intros [p Hp]. case_guard; simplify_eq/=; [|done].
+  f_equal. by apply Qp.to_Qc_inj_iff.
+Qed.
+
+Global Program Instance fin_countable n : Countable (fin n) :=
+  inj_countable
+    fin_to_nat
+    (λ m : nat, Hm ← guard (m < n)%nat; Some (nat_to_fin Hm)) _.
+Next Obligation.
+  intros n i; simplify_option_eq.
+  - by rewrite nat_to_fin_to_nat.
+  - by pose proof (fin_to_nat_lt i).
+Qed.
+
+(** ** Generic trees *)
+Local Close Scope positive.
+
+(** This type can help you construct a [Countable] instance for an arbitrary
+(even recursive) inductive datatype. The idea is tht you make [T] something like
+[T1 + T2 + ...], covering all the data types that can be contained inside your
+type.
+- Each non-recursive constructor to a [GenLeaf]. Different constructors must use
+  different variants of [T] to ensure they remain distinguishable!
+- Each recursive constructor to a [GenNode] where the [nat] is a (typically
+  small) constant representing the constructor itself, and then all the data in
+  the constructor (recursive or otherwise) is put into child nodes.
+
+This data type is the same as [GenTree.tree] in mathcomp, see
+https://github.com/math-comp/math-comp/blob/master/ssreflect/choice.v *)
+Inductive gen_tree (T : Type) : Type :=
+  | GenLeaf : T → gen_tree T
+  | GenNode : nat → list (gen_tree T) → gen_tree T.
+Global Arguments GenLeaf {_} _ : assert.
+Global Arguments GenNode {_} _ _ : assert.
+
+Global Instance gen_tree_dec `{EqDecision T} : EqDecision (gen_tree T).
+Proof.
+ refine (
+  fix go t1 t2 := let _ : EqDecision _ := @go in
+  match t1, t2 with
+  | GenLeaf x1, GenLeaf x2 => cast_if (decide (x1 = x2))
+  | GenNode n1 ts1, GenNode n2 ts2 =>
+     cast_if_and (decide (n1 = n2)) (decide (ts1 = ts2))
+  | _, _ => right _
+  end); abstract congruence.
+Defined.
+
+Fixpoint gen_tree_to_list {T} (t : gen_tree T) : list (nat * nat + T) :=
+  match t with
+  | GenLeaf x => [inr x]
+  | GenNode n ts => (ts ≫= gen_tree_to_list) ++ [inl (length ts, n)]
+  end.
+
+Fixpoint gen_tree_of_list {T}
+    (k : list (gen_tree T)) (l : list (nat * nat + T)) : option (gen_tree T) :=
+  match l with
+  | [] => head k
+  | inr x :: l => gen_tree_of_list (GenLeaf x :: k) l
+  | inl (len,n) :: l =>
+     gen_tree_of_list (GenNode n (reverse (take len k)) :: drop len k) l
+  end.
+
+Lemma gen_tree_of_to_list {T} k l (t : gen_tree T) :
+  gen_tree_of_list k (gen_tree_to_list t ++ l) = gen_tree_of_list (t :: k) l.
+Proof.
+  revert t k l; fix FIX 1; intros [|n ts] k l; simpl; auto.
+  trans (gen_tree_of_list (reverse ts ++ k) ([inl (length ts, n)] ++ l)).
+  - rewrite <-(assoc_L _). revert k. generalize ([inl (length ts, n)] ++ l).
+    induction ts as [|t ts'' IH]; intros k ts'''; csimpl; auto.
+    rewrite reverse_cons, <-!(assoc_L _), FIX; simpl; auto.
+  - simpl. by rewrite take_app_length', drop_app_length', reverse_involutive
+      by (by rewrite length_reverse).
+Qed.
+
+Global Program Instance gen_tree_countable `{Countable T} : Countable (gen_tree T) :=
+  inj_countable gen_tree_to_list (gen_tree_of_list []) _.
+Next Obligation.
+  intros T ?? t.
+  by rewrite <-(right_id_L [] _ (gen_tree_to_list _)), gen_tree_of_to_list.
+Qed.
+
+(** ** Sigma *)
+Global Program Instance countable_sig `{Countable A} (P : A → Prop)
+        `{!∀ x, Decision (P x), !∀ x, ProofIrrel (P x)} :
+  Countable { x : A | P x } :=
+  inj_countable proj1_sig (λ x, Hx ← guard (P x); Some (x ↾ Hx)) _.
+Next Obligation.
+  intros A ?? P ?? [x Hx]. by erewrite (option_guard_True_pi (P x)).
+Qed.

theories/decidable.v → stdpp/decidable.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file collects theorems, definitions, tactics, related to propositions
 with a decidable equality. Such propositions are collected by the [Decision]
 type class. *)
 From stdpp Require Export proof_irrel.
-Set Default Proof Using "Type*".
+From stdpp Require Import options.
 
-Hint Extern 200 (Decision _) => progress (lazy beta) : typeclass_instances.
+(* Pick up extra assumptions from section parameters. *)
+Set Default Proof Using "Type*".
 
 Lemma dec_stable `{Decision P} : ¬¬P → P.
 Proof. firstorder. Qed.
 
 Lemma Is_true_reflect (b : bool) : reflect b b.
-Proof. destruct b. left; constructor. right. intros []. Qed.
-Instance: Inj (=) (↔) Is_true.
+Proof. destruct b; [left; constructor | right; intros []]. Qed.
+Global Instance: Inj (=) (↔) Is_true.
 Proof. intros [] []; simpl; intuition. Qed.
 
-(** We introduce [decide_rel] to avoid inefficienct computation due to eager
-evaluation of propositions by [vm_compute]. This inefficiency occurs if
-[(x = y) := (f x = f y)] as [decide (x = y)] evaluates to [decide (f x = f y)]
-which then might lead to evaluation of [f x] and [f y]. Using [decide_rel]
-we hide [f] under a lambda abstraction to avoid this unnecessary evaluation. *)
-Definition decide_rel {A B} (R : A → B → Prop) {dec : ∀ x y, Decision (R x y)}
-  (x : A) (y : B) : Decision (R x y) := dec x y.
-Lemma decide_rel_correct {A B} (R : A → B → Prop) `{∀ x y, Decision (R x y)}
-  (x : A) (y : B) : decide_rel R x y = decide (R x y).
-Proof. reflexivity. Qed.
-
 Lemma decide_True {A} `{Decision P} (x y : A) :
   P → (if decide P then x else y) = x.
 Proof. destruct (decide P); tauto. Qed.
 Lemma decide_False {A} `{Decision P} (x y : A) :
   ¬P → (if decide P then x else y) = y.
 Proof. destruct (decide P); tauto. Qed.
-Lemma decide_iff {A} P Q `{Decision P, Decision Q} (x y : A) :
+Lemma decide_ext {A} P Q `{Decision P, Decision Q} (x y : A) :
   (P ↔ Q) → (if decide P then x else y) = (if decide Q then x else y).
 Proof. intros [??]. destruct (decide P), (decide Q); tauto. Qed.
 
-Lemma decide_left`{Decision P, !ProofIrrel P} (HP : P) : decide P = left HP.
-Proof. destruct (decide P) as [?|?]; [|contradiction]. f_equal. apply proof_irrel. Qed.
-Lemma decide_right`{Decision P} `{!ProofIrrel (¬ P)} (HP : ¬ P) : decide P = right HP.
-Proof. destruct (decide P) as [?|?]; [contradiction|]. f_equal. apply proof_irrel. Qed.
+Lemma decide_True_pi `{Decision P, !ProofIrrel P} (HP : P) : decide P = left HP.
+Proof. destruct (decide P); [|contradiction]. f_equal. apply proof_irrel. Qed.
+Lemma decide_False_pi `{Decision P, !ProofIrrel (¬ P)} (HP : ¬ P) : decide P = right HP.
+Proof. destruct (decide P); [contradiction|]. f_equal. apply proof_irrel. Qed.
 
 (** The tactic [destruct_decide] destructs a sumbool [dec]. If one of the
 components is double negated, it will try to remove the double negation. *)
@@ -75,9 +63,10 @@ Ltac solve_trivial_decision :=
   | |- Decision (?P) => apply _
   | |- sumbool ?P (¬?P) => change (Decision P); apply _
   end.
-Ltac solve_decision := intros; first
-  [ solve_trivial_decision
-  | unfold Decision; decide equality; solve_trivial_decision ].
+Ltac solve_decision :=
+  unfold EqDecision; intros; first
+    [ solve_trivial_decision
+    | unfold Decision; decide equality; solve_trivial_decision ].
 
 (** The following combinators are useful to create Decision proofs in
 combination with the [refine] tactic. *)
@@ -96,6 +85,79 @@ Notation cast_if_or3 S1 S2 S3 := (if S1 then left _ else cast_if_or S2 S3).
 Notation cast_if_not_or S1 S2 := (if S1 then cast_if S2 else left _).
 Notation cast_if_not S := (if S then right _ else left _).
 
+(** * Instances of [Decision] *)
+(** Instances of [Decision] for operators of propositional logic. *)
+(** The instances for [True] and [False] have a very high cost. If they are
+applied too eagerly, HO-unification could wrongfully instantiate TC instances
+with [λ .., True] or [λ .., False].
+See https://gitlab.mpi-sws.org/iris/stdpp/-/issues/165 *)
+Global Instance True_dec: Decision True | 1000 := left I.
+Global Instance False_dec: Decision False | 1000 := right (False_rect False).
+
+Global Instance Is_true_dec b : Decision (Is_true b).
+Proof. destruct b; simpl; apply _. Defined.
+
+Section prop_dec.
+  Context `(P_dec : Decision P) `(Q_dec : Decision Q).
+
+  Global Instance not_dec: Decision (¬P).
+  Proof. refine (cast_if_not P_dec); intuition. Defined.
+  Global Instance and_dec: Decision (P ∧ Q).
+  Proof. refine (cast_if_and P_dec Q_dec); intuition. Defined.
+  Global Instance or_dec: Decision (P ∨ Q).
+  Proof. refine (cast_if_or P_dec Q_dec); intuition. Defined.
+  Global Instance impl_dec: Decision (P → Q).
+  Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined.
+End prop_dec.
+Global Instance iff_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
+  Decision (P ↔ Q) := and_dec _ _.
+
+(** Instances of [Decision] for common data types. *)
+Global Instance bool_eq_dec : EqDecision bool.
+Proof. solve_decision. Defined.
+Global Instance unit_eq_dec : EqDecision unit.
+Proof. solve_decision. Defined.
+Global Instance Empty_set_eq_dec : EqDecision Empty_set.
+Proof. solve_decision. Defined.
+Global Instance prod_eq_dec `{EqDecision A, EqDecision B} : EqDecision (A * B).
+Proof. solve_decision. Defined.
+Global Instance sum_eq_dec `{EqDecision A, EqDecision B} : EqDecision (A + B).
+Proof. solve_decision. Defined.
+
+Global Instance uncurry_dec `(P_dec : ∀ (x : A) (y : B), Decision (P x y)) p :
+    Decision (uncurry P p) :=
+  match p as p return Decision (uncurry P p) with
+  | (x,y) => P_dec x y
+  end.
+
+Global Instance sig_eq_dec `(P : A → Prop) `{∀ x, ProofIrrel (P x), EqDecision A} :
+  EqDecision (sig P).
+Proof.
+ refine (λ x y, cast_if (decide (`x = `y))); rewrite sig_eq_pi; trivial.
+Defined.
+
+(** Some laws for decidable propositions *)
+Lemma not_and_l {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q.
+Proof. destruct (decide P); tauto. Qed.
+Lemma not_and_r {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q.
+Proof. destruct (decide Q); tauto. Qed.
+Lemma not_and_l_alt {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ (¬Q ∧ P).
+Proof. destruct (decide P); tauto. Qed.
+Lemma not_and_r_alt {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ (¬P ∧ Q) ∨ ¬Q.
+Proof. destruct (decide Q); tauto. Qed.
+
+Program Definition inj_eq_dec `{EqDecision A} {B} (f : B → A)
+  `{!Inj (=) (=) f} : EqDecision B := λ x y, cast_if (decide (f x = f y)).
+Solve Obligations with firstorder congruence.
+
+(** * Instances of [RelDecision] *)
+Definition flip_dec {A} (R : relation A) `{!RelDecision R} :
+  RelDecision (flip R) := λ x y, decide_rel R y x.
+(** We do not declare this as an actual instance since Coq can unify [flip ?R]
+with any relation. Coq's standard library is carrying out the same approach for
+the [Reflexive], [Transitive], etc, instance of [flip]. *)
+Global Hint Extern 3 (RelDecision (flip _)) => apply flip_dec : typeclass_instances.
+
 (** We can convert decidable propositions to booleans. *)
 Definition bool_decide (P : Prop) {dec : Decision P} : bool :=
   if dec then true else false.
@@ -103,7 +165,14 @@ Definition bool_decide (P : Prop) {dec : Decision P} : bool :=
 Lemma bool_decide_reflect P `{dec : Decision P} : reflect P (bool_decide P).
 Proof. unfold bool_decide. destruct dec; [left|right]; assumption. Qed.
 
-Tactic Notation "case_bool_decide" "as" ident (Hd) :=
+Lemma bool_decide_decide P `{!Decision P} :
+  bool_decide P = if decide P then true else false.
+Proof. reflexivity. Qed.
+Lemma decide_bool_decide P {Hdec: Decision P} {X : Type} (x1 x2 : X):
+  (if decide P then x1 else x2) = (if bool_decide P then x1 else x2).
+Proof. unfold bool_decide, decide. destruct Hdec; reflexivity. Qed.
+
+Tactic Notation "case_bool_decide" "as" ident(Hd) :=
   match goal with
   | H : context [@bool_decide ?P ?dec] |- _ =>
     destruct_decide (@bool_decide_reflect P dec) as Hd
@@ -119,14 +188,63 @@ Lemma bool_decide_unpack (P : Prop) {dec : Decision P} : bool_decide P → P.
 Proof. rewrite bool_decide_spec; trivial. Qed.
 Lemma bool_decide_pack (P : Prop) {dec : Decision P} : P → bool_decide P.
 Proof. rewrite bool_decide_spec; trivial. Qed.
-Hint Resolve bool_decide_pack.
-Lemma bool_decide_true (P : Prop) `{Decision P} : P → bool_decide P = true.
-Proof. case_bool_decide; tauto. Qed.
-Lemma bool_decide_false (P : Prop) `{Decision P} : ¬P → bool_decide P = false.
-Proof. case_bool_decide; tauto. Qed.
-Lemma bool_decide_iff (P Q : Prop) `{Decision P, Decision Q} :
+Global Hint Resolve bool_decide_pack : core.
+
+Lemma bool_decide_eq_true (P : Prop) `{Decision P} : bool_decide P = true ↔ P.
+Proof. case_bool_decide; intuition discriminate. Qed.
+Lemma bool_decide_eq_false (P : Prop) `{Decision P} : bool_decide P = false ↔ ¬P.
+Proof. case_bool_decide; intuition discriminate. Qed.
+Lemma bool_decide_ext (P Q : Prop) `{Decision P, Decision Q} :
   (P ↔ Q) → bool_decide P = bool_decide Q.
-Proof. repeat case_bool_decide; tauto. Qed.
+Proof. apply decide_ext. Qed.
+
+Lemma bool_decide_eq_true_1 P `{!Decision P}: bool_decide P = true → P.
+Proof. apply bool_decide_eq_true. Qed.
+Lemma bool_decide_eq_true_2 P `{!Decision P}: P → bool_decide P = true.
+Proof. apply bool_decide_eq_true. Qed.
+
+Lemma bool_decide_eq_false_1 P `{!Decision P}: bool_decide P = false → ¬P.
+Proof. apply bool_decide_eq_false. Qed.
+Lemma bool_decide_eq_false_2 P `{!Decision P}: ¬P → bool_decide P = false.
+Proof. apply bool_decide_eq_false. Qed.
+
+Lemma bool_decide_True : bool_decide True = true.
+Proof. reflexivity. Qed.
+Lemma bool_decide_False : bool_decide False = false.
+Proof. reflexivity. Qed.
+Lemma bool_decide_not P `{Decision P} :
+  bool_decide (¬ P) = negb (bool_decide P).
+Proof. repeat case_bool_decide; intuition. Qed.
+Lemma bool_decide_or P Q `{Decision P, Decision Q} :
+  bool_decide (P ∨ Q) = bool_decide P || bool_decide Q.
+Proof. repeat case_bool_decide; intuition. Qed.
+Lemma bool_decide_and P Q `{Decision P, Decision Q} :
+  bool_decide (P ∧ Q) = bool_decide P && bool_decide Q.
+Proof. repeat case_bool_decide; intuition. Qed.
+Lemma bool_decide_impl P Q `{Decision P, Decision Q} :
+  bool_decide (P → Q) = implb (bool_decide P) (bool_decide Q).
+Proof. repeat case_bool_decide; intuition. Qed.
+Lemma bool_decide_iff P Q `{Decision P, Decision Q} :
+  bool_decide (P ↔ Q) = eqb (bool_decide P) (bool_decide Q).
+Proof. repeat case_bool_decide; intuition. Qed.
+
+(** The tactic [compute_done] solves the following kinds of goals:
+- Goals [P] where [Decidable P] can be derived.
+- Goals that compute to [True] or [x = x].
+
+The goal must be a ground term for this, i.e., not contain variables (that do
+not compute away). The goal is solved by using [vm_compute] and then using a
+trivial proof term ([I]/[eq_refl]). *)
+Tactic Notation "compute_done" :=
+  try apply (bool_decide_unpack _);
+  vm_compute;
+  first [ exact I | exact eq_refl ].
+Tactic Notation "compute_by" tactic(tac) :=
+  tac; compute_done.
+
+(** Backwards compatibility notations. *)
+Notation bool_decide_true := bool_decide_eq_true_2.
+Notation bool_decide_false := bool_decide_eq_false_2.
 
 (** * Decidable Sigma types *)
 (** Leibniz equality on Sigma types requires the equipped proofs to be
@@ -146,57 +264,3 @@ Proof. apply (sig_eq_pi _). Qed.
 Lemma dexists_proj1 `(P : A → Prop) `{∀ x, Decision (P x)} (x : dsig P) p :
   dexist (`x) p = x.
 Proof. apply dsig_eq; reflexivity. Qed.
-
-(** * Instances of Decision *)
-(** Instances of [Decision] for operators of propositional logic. *)
-Instance True_dec: Decision True := left I.
-Instance False_dec: Decision False := right (False_rect False).
-Instance Is_true_dec b : Decision (Is_true b).
-Proof. destruct b; simpl; apply _. Defined.
-
-Section prop_dec.
-  Context `(P_dec : Decision P) `(Q_dec : Decision Q).
-
-  Global Instance not_dec: Decision (¬P).
-  Proof. refine (cast_if_not P_dec); intuition. Defined.
-  Global Instance and_dec: Decision (P ∧ Q).
-  Proof. refine (cast_if_and P_dec Q_dec); intuition. Defined.
-  Global Instance or_dec: Decision (P ∨ Q).
-  Proof. refine (cast_if_or P_dec Q_dec); intuition. Defined.
-  Global Instance impl_dec: Decision (P → Q).
-  Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined.
-End prop_dec.
-Instance iff_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
-  Decision (P ↔ Q) := and_dec _ _.
-
-(** Instances of [Decision] for common data types. *)
-Instance bool_eq_dec : EqDecision bool.
-Proof. solve_decision. Defined.
-Instance unit_eq_dec : EqDecision unit.
-Proof. solve_decision. Defined.
-Instance prod_eq_dec `{EqDecision A, EqDecision B} : EqDecision (A * B).
-Proof. solve_decision. Defined.
-Instance sum_eq_dec `{EqDecision A, EqDecision B} : EqDecision (A + B).
-Proof. solve_decision. Defined.
-
-Instance curry_dec `(P_dec : ∀ (x : A) (y : B), Decision (P x y)) p :
-    Decision (curry P p) :=
-  match p as p return Decision (curry P p) with
-  | (x,y) => P_dec x y
-  end.
-
-Instance sig_eq_dec `(P : A → Prop) `{∀ x, ProofIrrel (P x), EqDecision A} :
-  EqDecision (sig P).
-Proof.
- refine (λ x y, cast_if (decide (`x = `y))); rewrite sig_eq_pi; trivial.
-Defined.
-
-(** Some laws for decidable propositions *)
-Lemma not_and_l {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q.
-Proof. destruct (decide P); tauto. Qed.
-Lemma not_and_r {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q.
-Proof. destruct (decide Q); tauto. Qed.
-Lemma not_and_l_alt {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ (¬Q ∧ P).
-Proof. destruct (decide P); tauto. Qed.
-Lemma not_and_r_alt {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ (¬P ∧ Q) ∨ ¬Q.
-Proof. destruct (decide Q); tauto. Qed.

stdpp/dune

+(include_subdirs qualified)
+(coq.theory
+ (name stdpp)
+ (package coq-stdpp))

stdpp/fin.v

+(** This file collects general purpose definitions and theorems on the fin type
+(bounded naturals). It uses the definitions from the standard library, but
+renames or changes their notations, so that it becomes more consistent with the
+naming conventions in this development. *)
+(* Coq warns about using vector, but it is not deprecated. Instead somehow they seem concerned
+about people having too much fun with type indices. See
+<https://github.com/coq/coq/pull/18032> for discussion. The warning is also emitted by [Fin].
+Let's just silence that. *)
+Local Set Warnings "-stdlib-vector".
+From Coq Require Fin.
+From stdpp Require Export base tactics.
+From stdpp Require Import options.
+
+(** * The fin type *)
+(** The type [fin n] represents natural numbers [i] with [0 ≤ i < n]. We
+define a scope [fin], in which we declare notations for small literals of the
+[fin] type. Whereas the standard library starts counting at [1], we start
+counting at [0]. This way, the embedding [fin_to_nat] preserves [0], and allows
+us to define [fin_to_nat] as a coercion without introducing notational
+ambiguity. *)
+Notation fin := Fin.t.
+Notation FS := Fin.FS.
+
+Declare Scope fin_scope.
+Delimit Scope fin_scope with fin.
+Bind Scope fin_scope with fin.
+Global Arguments Fin.FS _ _%fin : assert.
+
+(** Allow any non-negative number literal to be parsed as a [fin]. For example
+[42%fin : fin 64], or [42%fin : fin _], or [42%fin : fin (43 + _)]. *)
+Number Notation fin Nat.of_num_uint Nat.to_num_uint (via nat
+  mapping [[Fin.F1] => O, [Fin.FS] => S]) : fin_scope.
+
+Fixpoint fin_to_nat {n} (i : fin n) : nat :=
+  match i with 0%fin => 0 | FS i => S (fin_to_nat i) end.
+Coercion fin_to_nat : fin >-> nat.
+
+Notation nat_to_fin := Fin.of_nat_lt.
+Notation fin_rect2 := Fin.rect2.
+
+Global Instance fin_dec {n} : EqDecision (fin n).
+Proof.
+ refine (fin_rect2
+  (λ n (i j : fin n), { i = j } + { i ≠ j })
+  (λ _, left _)
+  (λ _ _, right _)
+  (λ _ _, right _)
+  (λ _ _ _ H, cast_if H));
+  abstract (f_equal; by auto using Fin.FS_inj).
+Defined.
+
+(** The inversion principle [fin_S_inv] is more convenient than its variant
+[Fin.caseS] in the standard library, as we keep the parameter [n] fixed.
+In the tactic [inv_fin i] to perform dependent case analysis on [i], we
+therefore do not have to generalize over the index [n] and all assumptions
+depending on it. Notice that contrary to [dependent destruction], which uses
+the [JMeq_eq] axiom, the tactic [inv_fin] produces axiom free proofs.*)
+Notation fin_0_inv := Fin.case0.
+
+Definition fin_S_inv {n} (P : fin (S n) → Type)
+  (H0 : P 0%fin) (HS : ∀ i, P (FS i)) (i : fin (S n)) : P i.
+Proof.
+  revert P H0 HS.
+  refine match i with 0%fin => λ _ H0 _, H0 | FS i => λ _ _ HS, HS i end.
+Defined.
+
+Ltac inv_fin i :=
+  let T := type of i in
+  match eval hnf in T with
+  | fin ?n =>
+    match eval hnf in n with
+    | 0 =>
+      generalize dependent i;
+      match goal with |- ∀ i, @?P i => apply (fin_0_inv P) end
+    | S ?n =>
+      generalize dependent i;
+      match goal with |- ∀ i, @?P i => apply (fin_S_inv P) end
+    end
+  end.
+
+Global Instance FS_inj {n} : Inj (=) (=) (@FS n).
+Proof. intros i j. apply Fin.FS_inj. Qed.
+Global Instance fin_to_nat_inj {n} : Inj (=) (=) (@fin_to_nat n).
+Proof.
+  intros i. induction i; intros j; inv_fin j; intros; f_equal/=; auto with lia.
+Qed.
+
+Lemma fin_to_nat_lt {n} (i : fin n) : fin_to_nat i < n.
+Proof. induction i; simpl; lia. Qed.
+Lemma fin_to_nat_to_fin n m (H : n < m) : fin_to_nat (nat_to_fin H) = n.
+Proof.
+  revert m H. induction n; intros [|?]; simpl; auto; intros; exfalso; lia.
+Qed.
+Lemma nat_to_fin_to_nat {n} (i : fin n) H : @nat_to_fin (fin_to_nat i) n H = i.
+Proof. apply (inj fin_to_nat), fin_to_nat_to_fin. Qed.
+
+Fixpoint fin_add_inv {n1 n2} : ∀ (P : fin (n1 + n2) → Type)
+    (H1 : ∀ i1 : fin n1, P (Fin.L n2 i1))
+    (H2 : ∀ i2, P (Fin.R n1 i2)) (i : fin (n1 + n2)), P i :=
+  match n1 with
+  | 0 => λ P H1 H2 i, H2 i
+  | S n => λ P H1 H2, fin_S_inv P (H1 0%fin) (fin_add_inv _ (λ i, H1 (FS i)) H2)
+  end.
+
+Lemma fin_add_inv_l {n1 n2} (P : fin (n1 + n2) → Type)
+    (H1: ∀ i1 : fin n1, P (Fin.L _ i1)) (H2: ∀ i2, P (Fin.R _ i2)) (i: fin n1) :
+  fin_add_inv P H1 H2 (Fin.L n2 i) = H1 i.
+Proof.
+  revert P H1 H2 i.
+  induction n1 as [|n1 IH]; intros P H1 H2 i; inv_fin i; simpl; auto.
+  intros i. apply (IH (λ i, P (FS i))).
+Qed.
+
+Lemma fin_add_inv_r {n1 n2} (P : fin (n1 + n2) → Type)
+    (H1: ∀ i1 : fin n1, P (Fin.L _ i1)) (H2: ∀ i2, P (Fin.R _ i2)) (i: fin n2) :
+  fin_add_inv P H1 H2 (Fin.R n1 i) = H2 i.
+Proof.
+  revert P H1 H2 i; induction n1 as [|n1 IH]; intros P H1 H2 i; simpl; auto.
+  apply (IH (λ i, P (FS i))).
+Qed.

stdpp/fin_map_dom.v

+(** This file provides an axiomatization of the domain function of finite
+maps. We provide such an axiomatization, instead of implementing the domain
+function in a generic way, to allow more efficient implementations. *)
+From stdpp Require Export sets fin_maps.
+From stdpp Require Import options.
+
+(* Pick up extra assumptions from section parameters. *)
+Set Default Proof Using "Type*".
+
+Class FinMapDom K M D `{∀ A, Dom (M A) D, FMap M,
+    ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A, PartialAlter K A (M A),
+    OMap M, Merge M, ∀ A, MapFold K A (M A), EqDecision K,
+    ElemOf K D, Empty D, Singleton K D,
+    Union D, Intersection D, Difference D} := {
+  finmap_dom_map :: FinMap K M;
+  finmap_dom_set :: Set_ K D;
+  elem_of_dom {A} (m : M A) i : i ∈ dom m ↔ is_Some (m !! i)
+}.
+
+Section fin_map_dom.
+Context `{FinMapDom K M D}.
+
+Lemma lookup_lookup_total_dom `{!Inhabited A} (m : M A) i :
+  i ∈ dom m → m !! i = Some (m !!! i).
+Proof. rewrite elem_of_dom. apply lookup_lookup_total. Qed.
+
+Lemma dom_imap_subseteq {A B} (f: K → A → option B) (m: M A) :
+  dom (map_imap f m) ⊆ dom m.
+Proof.
+  intros k. rewrite 2!elem_of_dom, map_lookup_imap.
+  destruct 1 as [?[?[Eq _]]%bind_Some]. by eexists.
+Qed.
+Lemma dom_imap {A B} (f : K → A → option B) (m : M A) (X : D) :
+  (∀ i, i ∈ X ↔ ∃ x, m !! i = Some x ∧ is_Some (f i x)) →
+  dom (map_imap f m) ≡ X.
+Proof.
+  intros HX k. rewrite elem_of_dom, HX, map_lookup_imap.
+  unfold is_Some. setoid_rewrite bind_Some. naive_solver.
+Qed.
+
+Lemma elem_of_dom_2 {A} (m : M A) i x : m !! i = Some x → i ∈ dom m.
+Proof. rewrite elem_of_dom; eauto. Qed.
+Lemma not_elem_of_dom {A} (m : M A) i : i ∉ dom m ↔ m !! i = None.
+Proof. by rewrite elem_of_dom, eq_None_not_Some. Qed.
+Lemma not_elem_of_dom_1 {A} (m : M A) i : i ∉ dom m → m !! i = None.
+Proof. apply not_elem_of_dom. Qed.
+Lemma not_elem_of_dom_2 {A} (m : M A) i : m !! i = None → i ∉ dom m.
+Proof. apply not_elem_of_dom. Qed.
+Lemma subseteq_dom {A} (m1 m2 : M A) : m1 ⊆ m2 → dom m1 ⊆ dom m2.
+Proof.
+  rewrite map_subseteq_spec.
+  intros ??. rewrite !elem_of_dom. inv 1; eauto.
+Qed.
+Lemma subset_dom {A} (m1 m2 : M A) : m1 ⊂ m2 → dom m1 ⊂ dom m2.
+Proof.
+  intros [Hss1 Hss2]; split; [by apply subseteq_dom |].
+  contradict Hss2. rewrite map_subseteq_spec. intros i x Hi.
+  specialize (Hss2 i). rewrite !elem_of_dom in Hss2.
+  destruct Hss2; eauto. by simplify_map_eq.
+Qed.
+
+Lemma dom_filter {A} (P : K * A → Prop) `{!∀ x, Decision (P x)} (m : M A) (X : D) :
+  (∀ i, i ∈ X ↔ ∃ x, m !! i = Some x ∧ P (i, x)) →
+  dom (filter P m) ≡ X.
+Proof.
+  intros HX i. rewrite elem_of_dom, HX.
+  unfold is_Some. by setoid_rewrite map_lookup_filter_Some.
+Qed.
+Lemma dom_filter_subseteq {A} (P : K * A → Prop) `{!∀ x, Decision (P x)} (m : M A):
+  dom (filter P m) ⊆ dom m.
+Proof. apply subseteq_dom, map_filter_subseteq. Qed.
+
+Lemma filter_dom {A} `{!Elements K D, !FinSet K D}
+    (P : K → Prop) `{!∀ x, Decision (P x)} (m : M A) :
+  filter P (dom m) ≡ dom (filter (λ kv, P kv.1) m).
+Proof.
+  intros i. rewrite elem_of_filter, !elem_of_dom. unfold is_Some.
+  setoid_rewrite map_lookup_filter_Some. naive_solver.
+Qed.
+
+Lemma dom_empty {A} : dom (@empty (M A) _) ≡ ∅.
+Proof.
+  intros x. rewrite elem_of_dom, lookup_empty, <-not_eq_None_Some. set_solver.
+Qed.
+Lemma dom_empty_iff {A} (m : M A) : dom m ≡ ∅ ↔ m = ∅.
+Proof.
+  split; [|intros ->; by rewrite dom_empty].
+  intros E. apply map_empty. intros. apply not_elem_of_dom.
+  rewrite E. set_solver.
+Qed.
+Lemma dom_empty_inv {A} (m : M A) : dom m ≡ ∅ → m = ∅.
+Proof. apply dom_empty_iff. Qed.
+Lemma dom_alter {A} f (m : M A) i : dom (alter f i m) ≡ dom m.
+Proof.
+  apply set_equiv; intros j; rewrite !elem_of_dom; unfold is_Some.
+  destruct (decide (i = j)); simplify_map_eq/=; eauto.
+  destruct (m !! j); naive_solver.
+Qed.
+Lemma dom_insert {A} (m : M A) i x : dom (<[i:=x]>m) ≡ {[ i ]} ∪ dom m.
+Proof.
+  apply set_equiv. intros j. rewrite elem_of_union, !elem_of_dom.
+  unfold is_Some. setoid_rewrite lookup_insert_Some.
+  destruct (decide (i = j)); set_solver.
+Qed.
+Lemma dom_insert_lookup {A} (m : M A) i x :
+  is_Some (m !! i) → dom (<[i:=x]>m) ≡ dom m.
+Proof.
+  intros Hindom. assert (i ∈ dom m) by by apply elem_of_dom.
+  rewrite dom_insert. set_solver.
+Qed.
+Lemma dom_insert_subseteq {A} (m : M A) i x : dom m ⊆ dom (<[i:=x]>m).
+Proof. rewrite (dom_insert _). set_solver. Qed.
+Lemma dom_insert_subseteq_compat_l {A} (m : M A) i x X :
+  X ⊆ dom m → X ⊆ dom (<[i:=x]>m).
+Proof. intros. trans (dom m); eauto using dom_insert_subseteq. Qed.
+Lemma dom_singleton {A} (i : K) (x : A) : dom ({[i := x]} : M A) ≡ {[ i ]}.
+Proof. rewrite <-insert_empty, dom_insert, dom_empty; set_solver. Qed.
+Lemma dom_delete {A} (m : M A) i : dom (delete i m) ≡ dom m ∖ {[ i ]}.
+Proof.
+  apply set_equiv. intros j. rewrite elem_of_difference, !elem_of_dom.
+  unfold is_Some. setoid_rewrite lookup_delete_Some. set_solver.
+Qed.
+Lemma delete_partial_alter_dom {A} (m : M A) i f :
+  i ∉ dom m → delete i (partial_alter f i m) = m.
+Proof. rewrite not_elem_of_dom. apply delete_partial_alter. Qed.
+Lemma delete_insert_dom {A} (m : M A) i x :
+  i ∉ dom m → delete i (<[i:=x]>m) = m.
+Proof. rewrite not_elem_of_dom. apply delete_insert. Qed.
+Lemma map_disjoint_dom {A} (m1 m2 : M A) : m1 ##ₘ m2 ↔ dom m1 ## dom m2.
+Proof.
+  rewrite map_disjoint_spec, elem_of_disjoint.
+  setoid_rewrite elem_of_dom. unfold is_Some. naive_solver.
+Qed.
+Lemma map_disjoint_dom_1 {A} (m1 m2 : M A) : m1 ##ₘ m2 → dom m1 ## dom m2.
+Proof. apply map_disjoint_dom. Qed.
+Lemma map_disjoint_dom_2 {A} (m1 m2 : M A) : dom m1 ## dom m2 → m1 ##ₘ m2.
+Proof. apply map_disjoint_dom. Qed.
+Lemma dom_union {A} (m1 m2 : M A) : dom (m1 ∪ m2) ≡ dom m1 ∪ dom m2.
+Proof.
+  apply set_equiv. intros i. rewrite elem_of_union, !elem_of_dom.
+  unfold is_Some. setoid_rewrite lookup_union_Some_raw.
+  destruct (m1 !! i); naive_solver.
+Qed.
+Lemma dom_intersection {A} (m1 m2: M A) : dom (m1 ∩ m2) ≡ dom m1 ∩ dom m2.
+Proof.
+  apply set_equiv. intros i. rewrite elem_of_intersection, !elem_of_dom.
+  unfold is_Some. setoid_rewrite lookup_intersection_Some. naive_solver.
+Qed.
+Lemma dom_difference {A} (m1 m2 : M A) : dom (m1 ∖ m2) ≡ dom m1 ∖ dom m2.
+Proof.
+  apply set_equiv. intros i. rewrite elem_of_difference, !elem_of_dom.
+  unfold is_Some. setoid_rewrite lookup_difference_Some.
+  destruct (m2 !! i); naive_solver.
+Qed.
+Lemma dom_fmap {A B} (f : A → B) (m : M A) : dom (f <$> m) ≡ dom m.
+Proof.
+  apply set_equiv. intros i.
+  rewrite !elem_of_dom, lookup_fmap, <-!not_eq_None_Some.
+  destruct (m !! i); naive_solver.
+Qed.
+Lemma dom_finite {A} (m : M A) : set_finite (dom m).
+Proof.
+  induction m using map_ind; rewrite ?dom_empty, ?dom_insert.
+  - by apply empty_finite.
+  - apply union_finite; [apply singleton_finite|done].
+Qed.
+Global Instance dom_proper `{!Equiv A} : Proper ((≡@{M A}) ==> (≡)) dom.
+Proof.
+  intros m1 m2 EQm. apply set_equiv. intros i.
+  rewrite !elem_of_dom, EQm. done.
+Qed.
+Lemma dom_list_to_map {A} (l : list (K * A)) :
+  dom (list_to_map l : M A) ≡ list_to_set l.*1.
+Proof.
+  induction l as [|?? IH].
+  - by rewrite dom_empty.
+  - simpl. by rewrite dom_insert, IH.
+Qed.
+
+Lemma map_first_key_dom {A B} (m1 : M A) (m2 : M B) i :
+  dom m1 ≡ dom m2 → map_first_key m1 i ↔ map_first_key m2 i.
+Proof.
+  intros Hm. apply map_first_key_dom'. intros j.
+  by rewrite <-!elem_of_dom, Hm.
+Qed.
+Lemma map_first_key_dom_L {A B} (m1 : M A) (m2 : M B) i :
+  dom m1 = dom m2 → map_first_key m1 i ↔ map_first_key m2 i.
+Proof. intros Hm. apply map_first_key_dom. by rewrite Hm. Qed.
+
+Lemma map_Forall2_dom {A B} (P : K → A → B → Prop) (m1 : M A) (m2 : M B) :
+  map_Forall2 P m1 m2 → dom m1 ≡ dom m2.
+Proof.
+  revert m2. induction m1 as [|i x1 m1 ? IH] using map_ind; intros m2.
+  { intros ->%map_Forall2_empty_inv_l. by rewrite !dom_empty. }
+  intros (x2 & m2' & -> & ? & ? & ?)%map_Forall2_insert_inv_l; last done.
+  by rewrite !dom_insert, IH by done.
+Qed.
+
+(** Alternative definition of [dom] in terms of [map_to_list]. *)
+Lemma dom_alt {A} (m : M A) :
+  dom m ≡ list_to_set (map_to_list m).*1.
+Proof.
+  rewrite <-(list_to_map_to_list m) at 1.
+  rewrite dom_list_to_map.
+  done.
+Qed.
+
+Lemma size_dom `{!Elements K D, !FinSet K D} {A} (m : M A) :
+  size (dom m) = size m.
+Proof.
+  induction m as [|i x m ? IH] using map_ind.
+  { by rewrite dom_empty, map_size_empty, size_empty. }
+  assert ({[i]} ## dom m).
+  { intros j. rewrite elem_of_dom. unfold is_Some. set_solver. }
+  by rewrite dom_insert, size_union, size_singleton, map_size_insert_None, IH.
+Qed.
+
+Lemma dom_subseteq_size {A} (m1 m2 : M A) : dom m2 ⊆ dom m1 → size m2 ≤ size m1.
+Proof.
+  revert m1. induction m2 as [|i x m2 ? IH] using map_ind; intros m1 Hdom.
+  { rewrite map_size_empty. lia. }
+  rewrite dom_insert in Hdom.
+  assert (i ∉ dom m2) by (by apply not_elem_of_dom).
+  assert (i ∈ dom m1) as [x' Hx']%elem_of_dom by set_solver.
+  rewrite <-(insert_delete m1 i x') by done.
+  rewrite !map_size_insert_None, <-Nat.succ_le_mono by (by rewrite ?lookup_delete).
+  apply IH. rewrite dom_delete. set_solver.
+Qed.
+Lemma dom_subset_size {A} (m1 m2 : M A) : dom m2 ⊂ dom m1 → size m2 < size m1.
+Proof.
+  revert m1. induction m2 as [|i x m2 ? IH] using map_ind; intros m1 Hdom.
+  { destruct m1 as [|i x m1 ? _] using map_ind.
+    - rewrite !dom_empty in Hdom. set_solver.
+    - rewrite map_size_empty, map_size_insert_None by done. lia. }
+  rewrite dom_insert in Hdom.
+  assert (i ∉ dom m2) by (by apply not_elem_of_dom).
+  assert (i ∈ dom m1) as [x' Hx']%elem_of_dom by set_solver.
+  rewrite <-(insert_delete m1 i x') by done.
+  rewrite !map_size_insert_None, <-Nat.succ_lt_mono by (by rewrite ?lookup_delete).
+  apply IH. rewrite dom_delete. split; [set_solver|].
+  intros ?. destruct Hdom as [? []].
+  intros j. destruct (decide (i = j)); set_solver.
+Qed.
+
+Lemma subseteq_dom_eq {A} (m1 m2 : M A) :
+  m1 ⊆ m2 → dom m2 ⊆ dom m1 → m1 = m2.
+Proof. intros. apply map_subseteq_size_eq; auto using dom_subseteq_size. Qed.
+
+Lemma dom_singleton_inv {A} (m : M A) i :
+  dom m ≡ {[i]} → ∃ x, m = {[i := x]}.
+Proof.
+  intros Hdom. assert (is_Some (m !! i)) as [x ?].
+  { apply (elem_of_dom (D:=D)); set_solver. }
+  exists x. apply map_eq; intros j.
+  destruct (decide (i = j)); simplify_map_eq; [done|].
+  apply not_elem_of_dom. set_solver.
+Qed.
+
+Lemma dom_map_zip_with {A B C} (f : A → B → C) (ma : M A) (mb : M B) :
+  dom (map_zip_with f ma mb) ≡ dom ma ∩ dom mb.
+Proof.
+  rewrite set_equiv. intros x.
+  rewrite elem_of_intersection, !elem_of_dom, map_lookup_zip_with.
+  destruct (ma !! x), (mb !! x); rewrite !is_Some_alt; naive_solver.
+Qed.
+
+Lemma dom_union_inv `{!RelDecision (∈@{D})} {A} (m : M A) (X1 X2 : D) :
+  X1 ## X2 →
+  dom m ≡ X1 ∪ X2 →
+  ∃ m1 m2, m = m1 ∪ m2 ∧ m1 ##ₘ m2 ∧ dom m1 ≡ X1 ∧ dom m2 ≡ X2.
+Proof.
+  intros.
+  exists (filter (λ '(k,x), k ∈ X1) m), (filter (λ '(k,x), k ∉ X1) m).
+  assert (filter (λ '(k, _), k ∈ X1) m ##ₘ filter (λ '(k, _), k ∉ X1) m).
+  { apply map_disjoint_filter_complement. }
+  split_and!; [|done| |].
+  - apply map_eq; intros i. apply option_eq; intros x.
+    rewrite lookup_union_Some, !map_lookup_filter_Some by done.
+    destruct (decide (i ∈ X1)); naive_solver.
+  - apply dom_filter; intros i; split; [|naive_solver].
+    intros. assert (is_Some (m !! i)) as [x ?] by (apply elem_of_dom; set_solver).
+    naive_solver.
+  - apply dom_filter; intros i; split.
+    + intros. assert (is_Some (m !! i)) as [x ?] by (apply elem_of_dom; set_solver).
+      naive_solver.
+    + intros (x&?&?). apply dec_stable; intros ?.
+      assert (m !! i = None) by (apply not_elem_of_dom; set_solver).
+      naive_solver.
+Qed.
+
+Lemma dom_kmap `{!Elements K D, !FinSet K D, FinMapDom K2 M2 D2}
+    {A} (f : K → K2) `{!Inj (=) (=) f} (m : M A) :
+  dom (kmap (M2:=M2) f m) ≡@{D2} set_map f (dom m).
+Proof.
+  apply set_equiv. intros i.
+  rewrite !elem_of_dom, (lookup_kmap_is_Some _), elem_of_map.
+  by setoid_rewrite elem_of_dom.
+Qed.
+
+Lemma dom_omap_subseteq {A B} (f : A → option B) (m : M A) :
+  dom (omap f m) ⊆ dom m.
+Proof.
+  intros a. rewrite !elem_of_dom. intros [c Hm].
+  apply lookup_omap_Some in Hm. naive_solver.
+Qed.
+
+Lemma map_compose_dom_subseteq {C} `{FinMap K' M'} (m: M' C) (n : M K') :
+  dom (m ∘ₘ n : M C) ⊆@{D} dom n.
+Proof. apply dom_omap_subseteq. Qed.
+Lemma map_compose_min_r_dom {C} `{FinMap K' M', !RelDecision (∈@{D})}
+    (m : M C) (n : M' K) :
+  m ∘ₘ n = m ∘ₘ filter (λ '(_,b), b ∈ dom m) n.
+Proof.
+  rewrite map_compose_min_r. f_equal.
+  apply map_filter_ext. intros. by rewrite elem_of_dom.
+Qed.
+
+Lemma map_compose_empty_iff_dom_img {C} `{FinMap K' M', !RelDecision (∈@{D})}
+    (m : M C) (n : M' K) :
+  m ∘ₘ n = ∅ ↔ dom m ## map_img n.
+Proof.
+  rewrite map_compose_empty_iff, elem_of_disjoint.
+  setoid_rewrite elem_of_dom. setoid_rewrite eq_None_not_Some.
+  setoid_rewrite elem_of_map_img. naive_solver.
+Qed.
+
+(** If [D] has Leibniz equality, we can show an even stronger result.  This is a
+common case e.g. when having a [gmap K A] where the key [K] has Leibniz equality
+(and thus also [gset K], the usual domain) but the value type [A] does not. *)
+Global Instance dom_proper_L `{!Equiv A, !LeibnizEquiv D} :
+  Proper ((≡@{M A}) ==> (=)) (dom) | 0.
+Proof. intros ???. unfold_leibniz. by apply dom_proper. Qed.
+
+Section leibniz.
+  Context `{!LeibnizEquiv D}.
+
+  Lemma dom_filter_L {A} (P : K * A → Prop) `{!∀ x, Decision (P x)} (m : M A) X :
+    (∀ i, i ∈ X ↔ ∃ x, m !! i = Some x ∧ P (i, x)) →
+    dom (filter P m) = X.
+  Proof. unfold_leibniz. apply dom_filter. Qed.
+  Lemma filter_dom_L {A} `{!Elements K D, !FinSet K D}
+      (P : K → Prop) `{!∀ x, Decision (P x)} (m : M A) :
+    filter P (dom m) = dom (filter (λ kv, P kv.1) m).
+  Proof. unfold_leibniz. apply filter_dom. Qed.
+  Lemma dom_empty_L {A} : dom (@empty (M A) _) = ∅.
+  Proof. unfold_leibniz; apply dom_empty. Qed.
+  Lemma dom_empty_iff_L {A} (m : M A) : dom m = ∅ ↔ m = ∅.
+  Proof. unfold_leibniz. apply dom_empty_iff. Qed.
+  Lemma dom_empty_inv_L {A} (m : M A) : dom m = ∅ → m = ∅.
+  Proof. by intros; apply dom_empty_inv; unfold_leibniz. Qed.
+  Lemma dom_alter_L {A} f (m : M A) i : dom (alter f i m) = dom m.
+  Proof. unfold_leibniz; apply dom_alter. Qed.
+  Lemma dom_insert_L {A} (m : M A) i x : dom (<[i:=x]>m) = {[ i ]} ∪ dom m.
+  Proof. unfold_leibniz; apply dom_insert. Qed.
+  Lemma dom_insert_lookup_L {A} (m : M A) i x :
+    is_Some (m !! i) → dom (<[i:=x]>m) = dom m.
+  Proof. unfold_leibniz; apply dom_insert_lookup. Qed.
+  Lemma dom_singleton_L {A} (i : K) (x : A) : dom ({[i := x]} : M A) = {[ i ]}.
+  Proof. unfold_leibniz; apply dom_singleton. Qed.
+  Lemma dom_delete_L {A} (m : M A) i : dom (delete i m) = dom m ∖ {[ i ]}.
+  Proof. unfold_leibniz; apply dom_delete. Qed.
+  Lemma dom_union_L {A} (m1 m2 : M A) : dom (m1 ∪ m2) = dom m1 ∪ dom m2.
+  Proof. unfold_leibniz; apply dom_union. Qed.
+  Lemma dom_intersection_L {A} (m1 m2 : M A) :
+    dom (m1 ∩ m2) = dom m1 ∩ dom m2.
+  Proof. unfold_leibniz; apply dom_intersection. Qed.
+  Lemma dom_difference_L {A} (m1 m2 : M A) : dom (m1 ∖ m2) = dom m1 ∖ dom m2.
+  Proof. unfold_leibniz; apply dom_difference. Qed.
+  Lemma dom_fmap_L {A B} (f : A → B) (m : M A) : dom (f <$> m) = dom m.
+  Proof. unfold_leibniz; apply dom_fmap. Qed.
+  Lemma map_Forall2_dom_L {A B} (P : K → A → B → Prop) (m1 : M A) (m2 : M B) :
+    map_Forall2 P m1 m2 → dom m1 = dom m2.
+  Proof. unfold_leibniz. apply map_Forall2_dom. Qed.
+  Lemma dom_imap_L {A B} (f: K → A → option B) (m: M A) X :
+    (∀ i, i ∈ X ↔ ∃ x, m !! i = Some x ∧ is_Some (f i x)) →
+    dom (map_imap f m) = X.
+  Proof. unfold_leibniz; apply dom_imap. Qed.
+  Lemma dom_list_to_map_L {A} (l : list (K * A)) :
+    dom (list_to_map l : M A) = list_to_set l.*1.
+  Proof. unfold_leibniz. apply dom_list_to_map. Qed.
+  Lemma dom_singleton_inv_L {A} (m : M A) i :
+    dom m = {[i]} → ∃ x, m = {[i := x]}.
+  Proof. unfold_leibniz. apply dom_singleton_inv. Qed.
+  Lemma dom_map_zip_with_L {A B C} (f : A → B → C) (ma : M A) (mb : M B) :
+    dom (map_zip_with f ma mb) = dom ma ∩ dom mb.
+  Proof. unfold_leibniz. apply dom_map_zip_with. Qed.
+  Lemma dom_union_inv_L `{!RelDecision (∈@{D})} {A} (m : M A) (X1 X2 : D) :
+    X1 ## X2 →
+    dom m = X1 ∪ X2 →
+    ∃ m1 m2, m = m1 ∪ m2 ∧ m1 ##ₘ m2 ∧ dom m1 = X1 ∧ dom m2 = X2.
+  Proof. unfold_leibniz. apply dom_union_inv. Qed.
+End leibniz.
+
+Lemma dom_kmap_L `{!Elements K D, !FinSet K D, FinMapDom K2 M2 D2}
+    `{!LeibnizEquiv D2} {A} (f : K → K2) `{!Inj (=) (=) f} (m : M A) :
+  dom (kmap (M2:=M2) f m) = set_map f (dom m).
+Proof. unfold_leibniz. by apply dom_kmap. Qed.
+
+(** * Set solver instances *)
+Global Instance set_unfold_dom_empty {A} i : SetUnfoldElemOf i (dom (∅:M A)) False.
+Proof. constructor. by rewrite dom_empty, elem_of_empty. Qed.
+Global Instance set_unfold_dom_alter {A} f i j (m : M A) Q :
+  SetUnfoldElemOf i (dom m) Q →
+  SetUnfoldElemOf i (dom (alter f j m)) Q.
+Proof. constructor. by rewrite dom_alter, (set_unfold_elem_of _ (dom _) _). Qed.
+Global Instance set_unfold_dom_insert {A} i j x (m : M A) Q :
+  SetUnfoldElemOf i (dom m) Q →
+  SetUnfoldElemOf i (dom (<[j:=x]> m)) (i = j ∨ Q).
+Proof.
+  constructor. by rewrite dom_insert, elem_of_union,
+    (set_unfold_elem_of _ (dom _) _), elem_of_singleton.
+Qed.
+Global Instance set_unfold_dom_delete {A} i j (m : M A) Q :
+  SetUnfoldElemOf i (dom m) Q →
+  SetUnfoldElemOf i (dom (delete j m)) (Q ∧ i ≠ j).
+Proof.
+  constructor. by rewrite dom_delete, elem_of_difference,
+    (set_unfold_elem_of _ (dom _) _), elem_of_singleton.
+Qed.
+Global Instance set_unfold_dom_singleton {A} i j x :
+  SetUnfoldElemOf i (dom ({[ j := x ]} : M A)) (i = j).
+Proof. constructor. by rewrite dom_singleton, elem_of_singleton. Qed.
+Global Instance set_unfold_dom_union {A} i (m1 m2 : M A) Q1 Q2 :
+  SetUnfoldElemOf i (dom m1) Q1 → SetUnfoldElemOf i (dom m2) Q2 →
+  SetUnfoldElemOf i (dom (m1 ∪ m2)) (Q1 ∨ Q2).
+Proof.
+  constructor. by rewrite dom_union, elem_of_union,
+    !(set_unfold_elem_of _ (dom _) _).
+Qed.
+Global Instance set_unfold_dom_intersection {A} i (m1 m2 : M A) Q1 Q2 :
+  SetUnfoldElemOf i (dom m1) Q1 → SetUnfoldElemOf i (dom m2) Q2 →
+  SetUnfoldElemOf i (dom (m1 ∩ m2)) (Q1 ∧ Q2).
+Proof.
+  constructor. by rewrite dom_intersection, elem_of_intersection,
+    !(set_unfold_elem_of _ (dom _) _).
+Qed.
+Global Instance set_unfold_dom_difference {A} i (m1 m2 : M A) Q1 Q2 :
+  SetUnfoldElemOf i (dom m1) Q1 → SetUnfoldElemOf i (dom m2) Q2 →
+  SetUnfoldElemOf i (dom (m1 ∖ m2)) (Q1 ∧ ¬Q2).
+Proof.
+  constructor. by rewrite dom_difference, elem_of_difference,
+    !(set_unfold_elem_of _ (dom _) _).
+Qed.
+Global Instance set_unfold_dom_fmap {A B} (f : A → B) i (m : M A) Q :
+  SetUnfoldElemOf i (dom m) Q →
+  SetUnfoldElemOf i (dom (f <$> m)) Q.
+Proof. constructor. by rewrite dom_fmap, (set_unfold_elem_of _ (dom _) _). Qed.
+End fin_map_dom.
+
+Lemma dom_seq `{FinMapDom nat M D} {A} start (xs : list A) :
+  dom (map_seq start (M:=M A) xs) ≡ set_seq start (length xs).
+Proof.
+  revert start. induction xs as [|x xs IH]; intros start; simpl.
+  - by rewrite dom_empty.
+  - by rewrite dom_insert, IH.
+Qed.
+Lemma dom_seq_L `{FinMapDom nat M D, !LeibnizEquiv D} {A} start (xs : list A) :
+  dom (map_seq (M:=M A) start xs) = set_seq start (length xs).
+Proof. unfold_leibniz. apply dom_seq. Qed.
+
+Global Instance set_unfold_dom_seq `{FinMapDom nat M D} {A} start (xs : list A) i :
+  SetUnfoldElemOf i (dom (map_seq start (M:=M A) xs)) (start ≤ i < start + length xs).
+Proof. constructor. by rewrite dom_seq, elem_of_set_seq. Qed.

stdpp/fin_sets.v

+(** This file collects definitions and theorems on finite sets. Most
+importantly, it implements a fold and size function and some useful induction
+principles on finite sets . *)
+From stdpp Require Import relations.
+From stdpp Require Export numbers sets.
+From stdpp Require Import options.
+
+(* Pick up extra assumptions from section parameters. *)
+Set Default Proof Using "Type*".
+
+(** Operations *)
+Global Instance set_size `{Elements A C} : Size C := length ∘ elements.
+Global Typeclasses Opaque set_size.
+
+Definition set_fold `{Elements A C} {B}
+  (f : A → B → B) (b : B) : C → B := foldr f b ∘ elements.
+Global Typeclasses Opaque set_fold.
+
+Global Instance set_filter
+    `{Elements A C, Empty C, Singleton A C, Union C} : Filter A C := λ P _ X,
+  list_to_set (filter P (elements X)).
+Global Typeclasses Opaque set_filter.
+
+Definition set_map `{Elements A C, Singleton B D, Empty D, Union D}
+    (f : A → B) (X : C) : D :=
+  list_to_set (f <$> elements X).
+Global Typeclasses Opaque set_map.
+Global Instance: Params (@set_map) 8 := {}.
+
+Definition set_bind `{Elements A SA, Empty SB, Union SB}
+    (f : A → SB) (X : SA) : SB :=
+  ⋃ (f <$> elements X).
+Global Typeclasses Opaque set_bind.
+Global Instance: Params (@set_bind) 6 := {}.
+
+Definition set_omap `{Elements A C, Singleton B D, Empty D, Union D}
+    (f : A → option B) (X : C) : D :=
+  list_to_set (omap f (elements X)).
+Global Typeclasses Opaque set_omap.
+Global Instance: Params (@set_omap) 8 := {}.
+
+Global Instance set_fresh `{Elements A C, Fresh A (list A)} : Fresh A C :=
+  fresh ∘ elements.
+Global Typeclasses Opaque set_fresh.
+
+(** We generalize the [fresh] operation on sets to generate lists of fresh
+elements w.r.t. a set [X]. *)
+Fixpoint fresh_list `{Fresh A C, Union C, Singleton A C}
+    (n : nat) (X : C) : list A :=
+  match n with
+  | 0 => []
+  | S n => let x := fresh X in x :: fresh_list n ({[ x ]} ∪ X)
+  end.
+Global Instance: Params (@fresh_list) 6 := {}.
+
+(** The following inductive predicate classifies that a list of elements is
+in fact fresh w.r.t. a set [X]. *)
+Inductive Forall_fresh `{ElemOf A C} (X : C) : list A → Prop :=
+  | Forall_fresh_nil : Forall_fresh X []
+  | Forall_fresh_cons x xs :
+     x ∉ xs → x ∉ X → Forall_fresh X xs → Forall_fresh X (x :: xs).
+
+(** Properties **)
+Section fin_set.
+Context `{FinSet A C}.
+Implicit Types X Y : C.
+
+Lemma fin_set_finite X : set_finite X.
+Proof. by exists (elements X); intros; rewrite elem_of_elements. Qed.
+
+Local Instance elem_of_dec_slow : RelDecision (∈@{C}) | 100.
+Proof.
+  refine (λ x X, cast_if (decide_rel (∈) x (elements X)));
+    by rewrite <-(elem_of_elements _).
+Defined.
+
+(** * The [elements] operation *)
+Global Instance set_unfold_elements X x P :
+  SetUnfoldElemOf x X P → SetUnfoldElemOf x (elements X) P.
+Proof. constructor. by rewrite elem_of_elements, (set_unfold_elem_of x X P). Qed.
+
+Global Instance elements_proper: Proper ((≡) ==> (≡ₚ)) (elements (C:=C)).
+Proof.
+  intros ?? E. apply NoDup_Permutation.
+  - apply NoDup_elements.
+  - apply NoDup_elements.
+  - intros. by rewrite !elem_of_elements, E.
+Qed.
+
+Lemma elements_empty : elements (∅ : C) = [].
+Proof.
+  apply elem_of_nil_inv; intros x.
+  rewrite elem_of_elements, elem_of_empty; tauto.
+Qed.
+Lemma elements_empty_iff X : elements X = [] ↔ X ≡ ∅.
+Proof.
+  rewrite <-Permutation_nil_r. split; [|intros ->; by rewrite elements_empty].
+  intros HX. apply elem_of_equiv_empty; intros x.
+  rewrite <-elem_of_elements, HX. apply not_elem_of_nil.
+Qed.
+Lemma elements_empty_inv X : elements X = [] → X ≡ ∅.
+Proof. apply elements_empty_iff. Qed.
+
+Lemma elements_union_singleton (X : C) x :
+  x ∉ X → elements ({[ x ]} ∪ X) ≡ₚ x :: elements X.
+Proof.
+  intros ?; apply NoDup_Permutation.
+  { apply NoDup_elements. }
+  { by constructor; rewrite ?elem_of_elements; try apply NoDup_elements. }
+  intros y; rewrite elem_of_elements, elem_of_union, elem_of_singleton.
+  by rewrite elem_of_cons, elem_of_elements.
+Qed.
+Lemma elements_singleton x : elements ({[ x ]} : C) = [x].
+Proof.
+  apply Permutation_singleton_r. by rewrite <-(right_id ∅ (∪) {[x]}),
+    elements_union_singleton, elements_empty by set_solver.
+Qed.
+Lemma elements_disj_union (X Y : C) :
+  X ## Y → elements (X ∪ Y) ≡ₚ elements X ++ elements Y.
+Proof.
+  intros HXY. apply NoDup_Permutation.
+  - apply NoDup_elements.
+  - apply NoDup_app. set_solver by eauto using NoDup_elements.
+  - set_solver.
+Qed.
+Lemma elements_submseteq X Y : X ⊆ Y → elements X ⊆+ elements Y.
+Proof.
+  intros; apply NoDup_submseteq; eauto using NoDup_elements.
+  intros x. rewrite !elem_of_elements; auto.
+Qed.
+
+Lemma list_to_set_elements X : list_to_set (elements X) ≡ X.
+Proof. intros ?. rewrite elem_of_list_to_set. apply elem_of_elements. Qed.
+Lemma list_to_set_elements_L `{!LeibnizEquiv C} X : list_to_set (elements X) = X.
+Proof. unfold_leibniz. apply list_to_set_elements. Qed.
+
+Lemma elements_list_to_set l :
+  NoDup l → elements (list_to_set (C:=C) l) ≡ₚ l.
+Proof.
+  intros Hl. induction Hl.
+  { rewrite list_to_set_nil. rewrite elements_empty. done. }
+  rewrite list_to_set_cons, elements_disj_union by set_solver.
+  rewrite elements_singleton. apply Permutation_skip. done.
+Qed.
+
+(** * The [size] operation *)
+Global Instance set_size_proper: Proper ((≡) ==> (=)) (@size C _).
+Proof. intros ?? E. apply Permutation_length. by rewrite E. Qed.
+
+Lemma size_empty : size (∅ : C) = 0.
+Proof. unfold size, set_size. simpl. by rewrite elements_empty. Qed.
+Lemma size_empty_iff (X : C) : size X = 0 ↔ X ≡ ∅.
+Proof.
+  split; [|intros ->; by rewrite size_empty].
+  intros; apply equiv_empty; intros x; rewrite <-elem_of_elements.
+  by rewrite (nil_length_inv (elements X)), ?elem_of_nil.
+Qed.
+Lemma size_empty_inv (X : C) : size X = 0 → X ≡ ∅.
+Proof. apply size_empty_iff. Qed.
+Lemma size_non_empty_iff (X : C) : size X ≠ 0 ↔ X ≢ ∅.
+Proof. by rewrite size_empty_iff. Qed.
+
+Lemma set_choose_or_empty X : (∃ x, x ∈ X) ∨ X ≡ ∅.
+Proof.
+  destruct (elements X) as [|x l] eqn:HX; [right|left].
+  - apply equiv_empty; intros x. by rewrite <-elem_of_elements, HX, elem_of_nil.
+  - exists x. rewrite <-elem_of_elements, HX. by left.
+Qed.
+Lemma set_choose X : X ≢ ∅ → ∃ x, x ∈ X.
+Proof. intros. by destruct (set_choose_or_empty X). Qed.
+Lemma set_choose_L `{!LeibnizEquiv C} X : X ≠ ∅ → ∃ x, x ∈ X.
+Proof. unfold_leibniz. apply set_choose. Qed.
+Lemma size_pos_elem_of X : 0 < size X → ∃ x, x ∈ X.
+Proof.
+  intros Hsz. destruct (set_choose_or_empty X) as [|HX]; [done|].
+  contradict Hsz. rewrite HX, size_empty; lia.
+Qed.
+
+Lemma size_singleton (x : A) : size ({[ x ]} : C) = 1.
+Proof. unfold size, set_size. simpl. by rewrite elements_singleton. Qed.
+Lemma size_singleton_inv X x y : size X = 1 → x ∈ X → y ∈ X → x = y.
+Proof.
+  unfold size, set_size. simpl. rewrite <-!elem_of_elements.
+  generalize (elements X). intros [|? l]; intro; simplify_eq/=.
+  rewrite (nil_length_inv l), !elem_of_list_singleton by done; congruence.
+Qed.
+Lemma size_1_elem_of X : size X = 1 → ∃ x, X ≡ {[ x ]}.
+Proof.
+  intros E. destruct (size_pos_elem_of X) as [x ?]; auto with lia.
+  exists x. apply set_equiv. split.
+  - rewrite elem_of_singleton. eauto using size_singleton_inv.
+  - set_solver.
+Qed.
+
+Lemma size_union X Y : X ## Y → size (X ∪ Y) = size X + size Y.
+Proof.
+  intros. unfold size, set_size. simpl. rewrite <-length_app.
+  apply Permutation_length, NoDup_Permutation.
+  - apply NoDup_elements.
+  - apply NoDup_app; repeat split; try apply NoDup_elements.
+    intros x; rewrite !elem_of_elements; set_solver.
+  - intros. by rewrite elem_of_app, !elem_of_elements, elem_of_union.
+Qed.
+Lemma size_union_alt X Y : size (X ∪ Y) = size X + size (Y ∖ X).
+Proof.
+  rewrite <-size_union by set_solver.
+  setoid_replace (Y ∖ X) with ((Y ∪ X) ∖ X) by set_solver.
+  rewrite <-union_difference, (comm (∪)); set_solver.
+Qed.
+
+Lemma size_difference X Y : Y ⊆ X → size (X ∖ Y) = size X - size Y.
+Proof.
+  intros. rewrite (union_difference Y X) at 2 by done.
+  rewrite size_union by set_solver. lia.
+Qed.
+Lemma size_difference_alt X Y : size (X ∖ Y) = size X - size (X ∩ Y).
+Proof.
+  intros. rewrite <-size_difference by set_solver.
+  apply set_size_proper. set_solver.
+Qed.
+
+Lemma set_subseteq_size_equiv X1 X2 : X1 ⊆ X2 → size X2 ≤ size X1 → X1 ≡ X2.
+Proof.
+  intros. apply (anti_symm _); [done|].
+  apply empty_difference_subseteq, size_empty_iff.
+  rewrite size_difference by done. lia.
+Qed.
+Lemma set_subseteq_size_eq `{!LeibnizEquiv C} X1 X2 :
+  X1 ⊆ X2 → size X2 ≤ size X1 → X1 = X2.
+Proof. unfold_leibniz. apply set_subseteq_size_equiv. Qed.
+
+Lemma subseteq_size X Y : X ⊆ Y → size X ≤ size Y.
+Proof. intros. rewrite (union_difference X Y), size_union_alt by done. lia. Qed.
+Lemma subset_size X Y : X ⊂ Y → size X < size Y.
+Proof.
+  intros. rewrite (union_difference X Y) by set_solver.
+  rewrite size_union_alt, difference_twice.
+  cut (size (Y ∖ X) ≠ 0); [lia |].
+  by apply size_non_empty_iff, non_empty_difference.
+Qed.
+
+Lemma size_list_to_set l :
+  NoDup l → size (list_to_set (C:=C) l) = length l.
+Proof.
+  intros Hl. unfold size, set_size. simpl.
+  rewrite elements_list_to_set; done.
+Qed.
+
+(** * Induction principles *)
+Lemma set_wf : well_founded (⊂@{C}).
+Proof. apply (wf_projected (<) size); auto using subset_size, lt_wf. Qed.
+Lemma set_ind (P : C → Prop) :
+  Proper ((≡) ==> impl) P →
+  P ∅ → (∀ x X, x ∉ X → P X → P ({[ x ]} ∪ X)) → ∀ X, P X.
+Proof.
+  intros ? Hemp Hadd. apply well_founded_induction with (⊂).
+  { apply set_wf. }
+  intros X IH. destruct (set_choose_or_empty X) as [[x ?]|HX].
+  - rewrite (union_difference {[ x ]} X) by set_solver.
+    apply Hadd; [set_solver|]. apply IH; set_solver.
+  - by rewrite HX.
+Qed.
+Lemma set_ind_L `{!LeibnizEquiv C} (P : C → Prop) :
+  P ∅ → (∀ x X, x ∉ X → P X → P ({[ x ]} ∪ X)) → ∀ X, P X.
+Proof. apply set_ind. by intros ?? ->%leibniz_equiv_iff. Qed.
+
+(** * The [set_fold] operation *)
+Lemma set_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B) :
+  (∀ x, Proper ((≡) ==> impl) (P x)) →
+  P b ∅ → (∀ x X r, x ∉ X → P r X → P (f x r) ({[ x ]} ∪ X)) →
+  ∀ X, P (set_fold f b X) X.
+Proof.
+  intros ? Hemp Hadd.
+  cut (∀ l, NoDup l → ∀ X, (∀ x, x ∈ X ↔ x ∈ l) → P (foldr f b l) X).
+  { intros help ?. apply help; [apply NoDup_elements|].
+    symmetry. apply elem_of_elements. }
+  induction 1 as [|x l ?? IH]; simpl.
+  - intros X HX. setoid_rewrite elem_of_nil in HX.
+    rewrite equiv_empty; [done|]. set_solver.
+  - intros X HX. setoid_rewrite elem_of_cons in HX.
+    rewrite (union_difference {[ x ]} X) by set_solver.
+    apply Hadd; [set_solver|]. apply IH; set_solver.
+Qed.
+Lemma set_fold_ind_L `{!LeibnizEquiv C}
+    {B} (P : B → C → Prop) (f : A → B → B) (b : B) :
+  P b ∅ → (∀ x X r, x ∉ X → P r X → P (f x r) ({[ x ]} ∪ X)) →
+  ∀ X, P (set_fold f b X) X.
+Proof. apply set_fold_ind. solve_proper. Qed.
+Lemma set_fold_proper {B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (b : B) `{!∀ a, Proper (R ==> R) (f a)}
+    (Hf : ∀ a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) :
+  Proper ((≡) ==> R) (set_fold f b : C → B).
+Proof. intros ?? E. apply (foldr_permutation R f b); auto. by rewrite E. Qed.
+
+Lemma set_fold_empty {B} (f : A → B → B) (b : B) :
+  set_fold f b (∅ : C) = b.
+Proof. by unfold set_fold; simpl; rewrite elements_empty. Qed.
+Lemma set_fold_singleton {B} (f : A → B → B) (b : B) (a : A) :
+  set_fold f b ({[a]} : C) = f a b.
+Proof. by unfold set_fold; simpl; rewrite elements_singleton. Qed.
+
+(** The following lemma shows that folding over two sets separately (using the
+result of the first fold as input for the second fold) is equivalent to folding
+over the union, *if* the function is idempotent for the elements that will be
+processed twice ([X ∩ Y]) and does not care about the order in which elements
+are processed.
+
+This is a generalization of [set_fold_union] (below) with a.) a relation [R]
+instead of equality b.) a function [f : A → B → B] instead of [f : A → A → A],
+and c.) premises that ensure the elements are in [X ∪ Y]. *)
+Lemma set_fold_union_strong {B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (b : B) X Y :
+  (∀ x, Proper (R ==> R) (f x)) →
+  (∀ x b',
+    (** This is morally idempotence for elements of [X ∩ Y] *)
+    x ∈ X ∩ Y →
+    (** We cannot write this in the usual direction of idempotence properties
+    (i.e., [R (f x (f x b'))) (f x b')]) because [R] is not symmetric. *)
+    R (f x b') (f x (f x b'))) →
+  (∀ x1 x2 b',
+    (** This is morally commutativity + associativity for elements of [X ∪ Y] *)
+    x1 ∈ X ∪ Y → x2 ∈ X ∪ Y → x1 ≠ x2 →
+    R (f x1 (f x2 b')) (f x2 (f x1 b'))) →
+  R (set_fold f b (X ∪ Y)) (set_fold f (set_fold f b X) Y).
+Proof.
+  (** This lengthy proof involves various steps by transitivity of [R].
+  Roughly, we show that the LHS is related to folding over:
+
+    elements (Y ∖ X) ++ elements (X ∩ Y) ++ elements (X ∖ Y)
+
+  and the RHS is related to folding over:
+
+    elements (Y ∖ X) ++ elements (X ∩ Y) ++ elements (X ∩ Y) ++ elements (Y ∖ X)
+
+  These steps are justified by lemma [foldr_permutation]. In the middle we
+  remove the repeated folding over [elements (X ∩ Y)] using [foldr_idemp_strong].
+  Most of the proof work concerns the side conditions of [foldr_permutation]
+  and [foldr_idemp_strong], which require relating results about lists and
+  sets. *)
+  intros ?.
+  assert (∀ b1 b2 l, R b1 b2 → R (foldr f b1 l) (foldr f b2 l)) as Hff.
+  { intros b1 b2 l Hb. induction l as [|x l]; simpl; [done|]. by f_equiv. }
+  intros Hfidemp Hfcomm. unfold set_fold; simpl.
+  trans (foldr f b (elements (Y ∖ X) ++ elements (X ∩ Y) ++ elements (X ∖ Y))).
+  { apply (foldr_permutation R f b).
+    - intros j1 x1 j2 x2 b' Hj Hj1 Hj2. apply Hfcomm.
+      + apply elem_of_list_lookup_2 in Hj1. set_solver.
+      + apply elem_of_list_lookup_2 in Hj2. set_solver.
+      + intros ->. pose proof (NoDup_elements (X ∪ Y)).
+        by eapply Hj, NoDup_lookup.
+    - rewrite <-!elements_disj_union by set_solver. f_equiv; intros x.
+      destruct (decide (x ∈ X)), (decide (x ∈ Y)); set_solver. }
+  trans (foldr f (foldr f b (elements (X ∩ Y) ++ elements (X ∖ Y)))
+    (elements (Y ∖ X) ++ elements (X ∩ Y))).
+  { rewrite !foldr_app. apply Hff. apply (foldr_idemp_strong (flip R)).
+    - solve_proper.
+    - intros j a b' ?%elem_of_list_lookup_2. apply Hfidemp. set_solver.
+    - intros j1 x1 j2 x2 b' Hj Hj1 Hj2. apply Hfcomm.
+      + apply elem_of_list_lookup_2 in Hj2. set_solver.
+      + apply elem_of_list_lookup_2 in Hj1. set_solver.
+      + intros ->. pose proof (NoDup_elements (X ∩ Y)).
+        by eapply Hj, NoDup_lookup. }
+  trans (foldr f (foldr f b (elements (X ∩ Y) ++ elements (X ∖ Y))) (elements Y)).
+  { apply (foldr_permutation R f _).
+    - intros j1 x1 j2 x2 b' Hj Hj1 Hj2. apply Hfcomm.
+      + apply elem_of_list_lookup_2 in Hj1. set_solver.
+      + apply elem_of_list_lookup_2 in Hj2. set_solver.
+      + intros ->. assert (NoDup (elements (Y ∖ X) ++ elements (X ∩ Y))).
+        { rewrite <-elements_disj_union by set_solver. apply NoDup_elements. }
+        by eapply Hj, NoDup_lookup.
+    - rewrite <-!elements_disj_union by set_solver. f_equiv; intros x.
+      destruct (decide (x ∈ X)); set_solver. }
+  apply Hff. apply (foldr_permutation R f _).
+  - intros j1 x1 j2 x2 b' Hj Hj1 Hj2. apply Hfcomm.
+    + apply elem_of_list_lookup_2 in Hj1. set_solver.
+    + apply elem_of_list_lookup_2 in Hj2. set_solver.
+    + intros ->. assert (NoDup (elements (X ∩ Y) ++ elements (X ∖ Y))).
+      { rewrite <-elements_disj_union by set_solver. apply NoDup_elements. }
+      by eapply Hj, NoDup_lookup.
+  - rewrite <-!elements_disj_union by set_solver. f_equiv; intros x.
+    destruct (decide (x ∈ Y)); set_solver.
+Qed.
+Lemma set_fold_union (f : A → A → A) (b : A) X Y :
+  IdemP (=) f →
+  Comm (=) f →
+  Assoc (=) f →
+  set_fold f b (X ∪ Y) = set_fold f (set_fold f b X) Y.
+Proof.
+  intros. apply (set_fold_union_strong _ _ _ _ _ _).
+  - intros x b' _. by rewrite (assoc_L f), (idemp f).
+  - intros x1 x2 b' _ _ _. by rewrite !(assoc_L f), (comm_L f x1).
+Qed.
+
+(** Generalization of [set_fold_disj_union] (below) with a.) a relation [R]
+instead of equality b.) a function [f : A → B → B] instead of [f : A → A → A],
+and c.) premises that ensure the elements are in [X ∪ Y]. *)
+Lemma set_fold_disj_union_strong {B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (b : B) X Y :
+  (∀ x, Proper (R ==> R) (f x)) →
+  (∀ x1 x2 b',
+    (** This is morally commutativity + associativity for elements of [X ∪ Y] *)
+    x1 ∈ X ∪ Y → x2 ∈ X ∪ Y → x1 ≠ x2 →
+    R (f x1 (f x2 b')) (f x2 (f x1 b'))) →
+  X ## Y →
+  R (set_fold f b (X ∪ Y)) (set_fold f (set_fold f b X) Y).
+Proof. intros. apply set_fold_union_strong; set_solver. Qed.
+Lemma set_fold_disj_union (f : A → A → A) (b : A) X Y :
+  Comm (=) f →
+  Assoc (=) f →
+  X ## Y →
+  set_fold f b (X ∪ Y) = set_fold f (set_fold f b X) Y.
+Proof.
+  intros. apply (set_fold_disj_union_strong _ _ _ _ _ _); [|done].
+  intros x1 x2 b' _ _ _. by rewrite !(assoc_L f), (comm_L f x1).
+Qed.
+
+Lemma set_fold_comm_acc_strong {B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (g : B → B) (b : B) X :
+  (∀ x, Proper (R ==> R) (f x)) →
+  (∀ x y, x ∈ X → R (f x (g y)) (g (f x y))) →
+  R (set_fold f (g b) X) (g (set_fold f b X)).
+Proof.
+  intros. unfold set_fold; simpl.
+  apply foldr_comm_acc_strong; [done|solve_proper|set_solver].
+Qed.
+Lemma set_fold_comm_acc {B} (f : A → B → B) (g : B → B) (b : B) X :
+  (∀ x y, f x (g y) = g (f x y)) →
+  set_fold f (g b) X = g (set_fold f b X).
+Proof. intros. apply (set_fold_comm_acc_strong _); [solve_proper|auto]. Qed.
+
+(** * Minimal elements *)
+Lemma minimal_exists_elem_of R `{!Transitive R, ∀ x y, Decision (R x y)} (X : C) :
+  X ≢ ∅ → ∃ x, x ∈ X ∧ minimal R x X.
+Proof.
+  pattern X; apply set_ind; clear X.
+  { by intros X X' HX; setoid_rewrite HX. }
+  { done. }
+  intros x X ? IH Hemp. destruct (set_choose_or_empty X) as [[z ?]|HX].
+  { destruct IH as (x' & Hx' & Hmin); [set_solver|].
+    destruct (decide (R x x')).
+    - exists x; split; [set_solver|].
+      eapply union_minimal; [eapply singleton_minimal|by eapply minimal_weaken].
+    - exists x'; split; [set_solver|].
+      by eapply union_minimal; [apply singleton_minimal_not_above|]. }
+  exists x; split; [set_solver|].
+  rewrite HX, (right_id _ (∪)). apply singleton_minimal.
+Qed.
+Lemma minimal_exists_elem_of_L R `{!LeibnizEquiv C, !Transitive R,
+    ∀ x y, Decision (R x y)} (X : C) :
+  X ≠ ∅ → ∃ x, x ∈ X ∧ minimal R x X.
+Proof. unfold_leibniz. apply (minimal_exists_elem_of R). Qed.
+
+Lemma minimal_exists R `{!Transitive R,
+    ∀ x y, Decision (R x y)} `{!Inhabited A} (X : C) :
+  ∃ x, minimal R x X.
+Proof.
+  destruct (set_choose_or_empty X) as [ (y & Ha) | Hne].
+  - edestruct (minimal_exists_elem_of R X) as (x & Hel & Hmin); first set_solver.
+    exists x. done.
+  - exists inhabitant. intros y Hel. set_solver.
+Qed.
+
+(** * Filter *)
+Lemma elem_of_filter (P : A → Prop) `{!∀ x, Decision (P x)} X x :
+  x ∈ filter P X ↔ P x ∧ x ∈ X.
+Proof.
+  unfold filter, set_filter.
+  by rewrite elem_of_list_to_set, elem_of_list_filter, elem_of_elements.
+Qed.
+Global Instance set_unfold_filter (P : A → Prop) `{!∀ x, Decision (P x)} X Q x :
+  SetUnfoldElemOf x X Q → SetUnfoldElemOf x (filter P X) (P x ∧ Q).
+Proof.
+  intros ?; constructor. by rewrite elem_of_filter, (set_unfold_elem_of x X Q).
+Qed.
+
+Section filter.
+  Context (P : A → Prop) `{!∀ x, Decision (P x)}.
+
+  Lemma filter_empty : filter P (∅:C) ≡ ∅.
+  Proof. set_solver. Qed.
+  Lemma filter_singleton x : P x → filter P ({[ x ]} : C) ≡ {[ x ]}.
+  Proof. set_solver. Qed.
+  Lemma filter_singleton_not x : ¬P x → filter P ({[ x ]} : C) ≡ ∅.
+  Proof. set_solver. Qed.
+
+  Lemma filter_empty_not_elem_of X x : filter P X ≡ ∅ → P x → x ∉ X.
+  Proof. set_solver. Qed.
+
+  Lemma disjoint_filter X Y : X ## Y → filter P X ## filter P Y.
+  Proof. set_solver. Qed.
+  Lemma filter_union X Y : filter P (X ∪ Y) ≡ filter P X ∪ filter P Y.
+  Proof. set_solver. Qed.
+  Lemma disjoint_filter_complement X : filter P X ## filter (λ x, ¬P x) X.
+  Proof. set_solver. Qed.
+  Lemma filter_union_complement X : filter P X ∪ filter (λ x, ¬P x) X ≡ X.
+  Proof. intros x. destruct (decide (P x)); set_solver. Qed.
+
+  Section leibniz_equiv.
+    Context `{!LeibnizEquiv C}.
+    Lemma filter_empty_L : filter P (∅:C) = ∅.
+    Proof. unfold_leibniz. apply filter_empty. Qed.
+    Lemma filter_singleton_L x : P x → filter P ({[ x ]} : C) = {[ x ]}.
+    Proof. unfold_leibniz. apply filter_singleton. Qed.
+    Lemma filter_singleton_not_L x : ¬P x → filter P ({[ x ]} : C) = ∅.
+    Proof. unfold_leibniz. apply filter_singleton_not. Qed.
+
+    Lemma filter_empty_not_elem_of_L X x : filter P X = ∅ → P x → x ∉ X.
+    Proof. unfold_leibniz. apply filter_empty_not_elem_of. Qed.
+
+    Lemma filter_union_L X Y : filter P (X ∪ Y) = filter P X ∪ filter P Y.
+    Proof. unfold_leibniz. apply filter_union. Qed.
+    Lemma filter_union_complement_L X Y : filter P X ∪ filter (λ x, ¬P x) X = X.
+    Proof. unfold_leibniz. apply filter_union_complement. Qed.
+  End leibniz_equiv.
+End filter.
+
+(** * Map *)
+Section map.
+  Context `{SemiSet B D}.
+
+  Lemma elem_of_map (f : A → B) (X : C) y :
+    y ∈ set_map (D:=D) f X ↔ ∃ x, y = f x ∧ x ∈ X.
+  Proof.
+    unfold set_map. rewrite elem_of_list_to_set, elem_of_list_fmap.
+    by setoid_rewrite elem_of_elements.
+  Qed.
+  Global Instance set_unfold_map (f : A → B) (X : C) (P : A → Prop) y :
+    (∀ x, SetUnfoldElemOf x X (P x)) →
+    SetUnfoldElemOf y (set_map (D:=D) f X) (∃ x, y = f x ∧ P x).
+  Proof. constructor. rewrite elem_of_map; naive_solver. Qed.
+
+  Global Instance set_map_proper :
+    Proper (pointwise_relation _ (=) ==> (≡) ==> (≡)) (set_map (C:=C) (D:=D)).
+  Proof. intros f g ? X Y. set_unfold; naive_solver. Qed.
+  Global Instance set_map_mono :
+    Proper (pointwise_relation _ (=) ==> (⊆) ==> (⊆)) (set_map (C:=C) (D:=D)).
+  Proof. intros f g ? X Y. set_unfold; naive_solver. Qed.
+
+  Lemma elem_of_map_1 (f : A → B) (X : C) (y : B) :
+    y ∈ set_map (D:=D) f X → ∃ x, y = f x ∧ x ∈ X.
+  Proof. set_solver. Qed.
+  Lemma elem_of_map_2 (f : A → B) (X : C) (x : A) :
+    x ∈ X → f x ∈ set_map (D:=D) f X.
+  Proof. set_solver. Qed.
+  Lemma elem_of_map_2_alt (f : A → B) (X : C) (x : A) (y : B) :
+    x ∈ X → y = f x → y ∈ set_map (D:=D) f X.
+  Proof. set_solver. Qed.
+
+  Lemma set_map_empty (f : A → B) :
+    set_map (C:=C) (D:=D) f ∅ = ∅.
+  Proof. unfold set_map. rewrite elements_empty. done. Qed.
+
+  Lemma set_map_union (f : A → B) (X Y : C) :
+    set_map (D:=D) f (X ∪ Y) ≡ set_map (D:=D) f X ∪ set_map (D:=D) f Y.
+  Proof. set_solver. Qed.
+  (** This cannot be using [=] because [list_to_set_singleton] does not hold for [=]. *)
+  Lemma set_map_singleton (f : A → B) (x : A) :
+    set_map (C:=C) (D:=D) f {[x]} ≡ {[f x]}.
+  Proof. set_solver. Qed.
+
+  Lemma set_map_union_L `{!LeibnizEquiv D} (f : A → B) (X Y : C) :
+    set_map (D:=D) f (X ∪ Y) = set_map (D:=D) f X ∪ set_map (D:=D) f Y.
+  Proof. unfold_leibniz. apply set_map_union. Qed.
+  Lemma set_map_singleton_L `{!LeibnizEquiv D} (f : A → B) (x : A) :
+    set_map (C:=C) (D:=D) f {[x]} = {[f x]}.
+  Proof. unfold_leibniz. apply set_map_singleton. Qed.
+End map.
+
+(** * Bind *)
+Section set_bind.
+  Context `{SemiSet B SB}.
+
+  Local Notation set_bind := (set_bind (A:=A) (SA:=C) (SB:=SB)).
+
+  Lemma elem_of_set_bind (f : A → SB) (X : C) y :
+    y ∈ set_bind f X ↔ ∃ x, x ∈ X ∧ y ∈ f x.
+  Proof.
+    unfold set_bind. rewrite !elem_of_union_list. set_solver.
+  Qed.
+
+  Global Instance set_unfold_set_bind (f : A → SB) (X : C)
+       (y : B) (P : A → B → Prop) (Q : A → Prop) :
+    (∀ x y, SetUnfoldElemOf y (f x) (P x y)) →
+    (∀ x, SetUnfoldElemOf x X (Q x)) →
+    SetUnfoldElemOf y (set_bind f X) (∃ x, Q x ∧ P x y).
+  Proof.
+    intros HSU1 HSU2. constructor.
+    rewrite elem_of_set_bind. set_solver.
+  Qed.
+
+  Global Instance set_bind_proper :
+    Proper (pointwise_relation _ (≡) ==> (≡) ==> (≡)) set_bind.
+  Proof. unfold pointwise_relation; intros f1 f2 Hf X1 X2 HX. set_solver. Qed.
+
+  Global Instance set_bind_mono :
+    Proper (pointwise_relation _ (⊆) ==> (⊆) ==> (⊆)) set_bind.
+  Proof. unfold pointwise_relation; intros f1 f2 Hf X1 X2 HX. set_solver. Qed.
+
+  Lemma set_bind_ext (f g : A → SB) (X Y : C) :
+    (∀ x, x ∈ X → x ∈ Y → f x ≡ g x) → X ≡ Y → set_bind f X ≡ set_bind g Y.
+  Proof. set_solver. Qed.
+
+  Lemma set_bind_singleton f x : set_bind f {[x]} ≡ f x.
+  Proof. set_solver. Qed.
+  Lemma set_bind_singleton_L `{!LeibnizEquiv SB} f x : set_bind f {[x]} = f x.
+  Proof. unfold_leibniz. apply set_bind_singleton. Qed.
+
+  Lemma set_bind_disj_union f (X Y : C) :
+    X ## Y → set_bind f (X ∪ Y) ≡ set_bind f X ∪ set_bind f Y.
+  Proof. set_solver. Qed.
+  Lemma set_bind_disj_union_L `{!LeibnizEquiv SB} f (X Y : C) :
+    X ## Y → set_bind f (X ∪ Y) = set_bind f X ∪ set_bind f Y.
+  Proof. unfold_leibniz. apply set_bind_disj_union. Qed.
+End set_bind.
+
+(** * OMap *)
+Section set_omap.
+  Context `{SemiSet B D}.
+  Implicit Types (f : A → option B).
+  Implicit Types (x : A) (y : B).
+  Notation set_omap := (set_omap (C:=C) (D:=D)).
+
+  Lemma elem_of_set_omap f X y : y ∈ set_omap f X ↔ ∃ x, x ∈ X ∧ f x = Some y.
+  Proof.
+    unfold set_omap. rewrite elem_of_list_to_set, elem_of_list_omap.
+    by setoid_rewrite elem_of_elements.
+  Qed.
+
+  Global Instance set_unfold_omap f X (P : A → Prop) y :
+    (∀ x, SetUnfoldElemOf x X (P x)) →
+    SetUnfoldElemOf y (set_omap f X) (∃ x, Some y = f x ∧ P x).
+  Proof. constructor. rewrite elem_of_set_omap; naive_solver. Qed.
+
+  Global Instance set_omap_proper :
+    Proper (pointwise_relation _ (=) ==> (≡) ==> (≡)) set_omap.
+  Proof. intros f g Hfg X Y. set_unfold. setoid_rewrite Hfg. naive_solver. Qed.
+  Global Instance set_omap_mono :
+    Proper (pointwise_relation _ (=) ==> (⊆) ==> (⊆)) set_omap.
+  Proof. intros f g Hfg X Y. set_unfold. setoid_rewrite Hfg. naive_solver. Qed.
+
+  Lemma elem_of_set_omap_1 f X y : y ∈ set_omap f X → ∃ x, Some y = f x ∧ x ∈ X.
+  Proof. set_solver. Qed.
+  Lemma elem_of_set_omap_2 f X x y : x ∈ X → f x = Some y → y ∈ set_omap f X.
+  Proof. set_solver. Qed.
+
+  Lemma set_omap_empty f : set_omap f ∅ = ∅.
+  Proof. unfold set_omap. by rewrite elements_empty. Qed.
+  Lemma set_omap_empty_iff f X : set_omap f X ≡ ∅ ↔ set_Forall (λ x, f x = None) X.
+  Proof.
+    split; set_unfold; unfold set_Forall.
+    - intros Hi x Hx. destruct (f x) as [y|] eqn:Hy; naive_solver.
+    - intros Hi y (x & Hf & Hx). specialize (Hi x Hx). by rewrite Hi in Hf.
+  Qed.
+
+  Lemma set_omap_union f X Y : set_omap f (X ∪ Y) ≡ set_omap f X ∪ set_omap f Y.
+  Proof. set_solver. Qed.
+
+  Lemma set_omap_singleton f x :
+    set_omap f {[ x ]} ≡ match f x with Some y => {[ y ]} | None => ∅ end.
+  Proof. set_solver. Qed.
+  Lemma set_omap_singleton_Some f x y : f x = Some y → set_omap f {[ x ]} ≡ {[ y ]}.
+  Proof. intros Hx. by rewrite set_omap_singleton, Hx. Qed.
+  Lemma set_omap_singleton_None f x : f x = None → set_omap f {[ x ]} ≡ ∅.
+  Proof. intros Hx. by rewrite set_omap_singleton, Hx. Qed.
+
+  Lemma set_omap_alt f X : set_omap f X ≡ set_bind (λ x, option_to_set (f x)) X.
+  Proof. set_solver. Qed.
+  Lemma set_map_alt (f : A → B) X : set_map f X = set_omap (λ x, Some (f x)) X.
+  Proof. set_solver. Qed.
+
+  Lemma set_omap_filter P `{∀ x, Decision (P x)} f X :
+    (∀ x, x ∈ X → is_Some (f x) → P x) →
+    set_omap f (filter P X) ≡ set_omap f X.
+  Proof. set_solver. Qed.
+
+  Section leibniz.
+    Context `{!LeibnizEquiv D}.
+
+    Lemma set_omap_union_L f X Y : set_omap f (X ∪ Y) = set_omap f X ∪ set_omap f Y.
+    Proof. unfold_leibniz. apply set_omap_union. Qed.
+
+    Lemma set_omap_singleton_L f x :
+      set_omap f {[ x ]} = match f x with Some y => {[ y ]} | None => ∅ end.
+    Proof. unfold_leibniz. apply set_omap_singleton. Qed.
+    Lemma set_omap_singleton_Some_L f x y :
+      f x = Some y → set_omap f {[ x ]} = {[ y ]}.
+    Proof. unfold_leibniz. apply set_omap_singleton_Some. Qed.
+    Lemma set_omap_singleton_None_L f x : f x = None → set_omap f {[ x ]} = ∅.
+    Proof. unfold_leibniz. apply set_omap_singleton_None. Qed.
+
+    Lemma set_omap_alt_L f X :
+      set_omap f X = set_bind (λ x, option_to_set (f x)) X.
+    Proof. unfold_leibniz. apply set_omap_alt. Qed.
+
+    Lemma set_omap_filter_L P `{∀ x, Decision (P x)} f X :
+      (∀ x, x ∈ X → is_Some (f x) → P x) →
+      set_omap f (filter P X) = set_omap f X.
+    Proof. unfold_leibniz. apply set_omap_filter. Qed.
+  End leibniz.
+End set_omap.
+
+(** * Decision procedures *)
+Lemma set_Forall_elements P X : set_Forall P X ↔ Forall P (elements X).
+Proof. rewrite Forall_forall. by setoid_rewrite elem_of_elements. Qed.
+Lemma set_Exists_elements P X : set_Exists P X ↔ Exists P (elements X).
+Proof. rewrite Exists_exists. by setoid_rewrite elem_of_elements. Qed.
+
+Lemma set_Forall_Exists_dec (P Q : A → Prop) (dec : ∀ x, {P x} + {Q x}) X :
+  {set_Forall P X} + {set_Exists Q X}.
+Proof.
+ refine (cast_if (Forall_Exists_dec P Q dec (elements X)));
+   [by apply set_Forall_elements|by apply set_Exists_elements].
+Defined.
+
+Lemma not_set_Forall_Exists P `{dec : ∀ x, Decision (P x)} X :
+  ¬set_Forall P X → set_Exists (not ∘ P) X.
+Proof. intro. by destruct (set_Forall_Exists_dec P (not ∘ P) dec X). Qed.
+Lemma not_set_Exists_Forall P `{dec : ∀ x, Decision (P x)} X :
+  ¬set_Exists P X → set_Forall (not ∘ P) X.
+Proof.
+  by destruct (set_Forall_Exists_dec
+    (not ∘ P) P (λ x, swap_if (decide (P x))) X).
+Qed.
+
+Global Instance set_Forall_dec (P : A → Prop) `{∀ x, Decision (P x)} X :
+  Decision (set_Forall P X) | 100.
+Proof.
+ refine (cast_if (decide (Forall P (elements X))));
+   by rewrite set_Forall_elements.
+Defined.
+Global Instance set_Exists_dec `(P : A → Prop) `{∀ x, Decision (P x)} X :
+  Decision (set_Exists P X) | 100.
+Proof.
+ refine (cast_if (decide (Exists P (elements X))));
+   by rewrite set_Exists_elements.
+Defined.
+
+(** Alternative versions of finite and infinite predicates *)
+Lemma pred_finite_set (P : A → Prop) :
+  pred_finite P ↔ (∃ X : C, ∀ x, P x → x ∈ X).
+Proof.
+  split.
+  - intros [xs Hfin]. exists (list_to_set xs). set_solver.
+  - intros [X Hfin]. exists (elements X). set_solver.
+Qed.
+
+Lemma dec_pred_finite_set_alt (P : A → Prop) `{!∀ x : A, Decision (P x)} :
+  pred_finite P ↔ (∃ X : C, ∀ x, P x ↔ x ∈ X).
+Proof.
+  rewrite dec_pred_finite_alt; [|done]. split.
+  - intros [xs Hfin]. exists (list_to_set xs). set_solver.
+  - intros [X Hfin]. exists (elements X). set_solver.
+Qed.
+
+Lemma pred_infinite_set (P : A → Prop) :
+  pred_infinite P ↔ (∀ X : C, ∃ x, P x ∧ x ∉ X).
+Proof.
+  split.
+  - intros Hinf X. destruct (Hinf (elements X)). set_solver.
+  - intros Hinf xs. destruct (Hinf (list_to_set xs)). set_solver.
+Qed.
+
+Section infinite.
+  Context `{Infinite A}.
+
+  (** Properties about the [fresh] operation on finite sets *)
+  Global Instance fresh_proper: Proper ((≡@{C}) ==> (=)) fresh.
+  Proof. unfold fresh, set_fresh. by intros X1 X2 ->. Qed.
+
+  Lemma is_fresh X : fresh X ∉ X.
+  Proof.
+    unfold fresh, set_fresh. rewrite <-elem_of_elements. apply infinite_is_fresh.
+  Qed.
+  Lemma exist_fresh X : ∃ x, x ∉ X.
+  Proof. exists (fresh X). apply is_fresh. Qed.
+
+  (** Properties about the [fresh_list] operation on finite sets *)
+  Global Instance fresh_list_proper n : Proper ((≡@{C}) ==> (=)) (fresh_list n).
+  Proof. induction n as [|n IH]; intros ?? E; by setoid_subst. Qed.
+
+  Lemma Forall_fresh_NoDup X xs : Forall_fresh X xs → NoDup xs.
+  Proof. induction 1; by constructor. Qed.
+  Lemma Forall_fresh_elem_of X xs x : Forall_fresh X xs → x ∈ xs → x ∉ X.
+  Proof.
+    intros HX; revert x; rewrite <-Forall_forall. by induction HX; constructor.
+  Qed.
+  Lemma Forall_fresh_alt X xs :
+    Forall_fresh X xs ↔ NoDup xs ∧ ∀ x, x ∈ xs → x ∉ X.
+  Proof.
+    split; eauto using Forall_fresh_NoDup, Forall_fresh_elem_of.
+    rewrite <-Forall_forall.
+    intros [Hxs Hxs']. induction Hxs; decompose_Forall_hyps; constructor; auto.
+  Qed.
+  Lemma Forall_fresh_subseteq X Y xs :
+    Forall_fresh X xs → Y ⊆ X → Forall_fresh Y xs.
+  Proof. rewrite !Forall_fresh_alt; set_solver. Qed.
+
+  Lemma length_fresh_list n X : length (fresh_list n X) = n.
+  Proof. revert X. induction n; simpl; auto. Qed.
+  Lemma fresh_list_is_fresh n X x : x ∈ fresh_list n X → x ∉ X.
+  Proof.
+    revert X. induction n as [|n IH]; intros X; simpl;[by rewrite elem_of_nil|].
+    rewrite elem_of_cons; intros [->| Hin]; [apply is_fresh|].
+    apply IH in Hin; set_solver.
+  Qed.
+  Lemma NoDup_fresh_list n X : NoDup (fresh_list n X).
+  Proof.
+    revert X. induction n; simpl; constructor; auto.
+    intros Hin; apply fresh_list_is_fresh in Hin; set_solver.
+  Qed.
+  Lemma Forall_fresh_list X n : Forall_fresh X (fresh_list n X).
+  Proof.
+    rewrite Forall_fresh_alt; eauto using NoDup_fresh_list, fresh_list_is_fresh.
+  Qed.
+End infinite.
+End fin_set.
+
+Lemma size_set_seq `{FinSet nat C} start len :
+  size (set_seq (C:=C) start len) = len.
+Proof.
+  rewrite <-list_to_set_seq, size_list_to_set.
+  2:{ apply NoDup_seq. }
+  rewrite length_seq. done.
+Qed.

theories/finite.v → stdpp/finite.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
 From stdpp Require Export countable vector.
-Set Default Proof Using "Type".
+From stdpp Require Import options.
 
 Class Finite A `{EqDecision A} := {
   enum : list A;
+  (* [NoDup] makes it easy to define the cardinality of the type. *)
   NoDup_enum : NoDup enum;
   elem_of_enum x : x ∈ enum
 }.
-Arguments enum _ _ _ : clear implicits.
-Arguments enum _ {_ _}.
-Arguments NoDup_enum _ _ _ : clear implicits.
-Arguments NoDup_enum _ {_ _}.
+Global Hint Mode Finite ! - : typeclass_instances.
+Global Arguments enum : clear implicits.
+Global Arguments enum _ {_ _} : assert.
+Global Arguments NoDup_enum : clear implicits.
+Global Arguments NoDup_enum _ {_ _} : assert.
 Definition card A `{Finite A} := length (enum A).
-Program Instance finite_countable `{Finite A} : Countable A := {|
+
+Program Definition finite_countable `{Finite A} : Countable A := {|
   encode := λ x,
-    Pos.of_nat $ S $ from_option id 0 $ fst <$> list_find (x =) (enum A);
+    Pos.of_nat $ S $ default 0 $ fst <$> list_find (x =.) (enum A);
   decode := λ p, enum A !! pred (Pos.to_nat p)
 |}.
-Arguments Pos.of_nat _ : simpl never.
 Next Obligation.
   intros ?? [xs Hxs HA] x; unfold encode, decode; simpl.
-  destruct (list_find_elem_of (x =) xs x) as [[i y] Hi]; auto.
+  destruct (list_find_elem_of (x =.) xs x) as [[i y] Hi]; auto.
   rewrite Nat2Pos.id by done; simpl; rewrite Hi; simpl.
-  destruct (list_find_Some (x =) xs i y); naive_solver.
+  destruct (list_find_Some (x =.) xs i y); naive_solver.
 Qed.
-Definition find `{Finite A} P `{∀ x, Decision (P x)} : option A :=
+Global Hint Immediate finite_countable : typeclass_instances.
+
+Definition find `{Finite A} (P : A → Prop) `{∀ x, Decision (P x)} : option A :=
   list_find P (enum A) ≫= decode_nat ∘ fst.
 
-Lemma encode_lt_card `{finA: Finite A} x : encode_nat x < card A.
+Lemma encode_lt_card `{finA: Finite A} (x : A) : encode_nat x < card A.
 Proof.
   destruct finA as [xs Hxs HA]; unfold encode_nat, encode, card; simpl.
   rewrite Nat2Pos.id by done; simpl.
-  destruct (list_find _ xs) as [[i y]|] eqn:?; simpl.
-  - destruct (list_find_Some (x =) xs i y); eauto using lookup_lt_Some.
-  - destruct xs; simpl. exfalso; eapply not_elem_of_nil, (HA x). lia.
+  destruct (list_find _ xs) as [[i y]|] eqn:HE; simpl.
+  - apply list_find_Some in HE as (?&?&?); eauto using lookup_lt_Some.
+  - destruct xs; simpl; [|lia].
+    exfalso; eapply not_elem_of_nil, (HA x).
 Qed.
 Lemma encode_decode A `{finA: Finite A} i :
-  i < card A → ∃ x, decode_nat i = Some x ∧ encode_nat x = i.
+  i < card A → ∃ x : A, decode_nat i = Some x ∧ encode_nat x = i.
 Proof.
   destruct finA as [xs Hxs HA].
   unfold encode_nat, decode_nat, encode, decode, card; simpl.
   intros Hi. apply lookup_lt_is_Some in Hi. destruct Hi as [x Hx].
   exists x. rewrite !Nat2Pos.id by done; simpl.
-  destruct (list_find_elem_of (x =) xs x) as [[j y] Hj]; auto.
-  destruct (list_find_Some (x =) xs j y) as [? ->]; auto.
-  rewrite Hj; csimpl; eauto using NoDup_lookup.
+  destruct (list_find_elem_of (x =.) xs x) as [[j y] Hj]; auto.
+  split; [done|]; rewrite Hj; simpl.
+  apply list_find_Some in Hj as (?&->&?). eauto using NoDup_lookup.
 Qed.
-Lemma find_Some `{finA: Finite A} P `{∀ x, Decision (P x)} x :
+Lemma find_Some `{finA: Finite A} (P : A → Prop) `{∀ x, Decision (P x)} (x : A) :
   find P = Some x → P x.
 Proof.
   destruct finA as [xs Hxs HA]; unfold find, decode_nat, decode; simpl.
@@ -55,20 +58,20 @@ Proof.
   rewrite !Nat2Pos.id in Hx by done.
   destruct (list_find_Some P xs i y); naive_solver.
 Qed.
-Lemma find_is_Some `{finA: Finite A} P `{∀ x, Decision (P x)} x :
+Lemma find_is_Some `{finA: Finite A} (P : A → Prop) `{∀ x, Decision (P x)} (x : A) :
   P x → ∃ y, find P = Some y ∧ P y.
 Proof.
   destruct finA as [xs Hxs HA]; unfold find, decode; simpl.
   intros Hx. destruct (list_find_elem_of P xs x) as [[i y] Hi]; auto.
-  rewrite Hi. destruct (list_find_Some P xs i y); simplify_eq/=; auto.
-  exists y. by rewrite !Nat2Pos.id by done.
+  rewrite Hi; unfold decode_nat, decode; simpl. rewrite !Nat2Pos.id by done.
+  simpl. apply list_find_Some in Hi; naive_solver.
 Qed.
 
 Definition encode_fin `{Finite A} (x : A) : fin (card A) :=
   Fin.of_nat_lt (encode_lt_card x).
 Program Definition decode_fin `{Finite A} (i : fin (card A)) : A :=
   match Some_dec (decode_nat i) return _ with
-  | inleft (exist x _) => x | inright _ => _
+  | inleft (x ↾ _) => x | inright _ => _
   end.
 Next Obligation.
   intros A ?? i ?; exfalso.
@@ -77,8 +80,8 @@ Qed.
 Lemma decode_encode_fin `{Finite A} (x : A) : decode_fin (encode_fin x) = x.
 Proof.
   unfold decode_fin, encode_fin. destruct (Some_dec _) as [[x' Hx]|Hx].
-  { by rewrite fin_to_of_nat, decode_encode_nat in Hx; simplify_eq. }
-  exfalso; by rewrite ->fin_to_of_nat, decode_encode_nat in Hx.
+  { by rewrite fin_to_nat_to_fin, decode_encode_nat in Hx; simplify_eq. }
+  exfalso; by rewrite ->fin_to_nat_to_fin, decode_encode_nat in Hx.
 Qed.
 
 Lemma fin_choice {n} {B : fin n → Type} (P : ∀ i, B i → Prop) :
@@ -115,9 +118,9 @@ Qed.
 Lemma finite_inj_Permutation `{Finite A} `{Finite B} (f : A → B)
   `{!Inj (=) (=) f} : card A = card B → f <$> enum A ≡ₚ enum B.
 Proof.
-  intros. apply submseteq_Permutation_length_eq.
-  - by rewrite fmap_length.
+  intros. apply submseteq_length_Permutation.
   - by apply finite_inj_submseteq.
+  - rewrite length_fmap. by apply Nat.eq_le_incl.
 Qed.
 Lemma finite_inj_surj `{Finite A} `{Finite B} (f : A → B)
   `{!Inj (=) (=) f} : card A = card B → Surj (=) f.
@@ -130,7 +133,7 @@ Lemma finite_surj A `{Finite A} B `{Finite B} :
   0 < card A ≤ card B → ∃ g : B → A, Surj (=) g.
 Proof.
   intros [??]. destruct (finite_inhabited A) as [x']; auto with lia.
-  exists (λ y : B, from_option id x' (decode_nat (encode_nat y))).
+  exists (λ y : B, default x' (decode_nat (encode_nat y))).
   intros x. destruct (encode_decode B (encode_nat x)) as (y&Hy1&Hy2).
   { pose proof (encode_lt_card x); lia. }
   exists y. by rewrite Hy2, decode_encode_nat.
@@ -143,7 +146,7 @@ Proof.
     { exists (card_0_inv B HA). intros y. apply (card_0_inv _ HA y). }
     destruct (finite_surj A B) as (g&?); auto with lia.
     destruct (surj_cancel g) as (f&?). exists f. apply cancel_inj.
-  - intros [f ?]. unfold card. rewrite <-(fmap_length f).
+  - intros [f ?]. unfold card. rewrite <-(length_fmap f).
     by apply submseteq_length, (finite_inj_submseteq f).
 Qed.
 Lemma finite_bijective A `{Finite A} B `{Finite B} :
@@ -151,10 +154,10 @@ Lemma finite_bijective A `{Finite A} B `{Finite B} :
 Proof.
   split.
   - intros; destruct (proj1 (finite_inj A B)) as [f ?]; auto with lia.
-    exists f; auto using (finite_inj_surj f).
+    exists f; split; [done|]. by apply finite_inj_surj.
   - intros (f&?&?). apply (anti_symm (≤)); apply finite_inj.
     + by exists f.
-    + destruct (surj_cancel f) as (g&?); eauto using cancel_inj.
+    + destruct (surj_cancel f) as (g&?). exists g. apply cancel_inj.
 Qed.
 Lemma inj_card `{Finite A} `{Finite B} (f : A → B)
   `{!Inj (=) (=) f} : card A ≤ card B.
@@ -200,12 +203,12 @@ Section enc_finite.
   Context (to_nat_c : ∀ x, to_nat x < c).
   Context (to_of_nat : ∀ i, i < c → to_nat (of_nat i) = i).
 
-  Program Instance enc_finite : Finite A := {| enum := of_nat <$> seq 0 c |}.
+  Local Program Instance enc_finite : Finite A := {| enum := of_nat <$> seq 0 c |}.
   Next Obligation.
     apply NoDup_alt. intros i j x. rewrite !list_lookup_fmap. intros Hi Hj.
     destruct (seq _ _ !! i) as [i'|] eqn:Hi',
       (seq _ _ !! j) as [j'|] eqn:Hj'; simplify_eq/=.
-    destruct (lookup_seq_inv _ _ _ _ Hi'), (lookup_seq_inv _ _ _ _ Hj'); subst.
+    apply lookup_seq in Hi' as  [-> ?]. apply lookup_seq in Hj' as [-> ?].
     rewrite <-(to_of_nat i), <-(to_of_nat j) by done. by f_equal.
   Qed.
   Next Obligation.
@@ -213,22 +216,42 @@ Section enc_finite.
     split; auto. by apply elem_of_list_lookup_2 with (to_nat x), lookup_seq.
   Qed.
   Lemma enc_finite_card : card A = c.
-  Proof. unfold card. simpl. by rewrite fmap_length, seq_length. Qed.
+  Proof. unfold card. simpl. by rewrite length_fmap, length_seq. Qed.
 End enc_finite.
 
+(** If we have a surjection [f : A → B] and [A] is finite, then [B] is finite
+too. The surjection [f] could map multiple [x : A] on the same [B], so we
+need to remove duplicates in [enum]. If [f] is injective, we do not need to do that,
+leading to a potentially faster implementation of [enum], see [bijective_finite]
+below. *)
+Section surjective_finite.
+  Context `{Finite A, EqDecision B} (f : A → B).
+  Context `{!Surj (=) f}.
+
+  Program Definition surjective_finite: Finite B :=
+    {| enum := remove_dups (f <$> enum A) |}.
+  Next Obligation. apply NoDup_remove_dups. Qed.
+  Next Obligation.
+    intros y. rewrite elem_of_remove_dups, elem_of_list_fmap.
+    destruct (surj f y). eauto using elem_of_enum.
+  Qed.
+End surjective_finite.
+
 Section bijective_finite.
-  Context `{Finite A, EqDecision B} (f : A → B) (g : B → A).
-  Context `{!Inj (=) (=) f, !Cancel (=) f g}.
+  Context `{Finite A, EqDecision B} (f : A → B).
+  Context `{!Inj (=) (=) f, !Surj (=) f}.
 
-  Program Instance bijective_finite: Finite B := {| enum := f <$> enum A |}.
-  Next Obligation. apply (NoDup_fmap_2 _), NoDup_enum. Qed.
+  Program Definition bijective_finite : Finite B :=
+    {| enum := f <$> enum A |}.
+  Next Obligation. apply (NoDup_fmap f), NoDup_enum. Qed.
   Next Obligation.
-    intros y. rewrite elem_of_list_fmap. eauto using elem_of_enum.
+    intros b. rewrite elem_of_list_fmap. destruct (surj f b).
+    eauto using elem_of_enum.
   Qed.
 End bijective_finite.
 
-Program Instance option_finite `{Finite A} : Finite (option A) :=
-  {| enum := None :: Some <$> enum A |}.
+Global Program Instance option_finite `{Finite A} : Finite (option A) :=
+  {| enum := None :: (Some <$> enum A) |}.
 Next Obligation.
   constructor.
   - rewrite elem_of_list_fmap. by intros (?&?&?).
@@ -239,23 +262,29 @@ Next Obligation.
   apply elem_of_list_fmap. eauto using elem_of_enum.
 Qed.
 Lemma option_cardinality `{Finite A} : card (option A) = S (card A).
-Proof. unfold card. simpl. by rewrite fmap_length. Qed.
+Proof. unfold card. simpl. by rewrite length_fmap. Qed.
+
+Global Program Instance Empty_set_finite : Finite Empty_set := {| enum := [] |}.
+Next Obligation. by apply NoDup_nil. Qed.
+Next Obligation. intros []. Qed.
+Lemma Empty_set_card : card Empty_set = 0.
+Proof. done. Qed.
 
-Program Instance unit_finite : Finite () := {| enum := [tt] |}.
+Global Program Instance unit_finite : Finite () := {| enum := [tt] |}.
 Next Obligation. apply NoDup_singleton. Qed.
 Next Obligation. intros []. by apply elem_of_list_singleton. Qed.
 Lemma unit_card : card unit = 1.
 Proof. done. Qed.
 
-Program Instance bool_finite : Finite bool := {| enum := [true; false] |}.
+Global Program Instance bool_finite : Finite bool := {| enum := [true; false] |}.
 Next Obligation.
-  constructor. by rewrite elem_of_list_singleton. apply NoDup_singleton.
+  constructor; [ by rewrite elem_of_list_singleton | apply NoDup_singleton ].
 Qed.
-Next Obligation. intros [|]. left. right; left. Qed.
+Next Obligation. intros [|]; [ left | right; left ]. Qed.
 Lemma bool_card : card bool = 2.
 Proof. done. Qed.
 
-Program Instance sum_finite `{Finite A, Finite B} : Finite (A + B)%type :=
+Global Program Instance sum_finite `{Finite A, Finite B} : Finite (A + B)%type :=
   {| enum := (inl <$> enum A) ++ (inr <$> enum B) |}.
 Next Obligation.
   intros. apply NoDup_app; split_and?.
@@ -265,82 +294,71 @@ Next Obligation.
 Qed.
 Next Obligation.
   intros ?????? [x|y]; rewrite elem_of_app, !elem_of_list_fmap;
-    eauto using @elem_of_enum.
+    [left|right]; (eexists; split; [done|apply elem_of_enum]).
 Qed.
 Lemma sum_card `{Finite A, Finite B} : card (A + B) = card A + card B.
-Proof. unfold card. simpl. by rewrite app_length, !fmap_length. Qed.
+Proof. unfold card. simpl. by rewrite length_app, !length_fmap. Qed.
 
-Program Instance prod_finite `{Finite A, Finite B} : Finite (A * B)%type :=
-  {| enum := foldr (λ x, (pair x <$> enum B ++)) [] (enum A) |}.
+Global Program Instance prod_finite `{Finite A, Finite B} : Finite (A * B)%type :=
+  {| enum := a ← enum A; (a,.) <$> enum B |}.
 Next Obligation.
-  intros ??????. induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl.
-  { constructor. }
-  apply NoDup_app; split_and?.
-  - by apply (NoDup_fmap_2 _), NoDup_enum.
-  - intros [? y]. rewrite elem_of_list_fmap. intros (?&?&?); simplify_eq.
-    clear IH. induction Hxs as [|x' xs ?? IH]; simpl.
-    { rewrite elem_of_nil. tauto. }
-    rewrite elem_of_app, elem_of_list_fmap.
-    intros [(?&?&?)|?]; simplify_eq.
-    + destruct Hx. by left.
-    + destruct IH. by intro; destruct Hx; right. auto.
-  - done.
+  intros A ?????. apply NoDup_bind.
+  - intros a1 a2 [a b] ?? (?&?&_)%elem_of_list_fmap (?&?&_)%elem_of_list_fmap.
+    naive_solver.
+  - intros a ?. rewrite (NoDup_fmap _). apply NoDup_enum.
+  - apply NoDup_enum.
 Qed.
 Next Obligation.
-  intros ?????? [x y]. induction (elem_of_enum x); simpl.
-  - rewrite elem_of_app, !elem_of_list_fmap. eauto using @elem_of_enum.
-  - rewrite elem_of_app; eauto.
+  intros ?????? [a b]. apply elem_of_list_bind.
+  exists a. eauto using elem_of_enum, elem_of_list_fmap_1.
 Qed.
 Lemma prod_card `{Finite A} `{Finite B} : card (A * B) = card A * card B.
 Proof.
   unfold card; simpl. induction (enum A); simpl; auto.
-  rewrite app_length, fmap_length. auto.
+  rewrite length_app, length_fmap. auto.
 Qed.
 
-Definition list_enum {A} (l : list A) : ∀ n, list { l : list A | length l = n } :=
-  fix go n :=
+Fixpoint vec_enum {A} (l : list A) (n : nat) : list (vec A n) :=
   match n with
-  | 0 => [[]↾eq_refl]
-  | S n => foldr (λ x, (sig_map (x ::) (λ _ H, f_equal S H) <$> (go n) ++)) [] l
+  | 0 => [[#]]
+  | S m => a ← l; vcons a <$> vec_enum l m
   end.
 
-Program Instance list_finite `{Finite A} n : Finite { l | length l = n } :=
-  {| enum := list_enum (enum A) n |}.
+Global Program Instance vec_finite `{Finite A} n : Finite (vec A n) :=
+  {| enum := vec_enum (enum A) n |}.
 Next Obligation.
-  intros ????. induction n as [|n IH]; simpl; [apply NoDup_singleton |].
-  revert IH. generalize (list_enum (enum A) n). intros l Hl.
-  induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl; auto; [constructor |].
-  apply NoDup_app; split_and?.
-  - by apply (NoDup_fmap_2 _).
-  - intros [k1 Hk1]. clear Hxs IH. rewrite elem_of_list_fmap.
-    intros ([k2 Hk2]&?&?) Hxk2; simplify_eq/=. destruct Hx. revert Hxk2.
-    induction xs as [|x' xs IH]; simpl in *; [by rewrite elem_of_nil |].
-    rewrite elem_of_app, elem_of_list_fmap, elem_of_cons.
-    intros [([??]&?&?)|?]; simplify_eq/=; auto.
-  - apply IH.
+  intros A ?? n. induction n as [|n IH]; csimpl; [apply NoDup_singleton|].
+  apply NoDup_bind.
+  - intros x1 x2 y ?? (?&?&_)%elem_of_list_fmap (?&?&_)%elem_of_list_fmap.
+    congruence.
+  - intros x ?. rewrite NoDup_fmap by (intros ?; apply vcons_inj_2). done.
+  - apply NoDup_enum.
 Qed.
 Next Obligation.
-  intros ???? [l Hl]. revert l Hl.
-  induction n as [|n IH]; intros [|x l] ?; simpl; simplify_eq.
-  { apply elem_of_list_singleton. by apply (sig_eq_pi _). }
-  revert IH. generalize (list_enum (enum A) n). intros k Hk.
-  induction (elem_of_enum x) as [x xs|x xs]; simpl in *.
-  - rewrite elem_of_app, elem_of_list_fmap. left. injection Hl. intros Hl'.
-    eexists (l↾Hl'). split. by apply (sig_eq_pi _). done.
-  - rewrite elem_of_app. eauto.
+  intros A ?? n v. induction v as [|x n v IH]; csimpl; [apply elem_of_list_here|].
+  apply elem_of_list_bind. eauto using elem_of_enum, elem_of_list_fmap_1.
 Qed.
-
-Lemma list_card `{Finite A} n : card { l | length l = n } = card A ^ n.
+Lemma vec_card `{Finite A} n : card (vec A n) = card A ^ n.
 Proof.
-  unfold card; simpl. induction n as [|n IH]; simpl; auto.
-  rewrite <-IH. clear IH. generalize (list_enum (enum A) n).
-  induction (enum A) as [|x xs IH]; intros l; simpl; auto.
-  by rewrite app_length, fmap_length, IH.
+  unfold card; simpl. induction n as [|n IH]; simpl; [done|].
+  rewrite <-IH. clear IH. generalize (vec_enum (enum A) n).
+  induction (enum A) as [|x xs IH]; intros l; csimpl; auto.
+  by rewrite length_app, length_fmap, IH.
 Qed.
 
+Global Instance list_finite `{Finite A} n : Finite { l : list A | length l = n }.
+Proof.
+  refine (bijective_finite (λ v : vec A n, vec_to_list v ↾ length_vec_to_list _)).
+  - abstract (by intros v1 v2 [= ?%vec_to_list_inj2]).
+  - abstract (intros [l <-]; exists (list_to_vec l);
+      apply (sig_eq_pi _), vec_to_list_to_vec).
+Defined.
+Lemma list_card `{Finite A} n : card { l : list A | length l = n } = card A ^ n.
+Proof. unfold card; simpl. rewrite length_fmap. apply vec_card. Qed.
+
 Fixpoint fin_enum (n : nat) : list (fin n) :=
-  match n with 0 => [] | S n => 0%fin :: FS <$> fin_enum n end.
-Program Instance fin_finite n : Finite (fin n) := {| enum := fin_enum n |}.
+  match n with 0 => [] | S n => 0%fin :: (FS <$> fin_enum n) end.
+Global Program Instance fin_finite n : Finite (fin n) := {| enum := fin_enum n |}.
 Next Obligation.
   intros n. induction n; simpl; constructor.
   - rewrite elem_of_list_fmap. by intros (?&?&?).
@@ -351,4 +369,94 @@ Next Obligation.
     rewrite elem_of_cons, ?elem_of_list_fmap; eauto.
 Qed.
 Lemma fin_card n : card (fin n) = n.
-Proof. unfold card; simpl. induction n; simpl; rewrite ?fmap_length; auto. Qed.
+Proof. unfold card; simpl. induction n; simpl; rewrite ?length_fmap; auto. Qed.
+
+(* shouldn’t be an instance (cycle with [sig_finite]): *)
+Lemma finite_sig_dec `{!EqDecision A} (P : A → Prop) `{Finite (sig P)} x :
+  Decision (P x).
+Proof.
+  assert {xs : list A | ∀ x, P x ↔ x ∈ xs} as [xs ?].
+  { clear x. exists (proj1_sig <$> enum _). intros x. split; intros Hx.
+    - apply elem_of_list_fmap_1_alt with (x ↾ Hx); [apply elem_of_enum|]; done.
+    - apply elem_of_list_fmap in Hx as [[x' Hx'] [-> _]]; done. }
+  destruct (decide (x ∈ xs)); [left | right]; naive_solver.
+Qed. (* <- could be Defined but this lemma will probably not be used for computing *)
+
+Section sig_finite.
+  Context {A} (P : A → Prop) `{∀ x, Decision (P x)}.
+
+  Fixpoint list_filter_sig (l : list A) : list (sig P) :=
+    match l with
+    | [] => []
+    | x :: l => match decide (P x) with
+              | left H => x ↾ H :: list_filter_sig l
+              | _ => list_filter_sig l
+              end
+    end.
+  Lemma list_filter_sig_filter (l : list A) :
+    proj1_sig <$> list_filter_sig l = filter P l.
+  Proof.
+    induction l as [| a l IH]; [done |].
+    simpl; rewrite filter_cons.
+    destruct (decide _); csimpl; by rewrite IH.
+  Qed.
+
+  Context `{Finite A} `{∀ x, ProofIrrel (P x)}.
+
+  Global Program Instance sig_finite : Finite (sig P) :=
+    {| enum := list_filter_sig (enum A) |}.
+  Next Obligation.
+    eapply NoDup_fmap_1. rewrite list_filter_sig_filter.
+    apply NoDup_filter, NoDup_enum.
+  Qed.
+  Next Obligation.
+    intros p. apply (elem_of_list_fmap_2_inj proj1_sig).
+    rewrite list_filter_sig_filter, elem_of_list_filter.
+    split; [by destruct p | apply elem_of_enum].
+  Qed.
+  Lemma sig_card : card (sig P) = length (filter P (enum A)).
+  Proof. by rewrite <-list_filter_sig_filter, length_fmap. Qed.
+End sig_finite.
+
+Lemma finite_pigeonhole `{Finite A} `{Finite B} (f : A → B) :
+  card B < card A → ∃ x1 x2, x1 ≠ x2 ∧ f x1 = f x2.
+Proof.
+  intros. apply dec_stable; intros Heq.
+  cut (Inj eq eq f); [intros ?%inj_card; lia|].
+  intros x1 x2 ?. apply dec_stable. naive_solver.
+Qed.
+
+Lemma nat_pigeonhole (f : nat → nat) (n1 n2 : nat) :
+  n2 < n1 →
+  (∀ i, i < n1 → f i < n2) →
+  ∃ i1 i2, i1 < i2 < n1 ∧ f i1 = f i2.
+Proof.
+  intros Hn Hf. pose (f' (i : fin n1) := nat_to_fin (Hf _ (fin_to_nat_lt i))).
+  destruct (finite_pigeonhole f') as (i1&i2&Hi&Hf'); [by rewrite !fin_card|].
+  apply (not_inj (f:=fin_to_nat)) in Hi. apply (f_equal fin_to_nat) in Hf'.
+  unfold f' in Hf'. rewrite !fin_to_nat_to_fin in Hf'.
+  pose proof (fin_to_nat_lt i1); pose proof (fin_to_nat_lt i2).
+  destruct (decide (i1 < i2)); [exists i1, i2|exists i2, i1]; lia.
+Qed.
+
+Lemma list_pigeonhole {A} (l1 l2 : list A) :
+  l1 ⊆ l2 →
+  length l2 < length l1 →
+  ∃ i1 i2 x, i1 < i2 ∧ l1 !! i1 = Some x ∧ l1 !! i2 = Some x.
+Proof.
+  intros Hl Hlen.
+  assert (∀ i : fin (length l1), ∃ (j : fin (length l2)) x,
+    l1 !! (fin_to_nat i) = Some x ∧
+    l2 !! (fin_to_nat j) = Some x) as [f Hf]%fin_choice.
+  { intros i. destruct (lookup_lt_is_Some_2 l1 i)
+      as [x Hix]; [apply fin_to_nat_lt|].
+    assert (x ∈ l2) as [j Hjx]%elem_of_list_lookup_1
+      by (by eapply Hl, elem_of_list_lookup_2).
+    exists (nat_to_fin (lookup_lt_Some _ _ _ Hjx)), x.
+    by rewrite fin_to_nat_to_fin. }
+  destruct (finite_pigeonhole f) as (i1&i2&Hi&Hf'); [by rewrite !fin_card|].
+  destruct (Hf i1) as (x1&?&?), (Hf i2) as (x2&?&?).
+  assert (x1 = x2) as -> by congruence.
+  apply (not_inj (f:=fin_to_nat)) in Hi. apply (f_equal fin_to_nat) in Hf'.
+  destruct (decide (i1 < i2)); [exists i1, i2|exists i2, i1]; eauto with lia.
+Qed.

theories/functions.v → stdpp/functions.v

 From stdpp Require Export base tactics.
-Set Default Proof Using "Type".
+From stdpp Require Import options.
 
 Section definitions.
   Context {A T : Type} `{EqDecision A}.

stdpp/gmap.v

+(** This files implements an efficient implementation of finite maps whose keys
+range over Coq's data type of any countable type [K]. The data structure is
+similar to [Pmap], which in turn is based on the "canonical" binary tries
+representation by Appel and Leroy, https://hal.inria.fr/hal-03372247. It thus
+has the same good properties:
+
+- It guarantees logarithmic-time [lookup] and [partial_alter], and linear-time
+  [merge]. It has a low constant factor for computation in Coq compared to other
+  versions (see the Appel and Leroy paper for benchmarks).
+- It satisfies extensional equality [(∀ i, m1 !! i = m2 !! i) → m1 = m2].
+- It can be used in nested recursive definitions, e.g.,
+  [Inductive test := Test : gmap test → test]. This is possible because we do
+  _not_ use a Sigma type to ensure canonical representations (a Sigma type would
+  break Coq's strict positivity check).
+
+Compared to [Pmap], we not only need to make sure the trie representation is
+canonical, we also need to make sure that all positions (of type positive) are
+valid encodings of [K]. That is, for each position [q] in the trie, we have
+[encode <$> decode q = Some q].
+
+Instead of formalizing this condition using a Sigma type (which would break
+the strict positivity check in nested recursive definitions), we make
+[gmap_dep_ne A P] dependent on a predicate [P : positive → Prop] that describes
+the subset of valid positions, and instantiate it with [gmap_key K].
+
+The predicate [P : positive → Prop] is considered irrelevant by extraction, so
+after extraction, the resulting data structure is identical to [Pmap]. *)
+From stdpp Require Export countable infinite fin_maps fin_map_dom.
+From stdpp Require Import mapset pmap.
+From stdpp Require Import options.
+
+Local Open Scope positive_scope.
+
+Local Notation "P ~ 0" := (λ p, P p~0) : function_scope.
+Local Notation "P ~ 1" := (λ p, P p~1) : function_scope.
+Implicit Type P : positive → Prop.
+
+(** * The tree data structure *)
+Inductive gmap_dep_ne (A : Type) (P : positive → Prop) :=
+  | GNode001 : gmap_dep_ne A P~1  → gmap_dep_ne A P 
+  | GNode010 : P 1 → A → gmap_dep_ne A P
+  | GNode011 : P 1 → A → gmap_dep_ne A P~1 → gmap_dep_ne A P
+  | GNode100 : gmap_dep_ne A P~0 → gmap_dep_ne A P
+  | GNode101 : gmap_dep_ne A P~0 → gmap_dep_ne A P~1 → gmap_dep_ne A P
+  | GNode110 : gmap_dep_ne A P~0 → P 1 → A → gmap_dep_ne A P
+  | GNode111 : gmap_dep_ne A P~0 → P 1 → A → gmap_dep_ne A P~1 → gmap_dep_ne A P.
+Global Arguments GNode001 {A P} _ : assert.
+Global Arguments GNode010 {A P} _ _ : assert.
+Global Arguments GNode011 {A P} _ _ _ : assert.
+Global Arguments GNode100 {A P} _ : assert.
+Global Arguments GNode101 {A P} _ _ : assert.
+Global Arguments GNode110 {A P} _ _ _ : assert.
+Global Arguments GNode111 {A P} _ _ _ _ : assert.
+
+(** Using [Variant] we suppress the generation of the induction scheme. We use
+the induction scheme [gmap_ind] in terms of the smart constructors to reduce the
+number of cases, similar to Appel and Leroy. *)
+Variant gmap_dep (A : Type) (P : positive → Prop) :=
+  | GEmpty : gmap_dep A P
+  | GNodes : gmap_dep_ne A P → gmap_dep A P.
+Global Arguments GEmpty {A P}.
+Global Arguments GNodes {A P} _.
+
+Record gmap_key K `{Countable K} (q : positive) :=
+  GMapKey { _ : encode (A:=K) <$> decode q = Some q }.
+Add Printing Constructor gmap_key.
+Global Arguments GMapKey {_ _ _ _} _.
+
+Lemma gmap_key_encode `{Countable K} (k : K) : gmap_key K (encode k).
+Proof. constructor. by rewrite decode_encode. Qed.
+Global Instance gmap_key_pi `{Countable K} q : ProofIrrel (gmap_key K q).
+Proof. intros [?] [?]. f_equal. apply (proof_irrel _). Qed.
+
+Record gmap K `{Countable K} A := GMap { gmap_car : gmap_dep A (gmap_key K) }.
+Add Printing Constructor gmap.
+Global Arguments GMap {_ _ _ _} _.
+Global Arguments gmap_car {_ _ _ _} _.
+
+Global Instance gmap_dep_ne_eq_dec {A P} :
+  EqDecision A → (∀ i, ProofIrrel (P i)) → EqDecision (gmap_dep_ne A P).
+Proof.
+  intros ? Hirr t1 t2. revert P t1 t2 Hirr.
+  refine (fix go {P} (t1 t2 : gmap_dep_ne A P) {Hirr : _} : Decision (t1 = t2) :=
+    match t1, t2 with
+    | GNode001 r1, GNode001 r2 => cast_if (go r1 r2)
+    | GNode010 _ x1, GNode010 _ x2 => cast_if (decide (x1 = x2))
+    | GNode011 _ x1 r1, GNode011 _ x2 r2 =>
+       cast_if_and (decide (x1 = x2)) (go r1 r2)
+    | GNode100 l1, GNode100 l2 => cast_if (go l1 l2)
+    | GNode101 l1 r1, GNode101 l2 r2 => cast_if_and (go l1 l2) (go r1 r2)
+    | GNode110 l1 _ x1, GNode110 l2 _ x2 =>
+       cast_if_and (go l1 l2) (decide (x1 = x2))
+    | GNode111 l1 _ x1 r1, GNode111 l2 _ x2 r2 =>
+       cast_if_and3 (go l1 l2) (decide (x1 = x2)) (go r1 r2)
+    | _, _ => right _
+    end);
+    clear go; abstract first [congruence|f_equal; done || apply Hirr|idtac].
+Defined.
+Global Instance gmap_dep_eq_dec {A P} :
+  (∀ i, ProofIrrel (P i)) → EqDecision A → EqDecision (gmap_dep A P).
+Proof. intros. solve_decision. Defined.
+Global Instance gmap_eq_dec `{Countable K} {A} :
+  EqDecision A → EqDecision (gmap K A).
+Proof. intros. solve_decision. Defined.
+
+(** The smart constructor [GNode] and eliminator [gmap_dep_ne_case] are used to
+reduce the number of cases, similar to Appel and Leroy. *)
+Local Definition GNode {A P}
+    (ml : gmap_dep A P~0)
+    (mx : option (P 1 * A)) (mr : gmap_dep A P~1) : gmap_dep A P :=
+  match ml, mx, mr with
+  | GEmpty, None, GEmpty => GEmpty
+  | GEmpty, None, GNodes r => GNodes (GNode001 r)
+  | GEmpty, Some (p,x), GEmpty => GNodes (GNode010 p x)
+  | GEmpty, Some (p,x), GNodes r => GNodes (GNode011 p x r)
+  | GNodes l, None, GEmpty => GNodes (GNode100 l)
+  | GNodes l, None, GNodes r => GNodes (GNode101 l r)
+  | GNodes l, Some (p,x), GEmpty => GNodes (GNode110 l p x)
+  | GNodes l, Some (p,x), GNodes r => GNodes (GNode111 l p x r)
+  end.
+
+Local Definition gmap_dep_ne_case {A P B} (t : gmap_dep_ne A P)
+    (f : gmap_dep A P~0 → option (P 1 * A) → gmap_dep A P~1 → B) : B :=
+  match t with
+  | GNode001 r => f GEmpty None (GNodes r)
+  | GNode010 p x => f GEmpty (Some (p,x)) GEmpty
+  | GNode011 p x r => f GEmpty (Some (p,x)) (GNodes r)
+  | GNode100 l => f (GNodes l) None GEmpty
+  | GNode101 l r => f (GNodes l) None (GNodes r)
+  | GNode110 l p x => f (GNodes l) (Some (p,x)) GEmpty
+  | GNode111 l p x r => f (GNodes l) (Some (p,x)) (GNodes r)
+  end.
+
+(** Operations *)
+Local Definition gmap_dep_ne_lookup {A} : ∀ {P}, positive → gmap_dep_ne A P → option A :=
+  fix go {P} i t {struct t} :=
+  match t, i with
+  | (GNode010 _ x | GNode011 _ x _ | GNode110 _ _ x | GNode111 _ _ x _), 1 => Some x
+  | (GNode100 l | GNode110 l _ _ | GNode101 l _ | GNode111 l _ _ _), i~0 => go i l
+  | (GNode001 r | GNode011 _ _ r | GNode101 _ r | GNode111 _ _ _ r), i~1 => go i r
+  | _, _ => None
+  end.
+Local Definition gmap_dep_lookup {A P}
+    (i : positive) (mt : gmap_dep A P) : option A :=
+  match mt with GEmpty => None | GNodes t => gmap_dep_ne_lookup i t end.
+Global Instance gmap_lookup `{Countable K} {A} :
+    Lookup K A (gmap K A) := λ k mt,
+  gmap_dep_lookup (encode k) (gmap_car mt).
+
+Global Instance gmap_empty `{Countable K} {A} : Empty (gmap K A) := GMap GEmpty.
+
+(** Block reduction, even on concrete [gmap]s.
+Marking [gmap_empty] as [simpl never] would not be enough, because of
+https://github.com/coq/coq/issues/2972 and
+https://github.com/coq/coq/issues/2986.
+And marking [gmap] consumers as [simpl never] does not work either, see:
+https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/171#note_53216 *)
+Global Opaque gmap_empty.
+
+Local Fixpoint gmap_dep_ne_singleton {A P} (i : positive) :
+    P i → A → gmap_dep_ne A P :=
+  match i with
+  | 1 => GNode010
+  | i~0 => λ p x, GNode100 (gmap_dep_ne_singleton i p x)
+  | i~1 => λ p x, GNode001 (gmap_dep_ne_singleton i p x)
+  end.
+
+Local Definition gmap_partial_alter_aux {A P}
+    (go : ∀ i, P i → gmap_dep_ne A P → gmap_dep A P)
+    (f : option A → option A) (i : positive) (p : P i)
+    (mt : gmap_dep A P) : gmap_dep A P :=
+  match mt with
+  | GEmpty =>
+     match f None with
+     | None => GEmpty | Some x => GNodes (gmap_dep_ne_singleton i p x)
+     end
+  | GNodes t => go i p t
+  end.
+Local Definition gmap_dep_ne_partial_alter {A} (f : option A → option A) :
+    ∀ {P} (i : positive), P i → gmap_dep_ne A P → gmap_dep A P :=
+  Eval lazy -[gmap_dep_ne_singleton] in
+  fix go {P} i p t {struct t} :=
+    gmap_dep_ne_case t $ λ ml mx mr,
+      match i with
+      | 1 => λ p, GNode ml ((p,.) <$> f (snd <$> mx)) mr
+      | i~0 => λ p, GNode (gmap_partial_alter_aux go f i p ml) mx mr
+      | i~1 => λ p, GNode ml mx (gmap_partial_alter_aux go f i p mr)
+      end p.
+Local Definition gmap_dep_partial_alter {A P}
+    (f : option A → option A) : ∀ i : positive, P i → gmap_dep A P → gmap_dep A P :=
+  gmap_partial_alter_aux (gmap_dep_ne_partial_alter f) f.
+Global Instance gmap_partial_alter `{Countable K} {A} :
+    PartialAlter K A (gmap K A) := λ f k '(GMap mt),
+  GMap $ gmap_dep_partial_alter f (encode k) (gmap_key_encode k) mt.
+
+Local Definition gmap_dep_ne_fmap {A B} (f : A → B) :
+    ∀ {P}, gmap_dep_ne A P → gmap_dep_ne B P :=
+  fix go {P} t :=
+    match t with
+    | GNode001 r => GNode001 (go r)
+    | GNode010 p x => GNode010 p (f x)
+    | GNode011 p x r => GNode011 p (f x) (go r)
+    | GNode100 l => GNode100 (go l)
+    | GNode101 l r => GNode101 (go l) (go r)
+    | GNode110 l p x => GNode110 (go l) p (f x)
+    | GNode111 l p x r => GNode111 (go l) p (f x) (go r)
+    end.
+Local Definition gmap_dep_fmap {A B P} (f : A → B)
+    (mt : gmap_dep A P) : gmap_dep B P :=
+  match mt with GEmpty => GEmpty | GNodes t => GNodes (gmap_dep_ne_fmap f t) end.
+Global Instance gmap_fmap `{Countable K} : FMap (gmap K) := λ {A B} f '(GMap mt),
+  GMap $ gmap_dep_fmap f mt.
+
+Local Definition gmap_dep_omap_aux {A B P}
+    (go : gmap_dep_ne A P → gmap_dep B P) (tm : gmap_dep A P) : gmap_dep B P :=
+  match tm with GEmpty => GEmpty | GNodes t' => go t' end.
+Local Definition gmap_dep_ne_omap {A B} (f : A → option B) :
+    ∀ {P}, gmap_dep_ne A P → gmap_dep B P :=
+  fix go {P} t :=
+    gmap_dep_ne_case t $ λ ml mx mr,
+      GNode (gmap_dep_omap_aux go ml) ('(p,x) ← mx; (p,.) <$> f x)
+            (gmap_dep_omap_aux go mr).
+Local Definition gmap_dep_omap {A B P} (f : A → option B) :
+  gmap_dep A P → gmap_dep B P := gmap_dep_omap_aux (gmap_dep_ne_omap f).
+Global Instance gmap_omap `{Countable K} : OMap (gmap K) := λ {A B} f '(GMap mt),
+  GMap $ gmap_dep_omap f mt.
+
+Local Definition gmap_merge_aux {A B C P}
+    (go : gmap_dep_ne A P → gmap_dep_ne B P → gmap_dep C P)
+    (f : option A → option B → option C)
+    (mt1 : gmap_dep A P) (mt2 : gmap_dep B P) : gmap_dep C P :=
+  match mt1, mt2 with
+  | GEmpty, GEmpty => GEmpty
+  | GNodes t1', GEmpty => gmap_dep_ne_omap (λ x, f (Some x) None) t1'
+  | GEmpty, GNodes t2' => gmap_dep_ne_omap (λ x, f None (Some x)) t2'
+  | GNodes t1', GNodes t2' => go t1' t2'
+  end.
+
+Local Definition diag_None' {A B C} {P : Prop}
+    (f : option A → option B → option C)
+    (mx : option (P * A)) (my : option (P * B)) : option (P * C) :=
+  match mx, my with
+  | None, None => None
+  | Some (p,x), None => (p,.) <$> f (Some x) None
+  | None, Some (p,y) => (p,.) <$> f None (Some y)
+  | Some (p,x), Some (_,y) => (p,.) <$> f (Some x) (Some y)
+  end.
+
+Local Definition gmap_dep_ne_merge {A B C} (f : option A → option B → option C) :
+    ∀ {P}, gmap_dep_ne A P → gmap_dep_ne B P → gmap_dep C P :=
+  fix go {P} t1 t2 {struct t1} :=
+    gmap_dep_ne_case t1 $ λ ml1 mx1 mr1,
+      gmap_dep_ne_case t2 $ λ ml2 mx2 mr2,
+        GNode (gmap_merge_aux go f ml1 ml2) (diag_None' f mx1 mx2)
+              (gmap_merge_aux go f mr1 mr2).
+Local Definition gmap_dep_merge {A B C P} (f : option A → option B → option C) :
+    gmap_dep A P → gmap_dep B P → gmap_dep C P :=
+  gmap_merge_aux (gmap_dep_ne_merge f) f.
+Global Instance gmap_merge `{Countable K} : Merge (gmap K) :=
+  λ {A B C} f '(GMap mt1) '(GMap mt2), GMap $ gmap_dep_merge f mt1 mt2.
+
+Local Definition gmap_fold_aux {A B P}
+    (go : positive → B → gmap_dep_ne A P → B)
+    (i : positive) (y : B) (mt : gmap_dep A P) : B :=
+  match mt with GEmpty => y | GNodes t => go i y t end.
+Local Definition gmap_dep_ne_fold {A B} (f : positive → A → B → B) :
+    ∀ {P}, positive → B → gmap_dep_ne A P → B :=
+  fix go {P} i y t :=
+    gmap_dep_ne_case t $ λ ml mx mr,
+      gmap_fold_aux go i~1
+        (gmap_fold_aux go i~0
+          match mx with None => y | Some (p,x) => f (Pos.reverse i) x y end ml) mr.
+Local Definition gmap_dep_fold {A B P} (f : positive → A → B → B) :
+    positive → B → gmap_dep A P → B :=
+  gmap_fold_aux (gmap_dep_ne_fold f).
+Global Instance gmap_fold `{Countable K} {A} :
+    MapFold K A (gmap K A) := λ {B} f y '(GMap mt),
+  gmap_dep_fold (λ i x, match decode i with Some k => f k x | None => id end) 1 y mt.
+
+(** Proofs *)
+Local Definition GNode_valid {A P}
+    (ml : gmap_dep A P~0) (mx : option (P 1 * A)) (mr : gmap_dep A P~1) :=
+  match ml, mx, mr with GEmpty, None, GEmpty => False | _, _, _ => True end.
+Local Lemma gmap_dep_ind A (Q : ∀ P, gmap_dep A P → Prop) :
+  (∀ P, Q P GEmpty) →
+  (∀ P ml mx mr, GNode_valid ml mx mr → Q _ ml → Q _ mr → Q P (GNode ml mx mr)) →
+  ∀ P mt, Q P mt.
+Proof.
+  intros Hemp Hnode P [|t]; [done|]. induction t.
+  - by apply (Hnode _ GEmpty None (GNodes _)).
+  - by apply (Hnode _ GEmpty (Some (_,_)) GEmpty).
+  - by apply (Hnode _ GEmpty (Some (_,_)) (GNodes _)).
+  - by apply (Hnode _ (GNodes _) None GEmpty).
+  - by apply (Hnode _ (GNodes _) None (GNodes _)).
+  - by apply (Hnode _ (GNodes _) (Some (_,_)) GEmpty).
+  - by apply (Hnode _ (GNodes _) (Some (_,_)) (GNodes _)).
+Qed.
+
+Local Lemma gmap_dep_lookup_GNode {A P} (ml : gmap_dep A P~0) mr mx i :
+  gmap_dep_lookup i (GNode ml mx mr) =
+    match i with
+    | 1 => snd <$> mx | i~0 => gmap_dep_lookup i ml | i~1 => gmap_dep_lookup i mr
+    end.
+Proof. by destruct ml, mx as [[]|], mr, i. Qed.
+
+Local Lemma gmap_dep_ne_lookup_not_None {A P} (t : gmap_dep_ne A P) :
+  ∃ i, P i ∧ gmap_dep_ne_lookup i t ≠ None.
+Proof.
+  induction t; repeat select (∃ _, _) (fun H => destruct H);
+    try first [by eexists 1|by eexists _~0|by eexists _~1].
+Qed.
+Local Lemma gmap_dep_eq_empty {A P} (mt : gmap_dep A P) :
+  (∀ i, P i → gmap_dep_lookup i mt = None) → mt = GEmpty.
+Proof.
+  intros Hlookup. destruct mt as [|t]; [done|].
+  destruct (gmap_dep_ne_lookup_not_None t); naive_solver.
+Qed.
+Local Lemma gmap_dep_eq {A P} (mt1 mt2 : gmap_dep A P) :
+  (∀ i, ProofIrrel (P i)) →
+  (∀ i, P i → gmap_dep_lookup i mt1 = gmap_dep_lookup i mt2) → mt1 = mt2.
+Proof.
+  revert mt2. induction mt1 as [|P ml1 mx1 mr1 _ IHl IHr] using gmap_dep_ind;
+    intros mt2 ? Hlookup;
+    destruct mt2 as [|? ml2 mx2 mr2 _ _ _] using gmap_dep_ind.
+  - done.
+  - symmetry. apply gmap_dep_eq_empty. naive_solver.
+  - apply gmap_dep_eq_empty. naive_solver.
+  - f_equal.
+    + apply (IHl _ _). intros i. generalize (Hlookup (i~0)).
+      by rewrite !gmap_dep_lookup_GNode.
+    + generalize (Hlookup 1). rewrite !gmap_dep_lookup_GNode.
+      destruct mx1 as [[]|], mx2 as [[]|]; intros; simplify_eq/=;
+        repeat f_equal; try  apply proof_irrel; naive_solver.
+    + apply (IHr _ _). intros i. generalize (Hlookup (i~1)).
+      by rewrite !gmap_dep_lookup_GNode.
+Qed.
+
+Local Lemma gmap_dep_ne_lookup_singleton {A P} i (p : P i) (x : A) :
+  gmap_dep_ne_lookup i (gmap_dep_ne_singleton i p x) = Some x.
+Proof. revert P p. induction i; by simpl. Qed.
+Local Lemma gmap_dep_ne_lookup_singleton_ne {A P} i j (p : P i) (x : A) :
+  i ≠ j → gmap_dep_ne_lookup j (gmap_dep_ne_singleton i p x) = None.
+Proof. revert P j p. induction i; intros ? [?|?|]; naive_solver. Qed.
+
+Local Lemma gmap_dep_partial_alter_GNode {A P} (f : option A → option A)
+    i (p : P i) (ml : gmap_dep A P~0) mx mr :
+  GNode_valid ml mx mr →
+  gmap_dep_partial_alter f i p (GNode ml mx mr) =
+    match i with
+    | 1 => λ p, GNode ml ((p,.) <$> f (snd <$> mx)) mr
+    | i~0 => λ p, GNode (gmap_dep_partial_alter f i p ml) mx mr
+    | i~1 => λ p, GNode ml mx (gmap_dep_partial_alter f i p mr)
+    end p.
+Proof. by destruct ml, mx as [[]|], mr. Qed.
+Local Lemma gmap_dep_lookup_partial_alter {A P} (f : option A → option A)
+    (mt : gmap_dep A P) i (p : P i) :
+  gmap_dep_lookup i (gmap_dep_partial_alter f i p mt) = f (gmap_dep_lookup i mt).
+Proof.
+  revert i p. induction mt using gmap_dep_ind.
+  { intros i p; simpl. destruct (f None); simpl; [|done].
+    by rewrite gmap_dep_ne_lookup_singleton. }
+  intros [] ?;
+    rewrite gmap_dep_partial_alter_GNode, !gmap_dep_lookup_GNode by done;
+    done || by destruct (f _).
+Qed.
+Local Lemma gmap_dep_lookup_partial_alter_ne {A P} (f : option A → option A)
+    (mt : gmap_dep A P) i (p : P i) j :
+  i ≠ j →
+  gmap_dep_lookup j (gmap_dep_partial_alter f i p mt) = gmap_dep_lookup j mt.
+Proof.
+  revert i p j; induction mt using gmap_dep_ind.
+  { intros i p j ?; simpl. destruct (f None); simpl; [|done].
+    by rewrite gmap_dep_ne_lookup_singleton_ne. }
+  intros [] ? [] ?;
+    rewrite gmap_dep_partial_alter_GNode, !gmap_dep_lookup_GNode by done;
+    auto with lia.
+Qed.
+
+Local Lemma gmap_dep_lookup_fmap {A B P} (f : A → B) (mt : gmap_dep A P) i :
+  gmap_dep_lookup i (gmap_dep_fmap f mt) = f <$> gmap_dep_lookup i mt.
+Proof.
+  destruct mt as [|t]; simpl; [done|].
+  revert i. induction t; intros []; by simpl.
+Qed.
+
+Local Lemma gmap_dep_omap_GNode {A B P} (f : A → option B)
+    (ml : gmap_dep A P~0) mx mr :
+  GNode_valid ml mx mr →
+  gmap_dep_omap f (GNode ml mx mr) =
+    GNode (gmap_dep_omap f ml) ('(p,x) ← mx; (p,.) <$> f x) (gmap_dep_omap f mr).
+Proof. by destruct ml, mx as [[]|], mr. Qed.
+Local Lemma gmap_dep_lookup_omap {A B P} (f : A → option B) (mt : gmap_dep A P) i :
+  gmap_dep_lookup i (gmap_dep_omap f mt) = gmap_dep_lookup i mt ≫= f.
+Proof.
+  revert i. induction mt using gmap_dep_ind; [done|].
+  intros [];
+    rewrite gmap_dep_omap_GNode, !gmap_dep_lookup_GNode by done; [done..|].
+  destruct select (option _) as [[]|]; simpl; by try destruct (f _).
+Qed.
+
+Section gmap_merge.
+  Context {A B C} (f : option A → option B → option C).
+
+  Local Lemma gmap_dep_merge_GNode_GEmpty {P} (ml : gmap_dep A P~0) mx mr :
+    GNode_valid ml mx mr →
+    gmap_dep_merge f (GNode ml mx mr) GEmpty =
+      GNode (gmap_dep_omap (λ x, f (Some x) None) ml) (diag_None' f mx None)
+            (gmap_dep_omap (λ x, f (Some x) None) mr).
+  Proof. by destruct ml, mx as [[]|], mr. Qed.
+  Local Lemma gmap_dep_merge_GEmpty_GNode {P} (ml : gmap_dep B P~0) mx mr :
+    GNode_valid ml mx mr →
+    gmap_dep_merge f GEmpty (GNode ml mx mr) =
+      GNode (gmap_dep_omap (λ x, f None (Some x)) ml) (diag_None' f None mx)
+            (gmap_dep_omap (λ x, f None (Some x)) mr).
+  Proof. by destruct ml, mx as [[]|], mr. Qed.
+  Local Lemma gmap_dep_merge_GNode_GNode {P}
+      (ml1 : gmap_dep A P~0) ml2 mx1 mx2 mr1 mr2 :
+    GNode_valid ml1 mx1 mr1 → GNode_valid ml2 mx2 mr2 →
+    gmap_dep_merge f (GNode ml1 mx1 mr1) (GNode ml2 mx2 mr2) =
+      GNode (gmap_dep_merge f ml1 ml2) (diag_None' f mx1 mx2)
+            (gmap_dep_merge f mr1 mr2).
+  Proof. by destruct ml1, mx1 as [[]|], mr1, ml2, mx2 as [[]|], mr2. Qed.
+
+  Local Lemma gmap_dep_lookup_merge {P} (mt1 : gmap_dep A P) (mt2 : gmap_dep B P) i :
+    gmap_dep_lookup i (gmap_dep_merge f mt1 mt2) =
+      diag_None f (gmap_dep_lookup i mt1) (gmap_dep_lookup i mt2).
+  Proof.
+    revert mt2 i; induction mt1 using gmap_dep_ind; intros mt2 i.
+    { induction mt2 using gmap_dep_ind; [done|].
+      rewrite gmap_dep_merge_GEmpty_GNode, gmap_dep_lookup_GNode by done.
+      destruct i as [i|i|];
+        rewrite ?gmap_dep_lookup_omap, gmap_dep_lookup_GNode; simpl;
+        [by destruct (gmap_dep_lookup i _)..|].
+      destruct select (option _) as [[]|]; simpl; by try destruct (f _). }
+    destruct mt2 using gmap_dep_ind.
+    { rewrite gmap_dep_merge_GNode_GEmpty, gmap_dep_lookup_GNode by done.
+      destruct i as [i|i|];
+        rewrite ?gmap_dep_lookup_omap, gmap_dep_lookup_GNode; simpl;
+        [by destruct (gmap_dep_lookup i _)..|].
+      destruct select (option _) as [[]|]; simpl; by try destruct (f _). }
+    rewrite gmap_dep_merge_GNode_GNode by done.
+    destruct i; rewrite ?gmap_dep_lookup_GNode; [done..|].
+    repeat destruct select (option _) as [[]|]; simpl; by try destruct (f _).
+  Qed.
+End gmap_merge.
+
+Local Lemma gmap_dep_fold_GNode {A B} (f : positive → A → B → B)
+    {P} i y (ml : gmap_dep A P~0) mx mr :
+  gmap_dep_fold f i y (GNode ml mx mr) = gmap_dep_fold f i~1
+    (gmap_dep_fold f i~0
+      match mx with None => y | Some (_,x) => f (Pos.reverse i) x y end ml) mr.
+Proof. by destruct ml, mx as [[]|], mr. Qed.
+
+Local Lemma gmap_dep_fold_ind {A} {P} (Q : gmap_dep A P → Prop) :
+  Q GEmpty →
+  (∀ i p x mt,
+    gmap_dep_lookup i mt = None →
+    (∀ j A' B (f : positive → A' → B → B) (g : A → A') b x',
+      gmap_dep_fold f j b
+        (gmap_dep_partial_alter (λ _, Some x') i p (gmap_dep_fmap g mt))
+      = f (Pos.reverse_go i j) x' (gmap_dep_fold f j b (gmap_dep_fmap g mt))) →
+    Q mt → Q (gmap_dep_partial_alter (λ _, Some x) i p mt)) →
+  ∀ mt, Q mt.
+Proof.
+  intros Hemp Hinsert mt. revert Q Hemp Hinsert.
+  induction mt as [|P ml mx mr ? IHl IHr] using gmap_dep_ind;
+    intros Q Hemp Hinsert; [done|].
+  apply (IHr (λ mt, Q (GNode ml mx mt))).
+  { apply (IHl (λ mt, Q (GNode mt mx GEmpty))).
+    { destruct mx as [[p x]|]; [|done].
+      replace (GNode GEmpty (Some (p,x)) GEmpty) with
+        (gmap_dep_partial_alter (λ _, Some x) 1 p GEmpty) by done.
+      by apply Hinsert. }
+    intros i p x mt r ? Hfold.
+    replace (GNode (gmap_dep_partial_alter (λ _, Some x) i p mt) mx GEmpty)
+      with (gmap_dep_partial_alter (λ _, Some x) (i~0) p (GNode mt mx GEmpty))
+      by (by destruct mt, mx as [[]|]).
+    apply Hinsert.
+    - by rewrite gmap_dep_lookup_GNode.
+    - intros j A' B f g b x'.
+      replace (gmap_dep_partial_alter (λ _, Some x') (i~0) p
+          (gmap_dep_fmap g (GNode mt mx GEmpty)))
+        with (GNode (gmap_dep_partial_alter (λ _, Some x') i p (gmap_dep_fmap g mt))
+          (prod_map id g <$> mx) GEmpty)
+        by (by destruct mt, mx as [[]|]).
+      replace (gmap_dep_fmap g (GNode mt mx GEmpty))
+        with (GNode (gmap_dep_fmap g mt) (prod_map id g <$> mx) GEmpty)
+        by (by destruct mt, mx as [[]|]).
+      rewrite !gmap_dep_fold_GNode; simpl; auto.
+    - done. }
+  intros i p x mt r ? Hfold.
+  replace (GNode ml mx (gmap_dep_partial_alter (λ _, Some x) i p mt))
+    with (gmap_dep_partial_alter (λ _, Some x) (i~1) p (GNode ml mx mt))
+    by (by destruct ml, mx as [[]|], mt).
+  apply Hinsert.
+  - by rewrite gmap_dep_lookup_GNode.
+  - intros j A' B f g b x'.
+    replace (gmap_dep_partial_alter (λ _, Some x') (i~1) p
+        (gmap_dep_fmap g (GNode ml mx mt)))
+      with (GNode (gmap_dep_fmap g ml) (prod_map id g <$> mx)
+        (gmap_dep_partial_alter (λ _, Some x') i p (gmap_dep_fmap g mt)))
+      by (by destruct ml, mx as [[]|], mt).
+    replace (gmap_dep_fmap g (GNode ml mx mt))
+      with (GNode (gmap_dep_fmap g ml) (prod_map id g <$> mx) (gmap_dep_fmap g mt))
+      by (by destruct ml, mx as [[]|], mt).
+    rewrite !gmap_dep_fold_GNode; simpl; auto.
+  - done.
+Qed.
+
+(** Instance of the finite map type class *)
+Global Instance gmap_finmap `{Countable K} : FinMap K (gmap K).
+Proof.
+  split.
+  - intros A [mt1] [mt2] Hlookup. f_equal. apply (gmap_dep_eq _ _ _).
+    intros i [Hk]. destruct (decode i) as [k|]; simplify_eq/=. apply Hlookup.
+  - done.
+  - intros A f [mt] i. apply gmap_dep_lookup_partial_alter.
+  - intros A f [mt] i j ?. apply gmap_dep_lookup_partial_alter_ne. naive_solver.
+  - intros A b f [mt] i. apply gmap_dep_lookup_fmap.
+  - intros A B f [mt] i. apply gmap_dep_lookup_omap.
+  - intros A B C f [mt1] [mt2] i. apply gmap_dep_lookup_merge.
+  - done.
+  - intros A P Hemp Hins [mt].
+    apply (gmap_dep_fold_ind (λ mt, P (GMap mt))); clear mt; [done|].
+    intros i [Hk] x mt ? Hfold. destruct (fmap_Some_1 _ _ _ Hk) as (k&Hk'&->).
+    assert (GMapKey Hk = gmap_key_encode k) as Hkk by (apply proof_irrel).
+    rewrite Hkk in Hfold |- *. clear Hk Hkk.
+    apply (Hins k x (GMap mt)); [done|]. intros A' B f g b x'.
+    trans ((match decode (encode k) with Some k => f k x' | None => id end)
+      (map_fold f b (g <$> GMap mt))); [apply (Hfold 1)|].
+    by rewrite Hk'.
+Qed.
+
+Global Program Instance gmap_countable
+    `{Countable K, Countable A} : Countable (gmap K A) := {
+  encode m := encode (map_to_list m : list (K * A));
+  decode p := list_to_map <$> decode p
+}.
+Next Obligation.
+  intros K ?? A ?? m; simpl. rewrite decode_encode; simpl.
+  by rewrite list_to_map_to_list.
+Qed.
+
+(** Conversion to/from [Pmap] *)
+Local Definition gmap_dep_ne_to_pmap_ne {A} : ∀ {P}, gmap_dep_ne A P → Pmap_ne A :=
+  fix go {P} t :=
+    match t with
+    | GNode001 r => PNode001 (go r)
+    | GNode010 _ x => PNode010 x
+    | GNode011 _ x r => PNode011 x (go r)
+    | GNode100 l => PNode100 (go l)
+    | GNode101 l r => PNode101 (go l) (go r)
+    | GNode110 l _ x => PNode110 (go l) x
+    | GNode111 l _ x r => PNode111 (go l) x (go r)
+    end.
+Local Definition gmap_dep_to_pmap {A P} (mt : gmap_dep A P) : Pmap A :=
+  match mt with
+  | GEmpty => PEmpty
+  | GNodes t => PNodes (gmap_dep_ne_to_pmap_ne t)
+  end.
+Definition gmap_to_pmap {A} (m : gmap positive A) : Pmap A :=
+  let '(GMap mt) := m in gmap_dep_to_pmap mt.
+
+Local Lemma lookup_gmap_dep_ne_to_pmap_ne {A P} (t : gmap_dep_ne A P) i :
+  gmap_dep_ne_to_pmap_ne t !! i = gmap_dep_ne_lookup i t.
+Proof. revert i; induction t; intros []; by simpl. Qed.
+Lemma lookup_gmap_to_pmap {A} (m : gmap positive A) i :
+  gmap_to_pmap m !! i = m !! i.
+Proof. destruct m as [[|t]]; [done|]. apply lookup_gmap_dep_ne_to_pmap_ne. Qed.
+
+Local Definition pmap_ne_to_gmap_dep_ne {A} :
+    ∀ {P}, (∀ i, P i) → Pmap_ne A → gmap_dep_ne A P :=
+  fix go {P} (p : ∀ i, P i) t :=
+    match t with
+    | PNode001 r => GNode001 (go p~1 r)
+    | PNode010 x => GNode010 (p 1) x
+    | PNode011 x r => GNode011 (p 1) x (go p~1 r)
+    | PNode100 l => GNode100 (go p~0 l)
+    | PNode101 l r => GNode101 (go p~0 l) (go p~1 r)
+    | PNode110 l x => GNode110 (go p~0 l) (p 1) x
+    | PNode111 l x r => GNode111 (go p~0 l) (p 1) x (go p~1 r)
+    end%function.
+Local Definition pmap_to_gmap_dep {A P}
+    (p : ∀ i, P i) (mt : Pmap A) : gmap_dep A P :=
+  match mt with
+  | PEmpty => GEmpty
+  | PNodes t => GNodes (pmap_ne_to_gmap_dep_ne p t)
+  end.
+Definition pmap_to_gmap {A} (m : Pmap A) : gmap positive A :=
+  GMap $ pmap_to_gmap_dep gmap_key_encode m.
+
+Local Lemma lookup_pmap_ne_to_gmap_dep_ne {A P} (p : ∀ i, P i) (t : Pmap_ne A) i :
+  gmap_dep_ne_lookup i (pmap_ne_to_gmap_dep_ne p t) = t !! i.
+Proof. revert P i p; induction t; intros ? [] ?; by simpl. Qed.
+Lemma lookup_pmap_to_gmap {A} (m : Pmap A) i : pmap_to_gmap m !! i = m !! i.
+Proof. destruct m as [|t]; [done|]. apply lookup_pmap_ne_to_gmap_dep_ne. Qed.
+
+(** * Curry and uncurry *)
+Definition gmap_uncurry `{Countable K1, Countable K2} {A} :
+    gmap K1 (gmap K2 A) → gmap (K1 * K2) A :=
+  map_fold (λ i1 m' macc,
+    map_fold (λ i2 x, <[(i1,i2):=x]>) macc m') ∅.
+Definition gmap_curry `{Countable K1, Countable K2} {A} :
+    gmap (K1 * K2) A → gmap K1 (gmap K2 A) :=
+  map_fold (λ '(i1, i2) x,
+    partial_alter (Some ∘ <[i2:=x]> ∘ default ∅) i1) ∅.
+
+Section curry_uncurry.
+  Context `{Countable K1, Countable K2} {A : Type}.
+
+  Lemma lookup_gmap_uncurry (m : gmap K1 (gmap K2 A)) i j :
+    gmap_uncurry m !! (i,j) = m !! i ≫= (.!! j).
+  Proof.
+    apply (map_fold_weak_ind (λ mr m, mr !! (i,j) = m !! i ≫= (.!! j))).
+    { by rewrite !lookup_empty. }
+    clear m; intros i' m2 m m12 Hi' IH.
+    apply (map_fold_weak_ind (λ m2r m2, m2r !! (i,j) = <[i':=m2]> m !! i ≫= (.!! j))).
+    { rewrite IH. destruct (decide (i' = i)) as [->|].
+      - rewrite lookup_insert, Hi'; simpl; by rewrite lookup_empty.
+      - by rewrite lookup_insert_ne by done. }
+    intros j' y m2' m12' Hj' IH'. destruct (decide (i = i')) as [->|].
+    - rewrite lookup_insert; simpl. destruct (decide (j = j')) as [->|].
+      + by rewrite !lookup_insert.
+      + by rewrite !lookup_insert_ne, IH', lookup_insert by congruence.
+    - by rewrite !lookup_insert_ne, IH', lookup_insert_ne by congruence.
+  Qed.
+
+  Lemma lookup_gmap_curry (m : gmap (K1 * K2) A) i j :
+    gmap_curry m !! i ≫= (.!! j) = m !! (i, j).
+  Proof.
+    apply (map_fold_weak_ind (λ mr m, mr !! i ≫= (.!! j) = m !! (i, j))).
+    { by rewrite !lookup_empty. }
+    clear m; intros [i' j'] x m12 mr Hij' IH.
+    destruct (decide (i = i')) as [->|].
+    - rewrite lookup_partial_alter. destruct (decide (j = j')) as [->|].
+      + destruct (mr !! i'); simpl; by rewrite !lookup_insert.
+      + destruct (mr !! i'); simpl; by rewrite !lookup_insert_ne by congruence.
+    - by rewrite lookup_partial_alter_ne, lookup_insert_ne by congruence.
+  Qed.
+
+  Lemma lookup_gmap_curry_None (m : gmap (K1 * K2) A) i :
+    gmap_curry m !! i = None ↔ (∀ j, m !! (i, j) = None).
+  Proof.
+    apply (map_fold_weak_ind
+      (λ mr m, mr !! i = None ↔ (∀ j, m !! (i, j) = None))); [done|].
+    clear m; intros [i' j'] x m12 mr Hij' IH.
+    destruct (decide (i = i')) as [->|].
+    - split; [by rewrite lookup_partial_alter|].
+      intros Hi. specialize (Hi j'). by rewrite lookup_insert in Hi.
+    - rewrite lookup_partial_alter_ne, IH; [|done]. apply forall_proper.
+      intros j. rewrite lookup_insert_ne; [done|congruence].
+  Qed.
+
+  Lemma gmap_uncurry_curry (m : gmap (K1 * K2) A) :
+    gmap_uncurry (gmap_curry m) = m.
+  Proof.
+   apply map_eq; intros [i j]. by rewrite lookup_gmap_uncurry, lookup_gmap_curry.
+  Qed.
+
+  Lemma gmap_curry_non_empty (m : gmap (K1 * K2) A) i x :
+    gmap_curry m !! i = Some x → x ≠ ∅.
+  Proof.
+    intros Hm ->. eapply eq_None_not_Some; [|by eexists].
+    eapply lookup_gmap_curry_None; intros j.
+    by rewrite <-lookup_gmap_curry, Hm.
+  Qed.
+
+  Lemma gmap_curry_uncurry_non_empty (m : gmap K1 (gmap K2 A)) :
+    (∀ i x, m !! i = Some x → x ≠ ∅) →
+    gmap_curry (gmap_uncurry m) = m.
+  Proof.
+    intros Hne. apply map_eq; intros i. destruct (m !! i) as [m2|] eqn:Hm.
+    - destruct (gmap_curry (gmap_uncurry m) !! i) as [m2'|] eqn:Hcurry.
+      + f_equal. apply map_eq. intros j.
+        trans (gmap_curry (gmap_uncurry m) !! i ≫= (.!! j)).
+        { by rewrite Hcurry. }
+        by rewrite lookup_gmap_curry, lookup_gmap_uncurry, Hm.
+      + rewrite lookup_gmap_curry_None in Hcurry.
+        exfalso; apply (Hne i m2), map_eq; [done|intros j].
+        by rewrite lookup_empty, <-(Hcurry j), lookup_gmap_uncurry, Hm.
+   - apply lookup_gmap_curry_None; intros j. by rewrite lookup_gmap_uncurry, Hm.
+  Qed.
+End curry_uncurry.
+
+(** * Finite sets *)
+Definition gset K `{Countable K} := mapset (gmap K).
+
+Section gset.
+  Context `{Countable K}.
+  (* Lift instances of operational TCs from [mapset] and mark them [simpl never]. *)
+  Global Instance gset_elem_of: ElemOf K (gset K) := _.
+  Global Instance gset_empty : Empty (gset K) := _.
+  Global Instance gset_singleton : Singleton K (gset K) := _.
+  Global Instance gset_union: Union (gset K) := _.
+  Global Instance gset_intersection: Intersection (gset K) := _.
+  Global Instance gset_difference: Difference (gset K) := _.
+  Global Instance gset_elements: Elements K (gset K) := _.
+  Global Instance gset_eq_dec : EqDecision (gset K) := _.
+  Global Instance gset_countable : Countable (gset K) := _.
+  Global Instance gset_equiv_dec : RelDecision (≡@{gset K}) | 1 := _.
+  Global Instance gset_elem_of_dec : RelDecision (∈@{gset K}) | 1 := _.
+  Global Instance gset_disjoint_dec : RelDecision (##@{gset K}) := _.
+  Global Instance gset_subseteq_dec : RelDecision (⊆@{gset K}) := _.
+
+  (** We put in an eta expansion to avoid [injection] from unfolding equalities
+  like [dom (gset _) m1 = dom (gset _) m2]. *)
+  Global Instance gset_dom {A} : Dom (gmap K A) (gset K) := λ m,
+    let '(GMap mt) := m in mapset_dom (GMap mt).
+
+  Global Arguments gset_elem_of : simpl never.
+  Global Arguments gset_empty : simpl never.
+  Global Arguments gset_singleton : simpl never.
+  Global Arguments gset_union : simpl never.
+  Global Arguments gset_intersection : simpl never.
+  Global Arguments gset_difference : simpl never.
+  Global Arguments gset_elements : simpl never.
+  Global Arguments gset_eq_dec : simpl never.
+  Global Arguments gset_countable : simpl never.
+  Global Arguments gset_equiv_dec : simpl never.
+  Global Arguments gset_elem_of_dec : simpl never.
+  Global Arguments gset_disjoint_dec : simpl never.
+  Global Arguments gset_subseteq_dec : simpl never.
+  Global Arguments gset_dom : simpl never.
+
+  (* Lift instances of other TCs. *)
+  Global Instance gset_leibniz : LeibnizEquiv (gset K) := _.
+  Global Instance gset_semi_set : SemiSet K (gset K) | 1 := _.
+  Global Instance gset_set : Set_ K (gset K) | 1 := _.
+  Global Instance gset_fin_set : FinSet K (gset K) := _.
+  Global Instance gset_dom_spec : FinMapDom K (gmap K) (gset K).
+  Proof.
+    pose proof (mapset_dom_spec (M:=gmap K)) as [?? Hdom]; split; auto.
+    intros A m. specialize (Hdom A m). by destruct m.
+  Qed.
+
+  (** If you are looking for a lemma showing that [gset] is extensional, see
+  [sets.set_eq]. *)
+
+  (** The function [gset_to_gmap x X] converts a set [X] to a map with domain
+  [X] where each key has value [x]. Compared to the generic conversion
+  [set_to_map], the function [gset_to_gmap] has [O(n)] instead of [O(n log n)]
+  complexity and has an easier and better developed theory. *)
+
+  Definition gset_to_gmap {A} (x : A) (X : gset K) : gmap K A :=
+    (λ _, x) <$> mapset_car X.
+
+  Lemma lookup_gset_to_gmap {A} (x : A) (X : gset K) i :
+    gset_to_gmap x X !! i = (guard (i ∈ X);; Some x).
+  Proof.
+    destruct X as [X].
+    unfold gset_to_gmap, gset_elem_of, elem_of, mapset_elem_of; simpl.
+    rewrite lookup_fmap.
+    case_guard; destruct (X !! i) as [[]|]; naive_solver.
+  Qed.
+  Lemma lookup_gset_to_gmap_Some {A} (x : A) (X : gset K) i y :
+    gset_to_gmap x X !! i = Some y ↔ i ∈ X ∧ x = y.
+  Proof. rewrite lookup_gset_to_gmap. simplify_option_eq; naive_solver. Qed.
+  Lemma lookup_gset_to_gmap_None {A} (x : A) (X : gset K) i :
+    gset_to_gmap x X !! i = None ↔ i ∉ X.
+  Proof. rewrite lookup_gset_to_gmap. simplify_option_eq; naive_solver. Qed.
+
+  Lemma gset_to_gmap_empty {A} (x : A) : gset_to_gmap x ∅ = ∅.
+  Proof. apply fmap_empty. Qed.
+  Lemma gset_to_gmap_union_singleton {A} (x : A) i Y :
+    gset_to_gmap x ({[ i ]} ∪ Y) = <[i:=x]>(gset_to_gmap x Y).
+  Proof.
+    apply map_eq; intros j; apply option_eq; intros y.
+    rewrite lookup_insert_Some, !lookup_gset_to_gmap_Some, elem_of_union,
+      elem_of_singleton; destruct (decide (i = j)); intuition.
+  Qed.
+  Lemma gset_to_gmap_singleton {A} (x : A) i :
+    gset_to_gmap x {[ i ]} = {[i:=x]}.
+  Proof.
+    rewrite <-(right_id_L ∅ (∪) {[ i ]}), gset_to_gmap_union_singleton.
+    by rewrite gset_to_gmap_empty.
+  Qed.
+  Lemma gset_to_gmap_difference_singleton {A} (x : A) i Y :
+    gset_to_gmap x (Y ∖ {[i]}) = delete i (gset_to_gmap x Y).
+  Proof.
+    apply map_eq; intros j; apply option_eq; intros y.
+    rewrite lookup_delete_Some, !lookup_gset_to_gmap_Some, elem_of_difference,
+      elem_of_singleton; destruct (decide (i = j)); intuition.
+  Qed.
+
+  Lemma fmap_gset_to_gmap {A B} (f : A → B) (X : gset K) (x : A) :
+    f <$> gset_to_gmap x X = gset_to_gmap (f x) X.
+  Proof.
+    apply map_eq; intros j. rewrite lookup_fmap, !lookup_gset_to_gmap.
+    by simplify_option_eq.
+  Qed.
+  Lemma gset_to_gmap_dom {A B} (m : gmap K A) (y : B) :
+    gset_to_gmap y (dom m) = const y <$> m.
+  Proof.
+    apply map_eq; intros j. rewrite lookup_fmap, lookup_gset_to_gmap.
+    destruct (m !! j) as [x|] eqn:?.
+    - by rewrite option_guard_True by (rewrite elem_of_dom; eauto).
+    - by rewrite option_guard_False by (rewrite not_elem_of_dom; eauto).
+  Qed.
+  Lemma dom_gset_to_gmap {A} (X : gset K) (x : A) :
+    dom (gset_to_gmap x X) = X.
+  Proof.
+    induction X as [| y X not_in IH] using set_ind_L.
+    - rewrite gset_to_gmap_empty, dom_empty_L; done.
+    - rewrite gset_to_gmap_union_singleton, dom_insert_L, IH; done.
+  Qed.
+
+  Lemma gset_to_gmap_set_to_map {A} (X : gset K) (x : A) :
+    gset_to_gmap x X = set_to_map (.,x) X.
+  Proof.
+    apply map_eq; intros k. apply option_eq; intros y.
+    rewrite lookup_gset_to_gmap_Some, lookup_set_to_map; naive_solver.
+  Qed.
+
+  Lemma map_to_list_gset_to_gmap {A} (X : gset K) (x : A) :
+    map_to_list (gset_to_gmap x X) ≡ₚ (., x) <$> elements X.
+  Proof.
+    induction X as [| y X not_in IH] using set_ind_L.
+    - rewrite gset_to_gmap_empty, elements_empty, map_to_list_empty. done.
+    - rewrite gset_to_gmap_union_singleton, elements_union_singleton by done.
+      rewrite map_to_list_insert.
+      2:{ rewrite lookup_gset_to_gmap_None. done. }
+      rewrite IH. done.
+  Qed.
+End gset.
+
+Section gset_cprod.
+  Context `{Countable A, Countable B}.
+
+  Global Instance gset_cprod : CProd (gset A) (gset B) (gset (A * B)) :=
+    λ X Y, set_bind (λ e1, set_map (e1,.) Y) X.
+
+  Lemma elem_of_gset_cprod (X : gset A) (Y : gset B) x :
+    x ∈ cprod X Y ↔ x.1 ∈ X ∧ x.2 ∈ Y.
+  Proof. unfold cprod, gset_cprod. destruct x. set_solver. Qed.
+
+  Global Instance set_unfold_gset_cprod (X : gset A) (Y : gset B) x (P : Prop) Q :
+    SetUnfoldElemOf x.1 X P → SetUnfoldElemOf x.2 Y Q →
+    SetUnfoldElemOf x (cprod X Y) (P ∧ Q).
+  Proof using.
+    intros ??; constructor.
+    by rewrite elem_of_gset_cprod, (set_unfold_elem_of x.1 X P),
+      (set_unfold_elem_of x.2 Y Q).
+  Qed.
+
+End gset_cprod.
+
+Global Typeclasses Opaque gset.

stdpp/gmultiset.v

+From stdpp Require Export countable.
+From stdpp Require Import gmap.
+From stdpp Require ssreflect. (* don't import yet, but we'll later do that to use ssreflect rewrite *)
+From stdpp Require Import options.
+
+(** Multisets [gmultiset A] are represented as maps from [A] to natural numbers,
+which represent the multiplicity. To ensure we have canonical representations,
+the multiplicity is a [positive]. Therefore, [gmultiset_car !! x = None] means
+[x] has multiplicity [0] and [gmultiset_car !! x = Some 1] means [x] has
+multiplicity 1. *)
+
+Record gmultiset A `{Countable A} := GMultiSet { gmultiset_car : gmap A positive }.
+Global Arguments GMultiSet {_ _ _} _ : assert.
+Global Arguments gmultiset_car {_ _ _} _ : assert.
+
+Global Instance gmultiset_eq_dec `{Countable A} : EqDecision (gmultiset A).
+Proof. solve_decision. Defined.
+
+Global Program Instance gmultiset_countable `{Countable A} :
+    Countable (gmultiset A) := {|
+  encode X := encode (gmultiset_car X); decode p := GMultiSet <$> decode p
+|}.
+Next Obligation. intros A ?? [X]; simpl. by rewrite decode_encode. Qed.
+
+Section definitions.
+  Context `{Countable A}.
+
+  Definition multiplicity (x : A) (X : gmultiset A) : nat :=
+    match gmultiset_car X !! x with Some n => Pos.to_nat n | None => 0 end.
+  Global Instance gmultiset_elem_of : ElemOf A (gmultiset A) := λ x X,
+    0 < multiplicity x X.
+  Global Instance gmultiset_subseteq : SubsetEq (gmultiset A) := λ X Y, ∀ x,
+    multiplicity x X ≤ multiplicity x Y.
+  Global Instance gmultiset_equiv : Equiv (gmultiset A) := λ X Y, ∀ x,
+    multiplicity x X = multiplicity x Y.
+
+  Global Instance gmultiset_elements : Elements A (gmultiset A) := λ X,
+    let (X) := X in '(x,n) ← map_to_list X; replicate (Pos.to_nat n) x.
+  Global Instance gmultiset_size : Size (gmultiset A) := length ∘ elements.
+
+  Global Instance gmultiset_empty : Empty (gmultiset A) := GMultiSet ∅.
+  Global Instance gmultiset_singleton : SingletonMS A (gmultiset A) := λ x,
+    GMultiSet {[ x := 1%positive ]}.
+  Global Instance gmultiset_union : Union (gmultiset A) := λ X Y,
+    let (X) := X in let (Y) := Y in
+    GMultiSet $ union_with (λ x y, Some (x `max` y)%positive) X Y.
+  Global Instance gmultiset_intersection : Intersection (gmultiset A) := λ X Y,
+    let (X) := X in let (Y) := Y in
+    GMultiSet $ intersection_with (λ x y, Some (x `min` y)%positive) X Y.
+  (** Often called the "sum" *)
+  Global Instance gmultiset_disj_union : DisjUnion (gmultiset A) := λ X Y,
+    let (X) := X in let (Y) := Y in
+    GMultiSet $ union_with (λ x y, Some (x + y)%positive) X Y.
+  Global Instance gmultiset_difference : Difference (gmultiset A) := λ X Y,
+    let (X) := X in let (Y) := Y in
+    GMultiSet $ difference_with (λ x y,
+      guard (y < x)%positive;; Some (x - y)%positive) X Y.
+  Global Instance gmultiset_scalar_mul : ScalarMul nat (gmultiset A) := λ n X,
+    let (X) := X in GMultiSet $
+      match n with 0 => ∅ | _ => fmap (λ m, m * Pos.of_nat n)%positive X end.
+
+  Global Instance gmultiset_dom : Dom (gmultiset A) (gset A) := λ X,
+    let (X) := X in dom X.
+
+  Definition gmultiset_map `{Countable B} (f : A → B)
+      (X : gmultiset A) : gmultiset B :=
+    GMultiSet $ map_fold
+      (λ x n, partial_alter (Some ∘ from_option (Pos.add n) n) (f x))
+      ∅
+      (gmultiset_car X).
+End definitions.
+
+Global Typeclasses Opaque gmultiset_elem_of gmultiset_subseteq.
+Global Typeclasses Opaque gmultiset_elements gmultiset_size gmultiset_empty.
+Global Typeclasses Opaque gmultiset_singleton gmultiset_union gmultiset_difference.
+Global Typeclasses Opaque gmultiset_scalar_mul gmultiset_dom gmultiset_map.
+
+Section basic_lemmas.
+  Context `{Countable A}.
+  Implicit Types x y : A.
+  Implicit Types X Y : gmultiset A.
+
+  Lemma gmultiset_eq X Y : X = Y ↔ ∀ x, multiplicity x X = multiplicity x Y.
+  Proof.
+    split; [by intros ->|intros HXY].
+    destruct X as [X], Y as [Y]; f_equal; apply map_eq; intros x.
+    specialize (HXY x); unfold multiplicity in *; simpl in *.
+    repeat case_match; naive_solver lia.
+  Qed.
+  Global Instance gmultiset_leibniz : LeibnizEquiv (gmultiset A).
+  Proof. intros X Y. by rewrite gmultiset_eq. Qed.
+  Global Instance gmultiset_equiv_equivalence : Equivalence (≡@{gmultiset A}).
+  Proof. constructor; repeat intro; naive_solver. Qed.
+
+  (* Multiplicity *)
+  Lemma multiplicity_empty x : multiplicity x ∅ = 0.
+  Proof. done. Qed.
+  Lemma multiplicity_singleton x : multiplicity x {[+ x +]} = 1.
+  Proof. unfold multiplicity; simpl. by rewrite lookup_singleton. Qed.
+  Lemma multiplicity_singleton_ne x y : x ≠ y → multiplicity x {[+ y +]} = 0.
+  Proof. intros. unfold multiplicity; simpl. by rewrite lookup_singleton_ne. Qed.
+  Lemma multiplicity_singleton' x y :
+    multiplicity x {[+ y +]} = if decide (x = y) then 1 else 0.
+  Proof.
+    destruct (decide _) as [->|].
+    - by rewrite multiplicity_singleton.
+    - by rewrite multiplicity_singleton_ne.
+  Qed.
+  Lemma multiplicity_union X Y x :
+    multiplicity x (X ∪ Y) = multiplicity x X `max` multiplicity x Y.
+  Proof.
+    destruct X as [X], Y as [Y]; unfold multiplicity; simpl.
+    rewrite lookup_union_with. destruct (X !! _), (Y !! _); simpl; lia.
+  Qed.
+  Lemma multiplicity_intersection X Y x :
+    multiplicity x (X ∩ Y) = multiplicity x X `min` multiplicity x Y.
+  Proof.
+    destruct X as [X], Y as [Y]; unfold multiplicity; simpl.
+    rewrite lookup_intersection_with. destruct (X !! _), (Y !! _); simpl; lia.
+  Qed.
+  Lemma multiplicity_disj_union X Y x :
+    multiplicity x (X ⊎ Y) = multiplicity x X + multiplicity x Y.
+  Proof.
+    destruct X as [X], Y as [Y]; unfold multiplicity; simpl.
+    rewrite lookup_union_with. destruct (X !! _), (Y !! _); simpl; lia.
+  Qed.
+  Lemma multiplicity_difference X Y x :
+    multiplicity x (X ∖ Y) = multiplicity x X - multiplicity x Y.
+  Proof.
+    destruct X as [X], Y as [Y]; unfold multiplicity; simpl.
+    rewrite lookup_difference_with.
+    destruct (X !! _), (Y !! _); simplify_option_eq; lia.
+  Qed.
+  Lemma multiplicity_scalar_mul n X x :
+    multiplicity x (n *: X) = n * multiplicity x X.
+  Proof.
+    destruct X as [X]; unfold multiplicity; simpl. destruct n as [|n]; [done|].
+    rewrite lookup_fmap. destruct (X !! _); simpl; lia.
+  Qed.
+
+  (* Set *)
+  Lemma elem_of_multiplicity x X : x ∈ X ↔ 0 < multiplicity x X.
+  Proof. done. Qed.
+  Lemma gmultiset_elem_of_empty x : x ∈@{gmultiset A} ∅ ↔ False.
+  Proof. rewrite elem_of_multiplicity, multiplicity_empty. lia. Qed.
+  Lemma gmultiset_elem_of_singleton x y : x ∈@{gmultiset A} {[+ y +]} ↔ x = y.
+  Proof.
+    rewrite elem_of_multiplicity, multiplicity_singleton'.
+    case_decide; naive_solver lia.
+  Qed.
+  Lemma gmultiset_elem_of_union X Y x : x ∈ X ∪ Y ↔ x ∈ X ∨ x ∈ Y.
+  Proof. rewrite !elem_of_multiplicity, multiplicity_union. lia. Qed.
+  Lemma gmultiset_elem_of_disj_union X Y x : x ∈ X ⊎ Y ↔ x ∈ X ∨ x ∈ Y.
+  Proof. rewrite !elem_of_multiplicity, multiplicity_disj_union. lia. Qed.
+  Lemma gmultiset_elem_of_intersection X Y x : x ∈ X ∩ Y ↔ x ∈ X ∧ x ∈ Y.
+  Proof. rewrite !elem_of_multiplicity, multiplicity_intersection. lia. Qed.
+  Lemma gmultiset_elem_of_scalar_mul n X x : x ∈ n *: X ↔ n ≠ 0 ∧ x ∈ X.
+  Proof. rewrite !elem_of_multiplicity, multiplicity_scalar_mul. lia. Qed.
+
+  Global Instance gmultiset_elem_of_dec : RelDecision (∈@{gmultiset A}).
+  Proof. refine (λ x X, cast_if (decide (0 < multiplicity x X))); done. Defined.
+
+  Lemma gmultiset_elem_of_dom x X : x ∈ dom X ↔ x ∈ X.
+  Proof.
+    unfold dom, gmultiset_dom, elem_of at 2, gmultiset_elem_of, multiplicity.
+    destruct X as [X]; simpl; rewrite elem_of_dom, <-not_eq_None_Some.
+    destruct (X !! x); naive_solver lia.
+  Qed.
+End basic_lemmas.
+
+(** * A solver for multisets *)
+(** We define a tactic [multiset_solver] that solves goals involving multisets.
+The strategy of this tactic is as follows:
+
+1. Turn all equalities ([=]), equivalences ([≡]), inclusions ([⊆] and [⊂]),
+   and set membership relations ([∈]) into arithmetic (in)equalities
+   involving [multiplicity]. The multiplicities of [∅], [∪], [∩], [⊎] and [∖]
+   are turned into [0], [max], [min], [+], and [-], respectively.
+2. Decompose the goal into smaller subgoals through intuitionistic reasoning.
+3. Instantiate universally quantified hypotheses in hypotheses to obtain a
+   goal that can be solved using [lia].
+4. Simplify multiplicities of singletons [{[ x ]}].
+
+Step (1) and (2) are implemented using the [set_solver] tactic, which internally
+calls [naive_solver] for step (2). Step (1) is implemented by extending the
+[SetUnfold] mechanism with a class [MultisetUnfold].
+
+Step (3) is implemented using the tactic [multiset_instantiate], which
+instantiates universally quantified hypotheses [H : ∀ x : A, P x] in two ways:
+
+- If the goal or some hypothesis contains [multiplicity y X] it adds the
+  hypothesis [H y].
+- If [P] contains a multiset singleton [{[ y ]}] it adds the hypothesis [H y].
+  This is needed, for example, to prove [¬ ({[ x ]} ⊆ ∅)], which is turned
+  into hypothesis [H : ∀ y, multiplicity y {[ x ]} ≤ 0] and goal [False]. The
+  only way to make progress is to instantiate [H] with the singleton appearing
+  in [H], so variable [x].
+
+Step (4) is implemented using the tactic [multiset_simplify_singletons], which
+simplifies occurrences of [multiplicity x {[ y ]}] as follows:
+
+- First, we try to turn these occurencess into [1] or [0] if either [x = y] or
+  [x ≠ y] can be proved using [done], respectively.
+- Second, we try to turn these occurrences into a fresh [z ≤ 1] if [y] does not
+  occur elsewhere in the hypotheses or goal.
+- Finally, we make a case distinction between [x = y] or [x ≠ y]. This step is
+  done last so as to avoid needless exponential blow-ups.
+
+The tests [test_big_X] in [tests/multiset_solver.v] show the second step reduces
+the running time significantly (from >10 seconds to <1 second). *)
+
+Class MultisetUnfold `{Countable A} (x : A) (X : gmultiset A) (n : nat) :=
+  { multiset_unfold : multiplicity x X = n }.
+Global Arguments multiset_unfold {_ _ _} _ _ _ {_} : assert.
+Global Hint Mode MultisetUnfold + + + - + - : typeclass_instances.
+
+Section multiset_unfold.
+  Context `{Countable A}.
+  Implicit Types x y : A.
+  Implicit Types X Y : gmultiset A.
+
+  Global Instance multiset_unfold_default x X :
+    MultisetUnfold x X (multiplicity x X) | 1000.
+  Proof. done. Qed.
+  Global Instance multiset_unfold_empty x : MultisetUnfold x ∅ 0.
+  Proof. constructor. by rewrite multiplicity_empty. Qed.
+  Global Instance multiset_unfold_singleton x :
+    MultisetUnfold x {[+ x +]} 1.
+  Proof. constructor. by rewrite multiplicity_singleton. Qed.
+  Global Instance multiset_unfold_union x X Y n m :
+    MultisetUnfold x X n → MultisetUnfold x Y m →
+    MultisetUnfold x (X ∪ Y) (n `max` m).
+  Proof. intros [HX] [HY]; constructor. by rewrite multiplicity_union, HX, HY. Qed.
+  Global Instance multiset_unfold_intersection x X Y n m :
+    MultisetUnfold x X n → MultisetUnfold x Y m →
+    MultisetUnfold x (X ∩ Y) (n `min` m).
+  Proof. intros [HX] [HY]; constructor. by rewrite multiplicity_intersection, HX, HY. Qed.
+  Global Instance multiset_unfold_disj_union x X Y n m :
+    MultisetUnfold x X n → MultisetUnfold x Y m →
+    MultisetUnfold x (X ⊎ Y) (n + m).
+  Proof. intros [HX] [HY]; constructor. by rewrite multiplicity_disj_union, HX, HY. Qed.
+  Global Instance multiset_unfold_difference x X Y n m :
+    MultisetUnfold x X n → MultisetUnfold x Y m →
+    MultisetUnfold x (X ∖ Y) (n - m).
+  Proof. intros [HX] [HY]; constructor. by rewrite multiplicity_difference, HX, HY. Qed.
+  Global Instance multiset_unfold_scalar_mul x m X n :
+    MultisetUnfold x X n →
+    MultisetUnfold x (m *: X) (m * n).
+  Proof. intros [HX]; constructor. by rewrite multiplicity_scalar_mul, HX. Qed.
+
+  Global Instance set_unfold_multiset_equiv X Y f g :
+    (∀ x, MultisetUnfold x X (f x)) → (∀ x, MultisetUnfold x Y (g x)) →
+    SetUnfold (X ≡ Y) (∀ x, f x = g x) | 0.
+  Proof.
+    constructor. apply forall_proper; intros x.
+    by rewrite (multiset_unfold x X (f x)), (multiset_unfold x Y (g x)).
+  Qed.
+  Global Instance set_unfold_multiset_eq X Y f g :
+    (∀ x, MultisetUnfold x X (f x)) → (∀ x, MultisetUnfold x Y (g x)) →
+    SetUnfold (X = Y) (∀ x, f x = g x) | 0.
+  Proof. constructor. unfold_leibniz. by apply set_unfold_multiset_equiv. Qed.
+  Global Instance set_unfold_multiset_subseteq X Y f g :
+    (∀ x, MultisetUnfold x X (f x)) → (∀ x, MultisetUnfold x Y (g x)) →
+    SetUnfold (X ⊆ Y) (∀ x, f x ≤ g x) | 0.
+  Proof.
+    constructor. apply forall_proper; intros x.
+    by rewrite (multiset_unfold x X (f x)), (multiset_unfold x Y (g x)).
+  Qed.
+  Global Instance set_unfold_multiset_subset X Y f g :
+    (∀ x, MultisetUnfold x X (f x)) → (∀ x, MultisetUnfold x Y (g x)) →
+    SetUnfold (X ⊂ Y) ((∀ x, f x ≤ g x) ∧ (¬∀ x, g x ≤ f x)) | 0.
+  Proof.
+    constructor. unfold strict. f_equiv.
+    - by apply set_unfold_multiset_subseteq.
+    - f_equiv. by apply set_unfold_multiset_subseteq.
+  Qed.
+
+  Global Instance set_unfold_multiset_elem_of X x n :
+    MultisetUnfold x X n → SetUnfoldElemOf x X (0 < n) | 100.
+  Proof. constructor. by rewrite <-(multiset_unfold x X n). Qed.
+
+  Global Instance set_unfold_gmultiset_empty x :
+    SetUnfoldElemOf x (∅ : gmultiset A) False.
+  Proof. constructor. apply gmultiset_elem_of_empty. Qed.
+  Global Instance set_unfold_gmultiset_singleton x y :
+    SetUnfoldElemOf x ({[+ y +]} : gmultiset A) (x = y).
+  Proof. constructor; apply gmultiset_elem_of_singleton. Qed.
+  Global Instance set_unfold_gmultiset_union x X Y P Q :
+    SetUnfoldElemOf x X P → SetUnfoldElemOf x Y Q →
+    SetUnfoldElemOf x (X ∪ Y) (P ∨ Q).
+  Proof.
+    intros ??; constructor. by rewrite gmultiset_elem_of_union,
+      (set_unfold_elem_of x X P), (set_unfold_elem_of x Y Q).
+  Qed.
+  Global Instance set_unfold_gmultiset_disj_union x X Y P Q :
+    SetUnfoldElemOf x X P → SetUnfoldElemOf x Y Q →
+    SetUnfoldElemOf x (X ⊎ Y) (P ∨ Q).
+  Proof.
+    intros ??; constructor. rewrite gmultiset_elem_of_disj_union.
+    by rewrite <-(set_unfold_elem_of x X P), <-(set_unfold_elem_of x Y Q).
+  Qed.
+  Global Instance set_unfold_gmultiset_intersection x X Y P Q :
+    SetUnfoldElemOf x X P → SetUnfoldElemOf x Y Q →
+    SetUnfoldElemOf x (X ∩ Y) (P ∧ Q).
+  Proof.
+    intros ??; constructor. rewrite gmultiset_elem_of_intersection.
+    by rewrite (set_unfold_elem_of x X P), (set_unfold_elem_of x Y Q).
+  Qed.
+  Global Instance set_unfold_gmultiset_dom x X :
+    SetUnfoldElemOf x (dom X) (x ∈ X).
+  Proof. constructor. apply gmultiset_elem_of_dom. Qed.
+End multiset_unfold.
+
+(** Step 3: instantiate hypotheses *)
+(** For these tactics we want to use ssreflect rewrite. ssreflect matching
+interacts better with canonical structures (see
+<https://gitlab.mpi-sws.org/iris/stdpp/-/issues/195>). *)
+Module Export tactics.
+Import ssreflect.
+
+Ltac multiset_instantiate :=
+  repeat match goal with
+  | H : (∀ x : ?A, @?P x) |- _ =>
+     let e := mk_evar A in
+     lazymatch constr:(P e) with
+     | context [ {[+ ?y +]} ] => unify y e; learn_hyp (H y)
+     end
+  | H : (∀ x : ?A, _), _ : context [multiplicity ?y _] |- _ => learn_hyp (H y)
+  | H : (∀ x : ?A, _) |- context [multiplicity ?y _] => learn_hyp (H y)
+  end.
+
+(** Step 4: simplify singletons *)
+(** This lemma results in information loss if there are other occurrences of
+[y] in the goal. In the tactic [multiset_simplify_singletons] we use [clear y]
+to ensure we do not use the lemma if it leads to information loss. *)
+Local Lemma multiplicity_singleton_forget `{Countable A} x y :
+  ∃ n, multiplicity (A:=A) x {[+ y +]} = n ∧ n ≤ 1.
+Proof. rewrite multiplicity_singleton'. case_decide; eauto with lia. Qed.
+
+Ltac multiset_simplify_singletons :=
+  repeat match goal with
+  | H : context [multiplicity ?x {[+ ?y +]}] |- _ =>
+     first
+       [progress rewrite ?multiplicity_singleton ?multiplicity_singleton_ne in H; [|done..]
+       (* This second case does *not* use ssreflect matching (due to [destruct]
+       and the [->] pattern). If the default Coq matching goes wrong it will
+       fail and fall back to the third case, which is strictly more general,
+       just slower. *)
+       |destruct (multiplicity_singleton_forget x y) as (?&->&?); clear y
+       |rewrite multiplicity_singleton' in H; destruct (decide (x = y)); simplify_eq/=]
+  | |- context [multiplicity ?x {[+ ?y +]}] =>
+     first
+       [progress rewrite ?multiplicity_singleton ?multiplicity_singleton_ne; [|done..]
+       (* Similar to above, this second case does *not* use ssreflect matching. *)
+       |destruct (multiplicity_singleton_forget x y) as (?&->&?); clear y
+       |rewrite multiplicity_singleton'; destruct (decide (x = y)); simplify_eq/=]
+  end.
+End tactics.
+
+(** Putting it all together *)
+(** Similar to [set_solver] and [naive_solver], [multiset_solver] has a [by]
+parameter whose default is [eauto]. *)
+Tactic Notation "multiset_solver" "by" tactic3(tac) :=
+  set_solver by (multiset_instantiate;
+                 multiset_simplify_singletons;
+                 (* [fast_done] to solve trivial equalities or contradictions,
+                 [lia] for the common case that involves arithmetic,
+                 [tac] if all else fails *)
+                 solve [fast_done|lia|tac]).
+Tactic Notation "multiset_solver" := multiset_solver by eauto.
+
+Section more_lemmas.
+  Context `{Countable A}.
+  Implicit Types x y : A.
+  Implicit Types X Y : gmultiset A.
+
+  (* Algebraic laws *)
+  (** For union *)
+  Global Instance gmultiset_union_comm : Comm (=@{gmultiset A}) (∪).
+  Proof. unfold Comm. multiset_solver. Qed.
+  Global Instance gmultiset_union_assoc : Assoc (=@{gmultiset A}) (∪).
+  Proof. unfold Assoc. multiset_solver. Qed.
+  Global Instance gmultiset_union_left_id : LeftId (=@{gmultiset A}) ∅ (∪).
+  Proof. unfold LeftId. multiset_solver. Qed.
+  Global Instance gmultiset_union_right_id : RightId (=@{gmultiset A}) ∅ (∪).
+  Proof. unfold RightId. multiset_solver. Qed.
+  Global Instance gmultiset_union_idemp : IdemP (=@{gmultiset A}) (∪).
+  Proof. unfold IdemP. multiset_solver. Qed.
+
+  (** For intersection *)
+  Global Instance gmultiset_intersection_comm : Comm (=@{gmultiset A}) (∩).
+  Proof. unfold Comm. multiset_solver. Qed.
+  Global Instance gmultiset_intersection_assoc : Assoc (=@{gmultiset A}) (∩).
+  Proof. unfold Assoc. multiset_solver. Qed.
+  Global Instance gmultiset_intersection_left_absorb : LeftAbsorb (=@{gmultiset A}) ∅ (∩).
+  Proof. unfold LeftAbsorb. multiset_solver. Qed.
+  Global Instance gmultiset_intersection_right_absorb : RightAbsorb (=@{gmultiset A}) ∅ (∩).
+  Proof. unfold RightAbsorb. multiset_solver. Qed.
+  Global Instance gmultiset_intersection_idemp : IdemP (=@{gmultiset A}) (∩).
+  Proof. unfold IdemP. multiset_solver. Qed.
+
+  Lemma gmultiset_union_intersection_l X Y Z : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z).
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_union_intersection_r X Y Z : (X ∩ Y) ∪ Z = (X ∪ Z) ∩ (Y ∪ Z).
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_intersection_union_l X Y Z : X ∩ (Y ∪ Z) = (X ∩ Y) ∪ (X ∩ Z).
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_intersection_union_r X Y Z : (X ∪ Y) ∩ Z = (X ∩ Z) ∪ (Y ∩ Z).
+  Proof. multiset_solver. Qed.
+
+  (** For disjoint union (aka sum) *)
+  Global Instance gmultiset_disj_union_comm : Comm (=@{gmultiset A}) (⊎).
+  Proof. unfold Comm. multiset_solver. Qed.
+  Global Instance gmultiset_disj_union_assoc : Assoc (=@{gmultiset A}) (⊎).
+  Proof. unfold Assoc. multiset_solver. Qed.
+  Global Instance gmultiset_disj_union_left_id : LeftId (=@{gmultiset A}) ∅ (⊎).
+  Proof. unfold LeftId. multiset_solver. Qed.
+  Global Instance gmultiset_disj_union_right_id : RightId (=@{gmultiset A}) ∅ (⊎).
+  Proof. unfold RightId. multiset_solver. Qed.
+
+  Global Instance gmultiset_disj_union_inj_1 X : Inj (=) (=) (X ⊎.).
+  Proof. unfold Inj. multiset_solver. Qed.
+  Global Instance gmultiset_disj_union_inj_2 X : Inj (=) (=) (.⊎ X).
+  Proof. unfold Inj. multiset_solver. Qed.
+
+  Lemma gmultiset_disj_union_intersection_l X Y Z : X ⊎ (Y ∩ Z) = (X ⊎ Y) ∩ (X ⊎ Z).
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_disj_union_intersection_r X Y Z : (X ∩ Y) ⊎ Z = (X ⊎ Z) ∩ (Y ⊎ Z).
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_disj_union_union_l X Y Z : X ⊎ (Y ∪ Z) = (X ⊎ Y) ∪ (X ⊎ Z).
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_disj_union_union_r X Y Z : (X ∪ Y) ⊎ Z = (X ⊎ Z) ∪ (Y ⊎ Z).
+  Proof. multiset_solver. Qed.
+
+  (** Element of operation *)
+  Lemma gmultiset_not_elem_of_empty x : x ∉@{gmultiset A} ∅.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_not_elem_of_singleton x y : x ∉@{gmultiset A} {[+ y +]} ↔ x ≠ y.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_not_elem_of_union x X Y : x ∉ X ∪ Y ↔ x ∉ X ∧ x ∉ Y.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_not_elem_of_intersection x X Y : x ∉ X ∩ Y ↔ x ∉ X ∨ x ∉ Y.
+  Proof. multiset_solver. Qed.
+
+  (** Misc *)
+  Global Instance gmultiset_singleton_inj : Inj (=) (=@{gmultiset A}) singletonMS.
+  Proof.
+    intros x1 x2 Hx. rewrite gmultiset_eq in Hx. specialize (Hx x1).
+    rewrite multiplicity_singleton, multiplicity_singleton' in Hx.
+    case_decide; [done|lia].
+  Qed.
+  Lemma gmultiset_non_empty_singleton x : {[+ x +]} ≠@{gmultiset A} ∅.
+  Proof. multiset_solver. Qed.
+
+  (** Scalar *)
+  Lemma gmultiset_scalar_mul_0 X : 0 *: X = ∅.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_scalar_mul_S_l n X : S n *: X = X ⊎ (n *: X).
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_scalar_mul_S_r n X : S n *: X = (n *: X) ⊎ X.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_scalar_mul_1 X : 1 *: X = X.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_scalar_mul_2 X : 2 *: X = X ⊎ X.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_scalar_mul_empty n : n *: ∅ =@{gmultiset A} ∅.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_scalar_mul_disj_union n X Y :
+    n *: (X ⊎ Y) =@{gmultiset A} (n *: X) ⊎ (n *: Y).
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_scalar_mul_union n X Y :
+    n *: (X ∪ Y) =@{gmultiset A} (n *: X) ∪ (n *: Y).
+  Proof. set_unfold. intros x; by rewrite Nat.mul_max_distr_l. Qed.
+  Lemma gmultiset_scalar_mul_intersection n X Y :
+    n *: (X ∩ Y) =@{gmultiset A} (n *: X) ∩ (n *: Y).
+  Proof. set_unfold. intros x; by rewrite Nat.mul_min_distr_l. Qed.
+  Lemma gmultiset_scalar_mul_difference n X Y :
+    n *: (X ∖ Y) =@{gmultiset A} (n *: X) ∖ (n *: Y).
+  Proof. set_unfold. intros x; by rewrite Nat.mul_sub_distr_l. Qed.
+
+  Lemma gmultiset_scalar_mul_inj_ne_0 n X1 X2 :
+    n ≠ 0 → n *: X1 = n *: X2 → X1 = X2.
+  Proof. set_unfold. intros ? HX x. apply (Nat.mul_reg_l _ _ n); auto. Qed.
+  (** Specialized to [S n] so that type class search can find it. *)
+  Global Instance gmultiset_scalar_mul_inj_S n :
+    Inj (=) (=@{gmultiset A}) (S n *:.).
+  Proof. intros x1 x2. apply gmultiset_scalar_mul_inj_ne_0. lia. Qed.
+
+  (** Conversion from lists *)
+  Lemma list_to_set_disj_nil : list_to_set_disj [] =@{gmultiset A} ∅.
+  Proof. done. Qed.
+  Lemma list_to_set_disj_cons x l :
+    list_to_set_disj (x :: l) =@{gmultiset A} {[+ x +]} ⊎ list_to_set_disj l.
+  Proof. done. Qed.
+  Lemma list_to_set_disj_app l1 l2 :
+    list_to_set_disj (l1 ++ l2) =@{gmultiset A} list_to_set_disj l1 ⊎ list_to_set_disj l2.
+  Proof. induction l1; multiset_solver. Qed.
+  Lemma elem_of_list_to_set_disj x l :
+    x ∈@{gmultiset A} list_to_set_disj l ↔ x ∈ l.
+  Proof. induction l; set_solver. Qed.
+  Global Instance list_to_set_disj_perm :
+    Proper ((≡ₚ) ==> (=)) (list_to_set_disj (C:=gmultiset A)).
+  Proof. induction 1; multiset_solver. Qed.
+  Lemma list_to_set_disj_replicate n x :
+    list_to_set_disj (replicate n x) =@{gmultiset A} n *: {[+ x +]}.
+  Proof. induction n; multiset_solver. Qed.
+
+  (** Properties of the elements operation *)
+  Lemma gmultiset_elements_empty : elements (∅ : gmultiset A) = [].
+  Proof.
+    unfold elements, gmultiset_elements; simpl. by rewrite map_to_list_empty.
+  Qed.
+  Lemma gmultiset_elements_empty_iff X : elements X = [] ↔ X = ∅.
+  Proof.
+    split; [|intros ->; by rewrite gmultiset_elements_empty].
+    destruct X as [X]; unfold elements, gmultiset_elements; simpl.
+    intros; apply (f_equal GMultiSet).
+    destruct (map_to_list X) as [|[x p]] eqn:?; simpl in *.
+    - by apply map_to_list_empty_iff.
+    - pose proof (Pos2Nat.is_pos p). destruct (Pos.to_nat); naive_solver lia.
+  Qed.
+  Lemma gmultiset_elements_empty_inv X : elements X = [] → X = ∅.
+  Proof. apply gmultiset_elements_empty_iff. Qed.
+
+  Lemma gmultiset_elements_singleton x : elements ({[+ x +]} : gmultiset A) = [ x ].
+  Proof.
+    unfold elements, gmultiset_elements; simpl. by rewrite map_to_list_singleton.
+  Qed.
+  Lemma gmultiset_elements_disj_union X Y :
+    elements (X ⊎ Y) ≡ₚ elements X ++ elements Y.
+  Proof.
+    destruct X as [X], Y as [Y]; unfold elements, gmultiset_elements.
+    set (f xn := let '(x, n) := xn in replicate (Pos.to_nat n) x); simpl.
+    revert Y; induction X as [|x n X HX IH] using map_ind; intros Y.
+    { by rewrite (left_id_L _ _ Y), map_to_list_empty. }
+    destruct (Y !! x) as [n'|] eqn:HY.
+    - rewrite <-(insert_delete Y x n') by done.
+      erewrite <-insert_union_with by done.
+      rewrite !map_to_list_insert, !bind_cons
+        by (by rewrite ?lookup_union_with, ?lookup_delete, ?HX).
+      rewrite (assoc_L _), <-(comm (++) (f (_,n'))), <-!(assoc_L _), <-IH.
+      rewrite (assoc_L _). f_equiv.
+      rewrite (comm _); simpl. by rewrite Pos2Nat.inj_add, replicate_add.
+    - rewrite <-insert_union_with_l, !map_to_list_insert, !bind_cons
+        by (by rewrite ?lookup_union_with, ?HX, ?HY).
+      by rewrite <-(assoc_L (++)), <-IH.
+  Qed.
+  Lemma gmultiset_elements_scalar_mul n X :
+    elements (n *: X) ≡ₚ mjoin (replicate n (elements X)).
+  Proof.
+    induction n as [|n IH]; simpl.
+    - by rewrite gmultiset_scalar_mul_0, gmultiset_elements_empty.
+    - by rewrite gmultiset_scalar_mul_S_l, gmultiset_elements_disj_union, IH.
+  Qed.
+  Lemma gmultiset_elem_of_elements x X : x ∈ elements X ↔ x ∈ X.
+  Proof.
+    destruct X as [X]. unfold elements, gmultiset_elements.
+    set (f xn := let '(x, n) := xn in replicate (Pos.to_nat n) x); simpl.
+    unfold elem_of at 2, gmultiset_elem_of, multiplicity; simpl.
+    rewrite elem_of_list_bind. split.
+    - intros [[??] [[<- ?]%elem_of_replicate ->%elem_of_map_to_list]]; lia.
+    - intros. destruct (X !! x) as [n|] eqn:Hx; [|lia].
+      exists (x,n); split; [|by apply elem_of_map_to_list].
+      apply elem_of_replicate; auto with lia.
+  Qed.
+
+  (** Properties of the set_fold operation *)
+  Lemma gmultiset_set_fold_empty {B} (f : A → B → B) (b : B) :
+    set_fold f b (∅ : gmultiset A) = b.
+  Proof. by unfold set_fold; simpl; rewrite gmultiset_elements_empty. Qed.
+  Lemma gmultiset_set_fold_singleton {B} (f : A → B → B) (b : B) (a : A) :
+    set_fold f b ({[+ a +]} : gmultiset A) = f a b.
+  Proof. by unfold set_fold; simpl; rewrite gmultiset_elements_singleton. Qed.
+  Lemma gmultiset_set_fold_disj_union_strong {B} (R : relation B) `{!PreOrder R}
+      (f : A → B → B) (b : B) X Y :
+    (∀ x, Proper (R ==> R) (f x)) →
+    (∀ x1 x2 c, x1 ∈ X ⊎ Y → x2 ∈ X ⊎ Y → R (f x1 (f x2 c)) (f x2 (f x1 c))) →
+    R (set_fold f b (X ⊎ Y)) (set_fold f (set_fold f b X) Y).
+  Proof.
+    intros ? Hf. unfold set_fold; simpl.
+    rewrite <-foldr_app. apply (foldr_permutation R f b).
+    - intros j1 a1 j2 a2 c ? Ha1%elem_of_list_lookup_2 Ha2%elem_of_list_lookup_2.
+      rewrite gmultiset_elem_of_elements in Ha1, Ha2. eauto.
+    - rewrite (comm (++)). apply gmultiset_elements_disj_union.
+  Qed.
+  Lemma gmultiset_set_fold_disj_union (f : A → A → A) (b : A) X Y :
+    Comm (=) f →
+    Assoc (=) f →
+    set_fold f b (X ⊎ Y) = set_fold f (set_fold f b X) Y.
+  Proof.
+    intros ??; apply gmultiset_set_fold_disj_union_strong; [apply _..|].
+    intros x1 x2 ? _ _. by rewrite 2!assoc, (comm f x1 x2).
+  Qed.
+  Lemma gmultiset_set_fold_scalar_mul (f : A → A → A) (b : A) n X :
+    Comm (=) f →
+    Assoc (=) f →
+    set_fold f b (n *: X) = Nat.iter n (flip (set_fold f) X) b.
+  Proof.
+    intros Hcomm Hassoc. induction n as [|n IH]; simpl.
+    - by rewrite gmultiset_scalar_mul_0, gmultiset_set_fold_empty.
+    - rewrite gmultiset_scalar_mul_S_r.
+      by rewrite (gmultiset_set_fold_disj_union _ _ _ _ _ _), IH.
+  Qed.
+
+  Lemma gmultiset_set_fold_comm_acc_strong {B} (R : relation B) `{!PreOrder R}
+      (f : A → B → B) (g : B → B) b X :
+    (∀ x, Proper (R ==> R) (f x)) →
+    (∀ x (y : B), x ∈ X → R (f x (g y)) (g (f x y))) →
+    R (set_fold f (g b) X) (g (set_fold f b X)).
+  Proof.
+    intros ? Hfg. unfold set_fold; simpl.
+    apply foldr_comm_acc_strong; [done|solve_proper|].
+    intros. by apply Hfg, gmultiset_elem_of_elements.
+  Qed.
+  Lemma gmultiset_set_fold_comm_acc {B} (f : A → B → B) (g : B → B) (b : B) X :
+    (∀ x c, g (f x c) = f x (g c)) →
+    set_fold f (g b) X = g (set_fold f b X).
+  Proof.
+    intros. apply (gmultiset_set_fold_comm_acc_strong _); [solve_proper|done].
+  Qed.
+
+  (** Properties of the size operation *)
+  Lemma gmultiset_size_empty : size (∅ : gmultiset A) = 0.
+  Proof. done. Qed.
+  Lemma gmultiset_size_empty_iff X : size X = 0 ↔ X = ∅.
+  Proof.
+    unfold size, gmultiset_size; simpl.
+    by rewrite length_zero_iff_nil, gmultiset_elements_empty_iff.
+  Qed.
+  Lemma gmultiset_size_empty_inv X : size X = 0 → X = ∅.
+  Proof. apply gmultiset_size_empty_iff. Qed.
+  Lemma gmultiset_size_non_empty_iff X : size X ≠ 0 ↔ X ≠ ∅.
+  Proof. by rewrite gmultiset_size_empty_iff. Qed.
+
+  Lemma gmultiset_choose_or_empty X : (∃ x, x ∈ X) ∨ X = ∅.
+  Proof.
+    destruct (elements X) as [|x l] eqn:HX; [right|left].
+    - by apply gmultiset_elements_empty_iff.
+    - exists x. rewrite <-gmultiset_elem_of_elements, HX. by left.
+  Qed.
+  Lemma gmultiset_choose X : X ≠ ∅ → ∃ x, x ∈ X.
+  Proof. intros. by destruct (gmultiset_choose_or_empty X). Qed.
+  Lemma gmultiset_size_pos_elem_of X : 0 < size X → ∃ x, x ∈ X.
+  Proof.
+    intros Hsz. destruct (gmultiset_choose_or_empty X) as [|HX]; [done|].
+    contradict Hsz. rewrite HX, gmultiset_size_empty; lia.
+  Qed.
+
+  Lemma gmultiset_size_singleton x : size ({[+ x +]} : gmultiset A) = 1.
+  Proof.
+    unfold size, gmultiset_size; simpl. by rewrite gmultiset_elements_singleton.
+  Qed.
+  Lemma gmultiset_size_disj_union X Y : size (X ⊎ Y) = size X + size Y.
+  Proof.
+    unfold size, gmultiset_size; simpl.
+    by rewrite gmultiset_elements_disj_union, length_app.
+  Qed.
+  Lemma gmultiset_size_scalar_mul n X : size (n *: X) = n * size X.
+  Proof.
+    induction n as [|n IH].
+    - by rewrite gmultiset_scalar_mul_0, gmultiset_size_empty.
+    - rewrite gmultiset_scalar_mul_S_l, gmultiset_size_disj_union, IH. lia.
+  Qed.
+
+  (** Order stuff *)
+  Global Instance gmultiset_po : PartialOrder (⊆@{gmultiset A}).
+  Proof. repeat split; repeat intro; multiset_solver. Qed.
+
+  Local Lemma gmultiset_subseteq_alt X Y :
+    X ⊆ Y ↔
+    map_relation (λ _, Pos.le) (λ _ _, False) (λ _ _, True)
+      (gmultiset_car X) (gmultiset_car Y).
+  Proof.
+    apply forall_proper; intros x. unfold multiplicity.
+    destruct (gmultiset_car X !! x), (gmultiset_car Y !! x); naive_solver lia.
+  Qed.
+  Global Instance gmultiset_subseteq_dec : RelDecision (⊆@{gmultiset A}).
+  Proof.
+   refine (λ X Y, cast_if (decide (map_relation
+       (λ _, Pos.le) (λ _ _, False) (λ _ _, True)
+       (gmultiset_car X) (gmultiset_car Y))));
+     by rewrite gmultiset_subseteq_alt.
+  Defined.
+
+  Lemma gmultiset_subset_subseteq X Y : X ⊂ Y → X ⊆ Y.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_empty_subseteq X : ∅ ⊆ X.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_union_subseteq_l X Y : X ⊆ X ∪ Y.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_union_subseteq_r X Y : Y ⊆ X ∪ Y.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_union_mono X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_union_mono_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_union_mono_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_disj_union_subseteq_l X Y : X ⊆ X ⊎ Y.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_disj_union_subseteq_r X Y : Y ⊆ X ⊎ Y.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_disj_union_mono X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ⊎ Y1 ⊆ X2 ⊎ Y2.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_disj_union_mono_l X Y1 Y2 : Y1 ⊆ Y2 → X ⊎ Y1 ⊆ X ⊎ Y2.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_disj_union_mono_r X1 X2 Y : X1 ⊆ X2 → X1 ⊎ Y ⊆ X2 ⊎ Y.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_subset X Y : X ⊆ Y → size X < size Y → X ⊂ Y.
+  Proof. intros. apply strict_spec_alt; split; naive_solver auto with lia. Qed.
+  Lemma gmultiset_disj_union_subset_l X Y : Y ≠ ∅ → X ⊂ X ⊎ Y.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_union_subset_r X Y : X ≠ ∅ → Y ⊂ X ⊎ Y.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_singleton_subseteq_l x X : {[+ x +]} ⊆ X ↔ x ∈ X.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_singleton_subseteq x y :
+    {[+ x +]} ⊆@{gmultiset A} {[+ y +]} ↔ x = y.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_elem_of_subseteq X1 X2 x : x ∈ X1 → X1 ⊆ X2 → x ∈ X2.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_disj_union_difference X Y : X ⊆ Y → Y = X ⊎ Y ∖ X.
+  Proof. multiset_solver. Qed.
+  Lemma gmultiset_disj_union_difference' x Y :
+    x ∈ Y → Y = {[+ x +]} ⊎ Y ∖ {[+ x +]}.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_size_difference X Y : Y ⊆ X → size (X ∖ Y) = size X - size Y.
+  Proof.
+    intros HX%gmultiset_disj_union_difference.
+    rewrite HX at 2; rewrite gmultiset_size_disj_union. lia.
+  Qed.
+
+  Lemma gmultiset_empty_difference X Y : Y ⊆ X → Y ∖ X = ∅.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_non_empty_difference X Y : X ⊂ Y → Y ∖ X ≠ ∅.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_difference_diag X : X ∖ X = ∅.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_difference_subset X Y : X ≠ ∅ → X ⊆ Y → Y ∖ X ⊂ Y.
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_difference_disj_union_r X Y Z : X ∖ Y = (X ⊎ Z) ∖ (Y ⊎ Z).
+  Proof. multiset_solver. Qed.
+
+  Lemma gmultiset_difference_disj_union_l X Y Z : X ∖ Y = (Z ⊎ X) ∖ (Z ⊎ Y).
+  Proof. multiset_solver. Qed.
+
+  (** Mononicity *)
+  Lemma gmultiset_elements_submseteq X Y : X ⊆ Y → elements X ⊆+ elements Y.
+  Proof.
+    intros ->%gmultiset_disj_union_difference. rewrite gmultiset_elements_disj_union.
+    by apply submseteq_inserts_r.
+  Qed.
+
+  Lemma gmultiset_subseteq_size X Y : X ⊆ Y → size X ≤ size Y.
+  Proof. intros. by apply submseteq_length, gmultiset_elements_submseteq. Qed.
+
+  Lemma gmultiset_subset_size X Y : X ⊂ Y → size X < size Y.
+  Proof.
+    intros HXY. assert (size (Y ∖ X) ≠ 0).
+    { by apply gmultiset_size_non_empty_iff, gmultiset_non_empty_difference. }
+    rewrite (gmultiset_disj_union_difference X Y),
+      gmultiset_size_disj_union by auto using gmultiset_subset_subseteq. lia.
+  Qed.
+
+  (** Well-foundedness *)
+  Lemma gmultiset_wf : well_founded (⊂@{gmultiset A}).
+  Proof.
+    apply (wf_projected (<) size); auto using gmultiset_subset_size, lt_wf.
+  Qed.
+
+  Lemma gmultiset_ind (P : gmultiset A → Prop) :
+    P ∅ → (∀ x X, P X → P ({[+ x +]} ⊎ X)) → ∀ X, P X.
+  Proof.
+    intros Hemp Hinsert X. induction (gmultiset_wf X) as [X _ IH].
+    destruct (gmultiset_choose_or_empty X) as [[x Hx]| ->]; auto.
+    rewrite (gmultiset_disj_union_difference' x X) by done.
+    apply Hinsert, IH; multiset_solver.
+  Qed.
+End more_lemmas.
+
+(** * Map *)
+Section map.
+  Context `{Countable A, Countable B}.
+  Context (f : A → B).
+
+  Lemma gmultiset_map_alt X :
+    gmultiset_map f X = list_to_set_disj (f <$> elements X).
+  Proof.
+    destruct X as [m]. unfold elements, gmultiset_map. simpl.
+    induction m as [|x n m ?? IH] using map_first_key_ind; [done|].
+    rewrite map_to_list_insert_first_key, map_fold_insert_first_key by done.
+    csimpl. rewrite fmap_app, fmap_replicate, list_to_set_disj_app, <-IH.
+    apply gmultiset_eq; intros y.
+    rewrite multiplicity_disj_union, list_to_set_disj_replicate.
+    rewrite multiplicity_scalar_mul, multiplicity_singleton'.
+    unfold multiplicity; simpl. destruct (decide (y = f x)) as [->|].
+    - rewrite lookup_partial_alter; simpl. destruct (_ !! f x); simpl; lia.
+    - rewrite lookup_partial_alter_ne by done. lia.
+  Qed.
+
+  Lemma gmultiset_map_empty : gmultiset_map f ∅ = ∅.
+  Proof. done. Qed.
+
+  Lemma gmultiset_map_disj_union X Y :
+    gmultiset_map f (X ⊎ Y) = gmultiset_map f X ⊎ gmultiset_map f Y.
+  Proof.
+    apply gmultiset_eq; intros x.
+    rewrite !gmultiset_map_alt, gmultiset_elements_disj_union, fmap_app.
+    by rewrite list_to_set_disj_app.
+  Qed.
+
+  Lemma gmultiset_map_singleton x :
+    gmultiset_map f {[+ x +]} = {[+ f x +]}.
+  Proof.
+    rewrite gmultiset_map_alt, gmultiset_elements_singleton.
+    multiset_solver.
+  Qed.
+
+  Lemma elem_of_gmultiset_map X y :
+    y ∈ gmultiset_map f X ↔ ∃ x, y = f x ∧ x ∈ X.
+  Proof.
+    rewrite gmultiset_map_alt, elem_of_list_to_set_disj, elem_of_list_fmap.
+    by setoid_rewrite gmultiset_elem_of_elements.
+  Qed.
+
+  Lemma multiplicity_gmultiset_map X x :
+    Inj (=) (=) f →
+    multiplicity (f x) (gmultiset_map f X) = multiplicity x X.
+  Proof.
+    intros. induction X as [|y X IH] using gmultiset_ind; [multiset_solver|].
+    rewrite gmultiset_map_disj_union, gmultiset_map_singleton,
+      !multiplicity_disj_union.
+    multiset_solver.
+  Qed.
+
+  Global Instance gmultiset_map_inj :
+    Inj (=) (=) f → Inj (=) (=) (gmultiset_map f).
+  Proof.
+    intros ? X Y HXY. apply gmultiset_eq; intros x.
+    by rewrite <-!(multiplicity_gmultiset_map _ _ _), HXY.
+  Qed.
+
+  Global Instance set_unfold_gmultiset_map X (P : A → Prop) y :
+    (∀ x, SetUnfoldElemOf x X (P x)) →
+    SetUnfoldElemOf y (gmultiset_map f X) (∃ x, y = f x ∧ P x).
+  Proof. constructor. rewrite elem_of_gmultiset_map; naive_solver. Qed.
+
+  Global Instance multiset_unfold_map x X n :
+    Inj (=) (=) f →
+    MultisetUnfold x X n →
+    MultisetUnfold (f x) (gmultiset_map f X) n.
+  Proof.
+    intros ? [HX]; constructor. by rewrite multiplicity_gmultiset_map, HX.
+  Qed.
+End map.
+
+(** * Big disjoint unions *)
+Section disj_union_list.
+  Context `{Countable A}.
+  Implicit Types X Y : gmultiset A.
+  Implicit Types Xs Ys : list (gmultiset A).
+
+  Lemma gmultiset_disj_union_list_nil :
+    ⋃+ (@nil (gmultiset A)) = ∅.
+  Proof. done. Qed.
+
+  Lemma gmultiset_disj_union_list_cons X Xs :
+    ⋃+ (X :: Xs) = X ⊎ ⋃+ Xs.
+  Proof. done. Qed.
+
+  Lemma gmultiset_disj_union_list_singleton X :
+    ⋃+ [X] = X.
+  Proof. simpl. by rewrite (right_id_L ∅ _). Qed.
+
+  Lemma gmultiset_disj_union_list_app Xs1 Xs2 :
+    ⋃+ (Xs1 ++ Xs2) = ⋃+ Xs1 ⊎ ⋃+ Xs2.
+  Proof.
+    induction Xs1 as [|X Xs1 IH]; simpl; [by rewrite (left_id_L ∅ _)|].
+    by rewrite IH, (assoc_L _).
+  Qed.
+
+  Lemma elem_of_gmultiset_disj_union_list Xs x :
+    x ∈ ⋃+ Xs ↔ ∃ X, X ∈ Xs ∧ x ∈ X.
+  Proof. induction Xs; multiset_solver. Qed.
+
+  Lemma multiplicity_gmultiset_disj_union_list x Xs :
+    multiplicity x (⋃+ Xs) = sum_list (multiplicity x <$> Xs).
+  Proof.
+    induction Xs as [|X Xs IH]; [done|]; simpl.
+    by rewrite multiplicity_disj_union, IH.
+  Qed.
+
+  Global Instance gmultiset_disj_union_list_proper :
+    Proper ((≡ₚ) ==> (=)) (@disj_union_list (gmultiset A) _ _).
+  Proof. induction 1; multiset_solver. Qed.
+End disj_union_list.

theories/hashset.v → stdpp/hashset.v

-(* Copyright (c) 2012-2017, Robbert Krebbers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file implements finite set using hash maps. Hash sets are represented
 using radix-2 search trees. Each hash bucket is thus indexed using an binary
 integer of type [Z], and contains an unordered list without duplicates. *)
 From stdpp Require Export fin_maps listset.
 From stdpp Require Import zmap.
-Set Default Proof Using "Type".
+From stdpp Require Import options.
 
 Record hashset {A} (hash : A → Z) := Hashset {
   hashset_car : Zmap (list A);
   hashset_prf :
     map_Forall (λ n l, Forall (λ x, hash x = n) l ∧ NoDup l) hashset_car
 }.
-Arguments Hashset {_ _} _ _.
-Arguments hashset_car {_ _} _.
+Global Arguments Hashset {_ _} _ _ : assert.
+Global Arguments hashset_car {_ _} _ : assert.
 
 Section hashset.
 Context `{EqDecision A} (hash : A → Z).
 
-Instance hashset_elem_of: ElemOf A (hashset hash) := λ x m, ∃ l,
+Global Instance hashset_elem_of: ElemOf A (hashset hash) := λ x m, ∃ l,
   hashset_car m !! hash x = Some l ∧ x ∈ l.
 
-Program Instance hashset_empty: Empty (hashset hash) := Hashset ∅ _.
+Global Program Instance hashset_empty: Empty (hashset hash) := Hashset ∅ _.
 Next Obligation. by intros n X; simpl_map. Qed.
-Program Instance hashset_singleton: Singleton A (hashset hash) := λ x,
+Global Program Instance hashset_singleton: Singleton A (hashset hash) := λ x,
   Hashset {[ hash x := [x] ]} _.
 Next Obligation.
   intros x n l [<- <-]%lookup_singleton_Some.
   rewrite Forall_singleton; auto using NoDup_singleton.
 Qed.
-Program Instance hashset_union: Union (hashset hash) := λ m1 m2,
+Global Program Instance hashset_union: Union (hashset hash) := λ m1 m2,
   let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in
-  Hashset (union_with (λ l k, Some (list_union l k)) m1 m2) _. 
+  Hashset (union_with (λ l k, Some (list_union l k)) m1 m2) _.
 Next Obligation.
   intros _ _ m1 Hm1 m2 Hm2 n l'; rewrite lookup_union_with_Some.
   intros [[??]|[[??]|(l&k&?&?&?)]]; simplify_eq/=; auto.
   split; [apply Forall_list_union|apply NoDup_list_union];
     first [by eapply Hm1; eauto | by eapply Hm2; eauto].
 Qed.
-Program Instance hashset_intersection: Intersection (hashset hash) := λ m1 m2,
+Global Program Instance hashset_intersection: Intersection (hashset hash) := λ m1 m2,
   let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in
   Hashset (intersection_with (λ l k,
-    let l' := list_intersection l k in guard (l' ≠ []); Some l') m1 m2) _.
+    let l' := list_intersection l k in guard (l' ≠ []);; Some l') m1 m2) _.
 Next Obligation.
   intros _ _ m1 Hm1 m2 Hm2 n l'. rewrite lookup_intersection_with_Some.
   intros (?&?&?&?&?); simplify_option_eq.
   split; [apply Forall_list_intersection|apply NoDup_list_intersection];
     first [by eapply Hm1; eauto | by eapply Hm2; eauto].
 Qed.
-Program Instance hashset_difference: Difference (hashset hash) := λ m1 m2,
+Global Program Instance hashset_difference: Difference (hashset hash) := λ m1 m2,
   let (m1,Hm1) := m1 in let (m2,Hm2) := m2 in
   Hashset (difference_with (λ l k,
-    let l' := list_difference l k in guard (l' ≠ []); Some l') m1 m2) _.
+    let l' := list_difference l k in guard (l' ≠ []);; Some l') m1 m2) _.
 Next Obligation.
   intros _ _ m1 Hm1 m2 Hm2 n l'. rewrite lookup_difference_with_Some.
   intros [[??]|(?&?&?&?&?)]; simplify_option_eq; auto.
   split; [apply Forall_list_difference|apply NoDup_list_difference];
     first [by eapply Hm1; eauto | by eapply Hm2; eauto].
 Qed.
-Instance hashset_elems: Elements A (hashset hash) := λ m,
+Global Instance hashset_elements: Elements A (hashset hash) := λ m,
   map_to_list (hashset_car m) ≫= snd.
 
-Global Instance: FinCollection A (hashset hash).
+Global Instance hashset_fin_set : FinSet A (hashset hash).
 Proof.
   split; [split; [split| |]| |].
   - intros ? (?&?&?); simplify_map_eq/=.
@@ -98,16 +96,16 @@ Proof.
     assert (x ∈ list_difference l k) by (by rewrite elem_of_list_difference).
     exists (list_difference l k); split; [right; exists l,k|]; split_and?; auto.
     by rewrite option_guard_True by eauto using elem_of_not_nil.
-  - unfold elem_of at 2, hashset_elem_of, elements, hashset_elems.
+  - unfold elem_of at 2, hashset_elem_of, elements, hashset_elements.
     intros [m Hm] x; simpl. setoid_rewrite elem_of_list_bind. split.
     { intros ([n l]&Hx&Hn); simpl in *; rewrite elem_of_map_to_list in Hn.
       cut (hash x = n); [intros <-; eauto|].
       eapply (Forall_forall (λ x, hash x = n) l); eauto. eapply Hm; eauto. }
     intros (l&?&?). exists (hash x, l); simpl. by rewrite elem_of_map_to_list.
-  - unfold elements, hashset_elems. intros [m Hm]; simpl.
+  - unfold elements, hashset_elements. intros [m Hm]; simpl.
     rewrite map_Forall_to_list in Hm. generalize (NoDup_fst_map_to_list m).
-    induction Hm as [|[n l] m' [??]];
-      csimpl; inversion_clear 1 as [|?? Hn]; [constructor|].
+    induction Hm as [|[n l] m' [??] Hm];
+      csimpl; inv 1 as [|?? Hn]; [constructor|].
     apply NoDup_app; split_and?; eauto.
     setoid_rewrite elem_of_list_bind; intros x ? ([n' l']&?&?); simpl in *.
     assert (hash x = n ∧ hash x = n') as [??]; subst.
@@ -118,24 +116,7 @@ Proof.
 Qed.
 End hashset.
 
-Typeclasses Opaque hashset_elem_of.
-
-(** These instances are declared using [Hint Extern] to avoid too
-eager type class search. *)
-Hint Extern 1 (ElemOf _ (hashset _)) =>
-  eapply @hashset_elem_of : typeclass_instances.
-Hint Extern 1 (Empty (hashset _)) =>
-  eapply @hashset_empty : typeclass_instances.
-Hint Extern 1 (Singleton _ (hashset _)) =>
-  eapply @hashset_singleton : typeclass_instances.
-Hint Extern 1 (Union (hashset _)) =>
-  eapply @hashset_union : typeclass_instances.
-Hint Extern 1 (Intersection (hashset _)) =>
-  eapply @hashset_intersection : typeclass_instances.
-Hint Extern 1 (Difference (hashset _)) =>
-  eapply @hashset_difference : typeclass_instances.
-Hint Extern 1 (Elements _ (hashset _)) =>
-  eapply @hashset_elems : typeclass_instances.
+Global Typeclasses Opaque hashset_elem_of.
 
 Section remove_duplicates.
 Context `{EqDecision A} (hash : A → Z).
@@ -145,15 +126,15 @@ Definition remove_dups_fast (l : list A) : list A :=
   | [] => []
   | [x] => [x]
   | _ =>
-     let n : Z := length l in
-     elements (foldr (λ x, ({[ x ]} ∪)) ∅ l :
+     let n : Z := Z.of_nat (length l) in
+     elements (foldr (λ x, ({[ x ]} ∪.)) ∅ l :
        hashset (λ x, hash x `mod` (2 * n))%Z)
   end.
 Lemma elem_of_remove_dups_fast l x : x ∈ remove_dups_fast l ↔ x ∈ l.
 Proof.
   destruct l as [|x1 [|x2 l]]; try reflexivity.
   unfold remove_dups_fast; generalize (x1 :: x2 :: l); clear l; intros l.
-  generalize (λ x, hash x `mod` (2 * length l))%Z; intros f.
+  generalize (λ x, hash x `mod` (2 * Z.of_nat (length l)))%Z; intros f.
   rewrite elem_of_elements; split.
   - revert x. induction l as [|y l IH]; intros x; simpl.
     { by rewrite elem_of_empty. }
@@ -163,12 +144,14 @@ Qed.
 Lemma NoDup_remove_dups_fast l : NoDup (remove_dups_fast l).
 Proof.
   unfold remove_dups_fast; destruct l as [|x1 [|x2 l]].
-  apply NoDup_nil_2. apply NoDup_singleton. apply NoDup_elements.
+  - apply NoDup_nil_2.
+  - apply NoDup_singleton.
+  - apply NoDup_elements.
 Qed.
 Definition listset_normalize (X : listset A) : listset A :=
   let (l) := X in Listset (remove_dups_fast l).
 Lemma listset_normalize_correct X : listset_normalize X ≡ X.
 Proof.
-  destruct X as [l]. apply elem_of_equiv; intro; apply elem_of_remove_dups_fast.
+  destruct X as [l]. apply set_equiv; intro; apply elem_of_remove_dups_fast.
 Qed.
 End remove_duplicates.

theories/hlist.v → stdpp/hlist.v

 From stdpp Require Import tactics.
-Set Default Proof Using "Type".
+From stdpp Require Import options.
 Local Set Universe Polymorphism.
 
 (* Not using [list Type] in order to avoid universe inconsistencies *)
@@ -12,22 +12,22 @@ Inductive hlist : tlist → Type :=
 Fixpoint tapp (As Bs : tlist) : tlist :=
   match As with tnil => Bs | tcons A As => tcons A (tapp As Bs) end.
 Fixpoint happ {As Bs} (xs : hlist As) (ys : hlist Bs) : hlist (tapp As Bs) :=
-  match xs with hnil => ys | hcons _ _ x xs => hcons x (happ xs ys) end.
+  match xs with hnil => ys | hcons x xs => hcons x (happ xs ys) end.
 
-Fixpoint hhead {A As} (xs : hlist (tcons A As)) : A :=
-  match xs with hnil => () | hcons _ _ x _ => x end.
-Fixpoint htail {A As} (xs : hlist (tcons A As)) : hlist As :=
-  match xs with hnil => () | hcons _ _ _ xs => xs end.
+Definition hhead {A As} (xs : hlist (tcons A As)) : A :=
+  match xs with hnil => () | hcons x _ => x end.
+Definition htail {A As} (xs : hlist (tcons A As)) : hlist As :=
+  match xs with hnil => () | hcons _ xs => xs end.
 
 Fixpoint hheads {As Bs} : hlist (tapp As Bs) → hlist As :=
   match As with
   | tnil => λ _, hnil
-  | tcons A As => λ xs, hcons (hhead xs) (hheads (htail xs))
+  | tcons _ _ => λ xs, hcons (hhead xs) (hheads (htail xs))
   end.
 Fixpoint htails {As Bs} : hlist (tapp As Bs) → hlist Bs :=
   match As with
   | tnil => id
-  | tcons A As => λ xs, htails (htail xs)
+  | tcons _ _ => λ xs, htails (htail xs)
   end.
 
 Fixpoint himpl (As : tlist) (B : Type) : Type :=
@@ -35,23 +35,24 @@ Fixpoint himpl (As : tlist) (B : Type) : Type :=
 
 Definition hinit {B} (y : B) : himpl tnil B := y.
 Definition hlam {A As B} (f : A → himpl As B) : himpl (tcons A As) B := f.
-Arguments hlam _ _ _ _ _/.
+Global Arguments hlam _ _ _ _ _ / : assert.
 
-Definition hcurry {As B} (f : himpl As B) (xs : hlist As) : B :=
-  (fix go As xs :=
+Definition huncurry {As B} (f : himpl As B) (xs : hlist As) : B :=
+  (fix go {As} xs :=
     match xs in hlist As return himpl As B → B with
     | hnil => λ f, f
-    | hcons A As x xs => λ f, go As xs (f x)
+    | hcons x xs => λ f, go xs (f x)
     end) _ xs f.
-Coercion hcurry : himpl >-> Funclass.
+Coercion huncurry : himpl >-> Funclass.
 
-Fixpoint huncurry {As B} : (hlist As → B) → himpl As B :=
+Fixpoint hcurry {As B} : (hlist As → B) → himpl As B :=
   match As with
   | tnil => λ f, f hnil
-  | tcons x xs => λ f, hlam (λ x, huncurry (f ∘ hcons x))
+  | tcons x xs => λ f, hlam (λ x, hcurry (f ∘ hcons x))
   end.
 
-Lemma hcurry_uncurry {As B} (f : hlist As → B) xs : huncurry f xs = f xs.
+Lemma huncurry_curry {As B} (f : hlist As → B) xs :
+  huncurry (hcurry f) xs = f xs.
 Proof. by induction xs as [|A As x xs IH]; simpl; rewrite ?IH. Qed.
 
 Fixpoint hcompose {As B C} (f : B → C) {struct As} : himpl As B → himpl As C :=

stdpp/infinite.v

+From stdpp Require Export list.
+From stdpp Require Import relations pretty.
+From stdpp Require Import options.
+
+(* Pick up extra assumptions from section parameters. *)
+Set Default Proof Using "Type*".
+
+(** * Generic constructions *)
+(** If [A] is infinite, and there is an injection from [A] to [B], then [B] is
+also infinite. Note that due to constructivity we need a rather strong notion of
+being injective, we also need a partial function [B → option A] back. *)
+Program Definition inj_infinite `{Infinite A} {B}
+    (f : A → B) (g : B → option A) (Hgf : ∀ x, g (f x) = Some x) :
+  Infinite B := {| infinite_fresh := f ∘ fresh ∘ omap g |}.
+Next Obligation.
+  intros A ? B f g Hfg xs Hxs; simpl in *.
+  apply (infinite_is_fresh (omap g xs)), elem_of_list_omap; eauto.
+Qed.
+Next Obligation. solve_proper. Qed.
+
+(** If there is an injective function [f : nat → B], then [B] is infinite. This
+construction works as follows: to obtain an element not in [xs], we return the
+first element [f 0], [f 1], [f 2], ... that is not in [xs].
+
+This construction has a nice computational behavior to e.g. find fresh strings.
+Given some prefix [s], we use [f n := if n is S n' then s +:+ pretty n else s].
+The construction then finds the first string starting with [s] followed by a
+number that's not in the input list. For example, given [["H", "H1", "H4"]] and
+[s := "H"], it would find ["H2"]. *)
+Section search_infinite.
+  Context {B} (f : nat → B).
+
+  Let R (xs : list B) (n1 n2 : nat) :=
+    n2 < n1 ∧ (f (n1 - 1)) ∈ xs.
+  Lemma search_infinite_step xs n : f n ∈ xs → R xs (1 + n) n.
+  Proof. split; [lia|]. replace (1 + n - 1) with n by lia; eauto. Qed.
+
+  Context `{!Inj (=) (=) f, !EqDecision B}.
+
+  Lemma search_infinite_R_wf xs : well_founded (R xs).
+  Proof.
+    revert xs. assert (help : ∀ xs n n',
+      Acc (R (filter (.≠ f n') xs)) n → n' < n → Acc (R xs) n).
+    { induction 1 as [n _ IH]. constructor; intros n2 [??]. apply IH; [|lia].
+      split; [done|]. apply elem_of_list_filter; naive_solver lia. }
+    intros xs. induction (well_founded_ltof _ length xs) as [xs _ IH].
+    intros n1; constructor; intros n2 [Hn Hs].
+    apply help with (n2 - 1); [|lia]. apply IH. eapply length_filter_lt; eauto.
+  Qed.
+
+  Definition search_infinite_go (xs : list B) (n : nat)
+      (go : ∀ n', R xs n' n → B) : B :=
+    let x := f n in
+    match decide (x ∈ xs) with
+    | left Hx => go (S n) (search_infinite_step xs n Hx)
+    | right _ => x
+    end.
+
+  Program Definition search_infinite : Infinite B := {|
+    infinite_fresh xs :=
+      Fix_F _ (search_infinite_go xs) (wf_guard 32 (search_infinite_R_wf xs) 0)
+  |}.
+  Next Obligation.
+    intros xs. unfold fresh.
+    generalize 0 (wf_guard 32 (search_infinite_R_wf xs) 0). revert xs.
+    fix FIX 3; intros xs n [?]; simpl; unfold search_infinite_go at 1; simpl.
+    destruct (decide _); auto.
+  Qed.
+  Next Obligation.
+    intros xs1 xs2 Hxs. unfold fresh.
+    generalize (wf_guard 32 (search_infinite_R_wf xs1) 0).
+    generalize (wf_guard 32 (search_infinite_R_wf xs2) 0). generalize 0.
+    fix FIX 2. intros n [acc1] [acc2]; simpl; unfold search_infinite_go.
+    destruct (decide ( _ ∈ xs1)) as [H1|H1], (decide (_ ∈ xs2)) as [H2|H2]; auto.
+    - destruct H2. by rewrite <-Hxs.
+    - destruct H1. by rewrite Hxs.
+  Qed.
+End search_infinite.
+
+(** To select a fresh number from a given list [x₀ ... xₙ], a possible approach
+is to compute [(S x₀) `max` ... `max` (S xₙ) `max` 0]. For non-empty lists of
+non-negative numbers this is equal to taking the maximal element [xᵢ] and adding
+one.
+
+The construction below generalizes this construction to any type [A], function
+[f : A → A → A]. and initial value [a]. The fresh element is computed as
+[x₀ `f` ... `f` xₙ `f` a]. For numbers, the prototypical instance is
+[f x y := S x `max` y] and [a:=0], which gives the behavior described before.
+Note that this gives [a] (i.e. [0] for numbers) for the empty list. *)
+Section max_infinite.
+  Context {A} (f : A → A → A) (a : A) (lt : relation A).
+  Context (HR : ∀ x, ¬lt x x).
+  Context (HR1 : ∀ x y, lt x (f x y)).
+  Context (HR2 : ∀ x x' y, lt x x' → lt x (f y x')).
+  Context (Hf : ∀ x x' y, f x (f x' y) = f x' (f x y)).
+
+  Program Definition max_infinite: Infinite A := {|
+    infinite_fresh := foldr f a
+  |}.
+  Next Obligation.
+    cut (∀ xs x, x ∈ xs → lt x (foldr f a xs)).
+    { intros help xs []%help%HR. }
+    induction 1; simpl; auto.
+  Qed.
+  Next Obligation. by apply (foldr_permutation_proper _ _ _). Qed.
+End max_infinite.
+
+(** Instances for number types *)
+Global Program Instance nat_infinite : Infinite nat :=
+  max_infinite (Nat.max ∘ S) 0 (<) _ _ _ _.
+Solve Obligations with (intros; simpl; lia).
+
+Global Program Instance N_infinite : Infinite N :=
+  max_infinite (N.max ∘ N.succ) 0%N N.lt _ _ _ _.
+Solve Obligations with (intros; simpl; lia).
+
+Global Program Instance positive_infinite : Infinite positive :=
+  max_infinite (Pos.max ∘ Pos.succ) 1%positive Pos.lt _ _ _ _.
+Solve Obligations with (intros; simpl; lia).
+
+Global Program Instance Z_infinite: Infinite Z :=
+  max_infinite (Z.max ∘ Z.succ) 0%Z Z.lt _ _ _ _.
+Solve Obligations with (intros; simpl; lia).
+
+(** Instances for option, sum, products *)
+Global Instance option_infinite `{Infinite A} : Infinite (option A) :=
+  inj_infinite Some id (λ _, eq_refl).
+
+Global Instance sum_infinite_l `{Infinite A} {B} : Infinite (A + B) :=
+  inj_infinite inl (maybe inl) (λ _, eq_refl).
+Global Instance sum_infinite_r {A} `{Infinite B} : Infinite (A + B) :=
+  inj_infinite inr (maybe inr)  (λ _, eq_refl).
+
+Global Instance prod_infinite_l `{Infinite A, Inhabited B} : Infinite (A * B) :=
+  inj_infinite (., inhabitant) (Some ∘ fst) (λ _, eq_refl).
+Global Instance prod_infinite_r `{Inhabited A, Infinite B} : Infinite (A * B) :=
+  inj_infinite (inhabitant ,.) (Some ∘ snd) (λ _, eq_refl).
+
+(** Instance for lists *)
+Global Program Instance list_infinite `{Inhabited A} : Infinite (list A) := {|
+  infinite_fresh xxs := replicate (fresh (length <$> xxs)) inhabitant
+|}.
+Next Obligation.
+  intros A ? xs ?. destruct (infinite_is_fresh (length <$> xs)).
+  apply elem_of_list_fmap. eexists; split; [|done].
+  unfold fresh. by rewrite length_replicate.
+Qed.
+Next Obligation. unfold fresh. by intros A ? xs1 xs2 ->. Qed.
+
+(** Instance for strings *)
+Global Program Instance string_infinite : Infinite string :=
+  search_infinite pretty.