theories/countable.v → stdpp/countable.v

@@ -61,10 +61,9 @@ Section choice.
     { intros help. by apply (help (encode x)). }
     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)}.
@@ -295,16 +294,16 @@ Qed.
 Global Program Instance Qp_countable : Countable Qp :=
   inj_countable
     Qp_to_Qc
-    (λ p : Qc, guard (0 < p)%Qc as Hp; Some (mk_Qp p Hp)) _.
+    (λ p : Qc, Hp ← guard (0 < p)%Qc; Some (mk_Qp p Hp)) _.
 Next Obligation.
-  intros [p Hp]. unfold mguard, option_guard; simpl.
-  case_match; [|done]. f_equal. by apply Qp_to_Qc_inj_iff.
+  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, guard (m < n)%nat as Hm; Some (nat_to_fin Hm)) _.
+    (λ 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.
@@ -314,6 +313,18 @@ 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.
@@ -355,8 +366,8 @@ Proof.
   - 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_alt, drop_app_alt, reverse_involutive
-      by (by rewrite reverse_length).
+  - 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) :=
@@ -370,7 +381,7 @@ Qed.
 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, guard (P x) as Hx; Some (x ↾ Hx)) _.
+  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

@@ -21,7 +21,7 @@ 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.
 
@@ -85,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.
@@ -121,9 +194,9 @@ 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_iff (P Q : Prop) `{Decision P, Decision Q} :
+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.
@@ -135,6 +208,26 @@ 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].
@@ -171,71 +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. *)
-Global Instance True_dec: Decision True := left I.
-Global Instance False_dec: Decision False := 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.

stdpp/dune

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

theories/fin.v → stdpp/fin.v

@@ -17,14 +17,13 @@ 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.
 
-Notation "0" := Fin.F1 : fin_scope. Notation "1" := (FS 0) : fin_scope.
-Notation "2" := (FS 1) : fin_scope. Notation "3" := (FS 2) : fin_scope.
-Notation "4" := (FS 3) : fin_scope. Notation "5" := (FS 4) : fin_scope.
-Notation "6" := (FS 5) : fin_scope. Notation "7" := (FS 6) : fin_scope.
-Notation "8" := (FS 7) : fin_scope. Notation "9" := (FS 8) : fin_scope.
-Notation "10" := (FS 9) : fin_scope.
+(** 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.
@@ -65,9 +64,11 @@ Ltac inv_fin i :=
   | fin ?n =>
     match eval hnf in n with
     | 0 =>
-      revert dependent i; match goal with |- ∀ i, @?P i => apply (fin_0_inv P) end
+      generalize dependent i;
+      match goal with |- ∀ i, @?P i => apply (fin_0_inv P) end
     | S ?n =>
-      revert dependent i; match goal with |- ∀ i, @?P i => apply (fin_S_inv P) end
+      generalize dependent i;
+      match goal with |- ∀ i, @?P i => apply (fin_S_inv P) end
     end
   end.
 
@@ -87,26 +88,26 @@ 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_plus_inv {n1 n2} : ∀ (P : fin (n1 + n2) → Type)
+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_plus_inv _ (λ i, H1 (FS i)) H2)
+  | S n => λ P H1 H2, fin_S_inv P (H1 0%fin) (fin_add_inv _ (λ i, H1 (FS i)) H2)
   end.
 
-Lemma fin_plus_inv_L {n1 n2} (P : fin (n1 + n2) → Type)
+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_plus_inv P H1 H2 (Fin.L n2 i) = H1 i.
+  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_plus_inv_R {n1 n2} (P : fin (n1 + n2) → Type)
+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_plus_inv P H1 H2 (Fin.R n1 i) = H2 i.
+  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))).

theories/fin_map_dom.v → stdpp/fin_map_dom.v

@@ -9,45 +9,49 @@ 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, FinMapToList K A (M A), EqDecision K,
+    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 D m ↔ is_Some (m !! i)
+  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 D m → m !! i = Some (m !!! 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 D (map_imap f m) ⊆ dom D m.
+  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 :
+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 D (map_imap f m) ≡ 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 D m.
+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 D m ↔ m !! i = None.
+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 subseteq_dom {A} (m1 m2 : M A) : m1 ⊆ m2 → dom D m1 ⊆ dom D m2.
+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. inversion 1; eauto.
+  intros ??. rewrite !elem_of_dom. inv 1; eauto.
 Qed.
-Lemma subset_dom {A} (m1 m2 : M A) : m1 ⊂ m2 → dom D m1 ⊂ dom D m2.
+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.
@@ -55,119 +59,146 @@ Proof.
   destruct Hss2; eauto. by simplify_map_eq.
 Qed.
 
-Lemma dom_filter {A} (P : K * A → Prop) `{!∀ x, Decision (P x)} (m : M A) X :
+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 D (filter P m) ≡ X.
+  dom (filter P m) ≡ X.
 Proof.
   intros HX i. rewrite elem_of_dom, HX.
-  unfold is_Some. by setoid_rewrite map_filter_lookup_Some.
+  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 D (filter P m) ⊆ dom D m.
+  dom (filter P m) ⊆ dom m.
 Proof. apply subseteq_dom, map_filter_subseteq. Qed.
 
-Lemma dom_empty {A} : dom D (@empty (M A) _) ≡ ∅.
+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 D m ≡ ∅ ↔ m = ∅.
+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 D m ≡ ∅ → m = ∅.
+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 D (alter f i m) ≡ dom D m.
+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 D (<[i:=x]>m) ≡ {[ i ]} ∪ dom D m.
+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 D (<[i:=x]>m) ≡ dom D m.
+  is_Some (m !! i) → dom (<[i:=x]>m) ≡ dom m.
 Proof.
-  intros Hindom. assert (i ∈ dom D m) by by apply elem_of_dom.
+  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 D m ⊆ dom D (<[i:=x]>m).
+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 D m → X ⊆ dom D (<[i:=x]>m).
-Proof. intros. trans (dom D m); eauto using dom_insert_subseteq. Qed.
-Lemma dom_singleton {A} (i : K) (x : A) : dom D ({[i := x]} : M A) ≡ {[ i ]}.
+  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 D (delete i m) ≡ dom D m ∖ {[ i ]}.
+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 D m → delete i (partial_alter f i m) = m.
+  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 D m → delete i (<[i:=x]>m) = m.
+  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 D m1 ## dom D m2.
+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 D m1 ## dom D m2.
+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 D m1 ## dom D m2 → m1 ##ₘ m2.
+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 D (m1 ∪ m2) ≡ dom D m1 ∪ dom D m2.
+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 D (m1 ∩ m2) ≡ dom D m1 ∩ dom D m2.
+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 D (m1 ∖ m2) ≡ dom D m1 ∖ dom D m2.
+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 D (f <$> m) ≡ dom D m.
+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 D m).
+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 D).
+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 D (list_to_map l : M A) ≡ list_to_set l.*1.
+  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 D m ≡ list_to_set (map_to_list m).*1.
+  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.
@@ -175,15 +206,48 @@ Proof.
 Qed.
 
 Lemma size_dom `{!Elements K D, !FinSet K D} {A} (m : M A) :
-  size (dom D m) = size m.
+  size (dom m) = size m.
 Proof.
-  rewrite dom_alt, size_list_to_set.
-  2:{ apply NoDup_fst_map_to_list. }
-  unfold size, map_size. rewrite fmap_length. done.
+  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 D m ≡ {[i]} → ∃ x, m = {[i := x]}.
+  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. }
@@ -193,7 +257,7 @@ Proof.
 Qed.
 
 Lemma dom_map_zip_with {A B C} (f : A → B → C) (ma : M A) (mb : M B) :
-  dom D (map_zip_with f ma mb) ≡ dom D ma ∩ dom D mb.
+  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.
@@ -202,8 +266,8 @@ Qed.
 
 Lemma dom_union_inv `{!RelDecision (∈@{D})} {A} (m : M A) (X1 X2 : D) :
   X1 ## X2 →
-  dom D m ≡ X1 ∪ X2 →
-  ∃ m1 m2, m = m1 ∪ m2 ∧ m1 ##ₘ m2 ∧ dom D m1 ≡ X1 ∧ dom D m2 ≡ 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).
@@ -211,13 +275,13 @@ Proof.
   { apply map_disjoint_filter_complement. }
   split_and!; [|done| |].
   - apply map_eq; intros i. apply option_eq; intros x.
-    rewrite lookup_union_Some, !map_filter_lookup_Some by done.
+    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 (D:=D)); set_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 (D:=D)); set_solver).
+    + 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).
@@ -226,139 +290,174 @@ Qed.
 
 Lemma dom_kmap `{!Elements K D, !FinSet K D, FinMapDom K2 M2 D2}
     {A} (f : K → K2) `{!Inj (=) (=) f} (m : M A) :
-  dom D2 (kmap (M2:=M2) f m) ≡ set_map f (dom D m).
+  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 D) | 0.
+  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 D (filter P m) = X.
+    dom (filter P m) = X.
   Proof. unfold_leibniz. apply dom_filter. Qed.
-  Lemma dom_empty_L {A} : dom D (@empty (M A) _) = ∅.
+  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 D m = ∅ ↔ m = ∅.
+  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 D m = ∅ → m = ∅.
+  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 D (alter f i m) = dom D m.
+  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 D (<[i:=x]>m) = {[ i ]} ∪ dom D m.
+  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 D (<[i:=x]>m) = dom D m.
+    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 D ({[i := x]} : M A) = {[ i ]}.
+  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 D (delete i m) = dom D m ∖ {[ i ]}.
+  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 D (m1 ∪ m2) = dom D m1 ∪ dom D m2.
+  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 D (m1 ∩ m2) = dom D m1 ∩ dom D m2.
+    dom (m1 ∩ m2) = dom m1 ∩ dom m2.
   Proof. unfold_leibniz; apply dom_intersection. Qed.
-  Lemma dom_difference_L {A} (m1 m2 : M A) : dom D (m1 ∖ m2) = dom D m1 ∖ dom D m2.
+  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 D (f <$> m) = dom D m.
+  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 D (map_imap f m) = 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 D (list_to_map l : M A) = list_to_set l.*1.
+    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 D m = {[i]} → ∃ x, m = {[i := x]}.
+    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 D (map_zip_with f ma mb) = dom D ma ∩ dom D mb.
+    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 D m = X1 ∪ X2 →
-    ∃ m1 m2, m = m1 ∪ m2 ∧ m1 ##ₘ m2 ∧ dom D m1 = X1 ∧ dom D m2 = 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 D2 (kmap (M2:=M2) f m) = set_map f (dom D m).
+  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 D (∅:M A)) False.
+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 D m) Q →
-  SetUnfoldElemOf i (dom D (alter f j m)) Q.
-Proof. constructor. by rewrite dom_alter, (set_unfold_elem_of _ (dom _ _) _). Qed.
+  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 D m) Q →
-  SetUnfoldElemOf i (dom D (<[j:=x]> m)) (i = j ∨ 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.
+    (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 D m) Q →
-  SetUnfoldElemOf i (dom D (delete j m)) (Q ∧ i ≠ j).
+  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.
+    (set_unfold_elem_of _ (dom _) _), elem_of_singleton.
 Qed.
 Global Instance set_unfold_dom_singleton {A} i j x :
-  SetUnfoldElemOf i (dom D ({[ j := x ]} : M A)) (i = j).
+  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 D m1) Q1 → SetUnfoldElemOf i (dom D m2) Q2 →
-  SetUnfoldElemOf i (dom D (m1 ∪ m2)) (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 _ _) _).
+    !(set_unfold_elem_of _ (dom _) _).
 Qed.
 Global Instance set_unfold_dom_intersection {A} i (m1 m2 : M A) Q1 Q2 :
-  SetUnfoldElemOf i (dom D m1) Q1 → SetUnfoldElemOf i (dom D m2) Q2 →
-  SetUnfoldElemOf i (dom D (m1 ∩ m2)) (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 _ _) _).
+    !(set_unfold_elem_of _ (dom _) _).
 Qed.
 Global Instance set_unfold_dom_difference {A} i (m1 m2 : M A) Q1 Q2 :
-  SetUnfoldElemOf i (dom D m1) Q1 → SetUnfoldElemOf i (dom D m2) Q2 →
-  SetUnfoldElemOf i (dom D (m1 ∖ m2)) (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 _ _) _).
+    !(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 D m) Q →
-  SetUnfoldElemOf i (dom D (f <$> m)) Q.
-Proof. constructor. by rewrite dom_fmap, (set_unfold_elem_of _ (dom _ _) _). Qed.
+  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 D (map_seq start (M:=M A) xs) ≡ set_seq start (length xs).
+  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 D (map_seq (M:=M A) start xs) = set_seq start (length xs).
+  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 D (map_seq start (M:=M A) xs)) (start ≤ i < start + length xs).
+  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.

theories/fin_maps.v → stdpp/fin_maps.v

@@ -11,27 +11,34 @@ locally (or things moved out of sections) as no default works well enough. *)
 Unset Default Proof Using.
 
 (** * Axiomatization of finite maps *)
-(** We require Leibniz equality to be extensional on finite maps. This of
-course limits the space of finite map implementations, but since we are mainly
-interested in finite maps with numbers as indexes, we do not consider this to
-be a serious limitation. The main application of finite maps is to implement
-the memory, where extensionality of Leibniz equality is very important for a
-convenient use in the assertions of our axiomatic semantics. *)
-
-(** Finiteness is axiomatized by requiring that each map can be translated
-to an association list. The translation to association lists is used to
-prove well founded recursion on finite maps. *)
+(** We require Leibniz equality of finite maps to be extensional, i.e., to enjoy
+[(∀ i, m1 !! i = m2 !! i) → m1 = m2]. This is a very useful property as it
+avoids the need for setoid rewriting in proof. However, it comes at the cost of
+restricting what map implementations we support. Since Coq does not have
+quotient types, it rules out balanced search trees (AVL, red-black, etc.). We
+do provide a reasonably efficient implementation of binary tries (see [gmap]
+and [Pmap]). *)
+
+(** Finiteness is axiomatized through a fold operation [map_fold f b m], which
+folds a function [f] over each element of the map [m]. The order in which the
+elements are passed to [f] is unspecified. *)
+
+Class MapFold K A M := map_fold B : (K → A → B → B) → B → M → B.
+Global Arguments map_fold {_ _ _ _ _} _ _ _.
+Global Hint Mode MapFold - - ! : typeclass_instances.
+Global Hint Mode MapFold ! - - : typeclass_instances.
+
+(** Make sure that [map_fold] (and definitions based on it) are not unfolded
+too eagerly by unification. See [only_evens_Some] in [tests/pmap_gmap] for an
+example. We use level 1 because it is the least level for which the test works. *)
+Global Strategy 1 [map_fold].
 
 (** Finite map implementations are required to implement the [merge] function
 which enables us to give a generic implementation of [union_with],
-[intersection_with], and [difference_with]. *)
-
-Class FinMapToList K A M := map_to_list: M → list (K * A).
-Global Hint Mode FinMapToList ! - - : typeclass_instances.
-Global Hint Mode FinMapToList - - ! : typeclass_instances.
+[intersection_with], and [difference_with].
 
-(** The function [diag_None f] is used in the specification and lemmas of
-[merge f]. It lifts a function [f : option A → option B → option C] by returning
+The function [diag_None f] is used in the specification and lemmas of [merge f].
+It lifts a function [f : option A → option B → option C] by returning
 [None] if both arguments are [None], to make sure that in [merge f m1 m2], the
 function [f] can only operate on elements that are in the domain of either [m1]
 or [m2]. *)
@@ -39,8 +46,13 @@ Definition diag_None {A B C} (f : option A → option B → option C)
     (mx : option A) (my : option B) : option C :=
   match mx, my with None, None => None | _, _ => f mx my end.
 
+(** We need the [insert] operation as part of the [map_fold_ind] rule in the
+[FinMap] interface. Hence we define it before the other derived operations. *)
+Global Instance map_insert `{PartialAlter K A M} : Insert K A M :=
+  λ i x, partial_alter (λ _, Some x) i.
+
 Class FinMap K M `{FMap M, ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A,
-    PartialAlter K A (M A), OMap M, Merge M, ∀ A, FinMapToList K A (M A),
+    PartialAlter K A (M A), OMap M, Merge M, ∀ A, MapFold K A (M A),
     EqDecision K} := {
   map_eq {A} (m1 m2 : M A) : (∀ i, m1 !! i = m2 !! i) → m1 = m2;
   lookup_empty {A} i : (∅ : M A) !! i = None;
@@ -49,13 +61,28 @@ Class FinMap K M `{FMap M, ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A,
   lookup_partial_alter_ne {A} f (m : M A) i j :
     i ≠ j → partial_alter f i m !! j = m !! j;
   lookup_fmap {A B} (f : A → B) (m : M A) i : (f <$> m) !! i = f <$> m !! i;
-  NoDup_map_to_list {A} (m : M A) : NoDup (map_to_list m);
-  elem_of_map_to_list {A} (m : M A) i x :
-    (i,x) ∈ map_to_list m ↔ m !! i = Some x;
   lookup_omap {A B} (f : A → option B) (m : M A) i :
     omap f m !! i = m !! i ≫= f;
   lookup_merge {A B C} (f : option A → option B → option C) (m1 : M A) (m2 : M B) i :
-    merge f m1 m2 !! i = diag_None f (m1 !! i) (m2 !! i)
+    merge f m1 m2 !! i = diag_None f (m1 !! i) (m2 !! i);
+  map_fold_empty {A B} (f : K → A → B → B) (b : B) :
+    map_fold f b ∅ = b;
+  (** The law [map_fold_fmap_ind] implies that all uses of [map_fold] and the
+  induction principle traverse the map in the same way. This also means that
+  [map_fold] enjoys parametricity, i.e., the order cannot depend on the choice
+  of [A], [B], [f], and [b]. To make sure it cannot depend on [A], we quantify
+  over a function [g : A → A')].
+  This law can be used with [induction m as ... using map_fold_fmap_ind], but
+  in practice [map_first_key_ind] is more convenient. *)
+  map_fold_fmap_ind {A} (P : M A → Prop) :
+    P ∅ →
+    (∀ i x m,
+      m !! i = None →
+      (∀ A' B (f : K → A' → B → B) (g : A → A') b x',
+        map_fold f b (<[i:=x']> (g <$> m)) = f i x' (map_fold f b (g <$> m))) →
+      P m →
+      P (<[i:=x]> m)) →
+    ∀ m, P m;
 }.
 
 (** * Derived operations *)
@@ -63,8 +90,6 @@ Class FinMap K M `{FMap M, ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A,
 finite map implementations. These generic implementations do not cause a
 significant performance loss, which justifies including them in the finite map
 interface as primitive operations. *)
-Global Instance map_insert `{PartialAlter K A M} : Insert K A M :=
-  λ i x, partial_alter (λ _, Some x) i.
 Global Instance map_alter `{PartialAlter K A M} : Alter K A M :=
   λ f, partial_alter (fmap f).
 Global Instance map_delete `{PartialAlter K A M} : Delete K M :=
@@ -75,10 +100,19 @@ Global Instance map_singleton `{PartialAlter K A M, Empty M} :
 Definition list_to_map `{Insert K A M, Empty M} : list (K * A) → M :=
   fold_right (λ p, <[p.1:=p.2]>) ∅.
 
-Global Instance map_size `{FinMapToList K A M} : Size M := λ m,
-  length (map_to_list m).
+Global Instance map_size `{MapFold K A M} : Size M :=
+  map_fold (λ _ _, S) 0.
+
+Definition map_to_list `{MapFold K A M} : M → list (K * A) :=
+  map_fold (λ i x, ((i,x) ::.)) [].
+
+(** The key [i] is the first to occur in the conversion to list/fold of [m].
+This definition is useful in combination with [map_first_key_ind] and
+[map_fold_insert_first_key]/[map_to_list_insert_first_key]. *)
+Definition map_first_key `{MapFold K A M} (m : M) (i : K) :=
+  ∃ x, map_to_list m !! 0 = Some (i,x).
 
-Definition map_to_set `{FinMapToList K A M,
+Definition map_to_set `{MapFold K A M,
     Singleton B C, Empty C, Union C} (f : K → A → B) (m : M) : C :=
   list_to_set (uncurry f <$> map_to_list m).
 Definition set_to_map `{Elements B C, Insert K A M, Empty M}
@@ -100,19 +134,33 @@ Global Instance map_equiv `{∀ A, Lookup K A (M A), Equiv A} : Equiv (M A) | 20
 Definition map_Forall `{Lookup K A M} (P : K → A → Prop) : M → Prop :=
   λ m, ∀ i x, m !! i = Some x → P i x.
 
-Definition map_relation `{∀ A, Lookup K A (M A)} {A B} (R : A → B → Prop)
-    (P : A → Prop) (Q : B → Prop) (m1 : M A) (m2 : M B) : Prop := ∀ i,
-  option_relation R P Q (m1 !! i) (m2 !! i).
-Definition map_included `{∀ A, Lookup K A (M A)} {A}
-  (R : relation A) : relation (M A) := map_relation R (λ _, False) (λ _, True).
+Definition map_Exists `{Lookup K A M} (P : K → A → Prop) : M → Prop :=
+  λ m, ∃ i x, m !! i = Some x ∧ P i x.
+
+Definition map_relation `{∀ A, Lookup K A (M A)} {A B} (R : K → A → B → Prop)
+    (P : K → A → Prop) (Q : K → B → Prop) (m1 : M A) (m2 : M B) : Prop :=
+  ∀ i, option_relation (R i) (P i) (Q i) (m1 !! i) (m2 !! i).
+
+Definition map_Forall2 `{∀ A, Lookup K A (M A)} {A B}
+    (R : K → A → B → Prop) (m1 : M A) (m2 : M B) : Prop :=
+  ∀ i, option_Forall2 (R i) (m1 !! i) (m2 !! i).
+
+Definition map_included `{∀ A, Lookup K A (M A)} {A B}
+    (R : K → A → B → Prop) : M A → M B → Prop :=
+  map_relation R (λ _ _, False) (λ _ _, True).
+
+Definition map_agree `{∀ A, Lookup K A (M A)} {A} : relation (M A) :=
+  map_relation (λ _, (=)) (λ _ _, True) (λ _ _, True).
+
 Definition map_disjoint `{∀ A, Lookup K A (M A)} {A} : relation (M A) :=
-  map_relation (λ _ _, False) (λ _, True) (λ _, True).
+  map_relation (λ _ _ _, False) (λ _ _, True) (λ _ _, True).
 Infix "##ₘ" := map_disjoint (at level 70) : stdpp_scope.
 Global Hint Extern 0 (_ ##ₘ _) => symmetry; eassumption : core.
 Notation "( m ##ₘ.)" := (map_disjoint m) (only parsing) : stdpp_scope.
 Notation "(.##ₘ m )" := (λ m2, m2 ##ₘ m) (only parsing) : stdpp_scope.
+
 Global Instance map_subseteq `{∀ A, Lookup K A (M A)} {A} : SubsetEq (M A) :=
-  map_included (=).
+  map_included (λ _, (=)).
 
 (** The union of two finite maps only has a meaningful definition for maps
 that are disjoint. However, as working with partial functions is inconvenient
@@ -127,11 +175,13 @@ index contains a value in the second map as well. *)
 Global Instance map_difference `{Merge M} {A} : Difference (M A) :=
   difference_with (λ _ _, None).
 
-(** A stronger variant of map that allows the mapped function to use the index
-of the elements. Implemented by conversion to lists, so not very efficient. *)
+(** A stronger variant of [fmap] that allows the mapped function to use the
+index of the elements. Implemented by folding over the map, and repeatedly
+inserting the new elements, so not very efficient. (For [gmap] this function is
+[O (n log n)], while [fmap] is [O (n)] in the size [n] of the map. *)
 Definition map_imap `{∀ A, Insert K A (M A), ∀ A, Empty (M A),
-    ∀ A, FinMapToList K A (M A)} {A B} (f : K → A → option B) (m : M A) : M B :=
-  list_to_map (omap (λ ix, (fst ix ,.) <$> uncurry f ix) (map_to_list m)).
+    ∀ A, MapFold K A (M A)} {A B} (f : K → A → option B) : M A → M B :=
+  map_fold (λ i x m, match f i x with Some y => <[i:=y]> m | None => m end) ∅.
 
 (** Given a function [f : K1 → K2], the function [kmap f] turns a maps with
 keys of type [K1] into a map with keys of type [K2]. The function [kmap f]
@@ -139,7 +189,7 @@ is only well-behaved if [f] is injective, as otherwise it could map multiple
 entries into the same entry. All lemmas about [kmap f] thus have the premise
 [Inj (=) (=) f]. *)
 Definition kmap `{∀ A, Insert K2 A (M2 A), ∀ A, Empty (M2 A),
-    ∀ A, FinMapToList K1 A (M1 A)} {A} (f : K1 → K2) (m : M1 A) : M2 A :=
+    ∀ A, MapFold K1 A (M1 A)} {A} (f : K1 → K2) (m : M1 A) : M2 A :=
   list_to_map (fmap (prod_map f id) (map_to_list m)).
 
 (* The zip operation on maps combines two maps key-wise. The keys of resulting
@@ -149,13 +199,8 @@ Definition map_zip_with `{Merge M} {A B C} (f : A → B → C) : M A → M B →
     match mx, my with Some x, Some y => Some (f x y) | _, _ => None end).
 Notation map_zip := (map_zip_with pair).
 
-(* Folds a function [f] over a map. The order in which the function is called
-is unspecified. *)
-Definition map_fold `{FinMapToList K A M} {B}
-  (f : K → A → B → B) (b : B) : M → B := foldr (uncurry f) b ∘ map_to_list.
-
 Global Instance map_filter
-    `{FinMapToList K A M, Insert K A M, Empty M} : Filter (K * A) M :=
+    `{MapFold K A M, Insert K A M, Empty M} : Filter (K * A) M :=
   λ P _, map_fold (λ k v m, if decide (P (k,v)) then <[k := v]>m else m) ∅.
 
 Fixpoint map_seq `{Insert nat A M, Empty M} (start : nat) (xs : list A) : M :=
@@ -164,9 +209,42 @@ Fixpoint map_seq `{Insert nat A M, Empty M} (start : nat) (xs : list A) : M :=
   | x :: xs => <[start:=x]> (map_seq (S start) xs)
   end.
 
+Fixpoint map_seqZ `{Insert Z A M, Empty M} (start : Z) (xs : list A) : M :=
+  match xs with
+  | [] => ∅
+  | x :: xs => <[start:=x]> (map_seqZ (Z.succ start) xs)
+  end.
+
 Global Instance map_lookup_total `{!Lookup K A (M A), !Inhabited A} :
   LookupTotal K A (M A) | 20 := λ i m, default inhabitant (m !! i).
-Typeclasses Opaque map_lookup_total.
+Global Typeclasses Opaque map_lookup_total.
+
+(** Given a finite map [m : M] with keys [K] and values [A], the image [map_img m]
+gives a finite set containing with the values [A] of [m]. The type of [map_img]
+is generic to support different map and set implementations. A possible instance
+is [SA:=gset A]. *)
+Definition map_img `{MapFold K A M,
+  Singleton A SA, Empty SA, Union SA} : M → SA := map_to_set (λ _ x, x).
+Global Typeclasses Opaque map_img.
+
+(** Given a finite map [m] with keys [K] and values [A], the preimage
+[map_preimg m] gives a finite map with keys [A] and values being sets of [K].
+The type of [map_preimg] is very generic to support different map and set
+implementations. A possible instance is [MKA:=gmap K A], [MASK:=gmap A (gset K)],
+and [SK:=gset K]. *)
+Definition map_preimg `{MapFold K A MKA, Empty MASK,
+    PartialAlter A SK MASK, Empty SK, Singleton K SK, Union SK}
+    (m : MKA) : MASK :=
+  map_fold (λ i, partial_alter (λ mX, Some $ {[ i ]} ∪ default ∅ mX)) ∅ m.
+Global Typeclasses Opaque map_preimg.
+
+Definition map_compose `{OMap MA, Lookup B C MB}
+  (m : MB) (n : MA B) : MA C := omap (m !!.) n.
+
+Infix "∘ₘ" := map_compose (at level 65, right associativity) : stdpp_scope.
+Notation "(∘ₘ)" := map_compose (only parsing) : stdpp_scope.
+Notation "( m ∘ₘ.)" := (map_compose m) (only parsing) : stdpp_scope.
+Notation "(.∘ₘ m )" := (λ n, map_compose n m) (only parsing) : stdpp_scope.
 
 (** * Theorems *)
 Section theorems.
@@ -181,8 +259,8 @@ Proof.
   unfold subseteq, map_subseteq, map_relation. split; intros Hm i;
     specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver.
 Qed.
-Global Instance map_included_preorder {A} (R : relation A) :
-  PreOrder R → PreOrder (map_included R : relation (M A)).
+Global Instance map_included_preorder {A} (R : K → relation A) :
+  (∀ i, PreOrder (R i)) → PreOrder (map_included R : relation (M A)).
 Proof.
   split; [intros m i; by destruct (m !! i); simpl|].
   intros m1 m2 m3 Hm12 Hm23 i; specialize (Hm12 i); specialize (Hm23 i).
@@ -209,7 +287,7 @@ Lemma lookup_weaken {A} (m1 m2 : M A) i x :
 Proof. rewrite !map_subseteq_spec. auto. Qed.
 Lemma lookup_weaken_is_Some {A} (m1 m2 : M A) i :
   is_Some (m1 !! i) → m1 ⊆ m2 → is_Some (m2 !! i).
-Proof. inversion 1. eauto using lookup_weaken. Qed.
+Proof. inv 1. eauto using lookup_weaken. Qed.
 Lemma lookup_weaken_None {A} (m1 m2 : M A) i :
   m2 !! i = None → m1 ⊆ m2 → m1 !! i = None.
 Proof.
@@ -228,10 +306,10 @@ Proof.
   - intros Hm. apply map_eq. intros i. by rewrite Hm, lookup_empty.
 Qed.
 Lemma lookup_empty_is_Some {A} i : ¬is_Some ((∅ : M A) !! i).
-Proof. rewrite lookup_empty. by inversion 1. Qed.
+Proof. rewrite lookup_empty. by inv 1. Qed.
 Lemma lookup_empty_Some {A} i (x : A) : ¬(∅ : M A) !! i = Some x.
 Proof. by rewrite lookup_empty. Qed.
-Lemma loopup_total_empty `{!Inhabited A} i : (∅ : M A) !!! i = inhabitant.
+Lemma lookup_total_empty `{!Inhabited A} i : (∅ : M A) !!! i = inhabitant.
 Proof. by rewrite lookup_total_alt, lookup_empty. Qed.
 Lemma map_subset_empty {A} (m : M A) : m ⊄ ∅.
 Proof.
@@ -240,6 +318,75 @@ Qed.
 Lemma map_empty_subseteq {A} (m : M A) : ∅ ⊆ m.
 Proof. apply map_subseteq_spec. intros k v []%lookup_empty_Some. Qed.
 
+(** Induction principles for [map_fold] *)
+(** Use [map_first_key_ind] instead. *)
+Local Lemma map_fold_ind {A} (P : M A → Prop) :
+  P ∅ →
+  (∀ i x m,
+    m !! i = None →
+    (∀ B (f : K → A → B → B) b x',
+      map_fold f b (<[i:=x']> m) = f i x' (map_fold f b m)) →
+    P m →
+    P (<[i:=x]> m)) →
+  ∀ m, P m.
+Proof.
+  intros Hemp Hins m.
+  induction m as [|i x m ? Hfold IH] using map_fold_fmap_ind; [done|].
+  apply Hins; [done| |done]. intros B f b x'.
+  assert (m = id <$> m) as ->.
+  { apply map_eq; intros j; by rewrite lookup_fmap, option_fmap_id. }
+  apply Hfold.
+Qed.
+
+(** Use as [induction m as ... using map_first_key_ind]. In the inductive case
+[map_first_key (<[i:=x]> m) i] can be used in combination with the lemmas
+[map_fold_insert_first_key] and [map_to_list_first_key]. *)
+Lemma map_first_key_ind {A} (P : M A → Prop) :
+  P ∅ →
+  (∀ i x m,
+    m !! i = None → map_first_key (<[i:=x]> m) i →
+    P m →
+    P (<[i:=x]> m)) →
+  ∀ m, P m.
+Proof.
+  intros Hemp Hins m.
+  induction m as [|i x m ? Hfold IH] using map_fold_ind; first done.
+  apply Hins; [done| |done]. unfold map_first_key, map_to_list.
+  rewrite Hfold. eauto.
+Qed.
+
+(** The lemma [map_fold_weak_ind] exists for backwards compatibility; use
+[map_first_key_ind] instead, which is much more convenient to use. *)
+Lemma map_fold_weak_ind {A B} (P : B → M A → Prop) (f : K → A → B → B) (b : B) :
+  P b ∅ →
+  (∀ i x m r, m !! i = None → P r m → P (f i x r) (<[i:=x]> m)) →
+  ∀ m, P (map_fold f b m) m.
+Proof.
+  intros Hemp Hins m. induction m as [|i x m ? Hfold IH] using map_fold_ind.
+  - by rewrite map_fold_empty.
+  - rewrite Hfold. by apply Hins.
+Qed.
+
+(** [NoDup_map_to_list] and [NoDup_map_to_list] need to be proved mutually,
+hence a [Local] helper lemma. *)
+Local Lemma map_to_list_spec {A} (m : M A) :
+  NoDup (map_to_list m) ∧ (∀ i x, (i,x) ∈ map_to_list m ↔ m !! i = Some x).
+Proof.
+  apply (map_fold_weak_ind (λ l m,
+    NoDup l ∧ ∀ i x, (i,x) ∈ l ↔ m !! i = Some x)); clear m.
+  { split; [constructor|]. intros i x. by rewrite elem_of_nil, lookup_empty. }
+  intros i x m l ? [IH1 IH2]. split; [constructor; naive_solver|].
+  intros j y. rewrite elem_of_cons, IH2.
+  unfold insert, map_insert. destruct (decide (i = j)) as [->|].
+  - rewrite lookup_partial_alter. naive_solver.
+  - rewrite lookup_partial_alter_ne by done. naive_solver.
+Qed.
+Lemma NoDup_map_to_list {A} (m : M A) : NoDup (map_to_list m).
+Proof. apply map_to_list_spec. Qed.
+Lemma elem_of_map_to_list {A} (m : M A) i x :
+  (i,x) ∈ map_to_list m ↔ m !! i = Some x.
+Proof. apply map_to_list_spec. Qed.
+
 Lemma map_subset_alt {A} (m1 m2 : M A) :
   m1 ⊂ m2 ↔ m1 ⊆ m2 ∧ ∃ i, m1 !! i = None ∧ is_Some (m2 !! i).
 Proof.
@@ -301,6 +448,18 @@ Proof.
   intros Hi Hfi. apply map_subset_alt; split; [by apply partial_alter_subseteq|].
   exists i. by rewrite lookup_partial_alter.
 Qed.
+Lemma lookup_partial_alter_Some {A} (f : option A → option A) (m : M A) i j x :
+  partial_alter f i m !! j = Some x ↔
+    (i = j ∧ f (m !! i) = Some x) ∨ (i ≠ j ∧ m !! j = Some x).
+Proof.
+  destruct (decide (i = j)); subst.
+  - rewrite lookup_partial_alter. naive_solver.
+  - rewrite lookup_partial_alter_ne; naive_solver.
+Qed.
+Lemma lookup_total_partial_alter {A} `{Inhabited A}
+    (f : option A → option A) (m : M A) i:
+  partial_alter f i m !!! i = default inhabitant (f (m !! i)).
+Proof. by rewrite lookup_total_alt, lookup_partial_alter. Qed.
 
 (** ** Properties of the [alter] operation *)
 Lemma lookup_alter {A} (f : A → A) (m : M A) i : alter f i m !! i = f <$> m !! i.
@@ -320,6 +479,16 @@ Qed.
 Lemma alter_commute {A} (f g : A → A) (m : M A) i j :
   i ≠ j → alter f i (alter g j m) = alter g j (alter f i m).
 Proof. apply partial_alter_commute. Qed.
+Lemma alter_insert {A} (m : M A) i f x :
+  alter f i (<[i := x]> m) = <[i := f x]> m.
+Proof.
+  unfold alter, insert, map_alter, map_insert.
+  by rewrite <-partial_alter_compose.
+Qed.
+Lemma alter_insert_ne {A} (m : M A) i j f x :
+  i ≠ j →
+  alter f i (<[j := x]> m) = <[j := x]> (alter f i m).
+Proof. intros. symmetry. by apply partial_alter_commute. Qed.
 Lemma lookup_alter_Some {A} (f : A → A) (m : M A) i j y :
   alter f i m !! j = Some y ↔
     (i = j ∧ ∃ x, m !! j = Some x ∧ y = f x) ∨ (i ≠ j ∧ m !! j = Some y).
@@ -392,9 +561,6 @@ Lemma delete_commute {A} (m : M A) i j :
 Proof.
   destruct (decide (i = j)) as [->|]; [done|]. by apply partial_alter_commute.
 Qed.
-Lemma delete_insert_ne {A} (m : M A) i j x :
-  i ≠ j → delete i (<[j:=x]>m) = <[j:=x]>(delete i m).
-Proof. intro. by apply partial_alter_commute. Qed.
 Lemma delete_notin {A} (m : M A) i : m !! i = None → delete i m = m.
 Proof.
   intros. apply map_eq. intros j. by destruct (decide (i = j)) as [->|?];
@@ -415,6 +581,18 @@ Proof. apply delete_partial_alter. Qed.
 Lemma delete_insert_delete {A} (m : M A) i x :
   delete i (<[i:=x]>m) = delete i m.
 Proof. by setoid_rewrite <-partial_alter_compose. Qed.
+Lemma delete_insert_ne {A} (m : M A) i j x :
+  i ≠ j → delete i (<[j:=x]>m) = <[j:=x]>(delete i m).
+Proof. intro. by apply partial_alter_commute. Qed.
+Lemma delete_alter {A} (m : M A) i f :
+  delete i (alter f i m) = delete i m.
+Proof.
+  unfold delete, alter, map_delete, map_alter.
+  by rewrite <-partial_alter_compose.
+Qed.
+Lemma delete_alter_ne {A} (m : M A) i j f :
+  i ≠ j → delete i (alter f j m) = alter f j (delete i m).
+Proof. intro. by apply partial_alter_commute. Qed.
 Lemma delete_subseteq {A} (m : M A) i : delete i m ⊆ m.
 Proof.
   rewrite !map_subseteq_spec. intros j x. rewrite lookup_delete_Some. tauto.
@@ -473,8 +651,8 @@ Proof.
   intros; apply map_eq; intros j; destruct (decide (i = j)) as [->|];
     by rewrite ?lookup_insert, ?lookup_insert_ne by done.
 Qed.
-Lemma insert_included {A} R `{!Reflexive R} (m : M A) i x :
-  (∀ y, m !! i = Some y → R y x) → map_included R m (<[i:=x]>m).
+Lemma insert_included {A} R `{!∀ i, Reflexive (R i)} (m : M A) i x :
+  (∀ y, m !! i = Some y → R i y x) → map_included R m (<[i:=x]>m).
 Proof.
   intros ? j; destruct (decide (i = j)) as [->|].
   - rewrite lookup_insert. destruct (m !! j); simpl; eauto.
@@ -618,6 +796,15 @@ Proof.
 Qed.
 
 (** ** Properties of the map operations *)
+Lemma lookup_total_fmap `{!Inhabited A, !Inhabited B} (f : A → B) (m : M A) i :
+  (f <$> m) !!! i =
+    match m !! i with Some _ => f (m !!! i) | None => inhabitant end.
+Proof. rewrite !lookup_total_alt, lookup_fmap. by destruct (m !! i). Qed.
+Lemma lookup_total_fmap' `{!Inhabited A, !Inhabited B}
+    (f : A → B) (m : M A) i :
+  is_Some (m !! i) → (f <$> m) !!! i = f (m !!! i).
+Proof. intros [x Hi]. by rewrite lookup_total_fmap, Hi. Qed.
+
 Global Instance map_fmap_inj {A B} (f : A → B) :
   Inj (=) (=) f → Inj (=@{M A}) (=@{M B}) (fmap f).
 Proof.
@@ -649,13 +836,41 @@ Qed.
 Lemma fmap_empty_inv {A B} (f : A → B) m : f <$> m =@{M B} ∅ → m = ∅.
 Proof. apply fmap_empty_iff. Qed.
 
-Lemma fmap_insert {A B} (f: A → B) (m : M A) i x :
-  f <$> <[i:=x]>m = <[i:=f x]>(f <$> m).
+Lemma fmap_delete {A B} (f: A → B) (m : M A) i :
+  f <$> delete i m = delete i (f <$> m).
+Proof.
+  apply map_eq; intros i'; destruct (decide (i' = i)) as [->|].
+  - by rewrite lookup_fmap, !lookup_delete.
+  - by rewrite lookup_fmap, !lookup_delete_ne, lookup_fmap by done.
+Qed.
+Lemma omap_delete {A B} (f: A → option B) (m : M A) i :
+  omap f (delete i m) = delete i (omap f m).
+Proof.
+  apply map_eq; intros i'; destruct (decide (i' = i)) as [->|].
+  - by rewrite lookup_omap, !lookup_delete.
+  - by rewrite lookup_omap, !lookup_delete_ne, lookup_omap by done.
+Qed.
+
+Lemma fmap_insert {A B} (f : A → B) (m : M A) i x :
+  f <$> <[i:=x]> m = <[i:=f x]> (f <$> m).
 Proof.
   apply map_eq; intros i'; destruct (decide (i' = i)) as [->|].
   - by rewrite lookup_fmap, !lookup_insert.
   - by rewrite lookup_fmap, !lookup_insert_ne, lookup_fmap by done.
 Qed.
+Lemma fmap_insert_inv {A B} (f : A → B) (m1 : M A) (m2 : M B) i y :
+  m2 !! i = None →
+  f <$> m1 = <[i:=y]> m2 →
+  ∃ x m1', y = f x ∧ m1' !! i = None ∧ m1 = <[i:=x]> m1' ∧ m2 = f <$> m1'.
+Proof.
+  intros ? Hm. pose proof (f_equal (.!! i) Hm) as Hmi.
+  rewrite lookup_fmap, lookup_insert, fmap_Some in Hmi.
+  destruct Hmi as (x & ? & ->). exists x, (delete i m1). split; [done|].
+  split; [by rewrite lookup_delete|].
+  split; [by rewrite insert_delete|].
+  by rewrite fmap_delete, Hm, delete_insert by done.
+Qed.
+
 Lemma omap_insert {A B} (f : A → option B) (m : M A) i x :
   omap f (<[i:=x]>m) =
     (match f x with Some y => <[i:=y]> | None => delete i end) (omap f m).
@@ -676,21 +891,6 @@ Lemma omap_insert_None {A B} (f : A → option B) (m : M A) i x :
   f x = None → omap f (<[i:=x]>m) = delete i (omap f m).
 Proof. intros Hx. by rewrite omap_insert, Hx. Qed.
 
-Lemma fmap_delete {A B} (f: A → B) (m : M A) i :
-  f <$> delete i m = delete i (f <$> m).
-Proof.
-  apply map_eq; intros i'; destruct (decide (i' = i)) as [->|].
-  - by rewrite lookup_fmap, !lookup_delete.
-  - by rewrite lookup_fmap, !lookup_delete_ne, lookup_fmap by done.
-Qed.
-Lemma omap_delete {A B} (f: A → option B) (m : M A) i :
-  omap f (delete i m) = delete i (omap f m).
-Proof.
-  apply map_eq; intros i'; destruct (decide (i' = i)) as [->|].
-  - by rewrite lookup_omap, !lookup_delete.
-  - by rewrite lookup_omap, !lookup_delete_ne, lookup_omap by done.
-Qed.
-
 Lemma map_fmap_singleton {A B} (f : A → B) i x :
   f <$> {[i := x]} =@{M B} {[i := f x]}.
 Proof.
@@ -699,13 +899,8 @@ Qed.
 Lemma map_fmap_singleton_inv {A B} (f : A → B) (m : M A) i y :
   f <$> m = {[i := y]} → ∃ x, y = f x ∧ m = {[ i := x ]}.
 Proof.
-  intros Hm. pose proof (f_equal (.!! i) Hm) as Hmi.
-  rewrite lookup_fmap, lookup_singleton, fmap_Some in Hmi.
-  destruct Hmi as (x&?&->). exists x. split; [done|].
-  apply map_eq; intros j. destruct (decide (i = j)) as[->|?].
-  - by rewrite lookup_singleton.
-  - rewrite lookup_singleton_ne by done.
-    apply (fmap_None f). by rewrite <-lookup_fmap, Hm, lookup_singleton_ne.
+  intros (x & m' & -> & ? & -> & Hm')%fmap_insert_inv; [|by apply lookup_empty].
+  apply symmetry in Hm' as ->%fmap_empty_inv. by exists x.
 Qed.
 
 Lemma omap_singleton {A B} (f : A → option B) i x :
@@ -921,7 +1116,11 @@ Proof.
   intros; apply NoDup_submseteq; [by eauto using NoDup_map_to_list|].
   intros [i x]. rewrite !elem_of_map_to_list; eauto using lookup_weaken.
 Qed.
-Lemma map_to_list_fmap {A B} (f : A → B) (m : M A) :
+
+(** FIXME (improve structure): Remove in favor of [map_to_list_fmap] (proved
+below), which gives [=] instead of [≡ₚ]. Moving requires a bunch of reordering
+in this file. *)
+Local Lemma map_to_list_fmap_weak {A B} (f : A → B) (m : M A) :
   map_to_list (f <$> m) ≡ₚ prod_map id f <$> map_to_list m.
 Proof.
   assert (NoDup ((prod_map id f <$> map_to_list m).*1)).
@@ -949,6 +1148,14 @@ Proof.
     auto using not_elem_of_list_to_map_1.
 Qed.
 
+Lemma length_map_to_list {A} (m : M A) :
+  length (map_to_list m) = size m.
+Proof.
+  apply (map_fold_weak_ind (λ n m, length (map_to_list m) = n)); clear m.
+  { by rewrite map_to_list_empty. }
+  intros i x m n ? IH. by rewrite map_to_list_insert, <-IH by done.
+Qed.
+
 Lemma map_choose {A} (m : M A) : m ≠ ∅ → ∃ i x, m !! i = Some x.
 Proof.
   rewrite <-map_to_list_empty_iff.
@@ -962,21 +1169,22 @@ Proof.
     by rewrite <-?map_to_list_empty_iff.
 Defined.
 
+Lemma map_choose_or_empty {A} (m : M A) : (∃ i x, m !! i = Some x) ∨ m = ∅.
+Proof. destruct (decide (m = ∅)); [right|left]; auto using map_choose. Qed.
+
 (** Properties of the imap function *)
 Lemma map_lookup_imap {A B} (f : K → A → option B) (m : M A) i :
   map_imap f m !! i = m !! i ≫= f i.
 Proof.
-  unfold map_imap; destruct (m !! i ≫= f i) as [y|] eqn:Hi; simpl.
-  - destruct (m !! i) as [x|] eqn:?; simplify_eq/=.
-    apply elem_of_list_to_map_1'.
-    { intros y'; rewrite elem_of_list_omap; intros ([i' x']&Hi'&?).
-      by rewrite elem_of_map_to_list in Hi'; simplify_option_eq. }
-    apply elem_of_list_omap; exists (i,x); split;
-      [by apply elem_of_map_to_list|by simplify_option_eq].
-  - apply not_elem_of_list_to_map; rewrite elem_of_list_fmap.
-    intros ([i' x]&->&Hi'); simplify_eq/=.
-    rewrite elem_of_list_omap in Hi'; destruct Hi' as ([j y]&Hj&?).
-    rewrite elem_of_map_to_list in Hj; simplify_option_eq.
+  unfold map_imap.
+  apply (map_fold_weak_ind (λ r m, r !! i = m !! i ≫= f i)); clear m.
+  { by rewrite !lookup_empty. }
+  intros j y m m' Hj Hi. destruct (decide (i = j)) as [->|].
+  - rewrite lookup_insert; simpl. destruct (f j y).
+    + by rewrite lookup_insert.
+    + by rewrite Hi, Hj.
+  - rewrite lookup_insert_ne by done.
+    destruct (f j y); by rewrite ?lookup_insert_ne by done.
 Qed.
 
 Lemma map_imap_Some {A} (m : M A) : map_imap (λ _, Some) m = m.
@@ -1035,14 +1243,14 @@ Qed.
 
 Lemma map_imap_empty {A B} (f : K → A → option B) :
   map_imap f ∅ =@{M B} ∅.
-Proof. unfold map_imap. by rewrite map_to_list_empty. Qed.
+Proof. apply map_eq; intros i. by rewrite map_lookup_imap, !lookup_empty. Qed.
 
 (** ** Properties of the size operation *)
 Lemma map_size_empty {A} : size (∅ : M A) = 0.
-Proof. unfold size, map_size. by rewrite map_to_list_empty. Qed.
+Proof. by rewrite <-length_map_to_list, map_to_list_empty. Qed.
 Lemma map_size_empty_iff {A} (m : M A) : size m = 0 ↔ m = ∅.
 Proof.
-  unfold size, map_size. by rewrite length_zero_iff_nil, map_to_list_empty_iff.
+  by rewrite <-length_map_to_list, length_zero_iff_nil, map_to_list_empty_iff.
 Qed.
 Lemma map_size_empty_inv {A} (m : M A) : size m = 0 → m = ∅.
 Proof. apply map_size_empty_iff. Qed.
@@ -1050,16 +1258,30 @@ Lemma map_size_non_empty_iff {A} (m : M A) : size m ≠ 0 ↔ m ≠ ∅.
 Proof. by rewrite map_size_empty_iff. Qed.
 
 Lemma map_size_singleton {A} i (x : A) : size ({[ i := x ]} : M A) = 1.
-Proof. unfold size, map_size. by rewrite map_to_list_singleton. Qed.
+Proof. by rewrite <-length_map_to_list, map_to_list_singleton. Qed.
+
+Lemma map_size_ne_0_lookup {A} (m : M A) :
+  size m ≠ 0 ↔ ∃ i, is_Some (m !! i).
+Proof.
+  rewrite map_size_non_empty_iff. split.
+  - intros Hsz. apply map_choose. intros Hemp. done.
+  - intros [i [k Hi]] ->. rewrite lookup_empty in Hi. done.
+Qed.
+Lemma map_size_ne_0_lookup_1 {A} (m : M A) :
+  size m ≠ 0 → ∃ i, is_Some (m !! i).
+Proof. intros. by eapply map_size_ne_0_lookup. Qed.
+Lemma map_size_ne_0_lookup_2 {A} (m : M A) i :
+  is_Some (m !! i) → size m ≠ 0.
+Proof. intros. eapply map_size_ne_0_lookup. eauto. Qed.
 
 Lemma map_size_insert {A} i x (m : M A) :
   size (<[i:=x]> m) = (match m !! i with Some _ => id | None => S end) (size m).
 Proof.
   destruct (m !! i) as [y|] eqn:?; simpl.
   - rewrite <-(insert_id m i y) at 2 by done. rewrite <-!(insert_delete_insert m).
-    unfold size, map_size.
+    rewrite <-!length_map_to_list.
     by rewrite !map_to_list_insert by (by rewrite lookup_delete).
-  - unfold size, map_size. by rewrite map_to_list_insert.
+  - by rewrite <-!length_map_to_list, map_to_list_insert.
 Qed.
 Lemma map_size_insert_Some {A} i x (m : M A) :
   is_Some (m !! i) → size (<[i:=x]> m) = size m.
@@ -1072,7 +1294,7 @@ Lemma map_size_delete {A} i (m : M A) :
   size (delete i m) = (match m !! i with Some _ => pred | None => id end) (size m).
 Proof.
   destruct (m !! i) as [y|] eqn:?; simpl.
-  - unfold size, map_size. by rewrite <-(map_to_list_delete m).
+  - by rewrite <-!length_map_to_list, <-(map_to_list_delete m).
   - by rewrite delete_notin.
 Qed.
 Lemma map_size_delete_Some {A} i (m : M A) :
@@ -1083,7 +1305,53 @@ Lemma map_size_delete_None {A} i (m : M A) :
 Proof. intros Hi. by rewrite map_size_delete, Hi. Qed.
 
 Lemma map_size_fmap {A B} (f : A -> B) (m : M A) : size (f <$> m) = size m.
-Proof. intros. unfold size, map_size. by rewrite map_to_list_fmap, fmap_length. Qed.
+Proof.
+  intros. by rewrite <-!length_map_to_list, map_to_list_fmap_weak, length_fmap.
+Qed.
+
+Lemma map_size_list_to_map {A} (l : list (K * A)) :
+  NoDup l.*1 →
+  size (list_to_map l : M A) = length l.
+Proof.
+  induction l; csimpl; inv 1; simplify_eq/=; [by rewrite map_size_empty|].
+  rewrite map_size_insert_None by eauto using not_elem_of_list_to_map_1.
+  eauto with f_equal.
+Qed.
+
+Lemma map_subseteq_size_eq {A} (m1 m2 : M A) :
+  m1 ⊆ m2 → size m2 ≤ size m1 → m1 = m2.
+Proof.
+  intros. apply map_to_list_inj, submseteq_length_Permutation.
+  - by apply map_to_list_submseteq.
+  - by rewrite !length_map_to_list.
+Qed.
+
+Lemma map_subseteq_size {A} (m1 m2 : M A) : m1 ⊆ m2 → size m1 ≤ size m2.
+Proof.
+  intros. rewrite <-!length_map_to_list.
+  by apply submseteq_length, map_to_list_submseteq.
+Qed.
+
+Lemma map_subset_size {A} (m1 m2 : M A) : m1 ⊂ m2 → size m1 < size m2.
+Proof.
+  intros [Hm12 Hm21]. apply Nat.le_neq. split.
+  - by apply map_subseteq_size.
+  - intros Hsize. destruct Hm21.
+    apply reflexive_eq, symmetry, map_subseteq_size_eq; auto with lia.
+Qed.
+
+(** ** Induction principles *)
+Lemma map_wf {A} : well_founded (⊂@{M A}).
+Proof. apply (wf_projected (<) size); auto using map_subset_size, lt_wf. Qed.
+
+Lemma map_ind {A} (P : M A → Prop) :
+  P ∅ → (∀ i x m, m !! i = None → P m → P (<[i:=x]>m)) → ∀ m, P m.
+Proof.
+  intros ? Hins m. induction (map_wf m) as [m _ IH].
+  destruct (map_choose_or_empty m) as [(i&x&?)| ->]; [|done].
+  rewrite <-(insert_delete m i x) by done.
+  apply Hins; [by rewrite lookup_delete|]. by apply IH, delete_subset.
+Qed.
 
 (** ** Properties of conversion from sets *)
 Section set_to_map.
@@ -1101,6 +1369,18 @@ Section set_to_map.
     unfold set_to_map; rewrite <-elem_of_list_to_map' by done.
     rewrite elem_of_list_fmap. setoid_rewrite elem_of_elements; naive_solver.
   Qed.
+End set_to_map.
+
+Lemma lookup_set_to_map_id `{FinSet (K * A) C} (X : C) i x :
+  (∀ i y y', (i,y) ∈ X → (i,y') ∈ X → y = y') →
+  (set_to_map id X : M A) !! i = Some x ↔ (i,x) ∈ X.
+Proof.
+  intros. etrans; [apply lookup_set_to_map|naive_solver].
+  intros [] [] ???; simplify_eq/=; eauto with f_equal.
+Qed.
+
+Section map_to_set.
+  Context {A : Type} `{SemiSet B C}.
 
   Lemma elem_of_map_to_set (f : K → A → B) (m : M A) (y : B) :
     y ∈ map_to_set (C:=C) f m ↔ ∃ i x, m !! i = Some x ∧ f i x = y.
@@ -1123,57 +1403,106 @@ Section set_to_map.
     m !! i = None →
     map_to_set f (<[i:=x]>m) =@{C} {[f i x]} ∪ map_to_set f m.
   Proof. unfold_leibniz. apply map_to_set_insert. Qed.
-End set_to_map.
+End map_to_set.
 
-Lemma lookup_set_to_map_id `{FinSet (K * A) C} (X : C) i x :
-  (∀ i y y', (i,y) ∈ X → (i,y') ∈ X → y = y') →
-  (set_to_map id X : M A) !! i = Some x ↔ (i,x) ∈ X.
+Lemma elem_of_map_to_set_pair `{SemiSet (K * A) C} (m : M A) i x :
+  (i,x) ∈@{C} map_to_set pair m ↔ m !! i = Some x.
+Proof. rewrite elem_of_map_to_set. naive_solver. Qed.
+
+(** ** The fold operation *)
+Lemma map_fold_foldr {A B} (f : K → A → B → B) b (m : M A) :
+  map_fold f b m = foldr (uncurry f) b (map_to_list m).
 Proof.
-  intros. etrans; [apply lookup_set_to_map|naive_solver].
-  intros [] [] ???; simplify_eq/=; eauto with f_equal.
+  unfold map_to_list. induction m as [|i x m ? Hfold IH] using map_fold_ind.
+  - by rewrite !map_fold_empty.
+  - by rewrite !Hfold, IH.
 Qed.
 
-Lemma elem_of_map_to_set_pair `{FinSet (K * A) C} (m : M A) i x :
-  (i,x) ∈@{C} map_to_set pair m ↔ m !! i = Some x.
-Proof. rewrite elem_of_map_to_set. naive_solver. Qed.
+Lemma map_fold_fmap {A A' B} (f : K → A' → B → B) (g : A → A') b (m : M A) :
+  map_fold f b (g <$> m) = map_fold (λ i, f i ∘ g) b m.
+Proof.
+  induction m as [|i x m ? Hfold IH] using map_fold_fmap_ind.
+  { by rewrite fmap_empty, !map_fold_empty. }
+  rewrite fmap_insert. rewrite <-(map_fmap_id m) at 2. rewrite !Hfold.
+  by rewrite IH, map_fmap_id.
+Qed.
 
-(** ** Induction principles *)
-Lemma map_ind {A} (P : M A → Prop) :
-  P ∅ → (∀ i x m, m !! i = None → P m → P (<[i:=x]>m)) → ∀ m, P m.
+(** FIXME (Improve order): Move to [map_to_list] section. Moving requires a
+bunch of reordering in this file. *)
+Lemma map_to_list_fmap {A B} (f : A → B) (m : M A) :
+  map_to_list (f <$> m) = prod_map id f <$> map_to_list m.
 Proof.
-  intros ? Hins. cut (∀ l, NoDup (l.*1) → ∀ m, map_to_list m ≡ₚ l → P m).
-  { intros help m.
-    apply (help (map_to_list m)); auto using NoDup_fst_map_to_list. }
-  intros l. induction l as [|[i x] l IH]; intros Hnodup m Hml.
-  { rewrite Permutation_nil_r, map_to_list_empty_iff in Hml. by rewrite Hml. }
-  inversion_clear Hnodup.
-  apply map_to_list_insert_inv in Hml; subst m. apply Hins.
-  - by apply not_elem_of_list_to_map_1.
-  - apply IH; auto using map_to_list_to_map.
+  unfold map_to_list. rewrite map_fold_fmap, !map_fold_foldr.
+  induction (map_to_list m) as [|[]]; f_equal/=; auto.
 Qed.
-Lemma map_to_list_length {A} (m1 m2 : M A) :
-  m1 ⊂ m2 → length (map_to_list m1) < length (map_to_list m2).
+
+Lemma map_fold_singleton {A B} (f : K → A → B → B) (b : B) i x :
+  map_fold f b {[i:=x]} = f i x b.
+Proof. by rewrite map_fold_foldr, map_to_list_singleton. Qed.
+
+Lemma map_fold_delete_first_key {A B} (f : K → A → B → B) b (m : M A) i x :
+  m !! i = Some x →
+  map_first_key m i →
+  map_fold f b m = f i x (map_fold f b (delete i m)).
 Proof.
-  revert m2. induction m1 as [|i x m ? IH] using map_ind.
-  { intros m2 Hm2. rewrite map_to_list_empty. simpl.
-    apply neq_0_lt. intros Hlen. symmetry in Hlen.
-    apply nil_length_inv, map_to_list_empty_iff in Hlen.
-    rewrite Hlen in Hm2. destruct (irreflexivity (⊂) ∅ Hm2). }
-  intros m2 Hm2.
-  destruct (insert_subset_inv m m2 i x) as (m2'&?&?&?); auto; subst.
-  rewrite !map_to_list_insert; simpl; auto with arith.
+  intros Hi [x' ([] & ixs & Hixs & ?)%elem_of_list_split_length]; simplify_eq/=.
+  destruct m as [|j y m ? Hfold _] using map_fold_ind.
+  { by rewrite map_to_list_empty in Hixs. }
+  unfold map_to_list in Hixs. rewrite Hfold in Hixs. simplify_eq.
+  rewrite lookup_insert in Hi. simplify_eq.
+  by rewrite Hfold, delete_insert by done.
 Qed.
-Lemma map_wf {A} : wf (⊂@{M A}).
+
+Lemma map_fold_insert_first_key {A B} (f : K → A → B → B) b (m : M A) i x :
+  m !! i = None →
+  map_first_key (<[i:=x]> m) i →
+  map_fold f b (<[i:=x]> m) = f i x (map_fold f b m).
 Proof.
-  apply (wf_projected (<) (length ∘ map_to_list)).
-  - by apply map_to_list_length.
-  - by apply lt_wf.
+  intros. rewrite <-(delete_insert m i x) at 2 by done.
+  apply map_fold_delete_first_key; auto using lookup_insert.
 Qed.
 
-(** ** The fold operation *)
-Lemma map_fold_empty {A B} (f : K → A → B → B) (b : B) :
-  map_fold f b ∅ = b.
-Proof. unfold map_fold; simpl. by rewrite map_to_list_empty. Qed.
+(** FIXME (Improve order): Move to [map_to_list] section. Moving requires a
+bunch of reordering in this file. *)
+Lemma map_to_list_delete_first_key {A} (m : M A) i x :
+  m !! i = Some x →
+  map_first_key m i →
+  map_to_list m = (i,x) :: map_to_list (delete i m).
+Proof.
+  intros. unfold map_to_list. by erewrite map_fold_delete_first_key by done.
+Qed.
+
+(** FIXME (Improve order): Move to [map_to_list] section. Moving requires a
+bunch of reordering in this file. *)
+Lemma map_to_list_insert_first_key {A} (m : M A) i x :
+  m !! i = None →
+  map_first_key (<[i:=x]> m) i →
+  map_to_list (<[i:=x]> m) = (i,x) :: map_to_list m.
+Proof.
+  intros. unfold map_to_list. by rewrite map_fold_insert_first_key by done.
+Qed.
+
+Lemma map_first_key_fmap {A B} (f : A → B) (m : M A) i :
+  map_first_key (f <$> m) i ↔ map_first_key m i.
+Proof.
+  split.
+  - intros [x Hm]. rewrite map_to_list_fmap, list_lookup_fmap, fmap_Some in Hm.
+    destruct Hm as ([i' x'] & Hm & ?); simplify_eq/=. by exists x'.
+  - intros [x Hm]. exists (f x).
+    by rewrite map_to_list_fmap, list_lookup_fmap, Hm.
+Qed.
+
+(** We do not have [dom] here, [map_first_key_same_dom] from [fin_map_dom] is
+typically more convenient. *)
+Lemma map_first_key_dom' {A B} (m1 : M A) (m2 : M B) i :
+  (∀ j, is_Some (m1 !! j) ↔ is_Some (m2 !! j)) →
+  map_first_key m1 i ↔ map_first_key m2 i.
+Proof.
+  intros Hm. rewrite <-(map_first_key_fmap (λ _, ()) m1).
+  rewrite <-(map_first_key_fmap (λ _, ()) m2). f_equiv. apply map_eq; intros j.
+  specialize (Hm j). rewrite !lookup_fmap. unfold is_Some in *.
+  destruct (m1 !! j), (m2 !! j); naive_solver.
+Qed.
 
 Lemma map_fold_insert {A B} (R : relation B) `{!PreOrder R}
     (f : K → A → B → B) (b : B) (i : K) (x : A) (m : M A) :
@@ -1184,10 +1513,10 @@ Lemma map_fold_insert {A B} (R : relation B) `{!PreOrder R}
   m !! i = None →
   R (map_fold f b (<[i:=x]> m)) (f i x (map_fold f b m)).
 Proof.
-  intros Hf_proper Hf Hi. unfold map_fold; simpl.
-  assert (∀ kz, Proper (R ==> R) (uncurry f kz)) by (intros []; apply _).
-  trans (foldr (uncurry f) b ((i, x) :: map_to_list m)); [|done].
-  eapply (foldr_permutation R (uncurry f) b), map_to_list_insert; auto.
+  intros Hf_proper Hf Hi. rewrite !map_fold_foldr.
+  change (f i x) with (uncurry f (i,x)). rewrite <-foldr_cons.
+  assert (∀ kz, Proper (R ==> R) (uncurry f kz)) by (intros []; solve_proper).
+  eapply (foldr_permutation R (uncurry f) b), map_to_list_insert; [|done].
   intros j1 [k1 y1] j2 [k2 y2] c Hj Hj1 Hj2. apply Hf.
   - intros ->.
     eapply Hj, NoDup_lookup; [apply (NoDup_fst_map_to_list (<[i:=x]> m))| | ].
@@ -1205,38 +1534,237 @@ Lemma map_fold_insert_L {A B} (f : K → A → B → B) (b : B) (i : K) (x : A)
   map_fold f b (<[i:=x]> m) = f i x (map_fold f b m).
 Proof. apply map_fold_insert; apply _. Qed.
 
-Lemma map_fold_ind {A B} (P : B → M A → Prop) (f : K → A → B → B) (b : B) :
-  P b ∅ →
-  (∀ i x m r, m !! i = None → P r m → P (f i x r) (<[i:=x]> m)) →
-  ∀ m, P (map_fold f b m) m.
+Lemma map_fold_delete {A B} (R : relation B) `{!PreOrder R}
+    (f : K → A → B → B) (b : B) (i : K) (x : A) (m : M A) :
+  (∀ j z, Proper (R ==> R) (f j z)) →
+  (∀ j1 j2 z1 z2 y,
+    j1 ≠ j2 → m !! j1 = Some z1 → m !! j2 = Some z2 →
+    R (f j1 z1 (f j2 z2 y)) (f j2 z2 (f j1 z1 y))) →
+  m !! i = Some x →
+  R (map_fold f b m) (f i x (map_fold f b (delete i m))).
 Proof.
-  intros Hemp Hinsert.
-  cut (∀ l, NoDup l →
-    ∀ m, (∀ i x, m !! i = Some x ↔ (i,x) ∈ l) → P (foldr (uncurry f) b l) m).
-  { intros help ?. apply help; [apply NoDup_map_to_list|].
-    intros i x. by rewrite elem_of_map_to_list. }
-  induction 1 as [|[i x] l ?? IH]; simpl.
-  { intros m Hm. cut (m = ∅); [by intros ->|]. apply map_empty; intros i.
-    apply eq_None_not_Some; intros [x []%Hm%elem_of_nil]. }
-  intros m Hm. assert (m !! i = Some x) by (apply Hm; by left).
-  rewrite <-(insert_delete m i x) by done.
-  apply Hinsert; auto using lookup_delete.
-  apply IH. intros j y. rewrite lookup_delete_Some, Hm. split.
-  - by intros [? [[= ??]|?]%elem_of_cons].
-  - intros ?; split; [intros ->|by right].
-    assert (m !! j = Some y) by (apply Hm; by right). naive_solver.
+  intros Hf_proper Hf Hi.
+  rewrite <-map_fold_insert; [|done|done| |].
+  - rewrite insert_delete; done.
+  - intros j1 j2 z1 z2 y. rewrite insert_delete_insert, insert_id by done. auto.
+  - rewrite lookup_delete; done.
+Qed.
+
+Lemma map_fold_delete_L {A B} (f : K → A → B → B) (b : B) (i : K) (x : A) (m : M A) :
+  (∀ j1 j2 z1 z2 y,
+    j1 ≠ j2 → m !! j1 = Some z1 → m !! j2 = Some z2 →
+    f j1 z1 (f j2 z2 y) = f j2 z2 (f j1 z1 y)) →
+  m !! i = Some x →
+  map_fold f b m = f i x (map_fold f b (delete i m)).
+Proof. apply map_fold_delete; apply _. Qed.
+
+Lemma map_fold_comm_acc_strong {A B} (R : relation B) `{!PreOrder R}
+    (f : K → A → B → B) (g : B → B) (x : B) (m : M A) :
+  (∀ j z, Proper (R ==> R) (f j z)) →
+  (∀ j z y, m !! j = Some z → R (f j z (g y)) (g (f j z y))) →
+  R (map_fold f (g x) m) (g (map_fold f x m)).
+Proof.
+  intros ? Hg. induction m as [|i x' m ? Hfold IH] using map_fold_ind.
+  { by rewrite !map_fold_empty. }
+  rewrite !Hfold.
+  rewrite <-Hg by (by rewrite lookup_insert). f_equiv. apply IH.
+  intros j z y Hj. apply Hg. rewrite lookup_insert_ne by naive_solver. done.
 Qed.
 
+Lemma map_fold_comm_acc {A B} (f : K → A → B → B) (g : B → B) (x : B) (m : M A) :
+  (∀ j z y, f j z (g y) = g (f j z y)) →
+  map_fold f (g x) m = g (map_fold f x m).
+Proof. intros. apply (map_fold_comm_acc_strong _); [solve_proper|done..]. Qed.
+
+(** Not written using [Instance .. Proper] because it is ambigious to apply due
+to the arbitrary [R]. *)
+Lemma map_fold_proper {A B} (R : relation B) `{!PreOrder R}
+    (f : K → A → B → B) (b1 b2 : B) (m : M A) :
+  (∀ j z, Proper (R ==> R) (f j z)) →
+  R b1 b2 →
+  R (map_fold f b1 m) (map_fold f b2 m).
+Proof.
+  intros Hf Hb. induction m as [|i x m ?? IH] using map_first_key_ind.
+  { by rewrite !map_fold_empty. }
+  rewrite !map_fold_insert_first_key by done. by f_equiv.
+Qed.
+
+(** ** Properties of the [map_Forall] predicate *)
+Section map_Forall.
+  Context {A} (P : K → A → Prop).
+  Implicit Types m : M A.
+
+  Lemma map_Forall_to_list m : map_Forall P m ↔ Forall (uncurry P) (map_to_list m).
+  Proof.
+    rewrite Forall_forall. split.
+    - intros Hforall [i x]. rewrite elem_of_map_to_list. by apply (Hforall i x).
+    - intros Hforall i x. rewrite <-elem_of_map_to_list. by apply (Hforall (i,x)).
+  Qed.
+  Lemma map_Forall_empty : map_Forall P (∅ : M A).
+  Proof. intros i x. by rewrite lookup_empty. Qed.
+  Lemma map_Forall_impl (Q : K → A → Prop) m :
+    map_Forall P m → (∀ i x, P i x → Q i x) → map_Forall Q m.
+  Proof. unfold map_Forall; naive_solver. Qed.
+  Lemma map_Forall_insert_1_1 m i x : map_Forall P (<[i:=x]>m) → P i x.
+  Proof. intros Hm. by apply Hm; rewrite lookup_insert. Qed.
+  Lemma map_Forall_insert_1_2 m i x :
+    m !! i = None → map_Forall P (<[i:=x]>m) → map_Forall P m.
+  Proof.
+    intros ? Hm j y ?; apply Hm. by rewrite lookup_insert_ne by congruence.
+  Qed.
+  Lemma map_Forall_insert_2 m i x :
+    P i x → map_Forall P m → map_Forall P (<[i:=x]>m).
+  Proof. intros ?? j y; rewrite lookup_insert_Some; naive_solver. Qed.
+  Lemma map_Forall_insert m i x :
+    m !! i = None → map_Forall P (<[i:=x]>m) ↔ P i x ∧ map_Forall P m.
+  Proof.
+    naive_solver eauto using map_Forall_insert_1_1,
+      map_Forall_insert_1_2, map_Forall_insert_2.
+  Qed.
+  Lemma map_Forall_singleton (i : K) (x : A) :
+    map_Forall P ({[i := x]} : M A) ↔ P i x.
+  Proof.
+    unfold map_Forall. setoid_rewrite lookup_singleton_Some. naive_solver.
+  Qed.
+  Lemma map_Forall_delete m i : map_Forall P m → map_Forall P (delete i m).
+  Proof. intros Hm j x; rewrite lookup_delete_Some. naive_solver. Qed.
+  Lemma map_Forall_lookup m :
+    map_Forall P m ↔ ∀ i x, m !! i = Some x → P i x.
+  Proof. done. Qed.
+  Lemma map_Forall_lookup_1 m i x :
+    map_Forall P m → m !! i = Some x → P i x.
+  Proof. intros ?. by apply map_Forall_lookup. Qed.
+  Lemma map_Forall_lookup_2 m :
+    (∀ i x, m !! i = Some x → P i x) → map_Forall P m.
+  Proof. intros ?. by apply map_Forall_lookup. Qed.
+  Lemma map_Forall_fmap {B} (f : B → A) (m : M B) :
+    map_Forall P (f <$> m) ↔ map_Forall (λ k, (P k ∘ f)) m.
+  Proof.
+    unfold map_Forall. setoid_rewrite lookup_fmap.
+    setoid_rewrite fmap_Some. naive_solver.
+  Qed.
+
+  Lemma map_Forall_foldr_delete m is :
+    map_Forall P m → map_Forall P (foldr delete m is).
+  Proof. induction is; eauto using map_Forall_delete. Qed.
+  Lemma map_Forall_ind (Q : M A → Prop) :
+    Q ∅ →
+    (∀ m i x, m !! i = None → P i x → map_Forall P m → Q m → Q (<[i:=x]>m)) →
+    ∀ m, map_Forall P m → Q m.
+  Proof.
+    intros Hnil Hinsert m. induction m using map_ind; auto.
+    rewrite map_Forall_insert by done; intros [??]; eauto.
+  Qed.
+
+  Context `{∀ i x, Decision (P i x)}.
+  Global Instance map_Forall_dec m : Decision (map_Forall P m).
+  Proof.
+    refine (cast_if (decide (Forall (uncurry P) (map_to_list m))));
+      by rewrite map_Forall_to_list.
+  Defined.
+  Lemma map_not_Forall (m : M A) :
+    ¬map_Forall P m ↔ ∃ i x, m !! i = Some x ∧ ¬P i x.
+  Proof.
+    split; [|intros (i&x&?&?) Hm; specialize (Hm i x); tauto].
+    rewrite map_Forall_to_list. intros Hm.
+    apply (not_Forall_Exists _), Exists_exists in Hm.
+    destruct Hm as ([i x]&?&?). exists i, x. by rewrite <-elem_of_map_to_list.
+  Qed.
+End map_Forall.
+
+(** ** Properties of the [map_Exists] predicate *)
+Section map_Exists.
+  Context {A} (P : K → A → Prop).
+  Implicit Types m : M A.
+
+  Lemma map_Exists_to_list m : map_Exists P m ↔ Exists (uncurry P) (map_to_list m).
+  Proof.
+    rewrite Exists_exists. split.
+    - intros [? [? [? ?]]]. eexists (_, _). by rewrite elem_of_map_to_list.
+    - intros [[??] [??]]. eexists _, _. by rewrite <-elem_of_map_to_list.
+  Qed.
+  Lemma map_Exists_empty : ¬ map_Exists P (∅ : M A).
+  Proof. intros [?[?[Hm ?]]]. by rewrite lookup_empty in Hm. Qed.
+  Lemma map_Exists_impl (Q : K → A → Prop) m :
+    map_Exists P m → (∀ i x, P i x → Q i x) → map_Exists Q m.
+  Proof. unfold map_Exists; naive_solver. Qed.
+  Lemma map_Exists_insert_1 m i x :
+    map_Exists P (<[i:=x]>m) → P i x ∨ map_Exists P m.
+  Proof. intros [j[y[?%lookup_insert_Some ?]]]. unfold map_Exists. naive_solver. Qed.
+  Lemma map_Exists_insert_2_1 m i x : P i x → map_Exists P (<[i:=x]>m).
+  Proof. intros Hm. exists i, x. by rewrite lookup_insert. Qed.
+  Lemma map_Exists_insert_2_2 m i x :
+    m !! i = None → map_Exists P m → map_Exists P (<[i:=x]>m).
+  Proof.
+    intros Hm [j[y[??]]]. exists j, y. by rewrite lookup_insert_ne by congruence.
+  Qed.
+  Lemma map_Exists_insert m i x :
+    m !! i = None → map_Exists P (<[i:=x]>m) ↔ P i x ∨ map_Exists P m.
+  Proof.
+    naive_solver eauto using map_Exists_insert_1,
+      map_Exists_insert_2_1, map_Exists_insert_2_2.
+  Qed.
+  Lemma map_Exists_singleton (i : K) (x : A) :
+    map_Exists P ({[i := x]} : M A) ↔ P i x.
+  Proof.
+    unfold map_Exists. setoid_rewrite lookup_singleton_Some. naive_solver.
+  Qed.
+  Lemma map_Exists_delete m i : map_Exists P (delete i m) → map_Exists P m.
+  Proof.
+    intros [j [y [Hm ?]]]. rewrite lookup_delete_Some in Hm.
+    unfold map_Exists. naive_solver.
+  Qed.
+  Lemma map_Exists_lookup m :
+    map_Exists P m ↔ ∃ i x, m !! i = Some x ∧ P i x.
+  Proof. done. Qed.
+  Lemma map_Exists_lookup_1 m :
+    map_Exists P m → ∃ i x, m !! i = Some x ∧ P i x.
+  Proof. by rewrite map_Exists_lookup. Qed.
+  Lemma map_Exists_lookup_2 m i x :
+    m !! i = Some x → P i x → map_Exists P m.
+  Proof. rewrite map_Exists_lookup. by eauto. Qed.
+  Lemma map_Exists_foldr_delete m is :
+    map_Exists P (foldr delete m is) → map_Exists P m.
+  Proof. induction is; eauto using map_Exists_delete. Qed.
+
+  Lemma map_Exists_ind (Q : M A → Prop) :
+    (∀ i x, P i x → Q {[ i := x ]}) →
+    (∀ m i x, m !! i = None → map_Exists P m → Q m → Q (<[i:=x]>m)) →
+    ∀ m, map_Exists P m → Q m.
+  Proof.
+    intros Hsingleton Hinsert m Hm. induction m as [|i x m Hi IH] using map_ind.
+    { by destruct map_Exists_empty. }
+    apply map_Exists_insert in Hm as [?|?]; [|by eauto..].
+    clear IH. induction m as [|j y m Hj IH] using map_ind; [by eauto|].
+    apply lookup_insert_None in Hi as [??].
+    rewrite insert_commute by done. apply Hinsert.
+    - by apply lookup_insert_None.
+    - apply map_Exists_insert; by eauto.
+    - eauto.
+  Qed.
+
+  Lemma map_not_Exists (m : M A) :
+    ¬map_Exists P m ↔ map_Forall (λ i x, ¬ P i x) m.
+  Proof. unfold map_Exists, map_Forall; naive_solver. Qed.
+
+  Context `{∀ i x, Decision (P i x)}.
+  Global Instance map_Exists_dec m : Decision (map_Exists P m).
+  Proof.
+    refine (cast_if (decide (Exists (uncurry P) (map_to_list m))));
+      by rewrite map_Exists_to_list.
+  Defined.
+End map_Exists.
+
 (** ** The filter operation *)
-Section map_filter_lookup.
+Section map_lookup_filter.
   Context {A} (P : K * A → Prop) `{!∀ x, Decision (P x)}.
   Implicit Types m : M A.
 
-  Lemma map_filter_lookup m i :
-    filter P m !! i = x ← m !! i; guard (P (i,x)); Some x.
+  Lemma map_lookup_filter m i :
+    filter P m !! i = x ← m !! i; guard (P (i,x));; Some x.
   Proof.
-    revert m i. apply (map_fold_ind (λ m1 m2,
-      ∀ i, m1 !! i = x ← m2 !! i; guard (P (i,x)); Some x)); intros i.
+    revert m i. apply (map_fold_weak_ind (λ m1 m2,
+      ∀ i, m1 !! i = x ← m2 !! i; guard (P (i,x));; Some x)); intros i.
     { by rewrite lookup_empty. }
     intros y m m' Hm IH j. case (decide (j = i))as [->|?].
     - case_decide.
@@ -1247,39 +1775,46 @@ Section map_filter_lookup.
       + by rewrite !lookup_insert_ne.
   Qed.
 
-  Lemma map_filter_lookup_Some m i x :
+  Lemma map_lookup_filter_Some m i x :
     filter P m !! i = Some x ↔ m !! i = Some x ∧ P (i, x).
   Proof.
-    rewrite map_filter_lookup.
-    destruct (m !! i); simpl; repeat case_option_guard; naive_solver.
+    rewrite map_lookup_filter.
+    destruct (m !! i); simpl; repeat case_guard; naive_solver.
   Qed.
-  Lemma map_filter_lookup_Some_1_1 m i x :
+  Lemma map_lookup_filter_Some_1_1 m i x :
     filter P m !! i = Some x → m !! i = Some x.
-  Proof. apply map_filter_lookup_Some. Qed.
-  Lemma map_filter_lookup_Some_1_2 m i x :
+  Proof. apply map_lookup_filter_Some. Qed.
+  Lemma map_lookup_filter_Some_1_2 m i x :
     filter P m !! i = Some x → P (i, x).
-  Proof. apply map_filter_lookup_Some. Qed.
-  Lemma map_filter_lookup_Some_2 m i x :
+  Proof. apply map_lookup_filter_Some. Qed.
+  Lemma map_lookup_filter_Some_2 m i x :
     m !! i = Some x →
     P (i, x) →
     filter P m !! i = Some x.
-  Proof. intros. by apply map_filter_lookup_Some. Qed.
+  Proof. intros. by apply map_lookup_filter_Some. Qed.
 
-  Lemma map_filter_lookup_None m i :
+  Lemma map_lookup_filter_None m i :
     filter P m !! i = None ↔ m !! i = None ∨ ∀ x, m !! i = Some x → ¬ P (i, x).
   Proof.
     rewrite eq_None_not_Some. unfold is_Some.
-    setoid_rewrite map_filter_lookup_Some. naive_solver.
+    setoid_rewrite map_lookup_filter_Some. naive_solver.
   Qed.
-  Lemma map_filter_lookup_None_1 m i :
+  Lemma map_lookup_filter_None_1 m i :
     filter P m !! i = None →
     m !! i = None ∨ ∀ x, m !! i = Some x → ¬ P (i, x).
-  Proof. apply map_filter_lookup_None. Qed.
-  Lemma map_filter_lookup_None_2 m i :
+  Proof. apply map_lookup_filter_None. Qed.
+  Lemma map_lookup_filter_None_2 m i :
     m !! i = None ∨ (∀ x : A, m !! i = Some x → ¬ P (i, x)) →
     filter P m !! i = None.
-  Proof. apply map_filter_lookup_None. Qed.
-End map_filter_lookup.
+  Proof. apply map_lookup_filter_None. Qed.
+
+  Lemma map_filter_empty_not_lookup m i x :
+    filter P m = ∅ → P (i,x) → m !! i ≠ Some x.
+  Proof.
+    rewrite map_empty. setoid_rewrite map_lookup_filter_None. intros Hm ?.
+    destruct (Hm i); naive_solver.
+  Qed.
+End map_lookup_filter.
 
 Section map_filter_ext.
   Context {A} (P Q : K * A → Prop) `{!∀ x, Decision (P x), !∀ x, Decision (Q x)}.
@@ -1289,7 +1824,7 @@ Section map_filter_ext.
     (∀ i x, (P (i, x) ∧ m1 !! i = Some x) ↔ (Q (i, x) ∧ m2 !! i = Some x)).
   Proof.
     intros. rewrite map_eq_iff. setoid_rewrite option_eq.
-    setoid_rewrite map_filter_lookup_Some. naive_solver.
+    setoid_rewrite map_lookup_filter_Some. naive_solver.
   Qed.
   Lemma map_filter_strong_ext_1 (m1 m2 : M A) :
     (∀ i x, (P (i, x) ∧ m1 !! i = Some x) ↔ (Q (i, x) ∧ m2 !! i = Some x)) →
@@ -1309,7 +1844,7 @@ Section map_filter_ext.
     (∀ i x, (P (i, x) ∧ m1 !! i = Some x) → (Q (i, x) ∧ m2 !! i = Some x)).
   Proof.
     rewrite map_subseteq_spec.
-    setoid_rewrite map_filter_lookup_Some. naive_solver.
+    setoid_rewrite map_lookup_filter_Some. naive_solver.
   Qed.
   Lemma map_filter_subseteq_ext (m : M A) :
     filter P m ⊆ filter Q m ↔
@@ -1323,21 +1858,29 @@ Section map_filter.
 
   Lemma map_filter_empty : filter P ∅ =@{M A} ∅.
   Proof. apply map_fold_empty. Qed.
-  Lemma map_filter_empty_iff m :
+  Lemma map_empty_filter m :
     filter P m = ∅ ↔ map_Forall (λ i x, ¬P (i,x)) m.
   Proof.
-    rewrite map_empty. setoid_rewrite map_filter_lookup_None. split.
+    rewrite map_empty. setoid_rewrite map_lookup_filter_None. split.
     - intros Hm i x Hi. destruct (Hm i); naive_solver.
     - intros Hm i. destruct (m !! i) as [x|] eqn:?; [|by auto].
       right; intros ? [= <-]. by apply Hm.
   Qed.
+  Lemma map_empty_filter_1 m :
+    filter P m = ∅ →
+    map_Forall (λ i x, ¬P (i,x)) m.
+  Proof. apply map_empty_filter. Qed.
+  Lemma map_empty_filter_2 m :
+    map_Forall (λ i x, ¬P (i,x)) m →
+    filter P m = ∅.
+  Proof. apply map_empty_filter. Qed.
 
   Lemma map_filter_delete m i : filter P (delete i m) = delete i (filter P m).
   Proof.
     apply map_eq. intros j. apply option_eq; intros y.
     destruct (decide (j = i)) as [->|?].
-    - rewrite map_filter_lookup_Some, !lookup_delete. naive_solver.
-    - rewrite lookup_delete_ne, !map_filter_lookup_Some, lookup_delete_ne by done.
+    - rewrite map_lookup_filter_Some, !lookup_delete. naive_solver.
+    - rewrite lookup_delete_ne, !map_lookup_filter_Some, lookup_delete_ne by done.
       naive_solver.
   Qed.
   Lemma map_filter_delete_not m i:
@@ -1353,9 +1896,9 @@ Section map_filter.
     = if decide (P (i, x)) then <[i:=x]> (filter P m) else filter P (delete i m).
   Proof.
     apply map_eq. intros j. apply option_eq; intros y.
-    rewrite map_filter_lookup_Some, lookup_insert_Some. case_decide.
-    - rewrite lookup_insert_Some, map_filter_lookup_Some. naive_solver.
-    - rewrite map_filter_lookup_Some, lookup_delete_Some. naive_solver.
+    rewrite map_lookup_filter_Some, lookup_insert_Some. case_decide.
+    - rewrite lookup_insert_Some, map_lookup_filter_Some. naive_solver.
+    - rewrite map_lookup_filter_Some, lookup_delete_Some. naive_solver.
   Qed.
   Lemma map_filter_insert_True m i x :
     P (i, x) → filter P (<[i:=x]> m) = <[i:=x]> (filter P m).
@@ -1393,7 +1936,7 @@ Section map_filter.
     { by rewrite map_to_list_empty, map_filter_empty, map_to_list_empty. }
     rewrite map_to_list_insert, filter_cons by done. destruct (decide (P _)).
     - rewrite map_filter_insert_True by done.
-      by rewrite map_to_list_insert, IH by (rewrite map_filter_lookup_None; auto).
+      by rewrite map_to_list_insert, IH by (rewrite map_lookup_filter_None; auto).
     - by rewrite map_filter_insert_not' by naive_solver.
   Qed.
 
@@ -1401,7 +1944,7 @@ Section map_filter.
     filter P (f <$> m) = f <$> filter (λ '(i, x), P (i, (f x))) m.
   Proof.
     apply map_eq. intros i. apply option_eq; intros x.
-    repeat (rewrite lookup_fmap, fmap_Some || setoid_rewrite map_filter_lookup_Some).
+    repeat (rewrite lookup_fmap, fmap_Some || setoid_rewrite map_lookup_filter_Some).
     naive_solver.
   Qed.
 
@@ -1409,7 +1952,7 @@ Section map_filter.
     filter P (filter Q m) = filter (λ '(i, x), P (i, x) ∧ Q (i, x)) m.
   Proof.
     apply map_filter_strong_ext. intros ??.
-    rewrite map_filter_lookup_Some. naive_solver.
+    rewrite map_lookup_filter_Some. naive_solver.
   Qed.
   Lemma map_filter_filter_l Q `{!∀ x, Decision (Q x)} m :
     (∀ i x, m !! i = Some x → P (i, x) → Q (i, x)) →
@@ -1423,101 +1966,30 @@ Section map_filter.
   Lemma map_filter_id m :
     (∀ i x, m !! i = Some x → P (i, x)) → filter P m = m.
   Proof.
-    intros Hi. apply map_eq. intros i. rewrite map_filter_lookup.
+    intros Hi. apply map_eq. intros i. rewrite map_lookup_filter.
     destruct (m !! i) eqn:Hlook; [|done].
     apply option_guard_True, Hi, Hlook.
   Qed.
 
   Lemma map_filter_subseteq m : filter P m ⊆ m.
-  Proof. apply map_subseteq_spec, map_filter_lookup_Some_1_1. Qed.
+  Proof. apply map_subseteq_spec, map_lookup_filter_Some_1_1. Qed.
 
   Lemma map_filter_subseteq_mono m1 m2 : m1 ⊆ m2 → filter P m1 ⊆ filter P m2.
   Proof.
     rewrite map_subseteq_spec. intros Hm1m2.
     apply map_filter_strong_subseteq_ext. naive_solver.
   Qed.
-End map_filter.
-
-Lemma map_filter_comm {A}
-    (P Q : K * A → Prop) `{!∀ x, Decision (P x), !∀ x, Decision (Q x)} (m : M A) :
-  filter P (filter Q m) = filter Q (filter P m).
-Proof. rewrite !map_filter_filter. apply map_filter_ext. naive_solver. Qed.
-
-(** ** Properties of the [map_Forall] predicate *)
-Section map_Forall.
-  Context {A} (P : K → A → Prop).
-  Implicit Types m : M A.
-
-  Lemma map_Forall_to_list m : map_Forall P m ↔ Forall (uncurry P) (map_to_list m).
-  Proof.
-    rewrite Forall_forall. split.
-    - intros Hforall [i x]. rewrite elem_of_map_to_list. by apply (Hforall i x).
-    - intros Hforall i x. rewrite <-elem_of_map_to_list. by apply (Hforall (i,x)).
-  Qed.
-  Lemma map_Forall_empty : map_Forall P (∅ : M A).
-  Proof. intros i x. by rewrite lookup_empty. Qed.
-  Lemma map_Forall_impl (Q : K → A → Prop) m :
-    map_Forall P m → (∀ i x, P i x → Q i x) → map_Forall Q m.
-  Proof. unfold map_Forall; naive_solver. Qed.
-  Lemma map_Forall_insert_1_1 m i x : map_Forall P (<[i:=x]>m) → P i x.
-  Proof. intros Hm. by apply Hm; rewrite lookup_insert. Qed.
-  Lemma map_Forall_insert_1_2 m i x :
-    m !! i = None → map_Forall P (<[i:=x]>m) → map_Forall P m.
-  Proof.
-    intros ? Hm j y ?; apply Hm. by rewrite lookup_insert_ne by congruence.
-  Qed.
-  Lemma map_Forall_insert_2 m i x :
-    P i x → map_Forall P m → map_Forall P (<[i:=x]>m).
-  Proof. intros ?? j y; rewrite lookup_insert_Some; naive_solver. Qed.
-  Lemma map_Forall_insert m i x :
-    m !! i = None → map_Forall P (<[i:=x]>m) ↔ P i x ∧ map_Forall P m.
-  Proof.
-    naive_solver eauto using map_Forall_insert_1_1,
-      map_Forall_insert_1_2, map_Forall_insert_2.
-  Qed.
-  Lemma map_Forall_singleton (i : K) (x : A) :
-    map_Forall P ({[i := x]} : M A) ↔ P i x.
-  Proof.
-    unfold map_Forall. setoid_rewrite lookup_singleton_Some. naive_solver.
-  Qed.
-  Lemma map_Forall_delete m i : map_Forall P m → map_Forall P (delete i m).
-  Proof. intros Hm j x; rewrite lookup_delete_Some. naive_solver. Qed.
-  Lemma map_Forall_lookup m :
-    map_Forall P m ↔ ∀ i x, m !! i = Some x → P i x.
-  Proof. done. Qed.
-  Lemma map_Forall_lookup_1 m i x :
-    map_Forall P m → m !! i = Some x → P i x.
-  Proof. intros ?. by apply map_Forall_lookup. Qed.
-  Lemma map_Forall_lookup_2 m :
-    (∀ i x, m !! i = Some x → P i x) → map_Forall P m.
-  Proof. intros ?. by apply map_Forall_lookup. Qed.
-  Lemma map_Forall_foldr_delete m is :
-    map_Forall P m → map_Forall P (foldr delete m is).
-  Proof. induction is; eauto using map_Forall_delete. Qed.
-  Lemma map_Forall_ind (Q : M A → Prop) :
-    Q ∅ →
-    (∀ m i x, m !! i = None → P i x → map_Forall P m → Q m → Q (<[i:=x]>m)) →
-    ∀ m, map_Forall P m → Q m.
-  Proof.
-    intros Hnil Hinsert m. induction m using map_ind; auto.
-    rewrite map_Forall_insert by done; intros [??]; eauto.
-  Qed.
-
-  Context `{∀ i x, Decision (P i x)}.
-  Global Instance map_Forall_dec m : Decision (map_Forall P m).
-  Proof.
-    refine (cast_if (decide (Forall (uncurry P) (map_to_list m))));
-      by rewrite map_Forall_to_list.
-  Defined.
-  Lemma map_not_Forall (m : M A) :
-    ¬map_Forall P m ↔ ∃ i x, m !! i = Some x ∧ ¬P i x.
-  Proof.
-    split; [|intros (i&x&?&?) Hm; specialize (Hm i x); tauto].
-    rewrite map_Forall_to_list. intros Hm.
-    apply (not_Forall_Exists _), Exists_exists in Hm.
-    destruct Hm as ([i x]&?&?). exists i, x. by rewrite <-elem_of_map_to_list.
-  Qed.
-End map_Forall.
+
+  Lemma map_size_filter m :
+    size (filter P m) ≤ size m.
+  Proof. apply map_subseteq_size. apply map_filter_subseteq. Qed.
+
+End map_filter.
+
+Lemma map_filter_comm {A}
+    (P Q : K * A → Prop) `{!∀ x, Decision (P x), !∀ x, Decision (Q x)} (m : M A) :
+  filter P (filter Q m) = filter Q (filter P m).
+Proof. rewrite !map_filter_filter. apply map_filter_ext. naive_solver. Qed.
 
 (** ** Properties of the [merge] operation *)
 Section merge.
@@ -1688,6 +2160,19 @@ Proof. rewrite map_lookup_zip_with_Some. destruct p. naive_solver. Qed.
 Lemma map_zip_with_empty {A B C} (f : A → B → C) :
   map_zip_with f ∅ ∅ =@{M C} ∅.
 Proof. unfold map_zip_with. by rewrite merge_empty by done. Qed.
+Lemma map_zip_with_empty_l {A B C} (f : A → B → C) m2 :
+  map_zip_with f ∅ m2 =@{M C} ∅.
+Proof.
+  unfold map_zip_with. apply map_eq; intros i.
+  rewrite lookup_merge, !lookup_empty. destruct (m2 !! i); done.
+Qed.
+Lemma map_zip_with_empty_r {A B C} (f : A → B → C) m1 :
+  map_zip_with f m1 ∅ =@{M C} ∅.
+Proof.
+  unfold map_zip_with. apply map_eq; intros i.
+  rewrite lookup_merge, !lookup_empty. destruct (m1 !! i); done.
+Qed.
+
 Lemma map_insert_zip_with {A B C} (f : A → B → C) (m1 : M A) (m2 : M B) i y z :
   <[i:=f y z]>(map_zip_with f m1 m2) = map_zip_with f (<[i:=y]>m1) (<[i:=z]>m2).
 Proof. unfold map_zip_with. by erewrite insert_merge by done. Qed.
@@ -1790,20 +2275,31 @@ Lemma snd_map_zip {A B} (m1 : M A) (m2 : M B) :
   snd <$> map_zip m1 m2 = m2.
 Proof. intros ?. by apply map_fmap_zip_with_r. Qed.
 
-(** ** Properties on the [map_relation] relation *)
-Section Forall2.
-  Context {A B} (R : A → B → Prop) (P : A → Prop) (Q : B → Prop).
-  Context `{∀ x y, Decision (R x y), ∀ x, Decision (P x), ∀ y, Decision (Q y)}.
+Lemma map_zip_fst_snd {A B} (m : M (A * B)) :
+  map_zip (fst <$> m) (snd <$> m) = m.
+Proof.
+  apply map_eq; intros k.
+  rewrite map_lookup_zip_with, !lookup_fmap. by destruct (m !! k) as [[]|].
+Qed.
 
-  Let f (mx : option A) (my : option B) : option bool :=
+(** ** Properties on the [map_relation] relation *)
+Section map_relation.
+  Context {A B} (R : K → A → B → Prop) (P : K → A → Prop) (Q : K → B → Prop).
+  Context `{!∀ i x y, Decision (R i x y),
+    !∀ i x, Decision (P i x), !∀ i y, Decision (Q i y)}.
+
+  (** The function [f] and lemma [map_relation_alt] are helpers to prove the
+  [Decision] instance. These should not be used elsewhere. *)
+  Let f (mx : option A) (my : option B) : option (K → bool) :=
     match mx, my with
-    | Some x, Some y => Some (bool_decide (R x y))
-    | Some x, None => Some (bool_decide (P x))
-    | None, Some y => Some (bool_decide (Q y))
+    | Some x, Some y => Some (λ i, bool_decide (R i x y))
+    | Some x, None => Some (λ i, bool_decide (P i x))
+    | None, Some y => Some (λ i, bool_decide (Q i y))
     | None, None => None
     end.
-  Lemma map_relation_alt (m1 : M A) (m2 : M B) :
-    map_relation R P Q m1 m2 ↔ map_Forall (λ _, Is_true) (merge f m1 m2).
+
+  Local Lemma map_relation_alt (m1 : M A) (m2 : M B) :
+    map_relation R P Q m1 m2 ↔ map_Forall (λ i b, Is_true (b i)) (merge f m1 m2).
   Proof.
     split.
     - intros Hm i P'; rewrite lookup_merge; intros.
@@ -1811,20 +2307,23 @@ Section Forall2.
         simplify_eq/=; auto using bool_decide_pack.
     - intros Hm i. specialize (Hm i). rewrite lookup_merge in Hm.
       destruct (m1 !! i), (m2 !! i); simplify_eq/=; auto;
-        by eapply bool_decide_unpack, Hm.
+        eapply bool_decide_unpack, (Hm _ eq_refl).
   Qed.
+
   Global Instance map_relation_dec : RelDecision (map_relation (M:=M) R P Q).
   Proof.
-    refine (λ m1 m2, cast_if (decide (map_Forall (λ _, Is_true) (merge f m1 m2))));
+    refine (λ m1 m2,
+      cast_if (decide (map_Forall (λ i b, Is_true (b i)) (merge f m1 m2))));
       abstract by rewrite map_relation_alt.
   Defined.
+
   (** Due to the finiteness of finite maps, we can extract a witness if the
   relation does not hold. *)
-  Lemma map_not_Forall2 (m1 : M A) (m2 : M B) :
+  Lemma map_not_relation (m1 : M A) (m2 : M B) :
     ¬map_relation R P Q m1 m2 ↔ ∃ i,
-      (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ ¬R x y)
-      ∨ (∃ x, m1 !! i = Some x ∧ m2 !! i = None ∧ ¬P x)
-      ∨ (∃ y, m1 !! i = None ∧ m2 !! i = Some y ∧ ¬Q y).
+      (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ ¬R i x y)
+      ∨ (∃ x, m1 !! i = Some x ∧ m2 !! i = None ∧ ¬P i x)
+      ∨ (∃ y, m1 !! i = None ∧ m2 !! i = Some y ∧ ¬Q i y).
   Proof.
     split.
     - rewrite map_relation_alt, (map_not_Forall _). intros (i&?&Hm&?); exists i.
@@ -1834,27 +2333,194 @@ Section Forall2.
       by intros [i[(x&y&?&?&?)|[(x&?&?&?)|(y&?&?&?)]]] Hm;
         specialize (Hm i); simplify_option_eq.
   Qed.
-End Forall2.
+End map_relation.
+
+(** ** Properties of the [map_Forall2] relation *)
+Section map_Forall2.
+  Context {A B} (R : K → A → B → Prop).
+
+  Lemma map_Forall2_impl (R' : K → A → B → Prop) (m1 : M A) (m2 : M B) :
+    map_Forall2 R m1 m2 →
+    (∀ i x1 x2, R i x1 x2 → R' i x1 x2) →
+    map_Forall2 R' m1 m2.
+  Proof. intros Hm ? i. destruct (Hm i); constructor; eauto. Qed.
+
+  Lemma map_Forall2_empty : map_Forall2 R (∅ : M A) ∅.
+  Proof. intros i. rewrite !lookup_empty. constructor. Qed.
+  Lemma map_Forall2_empty_inv_l (m2 : M B) : map_Forall2 R ∅ m2 → m2 = ∅.
+  Proof.
+    intros Hm. apply map_eq; intros i. rewrite lookup_empty, eq_None_not_Some.
+    intros [x Hi]. specialize (Hm i). rewrite lookup_empty, Hi in Hm. inv Hm.
+  Qed.
+  Lemma map_Forall2_empty_inv_r (m1 : M A) : map_Forall2 R m1 ∅ → m1 = ∅.
+  Proof.
+    intros Hm. apply map_eq; intros i. rewrite lookup_empty, eq_None_not_Some.
+    intros [x Hi]. specialize (Hm i). rewrite lookup_empty, Hi in Hm. inv Hm.
+  Qed.
+
+  Lemma map_Forall2_delete (m1 : M A) (m2 : M B) i :
+    map_Forall2 R m1 m2 → map_Forall2 R (delete i m1) (delete i m2).
+  Proof.
+    intros Hm j. destruct (decide (i = j)) as [->|].
+    - rewrite !lookup_delete. constructor.
+    - by rewrite !lookup_delete_ne by done.
+  Qed.
+
+  Lemma map_Forall2_insert_2 (m1 : M A) (m2 : M B) i x1 x2 :
+    R i x1 x2 → map_Forall2 R m1 m2 → map_Forall2 R (<[i:=x1]> m1) (<[i:=x2]> m2).
+  Proof.
+    intros Hx Hm j. destruct (decide (i = j)) as [->|].
+    - rewrite !lookup_insert. by constructor.
+    - by rewrite !lookup_insert_ne by done.
+  Qed.
+  Lemma map_Forall2_insert (m1 : M A) (m2 : M B) i x1 x2 :
+    m1 !! i = None → m2 !! i = None →
+    map_Forall2 R (<[i:=x1]> m1) (<[i:=x2]> m2) ↔ R i x1 x2 ∧ map_Forall2 R m1 m2.
+  Proof.
+    intros Hi1 Hi2. split; [|naive_solver eauto using map_Forall2_insert_2].
+    intros Hm. split.
+    - specialize (Hm i). rewrite !lookup_insert in Hm. by inv Hm.
+    - intros j. destruct (decide (i = j)) as [->|].
+      + rewrite Hi1, Hi2. constructor.
+      + specialize (Hm j). by rewrite !lookup_insert_ne in Hm by done.
+  Qed.
+
+  Lemma map_Forall2_insert_inv_l (m1 : M A) (m2 : M B) i x1 :
+    m1 !! i = None →
+    map_Forall2 R (<[i:=x1]> m1) m2 →
+    ∃ x2 m2', m2 = <[i:=x2]> m2' ∧ m2' !! i = None ∧ R i x1 x2 ∧ map_Forall2 R m1 m2'.
+  Proof.
+    intros ? Hm. pose proof (Hm i) as Hi. rewrite lookup_insert in Hi.
+    destruct (m2 !! i) as [x2|] eqn:?; inv Hi.
+    exists x2, (delete i m2). split; [by rewrite insert_delete|].
+    split; [by rewrite lookup_delete|]. split; [done|].
+    rewrite <-(delete_insert m1 i x1) by done. by apply map_Forall2_delete.
+  Qed.
+  Lemma map_Forall2_insert_inv_r (m1 : M A) (m2 : M B) i x2 :
+    m2 !! i = None →
+    map_Forall2 R m1 (<[i:=x2]> m2) →
+    ∃ x1 m1', m1 = <[i:=x1]> m1' ∧ m1' !! i = None ∧ R i x1 x2 ∧ map_Forall2 R m1' m2.
+  Proof.
+    intros ? Hm. pose proof (Hm i) as Hi. rewrite lookup_insert in Hi.
+    destruct (m1 !! i) as [x1|] eqn:?; inv Hi.
+    exists x1, (delete i m1). split; [by rewrite insert_delete|].
+    split; [by rewrite lookup_delete|]. split; [done|].
+    rewrite <-(delete_insert m2 i x2) by done. by apply map_Forall2_delete.
+  Qed.
+
+  Lemma map_Forall2_singleton i x1 x2 :
+    map_Forall2 R ({[ i := x1 ]} : M A) {[ i := x2 ]} ↔ R i x1 x2.
+  Proof.
+    rewrite <-!insert_empty, map_Forall2_insert by (by rewrite lookup_empty).
+    naive_solver eauto using map_Forall2_empty.
+  Qed.
+End map_Forall2.
+
+(** ** Properties of the [map_agree] relation *)
+Lemma map_agree_spec {A} (m1 m2 : M A) :
+  map_agree m1 m2 ↔ ∀ i x y, m1 !! i = Some x → m2 !! i = Some y → x = y.
+Proof.
+  apply forall_proper; intros i; destruct (m1 !! i), (m2 !! i); naive_solver.
+Qed.
+Lemma map_agree_alt {A} (m1 m2 : M A) :
+  map_agree m1 m2 ↔ ∀ i, m1 !! i = None ∨ m2 !! i = None ∨ m1 !! i = m2 !! i.
+Proof.
+  apply forall_proper; intros i; destruct (m1 !! i), (m2 !! i); naive_solver.
+Qed.
+Lemma map_not_agree {A} (m1 m2 : M A) `{!EqDecision A}:
+  ¬map_agree m1 m2 ↔ ∃ i x1 x2, m1 !! i = Some x1 ∧ m2 !! i = Some x2 ∧ x1 ≠ x2.
+Proof.
+  unfold map_agree. rewrite map_not_relation by solve_decision. naive_solver.
+Qed.
+Global Instance map_agree_refl {A} : Reflexive (map_agree : relation (M A)).
+Proof. intros ?. rewrite !map_agree_spec. naive_solver. Qed.
+Global Instance map_agree_sym {A} : Symmetric (map_agree : relation (M A)).
+Proof.
+  intros m1 m2. rewrite !map_agree_spec.
+  intros Hm i x y Hm1 Hm2. symmetry. naive_solver.
+Qed.
+Lemma map_agree_empty_l {A} (m : M A) : map_agree ∅ m.
+Proof. rewrite !map_agree_spec. intros i x y. by rewrite lookup_empty. Qed.
+Lemma map_agree_empty_r {A} (m : M A) : map_agree m ∅.
+Proof. rewrite !map_agree_spec. intros i x y. by rewrite lookup_empty. Qed.
+Lemma map_agree_weaken {A} (m1 m1' m2 m2' : M A) :
+  map_agree m1' m2' → m1 ⊆ m1' → m2 ⊆ m2' → map_agree m1 m2.
+Proof. rewrite !map_subseteq_spec, !map_agree_spec. eauto. Qed.
+Lemma map_agree_weaken_l {A} (m1 m1' m2  : M A) :
+  map_agree m1' m2 → m1 ⊆ m1' → map_agree m1 m2.
+Proof. eauto using map_agree_weaken. Qed.
+Lemma map_agree_weaken_r {A} (m1 m2 m2' : M A) :
+  map_agree m1 m2' → m2 ⊆ m2' → map_agree m1 m2.
+Proof. eauto using map_agree_weaken. Qed.
+Lemma map_agree_Some_l {A} (m1 m2 : M A) i x:
+  map_agree m1 m2 → m1 !! i = Some x → m2 !! i = Some x ∨ m2 !! i = None.
+Proof. rewrite map_agree_spec. destruct (m2 !! i) eqn: ?; naive_solver. Qed.
+Lemma map_agree_Some_r {A} (m1 m2 : M A) i x:
+  map_agree m1 m2 → m2 !! i = Some x → m1 !! i = Some x ∨ m1 !! i = None.
+Proof. rewrite (symmetry_iff map_agree). apply map_agree_Some_l. Qed.
+Lemma map_agree_singleton_l {A} (m: M A) i x :
+  map_agree {[i:=x]} m ↔ m !! i = Some x ∨ m !! i = None.
+Proof.
+  rewrite map_agree_spec. setoid_rewrite lookup_singleton_Some.
+  destruct (m !! i) eqn:?; naive_solver.
+Qed.
+Lemma map_agree_singleton_r {A} (m : M A) i x :
+  map_agree m {[i := x]} ↔ m !! i = Some x ∨ m !! i = None.
+Proof. by rewrite (symmetry_iff map_agree), map_agree_singleton_l. Qed.
+Lemma map_agree_delete_l {A} (m1 m2 : M A) i :
+  map_agree m1 m2 → map_agree (delete i m1) m2.
+Proof.
+  rewrite !map_agree_alt. intros Hagree j. rewrite lookup_delete_None.
+  destruct (Hagree j) as [|[|<-]]; auto.
+  destruct (decide (i = j)); [naive_solver|].
+  rewrite lookup_delete_ne; naive_solver.
+Qed.
+Lemma map_agree_delete_r {A} (m1 m2 : M A) i :
+  map_agree m1 m2 → map_agree m1 (delete i m2).
+Proof. symmetry. by apply map_agree_delete_l. Qed.
+
+Lemma map_agree_filter {A} (P : K * A → Prop)
+    `{!∀ x, Decision (P x)} (m1 m2 : M A) :
+  map_agree m1 m2 → map_agree (filter P m1) (filter P m2).
+Proof.
+  rewrite !map_agree_spec. intros ? i x y.
+  rewrite !map_lookup_filter_Some. naive_solver.
+Qed.
+
+Lemma map_agree_fmap_1 {A B} (f : A → B) (m1 m2 : M A) `{!Inj (=) (=) f}:
+  map_agree (f <$> m1) (f <$> m2) → map_agree m1 m2.
+Proof.
+  rewrite !map_agree_spec. setoid_rewrite lookup_fmap_Some. naive_solver.
+Qed.
+Lemma map_agree_fmap_2 {A B} (f : A → B) (m1 m2 : M A):
+  map_agree m1 m2 → map_agree (f <$> m1) (f <$> m2).
+Proof.
+  rewrite !map_agree_spec. setoid_rewrite lookup_fmap_Some. naive_solver.
+Qed.
+Lemma map_agree_fmap {A B} (f : A → B) (m1 m2 : M A) `{!Inj (=) (=) f}:
+  map_agree (f <$> m1) (f <$> m2) ↔ map_agree m1 m2.
+Proof. naive_solver eauto using map_agree_fmap_1, map_agree_fmap_2. Qed.
+
+Lemma map_agree_omap {A B} (f : A → option B) (m1 m2 : M A) :
+  map_agree m1 m2 → map_agree (omap f m1) (omap f m2).
+Proof. rewrite !map_agree_spec. setoid_rewrite lookup_omap_Some. naive_solver. Qed.
 
 (** ** Properties on the disjoint maps *)
 Lemma map_disjoint_spec {A} (m1 m2 : M A) :
   m1 ##ₘ m2 ↔ ∀ i x y, m1 !! i = Some x → m2 !! i = Some y → False.
 Proof.
-  split; intros Hm i; specialize (Hm i);
-    destruct (m1 !! i), (m2 !! i); naive_solver.
+  apply forall_proper; intros i; destruct (m1 !! i), (m2 !! i); naive_solver.
 Qed.
 Lemma map_disjoint_alt {A} (m1 m2 : M A) :
   m1 ##ₘ m2 ↔ ∀ i, m1 !! i = None ∨ m2 !! i = None.
 Proof.
-  split; intros Hm1m2 i; specialize (Hm1m2 i);
-    destruct (m1 !! i), (m2 !! i); naive_solver.
+  apply forall_proper; intros i; destruct (m1 !! i), (m2 !! i); naive_solver.
 Qed.
 Lemma map_not_disjoint {A} (m1 m2 : M A) :
   ¬m1 ##ₘ m2 ↔ ∃ i x1 x2, m1 !! i = Some x1 ∧ m2 !! i = Some x2.
 Proof.
-  unfold disjoint, map_disjoint. rewrite map_not_Forall2 by solve_decision.
-  split; [|naive_solver].
-  intros [i[(x&y&?&?&?)|[(x&?&?&[])|(y&?&?&[])]]]; naive_solver.
+  unfold disjoint, map_disjoint. rewrite map_not_relation by solve_decision.
+  naive_solver.
 Qed.
 Global Instance map_disjoint_sym {A} : Symmetric (map_disjoint : relation (M A)).
 Proof. intros m1 m2. rewrite !map_disjoint_spec. naive_solver. Qed.
@@ -1879,12 +2545,8 @@ Lemma map_disjoint_Some_r {A} (m1 m2 : M A) i x:
 Proof. rewrite (symmetry_iff map_disjoint). apply map_disjoint_Some_l. Qed.
 Lemma map_disjoint_singleton_l {A} (m: M A) i x : {[i:=x]} ##ₘ m ↔ m !! i = None.
 Proof.
-  split; [|rewrite !map_disjoint_spec].
-  - intro. apply (map_disjoint_Some_l {[i := x]} _ _ x);
-      auto using lookup_singleton.
-  - intros ? j y1 y2. destruct (decide (i = j)) as [->|].
-    + rewrite lookup_singleton. intuition congruence.
-    + by rewrite lookup_singleton_ne.
+  rewrite !map_disjoint_spec. setoid_rewrite lookup_singleton_Some.
+  destruct (m !! i) eqn:?; naive_solver.
 Qed.
 Lemma map_disjoint_singleton_r {A} (m : M A) i x :
   m ##ₘ {[i := x]} ↔ m !! i = None.
@@ -1908,18 +2570,18 @@ Lemma map_disjoint_filter {A} (P : K * A → Prop)
   m1 ##ₘ m2 → filter P m1 ##ₘ filter P m2.
 Proof.
   rewrite !map_disjoint_spec. intros ? i x y.
-  rewrite !map_filter_lookup_Some. naive_solver.
+  rewrite !map_lookup_filter_Some. naive_solver.
 Qed.
 Lemma map_disjoint_filter_complement {A} (P : K * A → Prop)
     `{!∀ x, Decision (P x)} (m : M A) :
   filter P m ##ₘ filter (λ v, ¬ P v) m.
 Proof.
   apply map_disjoint_spec. intros i x y.
-  rewrite !map_filter_lookup_Some. naive_solver.
+  rewrite !map_lookup_filter_Some. naive_solver.
 Qed.
 
 Lemma map_disjoint_fmap {A B} (f1 f2 : A → B) (m1 m2 : M A) :
-  m1 ##ₘ m2 ↔ f1 <$> m1 ##ₘ f2 <$> m2.
+  f1 <$> m1 ##ₘ f2 <$> m2 ↔ m1 ##ₘ m2.
 Proof.
   rewrite !map_disjoint_spec. setoid_rewrite lookup_fmap_Some. naive_solver.
 Qed.
@@ -1929,6 +2591,10 @@ Proof.
   rewrite !map_disjoint_spec. setoid_rewrite lookup_omap_Some. naive_solver.
 Qed.
 
+Lemma map_disjoint_agree {A} (m1 m2 : M A) :
+  m1 ##ₘ m2 → map_agree m1 m2.
+Proof. rewrite !map_disjoint_spec, !map_agree_spec. naive_solver. Qed.
+
 (** ** Properties of the [union_with] operation *)
 Section union_with.
   Context {A} (f : A → A → option A).
@@ -2032,12 +2698,15 @@ Qed.
 Global Instance map_union_idemp {A} : IdemP (=@{M A}) (∪).
 Proof. intros ?. by apply union_with_idemp. Qed.
 Lemma lookup_union {A} (m1 m2 : M A) i :
-  (m1 ∪ m2) !! i = union_with (λ x _, Some x) (m1 !! i) (m2 !! i).
+  (m1 ∪ m2) !! i = (m1 !! i) ∪ (m2 !! i).
 Proof. apply lookup_union_with. Qed.
 Lemma lookup_union_r {A} (m1 m2 : M A) i :
   m1 !! i = None → (m1 ∪ m2) !! i = m2 !! i.
 Proof. intros Hi. by rewrite lookup_union, Hi, (left_id_L _ _).  Qed.
 Lemma lookup_union_l {A} (m1 m2 : M A) i :
+  m2 !! i = None → (m1 ∪ m2) !! i = m1 !! i.
+Proof. intros Hi. rewrite lookup_union, Hi. by destruct (m1 !! i). Qed.
+Lemma lookup_union_l' {A} (m1 m2 : M A) i :
   is_Some (m1 !! i) → (m1 ∪ m2) !! i = m1 !! i.
 Proof. intros [x Hi]. rewrite lookup_union, Hi. by destruct (m2 !! i). Qed.
 Lemma lookup_union_Some_raw {A} (m1 m2 : M A) i x :
@@ -2047,6 +2716,12 @@ Proof. rewrite lookup_union. destruct (m1 !! i), (m2 !! i); naive_solver. Qed.
 Lemma lookup_union_None {A} (m1 m2 : M A) i :
   (m1 ∪ m2) !! i = None ↔ m1 !! i = None ∧ m2 !! i = None.
 Proof. rewrite lookup_union.  destruct (m1 !! i), (m2 !! i); naive_solver. Qed.
+Lemma lookup_union_None_1 {A} (m1 m2 : M A) i :
+  (m1 ∪ m2) !! i = None → m1 !! i = None ∧ m2 !! i = None.
+Proof. apply lookup_union_None. Qed.
+Lemma lookup_union_None_2 {A} (m1 m2 : M A) i :
+  m1 !! i = None → m2 !! i = None → (m1 ∪ m2) !! i = None.
+Proof. intros. by apply lookup_union_None. Qed.
 Lemma lookup_union_Some {A} (m1 m2 : M A) i x :
   m1 ##ₘ m2 → (m1 ∪ m2) !! i = Some x ↔ m1 !! i = Some x ∨ m2 !! i = Some x.
 Proof.
@@ -2264,7 +2939,7 @@ Lemma map_filter_union {A} (P : K * A → Prop) `{!∀ x, Decision (P x)} (m1 m2
   filter P (m1 ∪ m2) = filter P m1 ∪ filter P m2.
 Proof.
   intros. apply map_eq; intros i. apply option_eq; intros x.
-  rewrite lookup_union_Some, !map_filter_lookup_Some,
+  rewrite lookup_union_Some, !map_lookup_filter_Some,
     lookup_union_Some by auto using map_disjoint_filter.
   naive_solver.
 Qed.
@@ -2273,10 +2948,17 @@ Lemma map_filter_union_complement {A} (P : K * A → Prop)
   filter P m ∪ filter (λ v, ¬ P v) m = m.
 Proof.
   apply map_eq; intros i. apply option_eq; intros x.
-  rewrite lookup_union_Some, !map_filter_lookup_Some
+  rewrite lookup_union_Some, !map_lookup_filter_Some
     by auto using map_disjoint_filter_complement.
   destruct (decide (P (i,x))); naive_solver.
 Qed.
+Lemma map_filter_or {A} (P Q : K * A → Prop)
+    `{!∀ x, Decision (P x), !∀ x, Decision (Q x)} (m : M A) :
+  filter (λ x, P x ∨ Q x) m = filter P m ∪ filter Q m.
+Proof.
+  apply map_eq. intros k. rewrite lookup_union. rewrite !map_lookup_filter.
+  destruct (m !! k); simpl; repeat case_guard; naive_solver.
+Qed.
 Lemma map_fmap_union {A B} (f : A → B) (m1 m2 : M A) :
   f <$> (m1 ∪ m2) = (f <$> m1) ∪ (f <$> m2).
 Proof.
@@ -2324,14 +3006,100 @@ Proof.
     map_filter_union_complement..| |].
   - rewrite <-map_filter_union, Hab by done.
     apply map_eq; intros k. apply option_eq; intros x.
-    rewrite map_filter_lookup_Some, lookup_union_Some, <-not_eq_None_Some by done.
+    rewrite map_lookup_filter_Some, lookup_union_Some, <-not_eq_None_Some by done.
     rewrite map_disjoint_alt in Hcd_disj; naive_solver.
   - rewrite <-map_filter_union, Hab by done.
     apply map_eq; intros k. apply option_eq; intros x.
-    rewrite map_filter_lookup_Some, lookup_union_Some, <-not_eq_None_Some by done.
+    rewrite map_lookup_filter_Some, lookup_union_Some, <-not_eq_None_Some by done.
     rewrite map_disjoint_alt in Hcd_disj; naive_solver.
 Qed.
 
+(** The following lemma shows that folding over two maps 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 ([m1 ∩ m2]) and does not care about the order in which elements
+are processed.
+
+This is a generalization of [map_fold_union] (below) with a.) a relation [R]
+instead of equality b.) premises that ensure the elements are in [m1 ∪ m2]. *)
+Lemma map_fold_union_strong {A B} (R : relation B) `{!PreOrder R}
+    (f : K → A → B → B) (b : B) (m1 m2 : M A) :
+  (∀ j z, Proper (R ==> R) (f j z)) →
+  (∀ j z1 z2 y,
+    (** This is morally idempotence for elements of [m1 ∩ m2] *)
+    m1 !! j = Some z1 → m2 !! j = Some z2 →
+    (** We cannot write this in the usual direction of idempotence properties
+    (i.e., [R (f j z1 (f j z2 y)) (f j z1 y)]) because [R] is not symmetric. *)
+    R (f j z1 y) (f j z1 (f j z2 y))) →
+  (∀ j1 j2 z1 z2 y,
+    (** This is morally commutativity + associativity for elements of [m1 ∪ m2] *)
+    j1 ≠ j2 →
+    m1 !! j1 = Some z1 ∨ m2 !! j1 = Some z1 →
+    m1 !! j2 = Some z2 ∨ m2 !! j2 = Some z2 →
+    R (f j1 z1 (f j2 z2 y)) (f j2 z2 (f j1 z1 y))) →
+  R (map_fold f b (m1 ∪ m2)) (map_fold f (map_fold f b m2) m1).
+Proof.
+  intros Hf. revert m2.
+  induction m1 as [|j x m Hmj IH] using map_ind; intros m2 Hf_idemp Hf_assoc.
+  { by rewrite (left_id_L _ _), map_fold_empty. }
+  setoid_rewrite lookup_insert_Some in Hf_assoc.
+  setoid_rewrite lookup_insert_Some in Hf_idemp.
+  rewrite <-insert_union_l, insert_union_r,
+    <-insert_delete_insert, <-insert_union_r by done.
+  trans (f j x (map_fold f b (m ∪ delete j m2))).
+  { apply (map_fold_insert R f); [solve_proper|..].
+    - intros j1 j2 z1 z2 y ? Hj1 Hj2.
+      apply Hf_assoc; [done|revert Hj1|revert Hj2];
+        rewrite lookup_insert_Some, !lookup_union_Some_raw, lookup_delete_Some;
+        naive_solver.
+    - by rewrite lookup_union, Hmj, lookup_delete. }
+  trans (f j x (map_fold f (map_fold f b (delete j m2)) m)).
+  { apply Hf, IH.
+    - intros j' z1 z2 y ? Hj'. apply Hf_idemp; revert Hj';
+        rewrite lookup_delete_Some, ?lookup_insert_Some; naive_solver.
+    - intros j1 j2 z1 z2 y ? Hj1 Hj2.
+      apply Hf_assoc; [done|revert Hj1|revert Hj2];
+        rewrite lookup_delete_Some; clear Hf_idemp Hf_assoc; naive_solver. }
+  trans (f j x (map_fold f (map_fold f b m2) m)).
+  - destruct (m2 !! j) as [x'|] eqn:?; [|by rewrite delete_notin by done].
+    trans (f j x (f j x' (map_fold f (map_fold f b (delete j m2)) m))); [by auto|].
+    f_equiv. trans (map_fold f (f j x' (map_fold f b (delete j m2))) m).
+    + apply (map_fold_comm_acc_strong (flip R)); [solve_proper|].
+      intros; apply Hf_assoc;
+        rewrite ?lookup_union_Some_raw, ?lookup_insert_Some; naive_solver.
+    + apply map_fold_proper; [solve_proper..|].
+      apply (map_fold_delete (flip R)); [solve_proper|naive_solver..].
+  - apply (map_fold_insert (flip R)); [solve_proper| |done].
+    intros j1 j2 z1 z2 y ? Hj1 Hj2.
+    apply Hf_assoc; [done|revert Hj2|revert Hj1];
+      rewrite !lookup_insert_Some; naive_solver.
+Qed.
+Lemma map_fold_union {A B} (f : K → A → B → B) (b : B) m1 m2 :
+  (∀ j z1 z2 y, f j z1 (f j z2 y) = f j z1 y) →
+  (∀ j1 j2 z1 z2 y, f j1 z1 (f j2 z2 y) = f j2 z2 (f j1 z1 y)) →
+  map_fold f b (m1 ∪ m2) = map_fold f (map_fold f b m2) m1.
+Proof. intros. apply (map_fold_union_strong _); [solve_proper|auto..]. Qed.
+
+Lemma map_fold_disj_union_strong {A B} (R : relation B) `{!PreOrder R}
+    (f : K → A → B → B) (b : B) (m1 m2 : M A) :
+  (∀ j z, Proper (R ==> R) (f j z)) →
+  m1 ##ₘ m2 →
+  (∀ j1 j2 z1 z2 y,
+    j1 ≠ j2 →
+    m1 !! j1 = Some z1 ∨ m2 !! j1 = Some z1 →
+    m1 !! j2 = Some z2 ∨ m2 !! j2 = Some z2 →
+    R (f j1 z1 (f j2 z2 y)) (f j2 z2 (f j1 z1 y))) →
+  R (map_fold f b (m1 ∪ m2)) (map_fold f (map_fold f b m2) m1).
+Proof.
+  rewrite map_disjoint_spec. intros ??.
+  apply (map_fold_union_strong _); [solve_proper|naive_solver].
+Qed.
+Lemma map_fold_disj_union {A B} (f : K → A → B → B) (b : B) m1 m2 :
+  m1 ##ₘ m2 →
+  (∀ j1 j2 z1 z2 y, f j1 z1 (f j2 z2 y) = f j2 z2 (f j1 z1 y)) →
+  map_fold f b (m1 ∪ m2) = map_fold f (map_fold f b m2) m1.
+Proof. intros. apply (map_fold_disj_union_strong _); [solve_proper|auto..]. Qed.
+
 (** ** Properties of the [union_list] operation *)
 Lemma map_disjoint_union_list_l {A} (ms : list (M A)) (m : M A) :
   ⋃ ms ##ₘ m ↔ Forall (.##ₘ m) ms.
@@ -2392,6 +3160,12 @@ Proof. induction is; simpl; auto using map_disjoint_delete_l. Qed.
 Lemma map_disjoint_foldr_delete_r {A} (m1 m2 : M A) is :
   m1 ##ₘ m2 → m1 ##ₘ foldr delete m2 is.
 Proof. induction is; simpl; auto using map_disjoint_delete_r. Qed.
+Lemma map_agree_foldr_delete_l {A} (m1 m2 : M A) is :
+  map_agree m1 m2 → map_agree (foldr delete m1 is) m2.
+Proof. induction is; simpl; auto using map_agree_delete_l. Qed.
+Lemma map_agree_foldr_delete_r {A} (m1 m2 : M A) is :
+  map_agree m1 m2 → map_agree m1 (foldr delete m2 is).
+Proof. induction is; simpl; auto using map_agree_delete_r. Qed.
 Lemma foldr_delete_union {A} (m1 m2 : M A) is :
   foldr delete (m1 ∪ m2) is = foldr delete m1 is ∪ foldr delete m2 is.
 Proof. apply foldr_delete_union_with. Qed.
@@ -2512,6 +3286,11 @@ Qed.
 Global Instance map_intersection_idemp {A} : IdemP (=@{M A}) (∩).
 Proof. intros ?. by apply intersection_with_idemp. Qed.
 
+Lemma lookup_intersection {A} (m1 m2 : M A) i :
+  (m1 ∩ m2) !! i = m1 !! i ∩ m2 !! i.
+Proof.
+  apply lookup_intersection_with.
+Qed.
 Lemma lookup_intersection_Some {A} (m1 m2 : M A) i x :
   (m1 ∩ m2) !! i = Some x ↔ m1 !! i = Some x ∧ is_Some (m2 !! i).
 Proof.
@@ -2528,9 +3307,23 @@ Lemma map_intersection_filter {A} (m1 m2 : M A) :
   m1 ∩ m2 = filter (λ kx, is_Some (m1 !! kx.1) ∧ is_Some (m2 !! kx.1)) (m1 ∪ m2).
 Proof.
   apply map_eq; intros i. apply option_eq; intros x.
-  rewrite lookup_intersection_Some, map_filter_lookup_Some, lookup_union; simpl.
+  rewrite lookup_intersection_Some, map_lookup_filter_Some, lookup_union; simpl.
   unfold is_Some. destruct (m1 !! i), (m2 !! i); naive_solver.
 Qed.
+Lemma map_filter_and {A} (P Q : K * A → Prop)
+    `{!∀ x, Decision (P x), !∀ x, Decision (Q x)} (m : M A) :
+  filter (λ x, P x ∧ Q x) m = filter P m ∩ filter Q m.
+Proof.
+  apply map_eq. intros k. rewrite lookup_intersection. rewrite !map_lookup_filter.
+  destruct (m !! k); simpl; repeat case_guard; naive_solver.
+Qed.
+Lemma map_fmap_intersection {A B} (f : A → B) (m1 m2 : M A) :
+  f <$> (m1 ∩ m2) = (f <$> m1) ∩ (f <$> m2).
+Proof.
+  apply map_eq. intros i.
+  rewrite !lookup_intersection, !lookup_fmap, !lookup_intersection.
+  destruct (m1 !! i), (m2 !! i); done.
+Qed.
 
 (** ** Properties of the [difference_with] operation *)
 Lemma lookup_difference_with {A} (f : A → A → option A) (m1 m2 : M A) i :
@@ -2550,29 +3343,34 @@ Proof.
 Qed.
 
 (** ** Properties of the [difference] operation *)
-Lemma lookup_difference_Some {A} (m1 m2 : M A) i x :
-  (m1 ∖ m2) !! i = Some x ↔ m1 !! i = Some x ∧ m2 !! i = None.
+Lemma lookup_difference {A} (m1 m2 : M A) i :
+  (m1 ∖ m2) !! i = match m2 !! i with None => m1 !! i | _ => None end.
 Proof.
   unfold difference, map_difference; rewrite lookup_difference_with.
-  destruct (m1 !! i), (m2 !! i); compute; intuition congruence.
+  destruct (m1 !! i), (m2 !! i); done.
 Qed.
+Lemma lookup_difference_Some {A} (m1 m2 : M A) i x :
+  (m1 ∖ m2) !! i = Some x ↔ m1 !! i = Some x ∧ m2 !! i = None.
+Proof. rewrite lookup_difference. destruct (m1 !! i), (m2 !! i); naive_solver. Qed.
 Lemma lookup_difference_is_Some {A} (m1 m2 : M A) i :
   is_Some ((m1 ∖ m2) !! i) ↔ is_Some (m1 !! i) ∧ m2 !! i = None.
 Proof. unfold is_Some. setoid_rewrite lookup_difference_Some. naive_solver. Qed.
 Lemma lookup_difference_None {A} (m1 m2 : M A) i :
   (m1 ∖ m2) !! i = None ↔ m1 !! i = None ∨ is_Some (m2 !! i).
 Proof.
-  unfold difference, map_difference; rewrite lookup_difference_with.
+  rewrite lookup_difference.
   destruct (m1 !! i), (m2 !! i); compute; naive_solver.
 Qed.
-Lemma map_disjoint_difference_l {A} (m1 m2 : M A) : m1 ⊆ m2 → m2 ∖ m1 ##ₘ m1.
+
+Lemma map_disjoint_difference_l {A} (m1 m2 m3 : M A) : m3 ⊆ m2 → m1 ∖ m2 ##ₘ m3.
 Proof.
   intros Hm i; specialize (Hm i).
   unfold difference, map_difference; rewrite lookup_difference_with.
-  by destruct (m1 !! i), (m2 !! i).
+  by destruct (m1 !! i), (m2 !! i), (m3 !! i).
 Qed.
-Lemma map_disjoint_difference_r {A} (m1 m2 : M A) : m1 ⊆ m2 → m1 ##ₘ m2 ∖ m1.
+Lemma map_disjoint_difference_r {A} (m1 m2 m3 : M A) : m3 ⊆ m2 → m3 ##ₘ m1 ∖ m2.
 Proof. intros. symmetry. by apply map_disjoint_difference_l. Qed.
+
 Lemma map_subseteq_difference_l {A} (m1 m2 m : M A) : m1 ⊆ m → m1 ∖ m2 ⊆ m.
 Proof.
   rewrite !map_subseteq_spec. setoid_rewrite lookup_difference_Some. naive_solver.
@@ -2595,6 +3393,13 @@ Qed.
 Global Instance map_difference_right_id {A} : RightId (=@{M A}) ∅ (∖) := _.
 Lemma map_difference_empty {A} (m : M A) : m ∖ ∅ = m.
 Proof. by rewrite (right_id _ _). Qed.
+Lemma map_fmap_difference {A B} (f : A → B) (m1 m2 : M A) :
+  f <$> (m1 ∖ m2) = (f <$> m1) ∖ (f <$> m2).
+Proof.
+  apply map_eq. intros i.
+  rewrite !lookup_difference, !lookup_fmap, !lookup_difference.
+  destruct (m1 !! i), (m2 !! i); done.
+Qed.
 
 Lemma insert_difference {A} (m1 m2 : M A) i x :
   <[i:=x]> (m1 ∖ m2) = <[i:=x]> m1 ∖ delete i m2.
@@ -2643,7 +3448,7 @@ Lemma map_difference_filter {A} (m1 m2 : M A) :
   m1 ∖ m2 = filter (λ kx, m2 !! kx.1 = None) m1.
 Proof.
   apply map_eq; intros i. apply option_eq; intros x.
-  by rewrite lookup_difference_Some, map_filter_lookup_Some.
+  by rewrite lookup_difference_Some, map_lookup_filter_Some.
 Qed.
 
 (** ** Misc properties about the order *)
@@ -2772,8 +3577,8 @@ Section setoid.
     (∀ k, Proper ((≡) ==> iff) (curry P k)) →
     Proper ((≡@{M A}) ==> (≡)) (filter P).
   Proof.
-    intros ? m1 m2 Hm i. rewrite !map_filter_lookup.
-    destruct (Hm i); simpl; repeat case_option_guard; try constructor; naive_solver.
+    intros ? m1 m2 Hm i. rewrite !map_lookup_filter.
+    destruct (Hm i); simpl; repeat case_guard; try constructor; naive_solver.
   Qed.
 
   Global Instance map_singleton_equiv_inj :
@@ -2782,7 +3587,7 @@ Section setoid.
     intros i1 x1 i2 x2 Heq. specialize (Heq i1).
     rewrite lookup_singleton in Heq. destruct (decide (i1 = i2)) as [->|].
     - rewrite lookup_singleton in Heq. apply (inj _) in Heq. naive_solver.
-    - rewrite lookup_singleton_ne in Heq by done. inversion Heq.
+    - rewrite lookup_singleton_ne in Heq by done. inv Heq.
   Qed.
 
   Global Instance map_fmap_equiv_inj `{Equiv B} (f : A → B) :
@@ -3016,7 +3821,7 @@ Section map_seq.
   Implicit Types xs : list A.
 
   Global Instance map_seq_proper `{Equiv A} start :
-    Proper ((≡) ==> (≡)) (map_seq (M:=M A) start).
+    Proper ((≡@{list A}) ==> (≡@{M A})) (map_seq start).
   Proof.
     intros l1 l2 Hl. revert start.
     induction Hl as [|x1 x2 l1 l2 ?? IH]; intros start; simpl.
@@ -3025,7 +3830,7 @@ Section map_seq.
   Qed.
 
   Lemma lookup_map_seq start xs i :
-    map_seq (M:=M A) start xs !! i = guard (start ≤ i); xs !! (i - start).
+    map_seq (M:=M A) start xs !! i = (guard (start ≤ i);; xs !! (i - start)).
   Proof.
     revert start. induction xs as [|x' xs IH]; intros start; simpl.
     { rewrite lookup_empty; simplify_option_eq; by rewrite ?lookup_nil. }
@@ -3046,24 +3851,34 @@ Section map_seq.
   Qed.
   Lemma lookup_map_seq_Some start xs i x :
     map_seq (M:=M A) start xs !! i = Some x ↔ start ≤ i ∧ xs !! (i - start) = Some x.
-  Proof. rewrite lookup_map_seq. case_option_guard; naive_solver. Qed.
+  Proof. rewrite lookup_map_seq. case_guard; naive_solver. Qed.
   Lemma lookup_map_seq_None start xs i :
     map_seq (M:=M A) start xs !! i = None ↔ i < start ∨ start + length xs ≤ i.
   Proof.
     rewrite lookup_map_seq.
-    case_option_guard; rewrite ?lookup_ge_None; naive_solver lia.
+    case_guard; simplify_option_eq; rewrite ?lookup_ge_None; naive_solver lia.
   Qed.
+  Lemma lookup_map_seq_is_Some start xs i x :
+    is_Some (map_seq (M:=M A) start xs !! i) ↔ start ≤ i < start + length xs.
+  Proof. rewrite <-not_eq_None_Some, lookup_map_seq_None. lia. Qed.
 
   Lemma map_seq_singleton start x :
     map_seq (M:=M A) start [x] = {[ start := x ]}.
   Proof. done. Qed.
 
-  Lemma map_seq_app_disjoint start xs1 xs2 :
-    map_seq (M:=M A) start xs1 ##ₘ map_seq (start + length xs1) xs2.
+  (** [map_seq_disjoint] uses [length xs = 0] instead of [xs = []] as
+  [lia] can handle the former but not the latter. *)
+  Lemma map_seq_disjoint start1 start2 xs1 xs2 :
+    map_seq (M:=M A) start1 xs1 ##ₘ map_seq start2 xs2 ↔
+      start1 + length xs1 ≤ start2 ∨ start2 + length xs2 ≤ start1
+      ∨ length xs1 = 0 ∨ length xs2 = 0.
   Proof.
-    apply map_disjoint_spec; intros i x1 x2. rewrite !lookup_map_seq_Some.
-    intros [??%lookup_lt_Some] [??%lookup_lt_Some]; lia.
+    rewrite map_disjoint_alt. setoid_rewrite lookup_map_seq_None.
+    split; intros Hi; [|lia]. pose proof (Hi start1). pose proof (Hi start2). lia.
   Qed.
+  Lemma map_seq_app_disjoint start xs1 xs2 :
+    map_seq (M:=M A) start xs1 ##ₘ map_seq (start + length xs1) xs2.
+  Proof. apply map_seq_disjoint. lia. Qed.
   Lemma map_seq_app start xs1 xs2 :
     map_seq start (xs1 ++ xs2)
     =@{M A} map_seq start xs1 ∪ map_seq (start + length xs1) xs2.
@@ -3098,17 +3913,163 @@ Section map_seq.
     by rewrite fmap_insert, IH.
   Qed.
 
-  Lemma insert_map_seq_0 (xs : list A) i x:
-    i < length xs →
-    <[i:=x]> (map_seq (M:=M A) 0 xs) = map_seq 0 (<[i:=x]> xs).
+  Lemma insert_map_seq start xs i x:
+    start ≤ i < start + length xs →
+    <[i:=x]> (map_seq start xs) =@{M A} map_seq start (<[i - start:=x]> xs).
   Proof.
-    intros ?. apply map_eq. intros j. rewrite lookup_map_seq_0.
-    destruct (decide (i = j)) as [->|Hne].
-    - rewrite lookup_insert, list_lookup_insert; done.
-    - rewrite lookup_insert_ne, lookup_map_seq_0, list_lookup_insert_ne; done.
+    intros. apply map_eq. intros j. destruct (decide (i = j)) as [->|?].
+    - rewrite lookup_insert, lookup_map_seq, option_guard_True by lia.
+      by rewrite list_lookup_insert by lia.
+    - rewrite lookup_insert_ne, !lookup_map_seq by done.
+      case_guard; [|done]. by rewrite list_lookup_insert_ne by lia.
   Qed.
+  Lemma map_seq_insert start xs i x:
+    i < length xs →
+    map_seq start (<[i:=x]> xs) =@{M A} <[start + i:=x]> (map_seq start xs).
+  Proof. intros. rewrite insert_map_seq by lia. auto with f_equal lia. Qed.
+
+  Lemma insert_map_seq_0 xs i x:
+    i < length xs →
+    <[i:=x]> (map_seq 0 xs) =@{M A} map_seq 0 (<[i:=x]> xs).
+  Proof. intros. rewrite insert_map_seq by lia. auto with f_equal lia. Qed.
 End map_seq.
 
+(** ** The [map_seqZ] operation *)
+Section map_seqZ.
+  Context `{FinMap Z M} {A : Type}.
+  Implicit Types x : A.
+  Implicit Types xs : list A.
+  Local Open Scope Z_scope.
+
+  Global Instance map_seqZ_proper `{Equiv A} start :
+    Proper ((≡@{list A}) ==> (≡@{M A})) (map_seqZ start).
+  Proof.
+    intros l1 l2 Hl. revert start.
+    induction Hl as [|x1 x2 l1 l2 ?? IH]; intros start; simpl.
+    - intros ?. rewrite lookup_empty; constructor.
+    - repeat (done || f_equiv).
+  Qed.
+
+  Lemma lookup_map_seqZ start xs i :
+    map_seqZ (M:=M A) start xs !! i = (guard (start ≤ i);; xs !! Z.to_nat (i - start)).
+  Proof.
+    revert start. induction xs as [|x' xs IH]; intros start; simpl.
+    { rewrite lookup_empty; simplify_option_eq; by rewrite ?lookup_nil. }
+    destruct (decide (start = i)) as [->|?].
+    - by rewrite lookup_insert, option_guard_True, Z.sub_diag by lia.
+    - rewrite lookup_insert_ne, IH by done.
+      simplify_option_eq; try done || lia.
+      replace (i - start) with (Z.succ (i - Z.succ start)) by lia.
+      by rewrite Z2Nat.inj_succ; [|lia].
+  Qed.
+  Lemma lookup_map_seqZ_0 xs i :
+    0 ≤ i →
+    map_seqZ (M:=M A) 0 xs !! i = xs !! Z.to_nat i.
+  Proof. intros ?. by rewrite lookup_map_seqZ, option_guard_True, Z.sub_0_r. Qed.
+
+  Lemma lookup_map_seqZ_Some_inv start xs i x :
+    xs !! i = Some x ↔ map_seqZ (M:=M A) start xs !! (start + Z.of_nat i) = Some x.
+  Proof.
+    rewrite ->lookup_map_seqZ, option_guard_True by lia.
+    assert (Z.to_nat (start + Z.of_nat i - start) = i) as -> by lia.
+    done.
+  Qed.
+  Lemma lookup_map_seqZ_Some start xs i x :
+    map_seqZ (M:=M A) start xs !! i = Some x ↔
+      start ≤ i ∧ xs !! Z.to_nat (i - start) = Some x.
+  Proof. rewrite lookup_map_seqZ. case_guard; naive_solver. Qed.
+  Lemma lookup_map_seqZ_None start xs i :
+    map_seqZ (M:=M A) start xs !! i = None ↔
+      i < start ∨ start + Z.of_nat (length xs) ≤ i.
+  Proof.
+    rewrite lookup_map_seqZ.
+    case_guard; simplify_option_eq; rewrite ?lookup_ge_None; naive_solver lia.
+  Qed.
+  Lemma lookup_map_seqZ_is_Some start xs i :
+    is_Some (map_seqZ (M:=M A) start xs !! i) ↔
+      start ≤ i < start + Z.of_nat (length xs).
+  Proof. rewrite <-not_eq_None_Some, lookup_map_seqZ_None. lia. Qed.
+
+  Lemma map_seqZ_singleton start x :
+    map_seqZ (M:=M A) start [x] = {[ start := x ]}.
+  Proof. done. Qed.
+
+  (** [map_seqZ_disjoint] uses [length xs = 0] instead of [xs = []] as
+  [lia] can handle the former but not the latter. *)
+  Lemma map_seqZ_disjoint start1 start2 xs1 xs2 :
+    map_seqZ (M:=M A) start1 xs1 ##ₘ map_seqZ (M:=M A) start2 xs2 ↔
+     start1 + Z.of_nat (length xs1) ≤ start2 ∨ start2 + Z.of_nat (length xs2) ≤ start1
+     ∨ length xs1 = 0%nat ∨ length xs2 = 0%nat.
+  Proof.
+    rewrite map_disjoint_alt. setoid_rewrite lookup_map_seqZ_None.
+    split; intros Hi; [|lia]. pose proof (Hi start1). pose proof (Hi start2). lia.
+  Qed.
+  Lemma map_seqZ_app_disjoint start xs1 xs2 :
+    map_seqZ (M:=M A) start xs1 ##ₘ map_seqZ (start + Z.of_nat (length xs1)) xs2.
+  Proof. apply map_seqZ_disjoint. lia. Qed.
+  Lemma map_seqZ_app start xs1 xs2 :
+    map_seqZ start (xs1 ++ xs2)
+    =@{M A} map_seqZ start xs1 ∪ map_seqZ (start + Z.of_nat (length xs1)) xs2.
+  Proof.
+    revert start. induction xs1 as [|x1 xs1 IH]; intros start; simpl.
+    - by rewrite ->(left_id_L _ _), Z.add_0_r.
+    - by rewrite IH, Nat2Z.inj_succ, Z.add_succ_r, Z.add_succ_l,
+        !insert_union_singleton_l, (assoc_L _).
+  Qed.
+
+  Lemma map_seqZ_cons_disjoint start xs :
+    map_seqZ (M:=M A) (Z.succ start) xs !! start = None.
+  Proof. rewrite lookup_map_seqZ_None. lia. Qed.
+  Lemma map_seqZ_cons start xs x :
+    map_seqZ start (x :: xs) =@{M A} <[start:=x]> (map_seqZ (Z.succ start) xs).
+  Proof. done. Qed.
+
+  Lemma map_seqZ_snoc_disjoint start xs :
+    map_seqZ (M:=M A) start xs !! (start + Z.of_nat (length xs)) = None.
+  Proof. rewrite lookup_map_seqZ_None. lia. Qed.
+  Lemma map_seqZ_snoc start xs x :
+    map_seqZ start (xs ++ [x])
+    =@{M A} <[(start + Z.of_nat (length xs)):=x]> (map_seqZ start xs).
+  Proof.
+    rewrite map_seqZ_app, map_seqZ_singleton.
+    by rewrite insert_union_singleton_r by (by rewrite map_seqZ_snoc_disjoint).
+  Qed.
+
+  Lemma fmap_map_seqZ {B} (f : A → B) start xs :
+    f <$> map_seqZ start xs =@{M B} map_seqZ start (f <$> xs).
+  Proof.
+    revert start. induction xs as [|x xs IH]; intros start; csimpl.
+    { by rewrite fmap_empty. }
+    by rewrite fmap_insert, IH.
+  Qed.
+
+  Lemma insert_map_seqZ start xs i x:
+    start ≤ i < start + Z.of_nat (length xs) →
+    <[i:=x]> (map_seqZ start xs)
+    =@{M A} map_seqZ start (<[Z.to_nat (i - start):=x]> xs).
+  Proof.
+    intros. apply map_eq. intros j. destruct (decide (i = j)) as [->|?].
+    - rewrite lookup_insert, lookup_map_seqZ, option_guard_True by lia.
+      by rewrite list_lookup_insert by lia.
+    - rewrite lookup_insert_ne, !lookup_map_seqZ by done.
+      case_guard; [|done]. by rewrite list_lookup_insert_ne by lia.
+  Qed.
+  Lemma map_seqZ_insert start xs i x:
+    (i < length xs)%nat →
+    map_seqZ start (<[i:=x]> xs) =@{M A}
+    <[start + Z.of_nat i:=x]> (map_seqZ start xs).
+  Proof. intros. rewrite insert_map_seqZ by lia. auto with lia f_equal. Qed.
+
+  Lemma insert_map_seqZ_0 xs i x:
+    0 ≤ i < Z.of_nat (length xs) →
+    <[i:=x]> (map_seqZ 0 xs) =@{M A} map_seqZ 0 (<[Z.to_nat i:=x]> xs).
+  Proof. intros. rewrite insert_map_seqZ by lia. auto with lia f_equal. Qed.
+  Lemma map_seqZ_insert_0 xs i x:
+    (i < length xs)%nat →
+    map_seqZ 0 (<[i:=x]> xs) =@{M A} <[Z.of_nat i:=x]> (map_seqZ 0 xs).
+  Proof. intros. by rewrite map_seqZ_insert. Qed.
+End map_seqZ.
+
 Section kmap.
   Context `{FinMap K1 M1} `{FinMap K2 M2}.
   Context (f : K1 → K2) `{!Inj (=) (=) f}.
@@ -3247,16 +4208,516 @@ Section kmap.
   Proof.
     rewrite !map_disjoint_spec. setoid_rewrite lookup_kmap_Some. naive_solver.
   Qed.
-  Lemma map_disjoint_subseteq {A} (m1 m2 : M1 A) :
+  Lemma map_agree_kmap {A} (m1 m2 : M1 A) :
+    map_agree (kmap f m1) (kmap f m2) ↔ map_agree m1 m2.
+  Proof.
+    rewrite !map_agree_spec. setoid_rewrite lookup_kmap_Some. naive_solver.
+  Qed.
+  Lemma kmap_subseteq {A} (m1 m2 : M1 A) :
     kmap f m1 ⊆ kmap f m2 ↔ m1 ⊆ m2.
   Proof.
     rewrite !map_subseteq_spec. setoid_rewrite lookup_kmap_Some. naive_solver.
   Qed.
-  Lemma map_disjoint_subset {A} (m1 m2 : M1 A) :
+  Lemma kmap_subset {A} (m1 m2 : M1 A) :
     kmap f m1 ⊂ kmap f m2 ↔ m1 ⊂ m2.
-  Proof. unfold strict. by rewrite !map_disjoint_subseteq. Qed.
+  Proof. unfold strict. by rewrite !kmap_subseteq. Qed.
 End kmap.
 
+Section preimg.
+  (** We restrict the theory to finite sets with Leibniz equality, which is
+  sufficient for [gset], but not for [boolset] or [propset]. The result of the
+  pre-image is a map of sets. To support general sets, we would need setoid
+  equality on sets, and thus setoid equality on maps. *)
+  Context `{FinMap K MK, FinMap A MA, FinSet K SK, !LeibnizEquiv SK}.
+  Local Notation map_preimg :=
+    (map_preimg (K:=K) (A:=A) (MKA:=MK A) (MASK:=MA SK) (SK:=SK)).
+  Implicit Types m : MK A.
+
+  Lemma map_preimg_empty : map_preimg ∅ = ∅.
+  Proof. apply map_fold_empty. Qed.
+  Lemma map_preimg_insert m i x :
+    m !! i = None →
+    map_preimg (<[i:=x]> m) =
+      partial_alter (λ mX, Some ({[ i ]} ∪ default ∅ mX)) x (map_preimg m).
+  Proof.
+    intros Hi. refine (map_fold_insert_L _ _ i x m _ Hi).
+    intros j1 j2 x1 x2 m' ? _ _. destruct (decide (x1 = x2)) as [->|?].
+    - rewrite <-!partial_alter_compose.
+      apply partial_alter_ext; intros ? _; f_equal/=. set_solver.
+    - by apply partial_alter_commute.
+  Qed.
+
+  (** The [map_preimg] function never returns an empty set (we represent that
+  case via [None]). *)
+  Lemma lookup_preimg_Some_non_empty m x :
+    map_preimg m !! x ≠ Some ∅.
+  Proof.
+    induction m as [|i x' m ? IH] using map_ind.
+    { by rewrite map_preimg_empty, lookup_empty. }
+    rewrite map_preimg_insert by done. destruct (decide (x = x')) as [->|].
+    - rewrite lookup_partial_alter. intros [=]. set_solver.
+    - rewrite lookup_partial_alter_ne by done. set_solver.
+  Qed.
+
+  Lemma lookup_preimg_None_1 m x i :
+    map_preimg m !! x = None → m !! i ≠ Some x.
+  Proof.
+    induction m as [|i' x' m ? IH] using map_ind; [by rewrite lookup_empty|].
+    rewrite map_preimg_insert by done. destruct (decide (x = x')) as [->|].
+    - by rewrite lookup_partial_alter.
+    - rewrite lookup_partial_alter_ne, lookup_insert_Some by done. naive_solver.
+  Qed.
+
+  Lemma lookup_preimg_Some_1 m X x i :
+    map_preimg m !! x = Some X →
+    i ∈ X ↔ m !! i = Some x.
+  Proof.
+    revert X. induction m as [|i' x' m ? IH] using map_ind; intros X.
+    { by rewrite map_preimg_empty, lookup_empty. }
+    rewrite map_preimg_insert by done. destruct (decide (x = x')) as [->|].
+    - rewrite lookup_partial_alter. intros [= <-].
+      rewrite elem_of_union, elem_of_singleton, lookup_insert_Some.
+      destruct (map_preimg m !! x') as [X'|] eqn:Hx'; simpl.
+      + rewrite IH by done. naive_solver.
+      + apply (lookup_preimg_None_1 _ _ i) in Hx'. set_solver.
+    - rewrite lookup_partial_alter_ne, lookup_insert_Some by done. naive_solver.
+  Qed.
+
+  Lemma lookup_preimg_None m x :
+    map_preimg m !! x = None ↔ ∀ i, m !! i ≠ Some x.
+  Proof.
+    split; [by eauto using lookup_preimg_None_1|].
+    intros Hm. apply eq_None_not_Some; intros [X ?].
+    destruct (set_choose_L X) as [i ?].
+    { intros ->. by eapply lookup_preimg_Some_non_empty. }
+    by eapply (Hm i), lookup_preimg_Some_1.
+  Qed.
+
+  Lemma lookup_preimg_Some m x X :
+    map_preimg m !! x = Some X ↔ X ≠ ∅ ∧ ∀ i, i ∈ X ↔ m !! i = Some x.
+  Proof.
+    split.
+    - intros HxX. split; [intros ->; by eapply lookup_preimg_Some_non_empty|].
+      intros j. by apply lookup_preimg_Some_1.
+    - intros [HXne HX]. destruct (map_preimg m !! x) as [X'|] eqn:HX'.
+      + f_equal; apply set_eq; intros i. rewrite HX.
+        by apply lookup_preimg_Some_1.
+      + apply set_choose_L in HXne as [j ?].
+        apply (lookup_preimg_None_1 _ _ j) in HX'. naive_solver.
+  Qed.
+
+  Lemma lookup_total_preimg m x i :
+    i ∈ map_preimg m !!! x ↔ m !! i = Some x.
+  Proof.
+    rewrite lookup_total_alt. destruct (map_preimg m !! x) as [X|] eqn:HX.
+    - by apply lookup_preimg_Some.
+    - rewrite lookup_preimg_None in HX. set_solver.
+  Qed.
+End preimg.
+
+
+(** ** The [map_img] (image/codomain) operation *)
+Section img.
+  Context `{FinMap K M, SemiSet A SA}.
+  Implicit Types m : M A.
+  Implicit Types x y : A.
+  Implicit Types X : SA.
+
+  (* avoid writing ≡@{D} everywhere... *)
+  Notation map_img := (map_img (M:=M A) (SA:=SA)).
+
+  Lemma elem_of_map_img m x : x ∈ map_img m ↔ ∃ i, m !! i = Some x.
+  Proof. unfold map_img. rewrite elem_of_map_to_set. naive_solver. Qed.
+  Lemma elem_of_map_img_1 m x : x ∈ map_img m → ∃ i, m !! i = Some x.
+  Proof. apply elem_of_map_img. Qed.
+  Lemma elem_of_map_img_2 m i x : m !! i = Some x → x ∈ map_img m.
+  Proof. rewrite elem_of_map_img. eauto. Qed.
+
+  Lemma not_elem_of_map_img m x : x ∉ map_img m ↔ ∀ i, m !! i ≠ Some x.
+  Proof. rewrite elem_of_map_img. naive_solver. Qed.
+  Lemma not_elem_of_map_img_1 m i x : x ∉ map_img m → m !! i ≠ Some x.
+  Proof. rewrite not_elem_of_map_img. eauto. Qed.
+  Lemma not_elem_of_map_img_2 m x : (∀ i, m !! i ≠ Some x) → x ∉ map_img m.
+  Proof. apply not_elem_of_map_img. Qed.
+
+  Lemma map_subseteq_img m1 m2 : m1 ⊆ m2 → map_img m1 ⊆ map_img m2.
+  Proof.
+    rewrite map_subseteq_spec. intros ? x.
+    rewrite !elem_of_map_img. naive_solver.
+  Qed.
+
+  Lemma map_img_filter (P : K * A → Prop) `{!∀ ix, Decision (P ix)} m X :
+    (∀ x, x ∈ X ↔ ∃ i, m !! i = Some x ∧ P (i, x)) →
+    map_img (filter P m) ≡ X.
+  Proof.
+    intros HX x. rewrite elem_of_map_img, HX.
+    unfold is_Some. by setoid_rewrite map_lookup_filter_Some.
+  Qed.
+  Lemma map_img_filter_subseteq (P : K * A → Prop) `{!∀ ix, Decision (P ix)} m :
+    map_img (filter P m) ⊆ map_img m.
+  Proof. apply map_subseteq_img, map_filter_subseteq. Qed.
+
+  Lemma map_img_empty : map_img ∅ ≡ ∅.
+  Proof.
+    rewrite set_equiv. intros x. rewrite elem_of_map_img, elem_of_empty.
+    setoid_rewrite lookup_empty. naive_solver.
+  Qed.
+  Lemma map_img_empty_iff m : map_img m ≡ ∅ ↔ m = ∅.
+  Proof.
+    split; [|intros ->; by rewrite map_img_empty].
+    intros Hm. apply map_empty; intros i.
+    apply eq_None_ne_Some; intros x ?%elem_of_map_img_2. set_solver.
+  Qed.
+  Lemma map_img_empty_inv m : map_img m ≡ ∅ → m = ∅.
+  Proof. apply map_img_empty_iff. Qed.
+
+  Lemma map_img_delete_subseteq i m : map_img (delete i m) ⊆ map_img m.
+  Proof. apply map_subseteq_img, delete_subseteq. Qed.
+
+  Lemma map_img_insert m i x :
+    map_img (<[i:=x]> m) ≡ {[ x ]} ∪ map_img (delete i m).
+  Proof.
+    intros y. rewrite elem_of_union, !elem_of_map_img, elem_of_singleton.
+    setoid_rewrite lookup_delete_Some. setoid_rewrite lookup_insert_Some.
+    naive_solver.
+  Qed.
+  Lemma map_img_insert_notin m i x :
+    m !! i = None → map_img (<[i:=x]> m) ≡ {[ x ]} ∪ map_img m.
+  Proof. intros. by rewrite map_img_insert, delete_notin. Qed.
+
+  Lemma map_img_insert_subseteq m i x :
+    map_img (<[i:=x]> m) ⊆ {[ x ]} ∪ map_img m.
+  Proof.
+    rewrite map_img_insert. apply union_mono_l, map_img_delete_subseteq.
+  Qed.
+  Lemma elem_of_map_img_insert m i x : x ∈ map_img (<[i:=x]> m).
+  Proof. apply elem_of_map_img. exists i. apply lookup_insert. Qed.
+  Lemma elem_of_map_img_insert_ne m i x y :
+    x ≠ y → x ∈ map_img (<[i:=y]> m) → x ∈ map_img m.
+  Proof. intros ? ?%map_img_insert_subseteq. set_solver. Qed.
+
+  Lemma map_img_singleton i x : map_img {[ i := x ]} ≡ {[ x ]}.
+  Proof.
+    apply set_equiv. intros y.
+    rewrite elem_of_map_img. setoid_rewrite lookup_singleton_Some. set_solver.
+  Qed.
+
+  Lemma elem_of_map_img_union m1 m2 x :
+    x ∈ map_img (m1 ∪ m2) →
+    x ∈ map_img m1 ∨ x ∈ map_img m2.
+  Proof.
+    rewrite !elem_of_map_img. setoid_rewrite lookup_union_Some_raw. naive_solver.
+  Qed.
+  Lemma elem_of_map_img_union_l m1 m2 x :
+    x ∈ map_img m1 → x ∈ map_img (m1 ∪ m2).
+  Proof.
+    rewrite !elem_of_map_img. setoid_rewrite lookup_union_Some_raw. naive_solver.
+  Qed.
+  Lemma elem_of_map_img_union_r m1 m2 x :
+    m1 ##ₘ m2 → x ∈ map_img m2 → x ∈ map_img (m1 ∪ m2).
+  Proof.
+    intros. rewrite map_union_comm by done. by apply elem_of_map_img_union_l.
+  Qed.
+  Lemma elem_of_map_img_union_disjoint m1 m2 x :
+    m1 ##ₘ m2 → x ∈ map_img (m1 ∪ m2) ↔ x ∈ map_img m1 ∨ x ∈ map_img m2.
+  Proof.
+    naive_solver eauto using elem_of_map_img_union,
+      elem_of_map_img_union_l, elem_of_map_img_union_r.
+  Qed.
+
+  Lemma map_img_union_subseteq m1 m2 :
+    map_img (m1 ∪ m2) ⊆ map_img m1 ∪ map_img m2.
+  Proof. intros v Hv. apply elem_of_union, elem_of_map_img_union. exact Hv. Qed.
+  Lemma map_img_union_subseteq_l m1 m2 : map_img m1 ⊆ map_img (m1 ∪ m2).
+  Proof. intros v Hv. by apply elem_of_map_img_union_l. Qed.
+  Lemma map_img_union_subseteq_r m1 m2 :
+    m1 ##ₘ m2 → map_img m2 ⊆ map_img (m1 ∪ m2).
+  Proof. intros Hdisj v Hv. by apply elem_of_map_img_union_r. Qed.
+  Lemma map_img_union_disjoint m1 m2 :
+    m1 ##ₘ m2 → map_img (m1 ∪ m2) ≡ map_img m1 ∪ map_img m2.
+  Proof.
+    intros Hdisj. apply set_equiv. intros x.
+    rewrite elem_of_union. by apply elem_of_map_img_union_disjoint.
+  Qed.
+
+  Lemma map_img_finite m : set_finite (map_img m).
+  Proof.
+    induction m as [|i x m ? IH] using map_ind.
+    - rewrite map_img_empty. apply empty_finite.
+    - eapply set_finite_subseteq; [by apply map_img_insert_subseteq|].
+      apply union_finite; [apply singleton_finite | apply IH].
+  Qed.
+
+  (** Alternative definition of [img] in terms of [map_to_list]. *)
+  Lemma map_img_alt m : map_img m ≡ list_to_set (map_to_list m).*2.
+  Proof.
+    induction m as [|i x m ? IH] using map_ind.
+    { by rewrite map_img_empty, map_to_list_empty. }
+    by rewrite map_img_insert_notin, map_to_list_insert by done.
+  Qed.
+
+  Lemma map_img_singleton_inv m i x :
+    map_img m ≡ {[ x ]} → m !! i = None ∨ m !! i = Some x.
+  Proof.
+    intros Hm. destruct (m !! i) eqn:Hmk; [|by auto].
+    apply elem_of_map_img_2 in Hmk. set_solver.
+  Qed.
+
+  Lemma map_img_union_inv `{!RelDecision (∈@{SA})} X Y m :
+    X ## Y →
+    map_img m ≡ X ∪ Y →
+    ∃ m1 m2, m = m1 ∪ m2 ∧ m1 ##ₘ m2 ∧ map_img m1 ≡ X ∧ map_img m2 ≡ Y.
+  Proof.
+    intros Hsep Himg.
+    exists (filter (λ '(_,x), x ∈ X) m), (filter (λ '(_,x), x ∉ X) m).
+    assert (filter (λ '(_,x), x ∈ X) m ##ₘ filter (λ '(_,x), x ∉ X) m).
+    { apply map_disjoint_filter_complement. }
+    split_and!.
+    - symmetry. apply map_filter_union_complement.
+    - done.
+    - apply map_img_filter; intros x. split; [|naive_solver].
+      intros. destruct (elem_of_map_img_1 m x); set_solver.
+    - apply map_img_filter; intros x; split.
+      + intros. destruct (elem_of_map_img_1 m x); set_solver.
+      + intros (i & ?%elem_of_map_img_2 & ?). set_solver.
+  Qed.
+
+  Section leibniz.
+    Context `{!LeibnizEquiv SA}.
+
+    Lemma map_img_empty_L : map_img ∅ = ∅.
+    Proof. unfold_leibniz. exact map_img_empty. Qed.
+
+    Lemma map_img_empty_iff_L m : map_img m = ∅ ↔ m = ∅.
+    Proof. unfold_leibniz. apply map_img_empty_iff. Qed.
+    Lemma map_img_empty_inv_L m : map_img m = ∅ → m = ∅.
+    Proof. apply map_img_empty_iff_L. Qed.
+
+    Lemma map_img_singleton_L i x : map_img {[ i := x ]} = {[ x ]}.
+    Proof. unfold_leibniz. apply map_img_singleton. Qed.
+
+    Lemma map_img_insert_notin_L m i x :
+      m !! i = None → map_img (<[i:=x]> m) = {[ x ]} ∪ map_img m.
+    Proof. unfold_leibniz. apply map_img_insert_notin. Qed.
+
+    Lemma map_img_union_disjoint_L m1 m2 :
+      m1 ##ₘ m2 → map_img (m1 ∪ m2) = map_img m1 ∪ map_img m2.
+    Proof. unfold_leibniz. apply map_img_union_disjoint. Qed.
+
+    Lemma map_img_alt_L m : map_img m = list_to_set (map_to_list m).*2.
+    Proof. unfold_leibniz. apply map_img_alt. Qed.
+
+    Lemma map_img_singleton_inv_L m i x :
+      map_img m = {[ x ]} → m !! i = None ∨ m !! i = Some x.
+    Proof. unfold_leibniz. apply map_img_singleton_inv. Qed.
+
+    Lemma map_img_union_inv_L `{!RelDecision (∈@{SA})} X Y m :
+      X ## Y →
+      map_img m = X ∪ Y →
+      ∃ m1 m2, m = m1 ∪ m2 ∧ m1 ##ₘ m2 ∧ map_img m1 = X ∧ map_img m2 = Y.
+    Proof. unfold_leibniz. apply map_img_union_inv. Qed.
+  End leibniz.
+
+  (** Set solver instances *)
+  Global Instance set_unfold_map_img_empty x :
+    SetUnfoldElemOf x (map_img (∅:M A)) False.
+  Proof. constructor. by rewrite map_img_empty, elem_of_empty. Qed.
+  Global Instance set_unfold_map_img_singleton x i y :
+    SetUnfoldElemOf x (map_img ({[i:=y]}:M A)) (x = y).
+  Proof. constructor. by rewrite map_img_singleton, elem_of_singleton. Qed.
+End img.
+
+Lemma map_img_fmap `{FinMap K M, FinSet A SA, SemiSet B SB} (f : A → B) (m : M A) :
+  map_img (f <$> m) ≡@{SB} set_map (C:=SA) f (map_img m).
+Proof.
+  apply set_equiv. intros y. rewrite elem_of_map_img, elem_of_map.
+  setoid_rewrite lookup_fmap. setoid_rewrite fmap_Some.
+  setoid_rewrite elem_of_map_img. naive_solver.
+Qed.
+Lemma map_img_fmap_L `{FinMap K M, FinSet A SA, SemiSet B SB, !LeibnizEquiv SB}
+    (f : A → B) (m : M A) :
+  map_img (f <$> m) =@{SB} set_map (C:=SA) f (map_img m).
+Proof. unfold_leibniz. apply map_img_fmap. Qed.
+
+Lemma map_img_kmap `{FinMap K M, FinMap K2 M2, SemiSet A SA}
+    (f : K → K2) `{!Inj (=) (=) f} m :
+  map_img (kmap (M2:=M2) f m) ≡@{SA} map_img m.
+Proof.
+  apply set_equiv. intros x. rewrite !elem_of_map_img.
+  setoid_rewrite (lookup_kmap_Some f). naive_solver.
+Qed.
+Lemma map_img_kmap_L `{FinMap K M, FinMap K2 M2, SemiSet A SA, !LeibnizEquiv SA}
+    (f : K → K2) `{!Inj (=) (=) f} m :
+  map_img (kmap (M2:=M2) f m) =@{SA} map_img m.
+Proof. unfold_leibniz. by apply map_img_kmap. Qed.
+
+(** ** The [map_compose] operation *)
+Section map_compose.
+  Context `{FinMap A MA, FinMap B MB} {C : Type}.
+  Implicit Types (m : MB C) (n : MA B) (a : A) (b : B) (c : C).
+
+  Lemma map_lookup_compose m n a : (m ∘ₘ n) !! a = n !! a ≫= (m !!.).
+  Proof. apply lookup_omap. Qed.
+
+  Lemma map_lookup_compose_Some m n a c :
+    (m ∘ₘ n) !! a = Some c ↔ ∃ b, n !! a = Some b ∧ m !! b = Some c.
+  Proof. rewrite map_lookup_compose. destruct (n !! a) eqn:?; naive_solver. Qed.
+  Lemma map_lookup_compose_Some_1 m n a c :
+    (m ∘ₘ n) !! a = Some c → ∃ b, n !! a = Some b ∧ m !! b = Some c.
+  Proof. by rewrite map_lookup_compose_Some. Qed.
+  Lemma map_lookup_compose_Some_2 m n a b c :
+    n !! a = Some b → m !! b = Some c → (m ∘ₘ n) !! a = Some c.
+  Proof. intros. apply map_lookup_compose_Some. by exists b. Qed.
+
+  Lemma map_lookup_compose_None m n a :
+    (m ∘ₘ n) !! a = None ↔
+    n !! a = None ∨ ∃ b, n !! a = Some b ∧ m !! b = None.
+  Proof. rewrite map_lookup_compose. destruct (n !! a) eqn:?; naive_solver. Qed.
+  Lemma map_lookup_compose_None_1 m n a :
+    (m ∘ₘ n) !! a = None → n !! a = None ∨ ∃ b, n !! a = Some b ∧ m !! b = None.
+  Proof. apply map_lookup_compose_None. Qed.
+  Lemma map_lookup_compose_None_2_1 m n a : n !! a = None → (m ∘ₘ n) !! a = None.
+  Proof. intros. apply map_lookup_compose_None. by left. Qed.
+  Lemma map_lookup_compose_None_2_2 m n a b :
+    n !! a = Some b → m !! b = None → (m ∘ₘ n) !! a = None.
+  Proof. intros. apply map_lookup_compose_None. naive_solver. Qed.
+
+  Lemma map_compose_img_subseteq `{SemiSet C D} m n :
+    map_img (m ∘ₘ n) ⊆@{D} map_img m.
+  Proof.
+    intros c. rewrite !elem_of_map_img.
+    setoid_rewrite map_lookup_compose_Some. naive_solver.
+  Qed.
+
+  Lemma map_compose_empty_r m : m ∘ₘ ∅ =@{MA C} ∅.
+  Proof. apply omap_empty. Qed.
+  Lemma map_compose_empty_l n : (∅ : MB C) ∘ₘ n =@{MA C} ∅.
+  Proof.
+    apply map_eq. intros k. rewrite map_lookup_compose, lookup_empty.
+    destruct (n !! k); simpl; [|done]. apply lookup_empty.
+  Qed.
+  Lemma map_compose_empty_iff m n :
+    m ∘ₘ n = ∅ ↔ ∀ a b, n !! a = Some b → m !! b = None.
+  Proof.
+    rewrite map_empty. setoid_rewrite map_lookup_compose_None.
+    apply forall_proper; intros a. destruct (n !! a); naive_solver.
+  Qed.
+
+  Lemma map_disjoint_compose_l m1 m2 n : m1 ##ₘ m2 → m1 ∘ₘ n ##ₘ m2 ∘ₘ n.
+  Proof.
+    rewrite !map_disjoint_spec; intros Hdisj a c1 c2.
+    rewrite !map_lookup_compose. destruct (n !! a); naive_solver.
+  Qed.
+  Lemma map_disjoint_compose_r m n1 n2 : n1 ##ₘ n2 → m ∘ₘ n1 ##ₘ m ∘ₘ n2.
+  Proof. apply map_disjoint_omap. Qed.
+
+  Lemma map_compose_union_l m1 m2 n : (m1 ∪ m2) ∘ₘ n = (m1 ∘ₘ n) ∪ (m2 ∘ₘ n).
+  Proof.
+    apply map_eq; intros a. rewrite lookup_union, !map_lookup_compose.
+    destruct (n !! a) as [b|] eqn:?; simpl; [|done]. by rewrite lookup_union.
+  Qed.
+  Lemma map_compose_union_r m n1 n2 :
+    n1 ##ₘ n2 → m ∘ₘ (n1 ∪ n2) = (m ∘ₘ n1) ∪ (m ∘ₘ n2).
+  Proof. intros Hs. by apply map_omap_union. Qed.
+
+  Lemma map_compose_mono_l m n1 n2 : n1 ⊆ n2 → m ∘ₘ n1 ⊆ m ∘ₘ n2.
+  Proof. by apply map_omap_mono. Qed.
+  Lemma map_compose_mono_r m1 m2 n : m1 ⊆ m2 → m1 ∘ₘ n ⊆ m2 ∘ₘ n.
+  Proof.
+    rewrite !map_subseteq_spec; intros ? a c.
+    rewrite !map_lookup_compose_Some. naive_solver.
+  Qed.
+  Lemma map_compose_mono m1 m2 n1 n2 :
+    m1 ⊆ m2 → n1 ⊆ n2 → m1 ∘ₘ n1 ⊆ m2 ∘ₘ n2.
+  Proof.
+    intros. transitivity (m1 ∘ₘ n2);
+      [by apply map_compose_mono_l|by apply map_compose_mono_r].
+  Qed.
+
+  Lemma map_compose_as_omap m n : m ∘ₘ n = omap (m !!.) n.
+  Proof. done. Qed.
+
+  (** Alternative definition of [m ∘ₘ n] by recursion on [n] *)
+  Lemma map_compose_as_fold m n :
+    m ∘ₘ n = map_fold (λ a b,
+               match m !! b with
+               | Some c => <[a:=c]>
+               | None => id
+               end) ∅ n.
+  Proof.
+    apply (map_fold_weak_ind (λ mn n, omap (m !!.) n = mn)).
+    { apply map_compose_empty_r. }
+    intros k b n' mn Hn' IH. rewrite omap_insert, <-IH.
+    destruct (m !! b); [done|].
+    by apply delete_notin, map_lookup_compose_None_2_1.
+  Qed.
+
+  Lemma map_compose_min_l `{SemiSet B D, !RelDecision (∈@{D})} m n :
+    m ∘ₘ n = filter (λ '(b,_), b ∈ map_img (SA:=D) n) m ∘ₘ n.
+  Proof.
+    apply map_eq; intros a. rewrite !map_lookup_compose.
+    destruct (n !! a) as [b|] eqn:?; simpl; [|done].
+    rewrite map_lookup_filter. destruct (m !! b) eqn:?; simpl; [|done].
+    by rewrite option_guard_True by (by eapply elem_of_map_img_2).
+  Qed.
+  Lemma map_compose_min_r m n :
+    m ∘ₘ n = m ∘ₘ filter (λ '(_,b), is_Some (m !! b)) n.
+  Proof.
+    apply map_eq; intros a. rewrite !map_lookup_compose, map_lookup_filter.
+    destruct (n !! a) as [b|] eqn:?; simpl; [|done]. by destruct (m !! b) eqn:?.
+  Qed.
+
+  Lemma map_compose_insert_Some m n a b c :
+    m !! b = Some c →
+    m ∘ₘ <[a:=b]> n =@{MA C} <[a:=c]> (m ∘ₘ n).
+  Proof. intros. by apply omap_insert_Some. Qed.
+  Lemma map_compose_insert_None m n a b :
+    m !! b = None →
+    m ∘ₘ <[a:=b]> n =@{MA C} delete a (m ∘ₘ n).
+  Proof. intros. by apply omap_insert_None. Qed.
+
+  Lemma map_compose_delete m n a :
+    m ∘ₘ delete a n =@{MA C} delete a (m ∘ₘ n).
+  Proof. intros. by apply omap_delete. Qed.
+
+  Lemma map_compose_singleton_Some m a b c :
+    m !! b = Some c →
+    m ∘ₘ {[a := b]} =@{MA C} {[a := c]}.
+  Proof. intros. by apply omap_singleton_Some. Qed.
+  Lemma map_compose_singleton_None m a b :
+    m !! b = None →
+    m ∘ₘ {[a := b]} =@{MA C} ∅.
+  Proof. intros. by apply omap_singleton_None. Qed.
+
+  Lemma map_compose_singletons a b c :
+    ({[b := c]} : MB C) ∘ₘ {[a := b]} =@{MA C} {[a := c]}.
+  Proof. by apply map_compose_singleton_Some, lookup_insert. Qed.
+End map_compose.
+
+Lemma map_compose_assoc `{FinMap A MA, FinMap B MB, FinMap C MC} {D}
+    (m : MC D) (n : MB C) (o : MA B) :
+  m ∘ₘ (n ∘ₘ o) = (m ∘ₘ n) ∘ₘ o.
+Proof.
+  apply map_eq; intros a. rewrite !map_lookup_compose.
+  destruct (o !! a); simpl; [|done]. by rewrite map_lookup_compose.
+Qed.
+
+Lemma map_fmap_map_compose `{FinMap A MA, FinMap B MB} {C1 C2} (f : C1 → C2)
+    (m : MB C1) (n : MA B) :
+  f <$> (m ∘ₘ n) = (f <$> m) ∘ₘ n.
+Proof.
+  apply map_eq; intros a. rewrite lookup_fmap, !map_lookup_compose.
+  destruct (n !! a); simpl; [|done]. by rewrite lookup_fmap.
+Qed.
+
+Lemma map_omap_map_compose `{FinMap A MA, FinMap B MB} {C1 C2} (f : C1 → option C2)
+    (m : MB C1) (n : MA B) :
+  omap f (m ∘ₘ n) = omap f m ∘ₘ n.
+Proof.
+  apply map_eq; intros a. rewrite lookup_omap, !map_lookup_compose.
+  destruct (n !! a); simpl; [|done]. by rewrite lookup_omap.
+Qed.
+
 (** * Tactics *)
 (** The tactic [decompose_map_disjoint] simplifies occurrences of [disjoint]
 in the hypotheses that involve the empty map [∅], the union [(∪)] or insert
@@ -3314,6 +4775,10 @@ Global Hint Extern 2 (foldr delete _ _ ##ₘ _) =>
   apply map_disjoint_foldr_delete_l : map_disjoint.
 Global Hint Extern 2 (_ ##ₘ foldr delete _ _) =>
   apply map_disjoint_foldr_delete_r : map_disjoint.
+Global Hint Extern 3 (_ ∘ₘ _ ##ₘ _ ∘ₘ _) =>
+  apply map_disjoint_compose_l : map_disjoint.
+Global Hint Extern 3 (_ ∘ₘ _ ##ₘ _ ∘ₘ _) =>
+  apply map_disjoint_compose_r : map_disjoint.
 
 (** The tactic [simpl_map by tac] simplifies occurrences of finite map look
 ups. It uses [tac] to discharge generated inequalities. Look ups in unions do
@@ -3377,7 +4842,7 @@ Tactic Notation "simplify_map_eq" "by" tactic3(tac) :=
     rewrite lookup_singleton_Some in H; destruct H
   | H1 : ?m1 !! ?i = Some ?x, H2 : ?m2 !! ?i = Some ?y |- _ =>
     let H3 := fresh in
-    feed pose proof (lookup_weaken_inv m1 m2 i x y) as H3; [done|by tac|done|];
+    opose proof* (lookup_weaken_inv m1 m2 i x y) as H3; [done|by tac|done|];
     clear H2; symmetry in H3
   | H1 : ?m1 !! ?i = Some ?x, H2 : ?m2 !! ?i = None |- _ =>
     let H3 := fresh in

theories/fin_sets.v → stdpp/fin_sets.v

@@ -10,26 +10,38 @@ Set Default Proof Using "Type*".
 
 (** Operations *)
 Global Instance set_size `{Elements A C} : Size C := length ∘ elements.
-Typeclasses Opaque set_size.
+Global Typeclasses Opaque set_size.
 
 Definition set_fold `{Elements A C} {B}
   (f : A → B → B) (b : B) : C → B := foldr f b ∘ elements.
-Typeclasses Opaque set_fold.
+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)).
-Typeclasses Opaque set_filter.
+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).
-Typeclasses Opaque set_map.
+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.
-Typeclasses Opaque set_fresh.
+Global Typeclasses Opaque set_fresh.
 
 (** We generalize the [fresh] operation on sets to generate lists of fresh
 elements w.r.t. a set [X]. *)
@@ -182,7 +194,7 @@ Qed.
 
 Lemma size_union X Y : X ## Y → size (X ∪ Y) = size X + size Y.
 Proof.
-  intros. unfold size, set_size. simpl. rewrite <-app_length.
+  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.
@@ -207,6 +219,16 @@ Proof.
   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.
@@ -225,10 +247,10 @@ Proof.
 Qed.
 
 (** * Induction principles *)
-Lemma set_wf : wf (⊂@{C}).
+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 ((≡) ==> iff) P →
+  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 (⊂).
@@ -244,7 +266,7 @@ 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) :
-  Proper ((=) ==> (≡) ==> iff) P →
+  (∀ 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.
@@ -263,9 +285,9 @@ 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. by intros ?? -> ?? ->%leibniz_equiv. Qed.
-Lemma set_fold_proper {B} (R : relation B) `{!Equivalence R}
-    (f : A → B → B) (b : B) `{!Proper ((=) ==> R ==> R) f}
+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.
@@ -276,28 +298,112 @@ 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.
-(** Generalization of [set_fold_disj_union] (below) with a.) a relation [R]
+
+(** 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_disj_union_strong {B} (R : relation B) `{!PreOrder R}
+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'))) →
-  X ## Y →
   R (set_fold f b (X ∪ Y)) (set_fold f (set_fold f b X) Y).
 Proof.
-  intros ? Hf Hdisj. unfold set_fold; simpl.
-  rewrite <-foldr_app. apply (foldr_permutation R f b).
-  - intros j1 x1 j2 x2 b' Hj Hj1 Hj2. apply Hf.
+  (** 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 ->. pose proof (NoDup_elements (X ∪ Y)).
+    + intros ->. assert (NoDup (elements (X ∩ Y) ++ elements (X ∖ Y))).
+      { rewrite <-elements_disj_union by set_solver. apply NoDup_elements. }
       by eapply Hj, NoDup_lookup.
-  - by rewrite elements_disj_union, (comm (++)).
+  - 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 →
@@ -308,8 +414,22 @@ Proof.
   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 R `{!Transitive R, ∀ x y, Decision (R x y)} (X : C) :
+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.
@@ -325,10 +445,20 @@ Proof.
   exists x; split; [set_solver|].
   rewrite HX, (right_id _ (∪)). apply singleton_minimal.
 Qed.
-Lemma minimal_exists_L R `{!LeibnizEquiv C, !Transitive R,
+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 R). Qed.
+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 :
@@ -353,6 +483,9 @@ Section filter.
   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.
@@ -371,6 +504,9 @@ Section filter.
     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.
@@ -380,7 +516,7 @@ End filter.
 
 (** * Map *)
 Section map.
-  Context `{Set_ B D}.
+  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.
@@ -430,6 +566,139 @@ Section map.
   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.
@@ -475,6 +744,14 @@ Proof.
   - 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.
@@ -518,7 +795,7 @@ Section infinite.
     Forall_fresh X xs → Y ⊆ X → Forall_fresh Y xs.
   Proof. rewrite !Forall_fresh_alt; set_solver. Qed.
 
-  Lemma fresh_list_length n X : length (fresh_list n X) = n.
+  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.
@@ -543,5 +820,5 @@ Lemma size_set_seq `{FinSet nat C} start len :
 Proof.
   rewrite <-list_to_set_seq, size_list_to_set.
   2:{ apply NoDup_seq. }
-  rewrite seq_length. done.
+  rewrite length_seq. done.
 Qed.

theories/finite.v → stdpp/finite.v

@@ -19,7 +19,6 @@ Program Definition finite_countable `{Finite A} : Countable A := {|
     Pos.of_nat $ S $ default 0 $ fst <$> list_find (x =.) (enum A);
   decode := λ p, enum A !! pred (Pos.to_nat p)
 |}.
-Global 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.
@@ -119,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.
@@ -147,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} :
@@ -217,9 +216,14 @@ 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}.
@@ -234,12 +238,16 @@ Section surjective_finite.
 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}.
 
-  Definition bijective_finite : Finite B :=
-    let _ := cancel_surj (f:=f) (g:=g) in
-    surjective_finite f.
+  Program Definition bijective_finite : Finite B :=
+    {| enum := f <$> enum A |}.
+  Next Obligation. apply (NoDup_fmap f), NoDup_enum. Qed.
+  Next Obligation.
+    intros b. rewrite elem_of_list_fmap. destruct (surj f b).
+    eauto using elem_of_enum.
+  Qed.
 End bijective_finite.
 
 Global Program Instance option_finite `{Finite A} : Finite (option A) :=
@@ -254,7 +262,7 @@ 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.
@@ -289,76 +297,65 @@ Next Obligation.
     [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.
 
 Global Program Instance prod_finite `{Finite A, Finite B} : Finite (A * B)%type :=
-  {| enum := foldr (λ x, (pair x <$> enum B ++.)) [] (enum A) |}.
+  {| enum := a ← enum A; (a,.) <$> enum B |}.
 Next Obligation.
-  intros A ?????. 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 auto ]. by intro; destruct Hx; right.
-  - 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.
 
-Global Program Instance list_finite `{Finite A} n : Finite { l : list A | 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 A ?? n. 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 A ?? n [l Hl]. revert l Hl.
-  induction n as [|n IH]; intros [|x l] Hl; 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; [|done]. by apply (sig_eq_pi _).
-  - 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 : list A | 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.
 Global Program Instance fin_finite n : Finite (fin n) := {| enum := fin_enum n |}.
@@ -372,7 +369,18 @@ 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)}.
@@ -407,5 +415,48 @@ Section sig_finite.
     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, fmap_length. Qed.
+  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.

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.

theories/gmultiset.v → 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.
 
-Record gmultiset A `{Countable A} := GMultiSet { gmultiset_car : gmap A nat }.
+(** 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.
 
@@ -19,7 +26,7 @@ Section definitions.
   Context `{Countable A}.
 
   Definition multiplicity (x : A) (X : gmultiset A) : nat :=
-    match gmultiset_car X !! x with Some n => S n | None => 0 end.
+    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,
@@ -28,35 +35,45 @@ Section definitions.
     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 (S n) 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 := 0 ]}.
+    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)) X Y.
+    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)) X Y.
+    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 (S (x + y))) X Y.
+    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,
-      let z := x - y in guard (0 < z); Some (pred z)) 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.
+    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.
 
-Typeclasses Opaque gmultiset_elem_of gmultiset_subseteq.
-Typeclasses Opaque gmultiset_elements gmultiset_size gmultiset_empty.
-Typeclasses Opaque gmultiset_singleton gmultiset_union gmultiset_difference.
-Typeclasses Opaque gmultiset_dom.
+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}.
@@ -68,7 +85,7 @@ Section basic_lemmas.
     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.
+    repeat case_match; naive_solver lia.
   Qed.
   Global Instance gmultiset_leibniz : LeibnizEquiv (gmultiset A).
   Proof. intros X Y. by rewrite gmultiset_eq. Qed.
@@ -114,6 +131,12 @@ Section basic_lemmas.
     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.
@@ -131,9 +154,18 @@ Section basic_lemmas.
   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 *)
@@ -165,15 +197,18 @@ instantiates universally quantified hypotheses [H : ∀ x : A, P x] in two ways:
   in [H], so variable [x].
 
 Step (4) is implemented using the tactic [multiset_simplify_singletons], which
-simplifies occurences of [multiplicity x {[ y ]}] as follows:
+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 occurences into a fresh [z ≤ 1] if [y] does not
+- 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.
@@ -189,7 +224,7 @@ Section multiset_unfold.
   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 y :
+  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 :
@@ -208,6 +243,10 @@ Section multiset_unfold.
     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)) →
@@ -267,9 +306,18 @@ Section multiset_unfold.
     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) |- _ =>
@@ -282,6 +330,9 @@ Ltac multiset_instantiate :=
   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.
@@ -290,19 +341,33 @@ Ltac multiset_simplify_singletons :=
   repeat match goal with
   | H : context [multiplicity ?x {[+ ?y +]}] |- _ =>
      first
-       [progress rewrite ?multiplicity_singleton, ?multiplicity_singleton_ne in H by done
+       [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 by done
+       [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 *)
-Ltac multiset_solver :=
-  set_solver by (multiset_instantiate; multiset_simplify_singletons; lia).
+(** 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}.
@@ -388,6 +453,40 @@ Section more_lemmas.
   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.
@@ -397,9 +496,15 @@ Section more_lemmas.
   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) = [].
@@ -410,9 +515,10 @@ Section more_lemmas.
   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 [|[]] eqn:?.
+    intros; apply (f_equal GMultiSet).
+    destruct (map_to_list X) as [|[x p]] eqn:?; simpl in *.
     - by apply map_to_list_empty_iff.
-    - naive_solver.
+    - 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.
@@ -425,7 +531,7 @@ Section more_lemmas.
     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 (S n) x); simpl.
+    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.
@@ -435,15 +541,22 @@ Section more_lemmas.
         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 replicate_plus, Permutation_middle.
+      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 (S n) x); simpl.
+    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.
@@ -451,12 +564,6 @@ Section more_lemmas.
       exists (x,n); split; [|by apply elem_of_map_to_list].
       apply elem_of_replicate; auto with lia.
   Qed.
-  Lemma gmultiset_elem_of_dom x X : x ∈ dom (gset A) 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.
 
   (** Properties of the set_fold operation *)
   Lemma gmultiset_set_fold_empty {B} (f : A → B → B) (b : B) :
@@ -465,13 +572,52 @@ Section more_lemmas.
   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 Hcomm Hassoc. unfold set_fold; simpl.
-    by rewrite gmultiset_elements_disj_union, <- foldr_app, (comm (++)).
+    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 *)
@@ -508,24 +654,32 @@ Section more_lemmas.
   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, app_length.
+    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.
 
-  Lemma gmultiset_subseteq_alt X Y :
+  Local Lemma gmultiset_subseteq_alt X Y :
     X ⊆ Y ↔
-    map_relation (≤) (λ _, False) (λ _, True) (gmultiset_car X) (gmultiset_car 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 (≤)
-     (λ _, False) (λ _, True) (gmultiset_car X) (gmultiset_car Y))));
+   refine (λ X Y, cast_if (decide (map_relation
+       (λ _, Pos.le) (λ _ _, False) (λ _ _, True)
+       (gmultiset_car X) (gmultiset_car Y))));
      by rewrite gmultiset_subseteq_alt.
   Defined.
 
@@ -568,13 +722,7 @@ Section more_lemmas.
   Proof. multiset_solver. Qed.
   Lemma gmultiset_singleton_subseteq x y :
     {[+ x +]} ⊆@{gmultiset A} {[+ y +]} ↔ x = y.
-  Proof.
-    split; [|multiset_solver].
-    (* FIXME: [multiset_solver] should solve this *)
-    intros Hxy. specialize (Hxy x).
-    rewrite multiplicity_singleton, multiplicity_singleton' in Hxy.
-    case_decide; [done|lia].
-  Qed.
+  Proof. multiset_solver. Qed.
 
   Lemma gmultiset_elem_of_subseteq X1 X2 x : x ∈ X1 → X1 ⊆ X2 → x ∈ X2.
   Proof. multiset_solver. Qed.
@@ -603,6 +751,12 @@ Section more_lemmas.
   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.
@@ -622,7 +776,7 @@ Section more_lemmas.
   Qed.
 
   (** Well-foundedness *)
-  Lemma gmultiset_wf : wf (⊂@{gmultiset A}).
+  Lemma gmultiset_wf : well_founded (⊂@{gmultiset A}).
   Proof.
     apply (wf_projected (<) size); auto using gmultiset_subset_size, lt_wf.
   Qed.
@@ -636,3 +790,120 @@ Section more_lemmas.
     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

@@ -39,7 +39,7 @@ Qed.
 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.
@@ -49,7 +49,7 @@ Qed.
 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.
@@ -105,7 +105,7 @@ Proof.
   - 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' [??] Hm];
-      csimpl; inversion_clear 1 as [|?? Hn]; [constructor|].
+      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.
@@ -116,7 +116,7 @@ Proof.
 Qed.
 End hashset.
 
-Typeclasses Opaque hashset_elem_of.
+Global Typeclasses Opaque hashset_elem_of.
 
 Section remove_duplicates.
 Context `{EqDecision A} (hash : A → Z).

theories/infinite.v → stdpp/infinite.v

@@ -37,7 +37,7 @@ Section search_infinite.
 
   Context `{!Inj (=) (=) f, !EqDecision B}.
 
-  Lemma search_infinite_R_wf xs : wf (R xs).
+  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).
@@ -45,7 +45,7 @@ Section search_infinite.
       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 filter_length_lt; eauto.
+    apply help with (n2 - 1); [|lia]. apply IH. eapply length_filter_lt; eauto.
   Qed.
 
   Definition search_infinite_go (xs : list B) (n : nat)
@@ -143,7 +143,7 @@ Global Program Instance list_infinite `{Inhabited A} : Infinite (list A) := {|
 Next Obligation.
   intros A ? xs ?. destruct (infinite_is_fresh (length <$> xs)).
   apply elem_of_list_fmap. eexists; split; [|done].
-  unfold fresh. by rewrite replicate_length.
+  unfold fresh. by rewrite length_replicate.
 Qed.
 Next Obligation. unfold fresh. by intros A ? xs1 xs2 ->. Qed.
 

theories/lexico.v → stdpp/lexico.v

@@ -19,7 +19,7 @@ Global Instance bool_lexico : Lexico bool := λ b1 b2,
 Global Instance nat_lexico : Lexico nat := (<).
 Global Instance N_lexico : Lexico N := (<)%N.
 Global Instance Z_lexico : Lexico Z := (<)%Z.
-Typeclasses Opaque bool_lexico nat_lexico N_lexico Z_lexico.
+Global Typeclasses Opaque bool_lexico nat_lexico N_lexico Z_lexico.
 Global Instance list_lexico `{Lexico A} : Lexico (list A) :=
   fix go l1 l2 :=
   let _ : Lexico (list A) := @go in
@@ -138,7 +138,7 @@ Proof.
   | _ :: _, [] => inright _
   | x1 :: l1, x2 :: l2 => cast_trichotomy (trichotomyT lexico (x1,l1) (x2,l2))
   end); clear tA go go';
-    abstract (repeat (done || constructor || congruence || by inversion 1)).
+    abstract (repeat (done || constructor || congruence || by inv 1)).
 Defined.
 
 Global Instance sig_lexico_po `{Lexico A, !StrictOrder (@lexico A _)}

stdpp/list.v

+(** This file re-exports all the list lemmas in std++. Do *not* import the individual
+[list_*] modules; their organization may cahnge over time. Always import [list]. *)
+
+From stdpp Require Export list_basics list_relations list_monad list_misc list_tactics list_numbers.
+From stdpp Require Import options.

stdpp/list_basics.v

+From stdpp Require Export numbers base option.
+From stdpp Require Import options.
+
+Global Arguments length {_} _ : assert.
+Global Arguments cons {_} _ _ : assert.
+Global Arguments app {_} _ _ : assert.
+
+Global Instance: Params (@length) 1 := {}.
+Global Instance: Params (@cons) 1 := {}.
+Global Instance: Params (@app) 1 := {}.
+
+(** [head] and [tail] are defined as [parsing only] for [hd_error] and [tl] in
+the Coq standard library. We redefine these notations to make sure they also
+pretty print properly. *)
+Notation head := hd_error.
+Notation tail := tl.
+
+Notation take := firstn.
+Notation drop := skipn.
+
+Global Arguments head {_} _ : assert.
+Global Arguments tail {_} _ : assert.
+
+Global Arguments take {_} !_ !_ / : assert.
+Global Arguments drop {_} !_ !_ / : assert.
+
+Global Instance: Params (@head) 1 := {}.
+Global Instance: Params (@tail) 1 := {}.
+Global Instance: Params (@take) 1 := {}.
+Global Instance: Params (@drop) 1 := {}.
+
+Notation "(::)" := cons (only parsing) : list_scope.
+Notation "( x ::.)" := (cons x) (only parsing) : list_scope.
+Notation "(.:: l )" := (λ x, cons x l) (only parsing) : list_scope.
+Notation "(++)" := app (only parsing) : list_scope.
+Notation "( l ++.)" := (app l) (only parsing) : list_scope.
+Notation "(.++ k )" := (λ l, app l k) (only parsing) : list_scope.
+
+Global Instance maybe_cons {A} : Maybe2 (@cons A) := λ l,
+  match l with x :: l => Some (x,l) | _ => None end.
+
+(** The operation [l !! i] gives the [i]th element of the list [l], or [None]
+in case [i] is out of bounds. *)
+Global Instance list_lookup {A} : Lookup nat A (list A) :=
+  fix go i l {struct l} : option A := let _ : Lookup _ _ _ := @go in
+  match l with
+  | [] => None | x :: l => match i with 0 => Some x | S i => l !! i end
+  end.
+
+(** The operation [l !!! i] is a total version of the lookup operation
+[l !! i]. *)
+Global Instance list_lookup_total `{!Inhabited A} : LookupTotal nat A (list A) :=
+  fix go i l {struct l} : A := let _ : LookupTotal _ _ _ := @go in
+  match l with
+  | [] => inhabitant
+  | x :: l => match i with 0 => x | S i => l !!! i end
+  end.
+
+(** The operation [alter f i l] applies the function [f] to the [i]th element
+of [l]. In case [i] is out of bounds, the list is returned unchanged. *)
+Global Instance list_alter {A} : Alter nat A (list A) := λ f,
+  fix go i l {struct l} :=
+  match l with
+  | [] => []
+  | x :: l => match i with 0 => f x :: l | S i => x :: go i l end
+  end.
+
+(** The operation [<[i:=x]> l] overwrites the element at position [i] with the
+value [x]. In case [i] is out of bounds, the list is returned unchanged. *)
+Global Instance list_insert {A} : Insert nat A (list A) :=
+  fix go i y l {struct l} := let _ : Insert _ _ _ := @go in
+  match l with
+  | [] => []
+  | x :: l => match i with 0 => y :: l | S i => x :: <[i:=y]>l end
+  end.
+Fixpoint list_inserts {A} (i : nat) (k l : list A) : list A :=
+  match k with
+  | [] => l
+  | y :: k => <[i:=y]>(list_inserts (S i) k l)
+  end.
+Global Instance: Params (@list_inserts) 1 := {}.
+
+(** The operation [delete i l] removes the [i]th element of [l] and moves
+all consecutive elements one position ahead. In case [i] is out of bounds,
+the list is returned unchanged. *)
+Global Instance list_delete {A} : Delete nat (list A) :=
+  fix go (i : nat) (l : list A) {struct l} : list A :=
+  match l with
+  | [] => []
+  | x :: l => match i with 0 => l | S i => x :: @delete _ _ go i l end
+  end.
+
+(** The function [option_list o] converts an element [Some x] into the
+singleton list [[x]], and [None] into the empty list [[]]. *)
+Definition option_list {A} : option A → list A := option_rect _ (λ x, [x]) [].
+Global Instance: Params (@option_list) 1 := {}.
+Global Instance maybe_list_singleton {A} : Maybe (λ x : A, [x]) := λ l,
+  match l with [x] => Some x | _ => None end.
+
+(** The function [filter P l] returns the list of elements of [l] that
+satisfies [P]. The order remains unchanged. *)
+Global Instance list_filter {A} : Filter A (list A) :=
+  fix go P _ l := let _ : Filter _ _ := @go in
+  match l with
+  | [] => []
+  | x :: l => if decide (P x) then x :: filter P l else filter P l
+  end.
+
+(** The function [replicate n x] generates a list with length [n] of elements
+with value [x]. *)
+Fixpoint replicate {A} (n : nat) (x : A) : list A :=
+  match n with 0 => [] | S n => x :: replicate n x end.
+Global Instance: Params (@replicate) 2 := {}.
+
+(** The function [reverse l] returns the elements of [l] in reverse order. *)
+Definition reverse {A} (l : list A) : list A := rev_append l [].
+Global Instance: Params (@reverse) 1 := {}.
+
+(** The function [last l] returns the last element of the list [l], or [None]
+if the list [l] is empty. *)
+Fixpoint last {A} (l : list A) : option A :=
+  match l with [] => None | [x] => Some x | _ :: l => last l end.
+Global Instance: Params (@last) 1 := {}.
+Global Arguments last : simpl nomatch.
+
+(** Functions to fold over a list. We redefine [foldl] with the arguments in
+the same order as in Haskell. *)
+Notation foldr := fold_right.
+Definition foldl {A B} (f : A → B → A) : A → list B → A :=
+  fix go a l := match l with [] => a | x :: l => go (f a x) l end.
+
+(** Set operations on lists *)
+Section list_set.
+  Context `{dec : EqDecision A}.
+  Global Instance elem_of_list_dec : RelDecision (∈@{list A}).
+  Proof using Type*.
+   refine (
+    fix go x l :=
+    match l return Decision (x ∈ l) with
+    | [] => right _
+    | y :: l => cast_if_or (decide (x = y)) (go x l)
+    end); clear go dec; subst; try (by constructor); abstract by inv 1.
+  Defined.
+  Fixpoint remove_dups (l : list A) : list A :=
+    match l with
+    | [] => []
+    | x :: l =>
+      if decide_rel (∈) x l then remove_dups l else x :: remove_dups l
+    end.
+  Fixpoint list_difference (l k : list A) : list A :=
+    match l with
+    | [] => []
+    | x :: l =>
+      if decide_rel (∈) x k
+      then list_difference l k else x :: list_difference l k
+    end.
+  Definition list_union (l k : list A) : list A := list_difference l k ++ k.
+  Fixpoint list_intersection (l k : list A) : list A :=
+    match l with
+    | [] => []
+    | x :: l =>
+      if decide_rel (∈) x k
+      then x :: list_intersection l k else list_intersection l k
+    end.
+  Definition list_intersection_with (f : A → A → option A) :
+    list A → list A → list A := fix go l k :=
+    match l with
+    | [] => []
+    | x :: l => foldr (λ y,
+        match f x y with None => id | Some z => (z ::.) end) (go l k) k
+    end.
+End list_set.
+
+(** * General theorems *)
+Section general_properties.
+Context {A : Type}.
+Implicit Types x y z : A.
+Implicit Types l k : list A.
+
+(* TODO: Coq 8.20 has the same lemma under the same name, so remove our version
+once we require Coq 8.20. In Coq 8.19 and before, this lemma is called
+[app_length]. *)
+Lemma length_app (l l' : list A) : length (l ++ l') = length l + length l'.
+Proof. induction l; f_equal/=; auto. Qed.
+
+Lemma app_inj_1 (l1 k1 l2 k2 : list A) :
+  length l1 = length k1 → l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2.
+Proof. revert k1. induction l1; intros [|??]; naive_solver. Qed.
+Lemma app_inj_2 (l1 k1 l2 k2 : list A) :
+  length l2 = length k2 → l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2.
+Proof.
+  intros ? Hl. apply app_inj_1; auto.
+  apply (f_equal length) in Hl. rewrite !length_app in Hl. lia.
+Qed.
+
+Global Instance cons_eq_inj : Inj2 (=) (=) (=) (@cons A).
+Proof. by injection 1. Qed.
+
+Global Instance: ∀ k, Inj (=) (=) (k ++.).
+Proof. intros ???. apply app_inv_head. Qed.
+Global Instance: ∀ k, Inj (=) (=) (.++ k).
+Proof. intros ???. apply app_inv_tail. Qed.
+Global Instance: Assoc (=) (@app A).
+Proof. intros ???. apply app_assoc. Qed.
+Global Instance: LeftId (=) [] (@app A).
+Proof. done. Qed.
+Global Instance: RightId (=) [] (@app A).
+Proof. intro. apply app_nil_r. Qed.
+
+Lemma app_nil l1 l2 : l1 ++ l2 = [] ↔ l1 = [] ∧ l2 = [].
+Proof. split; [apply app_eq_nil|]. by intros [-> ->]. Qed.
+Lemma app_singleton l1 l2 x :
+  l1 ++ l2 = [x] ↔ l1 = [] ∧ l2 = [x] ∨ l1 = [x] ∧ l2 = [].
+Proof. split; [apply app_eq_unit|]. by intros [[-> ->]|[-> ->]]. Qed.
+Lemma cons_middle x l1 l2 : l1 ++ x :: l2 = l1 ++ [x] ++ l2.
+Proof. done. Qed.
+Lemma list_eq l1 l2 : (∀ i, l1 !! i = l2 !! i) → l1 = l2.
+Proof.
+  revert l2. induction l1 as [|x l1 IH]; intros [|y l2] H.
+  - done.
+  - discriminate (H 0).
+  - discriminate (H 0).
+  - f_equal; [by injection (H 0)|]. apply (IH _ $ λ i, H (S i)).
+Qed.
+Global Instance list_eq_dec {dec : EqDecision A} : EqDecision (list A) :=
+  list_eq_dec dec.
+Global Instance list_eq_nil_dec l : Decision (l = []).
+Proof. by refine match l with [] => left _ | _ => right _ end. Defined.
+Lemma list_singleton_reflect l :
+  option_reflect (λ x, l = [x]) (length l ≠ 1) (maybe (λ x, [x]) l).
+Proof. by destruct l as [|? []]; constructor. Defined.
+
+Lemma list_eq_Forall2 l1 l2 : l1 = l2 ↔ Forall2 eq l1 l2.
+Proof.
+  split.
+  - intros <-. induction l1; eauto using Forall2.
+  - induction 1; naive_solver.
+Qed.
+
+Definition length_nil : length (@nil A) = 0 := eq_refl.
+Definition length_cons x l : length (x :: l) = S (length l) := eq_refl.
+
+Lemma nil_or_length_pos l : l = [] ∨ length l ≠ 0.
+Proof. destruct l; simpl; auto with lia. Qed.
+Lemma nil_length_inv l : length l = 0 → l = [].
+Proof. by destruct l. Qed.
+Lemma lookup_cons_ne_0 l x i : i ≠ 0 → (x :: l) !! i = l !! pred i.
+Proof. by destruct i. Qed.
+Lemma lookup_total_cons_ne_0 `{!Inhabited A} l x i :
+  i ≠ 0 → (x :: l) !!! i = l !!! pred i.
+Proof. by destruct i. Qed.
+Lemma lookup_nil i : @nil A !! i = None.
+Proof. by destruct i. Qed.
+Lemma lookup_total_nil `{!Inhabited A} i : @nil A !!! i = inhabitant.
+Proof. by destruct i. Qed.
+Lemma lookup_tail l i : tail l !! i = l !! S i.
+Proof. by destruct l. Qed.
+Lemma lookup_total_tail `{!Inhabited A} l i : tail l !!! i = l !!! S i.
+Proof. by destruct l. Qed.
+Lemma lookup_lt_Some l i x : l !! i = Some x → i < length l.
+Proof. revert i. induction l; intros [|?] ?; naive_solver auto with arith. Qed.
+Lemma lookup_lt_is_Some_1 l i : is_Some (l !! i) → i < length l.
+Proof. intros [??]; eauto using lookup_lt_Some. Qed.
+Lemma lookup_lt_is_Some_2 l i : i < length l → is_Some (l !! i).
+Proof. revert i. induction l; intros [|?] ?; naive_solver auto with lia. Qed.
+Lemma lookup_lt_is_Some l i : is_Some (l !! i) ↔ i < length l.
+Proof. split; auto using lookup_lt_is_Some_1, lookup_lt_is_Some_2. Qed.
+Lemma lookup_ge_None l i : l !! i = None ↔ length l ≤ i.
+Proof. rewrite eq_None_not_Some, lookup_lt_is_Some. lia. Qed.
+Lemma lookup_ge_None_1 l i : l !! i = None → length l ≤ i.
+Proof. by rewrite lookup_ge_None. Qed.
+Lemma lookup_ge_None_2 l i : length l ≤ i → l !! i = None.
+Proof. by rewrite lookup_ge_None. Qed.
+
+Lemma list_eq_same_length l1 l2 n :
+  length l2 = n → length l1 = n →
+  (∀ i x y, i < n → l1 !! i = Some x → l2 !! i = Some y → x = y) → l1 = l2.
+Proof.
+  intros <- Hlen Hl; apply list_eq; intros i. destruct (l2 !! i) as [x|] eqn:Hx.
+  - destruct (lookup_lt_is_Some_2 l1 i) as [y Hy].
+    { rewrite Hlen; eauto using lookup_lt_Some. }
+    rewrite Hy; f_equal; apply (Hl i); eauto using lookup_lt_Some.
+  - by rewrite lookup_ge_None, Hlen, <-lookup_ge_None.
+Qed.
+
+Lemma nth_lookup l i d : nth i l d = default d (l !! i).
+Proof. revert i. induction l as [|x l IH]; intros [|i]; simpl; auto. Qed.
+Lemma nth_lookup_Some l i d x : l !! i = Some x → nth i l d = x.
+Proof. rewrite nth_lookup. by intros ->. Qed.
+Lemma nth_lookup_or_length l i d : {l !! i = Some (nth i l d)} + {length l ≤ i}.
+Proof.
+  rewrite nth_lookup. destruct (l !! i) eqn:?; eauto using lookup_ge_None_1.
+Qed.
+
+Lemma list_lookup_total_alt `{!Inhabited A} l i :
+  l !!! i = default inhabitant (l !! i).
+Proof. revert i. induction l; intros []; naive_solver. Qed.
+Lemma list_lookup_total_correct `{!Inhabited A} l i x :
+  l !! i = Some x → l !!! i = x.
+Proof. rewrite list_lookup_total_alt. by intros ->. Qed.
+Lemma list_lookup_lookup_total `{!Inhabited A} l i :
+  is_Some (l !! i) → l !! i = Some (l !!! i).
+Proof. rewrite list_lookup_total_alt; by intros [x ->]. Qed.
+Lemma list_lookup_lookup_total_lt `{!Inhabited A} l i :
+  i < length l → l !! i = Some (l !!! i).
+Proof. intros ?. by apply list_lookup_lookup_total, lookup_lt_is_Some_2. Qed.
+Lemma list_lookup_alt `{!Inhabited A} l i x :
+  l !! i = Some x ↔ i < length l ∧ l !!! i = x.
+Proof.
+  naive_solver eauto using list_lookup_lookup_total_lt,
+    list_lookup_total_correct, lookup_lt_Some.
+Qed.
+
+Lemma lookup_app l1 l2 i :
+  (l1 ++ l2) !! i =
+    match l1 !! i with Some x => Some x | None => l2 !! (i - length l1) end.
+Proof. revert i. induction l1 as [|x l1 IH]; intros [|i]; naive_solver. Qed.
+Lemma lookup_app_l l1 l2 i : i < length l1 → (l1 ++ l2) !! i = l1 !! i.
+Proof. rewrite lookup_app. by intros [? ->]%lookup_lt_is_Some. Qed.
+Lemma lookup_total_app_l `{!Inhabited A} l1 l2 i :
+  i < length l1 → (l1 ++ l2) !!! i = l1 !!! i.
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_app_l. Qed.
+Lemma lookup_app_l_Some l1 l2 i x : l1 !! i = Some x → (l1 ++ l2) !! i = Some x.
+Proof. rewrite lookup_app. by intros ->. Qed.
+Lemma lookup_app_r l1 l2 i :
+  length l1 ≤ i → (l1 ++ l2) !! i = l2 !! (i - length l1).
+Proof. rewrite lookup_app. by intros ->%lookup_ge_None. Qed.
+Lemma lookup_total_app_r `{!Inhabited A} l1 l2 i :
+  length l1 ≤ i → (l1 ++ l2) !!! i = l2 !!! (i - length l1).
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_app_r. Qed.
+Lemma lookup_app_Some l1 l2 i x :
+  (l1 ++ l2) !! i = Some x ↔
+    l1 !! i = Some x ∨ length l1 ≤ i ∧ l2 !! (i - length l1) = Some x.
+Proof.
+  rewrite lookup_app. destruct (l1 !! i) eqn:Hi.
+  - apply lookup_lt_Some in Hi. naive_solver lia.
+  - apply lookup_ge_None in Hi. naive_solver lia.
+Qed.
+
+Lemma lookup_cons x l i :
+  (x :: l) !! i =
+    match i with 0 => Some x | S i => l !! i end.
+Proof. reflexivity. Qed.
+Lemma lookup_cons_Some x l i y :
+  (x :: l) !! i = Some y ↔
+    (i = 0 ∧ x = y) ∨ (1 ≤ i ∧ l !! (i - 1) = Some y).
+Proof.
+  rewrite lookup_cons. destruct i as [|i].
+  - naive_solver lia.
+  - replace (S i - 1) with i by lia. naive_solver lia.
+Qed.
+
+Lemma list_lookup_singleton x i :
+  [x] !! i =
+    match i with 0 => Some x | S _ => None end.
+Proof. reflexivity. Qed.
+Lemma list_lookup_singleton_Some x i y :
+  [x] !! i = Some y ↔ i = 0 ∧ x = y.
+Proof. rewrite lookup_cons_Some. naive_solver. Qed.
+
+Lemma lookup_snoc_Some x l i y :
+  (l ++ [x]) !! i = Some y ↔
+    (i < length l ∧ l !! i = Some y) ∨ (i = length l ∧ x = y).
+Proof.
+  rewrite lookup_app_Some, list_lookup_singleton_Some.
+  naive_solver auto using lookup_lt_is_Some_1 with lia.
+Qed.
+
+Lemma list_lookup_middle l1 l2 x n :
+  n = length l1 → (l1 ++ x :: l2) !! n = Some x.
+Proof. intros ->. by induction l1. Qed.
+Lemma list_lookup_total_middle `{!Inhabited A} l1 l2 x n :
+  n = length l1 → (l1 ++ x :: l2) !!! n = x.
+Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_middle. Qed.
+
+Lemma list_insert_alter l i x : <[i:=x]>l = alter (λ _, x) i l.
+Proof. by revert i; induction l; intros []; intros; f_equal/=. Qed.
+Lemma length_alter f l i : length (alter f i l) = length l.
+Proof. revert i. by induction l; intros [|?]; f_equal/=. Qed.
+Lemma length_insert l i x : length (<[i:=x]>l) = length l.
+Proof. revert i. by induction l; intros [|?]; f_equal/=. Qed.
+Lemma list_lookup_alter f l i : alter f i l !! i = f <$> l !! i.
+Proof.
+  revert i.
+  induction l as [|?? IHl]; [done|].
+  intros [|i]; [done|]. apply (IHl i).
+Qed.
+Lemma list_lookup_total_alter `{!Inhabited A} f l i :
+  i < length l → alter f i l !!! i = f (l !!! i).
+Proof.
+  intros [x Hx]%lookup_lt_is_Some_2.
+  by rewrite !list_lookup_total_alt, list_lookup_alter, Hx.
+Qed.
+Lemma list_lookup_alter_ne f l i j : i ≠ j → alter f i l !! j = l !! j.
+Proof. revert i j. induction l; [done|]. intros [] []; naive_solver. Qed.
+Lemma list_lookup_total_alter_ne `{!Inhabited A} f l i j :
+  i ≠ j → alter f i l !!! j = l !!! j.
+Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_alter_ne. Qed.
+
+Lemma list_lookup_insert l i x : i < length l → <[i:=x]>l !! i = Some x.
+Proof. revert i. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed.
+Lemma list_lookup_total_insert `{!Inhabited A} l i x :
+  i < length l → <[i:=x]>l !!! i = x.
+Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_insert. Qed.
+Lemma list_lookup_insert_ne l i j x : i ≠ j → <[i:=x]>l !! j = l !! j.
+Proof. revert i j. induction l; [done|]. intros [] []; naive_solver. Qed.
+Lemma list_lookup_total_insert_ne `{!Inhabited A} l i j x :
+  i ≠ j → <[i:=x]>l !!! j = l !!! j.
+Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_insert_ne. Qed.
+Lemma list_lookup_insert_Some l i x j y :
+  <[i:=x]>l !! j = Some y ↔
+    i = j ∧ x = y ∧ j < length l ∨ i ≠ j ∧ l !! j = Some y.
+Proof.
+  destruct (decide (i = j)) as [->|];
+    [split|rewrite list_lookup_insert_ne by done; tauto].
+  - intros Hy. assert (j < length l).
+    { rewrite <-(length_insert l j x); eauto using lookup_lt_Some. }
+    rewrite list_lookup_insert in Hy by done; naive_solver.
+  - intros [(?&?&?)|[??]]; rewrite ?list_lookup_insert; naive_solver.
+Qed.
+Lemma list_insert_commute l i j x y :
+  i ≠ j → <[i:=x]>(<[j:=y]>l) = <[j:=y]>(<[i:=x]>l).
+Proof. revert i j. by induction l; intros [|?] [|?] ?; f_equal/=; auto. Qed.
+Lemma list_insert_id' l i x : (i < length l → l !! i = Some x) → <[i:=x]>l = l.
+Proof. revert i. induction l; intros [|i] ?; f_equal/=; naive_solver lia. Qed.
+Lemma list_insert_id l i x : l !! i = Some x → <[i:=x]>l = l.
+Proof. intros ?. by apply list_insert_id'. Qed.
+Lemma list_insert_ge l i x : length l ≤ i → <[i:=x]>l = l.
+Proof. revert i. induction l; intros [|i] ?; f_equal/=; auto with lia. Qed.
+Lemma list_insert_insert l i x y : <[i:=x]> (<[i:=y]> l) = <[i:=x]> l.
+Proof. revert i. induction l; intros [|i]; f_equal/=; auto. Qed.
+
+Lemma list_lookup_other l i x :
+  length l ≠ 1 → l !! i = Some x → ∃ j y, j ≠ i ∧ l !! j = Some y.
+Proof.
+  intros. destruct i, l as [|x0 [|x1 l]]; simplify_eq/=.
+  - by exists 1, x1.
+  - by exists 0, x0.
+Qed.
+
+Lemma alter_app_l f l1 l2 i :
+  i < length l1 → alter f i (l1 ++ l2) = alter f i l1 ++ l2.
+Proof. revert i. induction l1; intros [|?] ?; f_equal/=; auto with lia. Qed.
+Lemma alter_app_r f l1 l2 i :
+  alter f (length l1 + i) (l1 ++ l2) = l1 ++ alter f i l2.
+Proof. revert i. induction l1; intros [|?]; f_equal/=; auto. Qed.
+Lemma alter_app_r_alt f l1 l2 i :
+  length l1 ≤ i → alter f i (l1 ++ l2) = l1 ++ alter f (i - length l1) l2.
+Proof.
+  intros. assert (i = length l1 + (i - length l1)) as Hi by lia.
+  rewrite Hi at 1. by apply alter_app_r.
+Qed.
+Lemma list_alter_id f l i : (∀ x, f x = x) → alter f i l = l.
+Proof. intros ?. revert i. induction l; intros [|?]; f_equal/=; auto. Qed.
+Lemma list_alter_ext f g l k i :
+  (∀ x, l !! i = Some x → f x = g x) → l = k → alter f i l = alter g i k.
+Proof. intros H ->. revert i H. induction k; intros [|?] ?; f_equal/=; auto. Qed.
+Lemma list_alter_compose f g l i :
+  alter (f ∘ g) i l = alter f i (alter g i l).
+Proof. revert i. induction l; intros [|?]; f_equal/=; auto. Qed.
+Lemma list_alter_commute f g l i j :
+  i ≠ j → alter f i (alter g j l) = alter g j (alter f i l).
+Proof. revert i j. induction l; intros [|?][|?] ?; f_equal/=; auto with lia. Qed.
+Lemma insert_app_l l1 l2 i x :
+  i < length l1 → <[i:=x]>(l1 ++ l2) = <[i:=x]>l1 ++ l2.
+Proof. revert i. induction l1; intros [|?] ?; f_equal/=; auto with lia. Qed.
+Lemma insert_app_r l1 l2 i x : <[length l1+i:=x]>(l1 ++ l2) = l1 ++ <[i:=x]>l2.
+Proof. revert i. induction l1; intros [|?]; f_equal/=; auto. Qed.
+Lemma insert_app_r_alt l1 l2 i x :
+  length l1 ≤ i → <[i:=x]>(l1 ++ l2) = l1 ++ <[i - length l1:=x]>l2.
+Proof.
+  intros. assert (i = length l1 + (i - length l1)) as Hi by lia.
+  rewrite Hi at 1. by apply insert_app_r.
+Qed.
+
+Lemma delete_middle l1 l2 x : delete (length l1) (l1 ++ x :: l2) = l1 ++ l2.
+Proof. induction l1; f_equal/=; auto. Qed.
+Lemma length_delete l i :
+  is_Some (l !! i) → length (delete i l) = length l - 1.
+Proof.
+  rewrite lookup_lt_is_Some. revert i.
+  induction l as [|x l IH]; intros [|i] ?; simpl in *; [lia..|].
+  rewrite IH by lia. lia.
+Qed.
+Lemma lookup_delete_lt l i j : j < i → delete i l !! j = l !! j.
+Proof. revert i j; induction l; intros [] []; naive_solver eauto with lia. Qed.
+Lemma lookup_total_delete_lt `{!Inhabited A} l i j :
+  j < i → delete i l !!! j = l !!! j.
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_delete_lt. Qed.
+Lemma lookup_delete_ge l i j : i ≤ j → delete i l !! j = l !! S j.
+Proof. revert i j; induction l; intros [] []; naive_solver eauto with lia. Qed.
+Lemma lookup_total_delete_ge `{!Inhabited A} l i j :
+  i ≤ j → delete i l !!! j = l !!! S j.
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_delete_ge. Qed.
+
+Lemma length_inserts l i k : length (list_inserts i k l) = length l.
+Proof.
+  revert i. induction k; intros ?; csimpl; rewrite ?length_insert; auto.
+Qed.
+Lemma list_lookup_inserts l i k j :
+  i ≤ j < i + length k → j < length l →
+  list_inserts i k l !! j = k !! (j - i).
+Proof.
+  revert i j. induction k as [|y k IH]; csimpl; intros i j ??; [lia|].
+  destruct (decide (i = j)) as [->|].
+  { by rewrite list_lookup_insert, Nat.sub_diag
+      by (rewrite length_inserts; lia). }
+  rewrite list_lookup_insert_ne, IH by lia.
+  by replace (j - i) with (S (j - S i)) by lia.
+Qed.
+Lemma list_lookup_total_inserts `{!Inhabited A} l i k j :
+  i ≤ j < i + length k → j < length l →
+  list_inserts i k l !!! j = k !!! (j - i).
+Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_inserts. Qed.
+Lemma list_lookup_inserts_lt l i k j :
+  j < i → list_inserts i k l !! j = l !! j.
+Proof.
+  revert i j. induction k; intros i j ?; csimpl;
+    rewrite ?list_lookup_insert_ne by lia; auto with lia.
+Qed.
+Lemma list_lookup_total_inserts_lt `{!Inhabited A}l i k j :
+  j < i → list_inserts i k l !!! j = l !!! j.
+Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_inserts_lt. Qed.
+Lemma list_lookup_inserts_ge l i k j :
+  i + length k ≤ j → list_inserts i k l !! j = l !! j.
+Proof.
+  revert i j. induction k; csimpl; intros i j ?;
+    rewrite ?list_lookup_insert_ne by lia; auto with lia.
+Qed.
+Lemma list_lookup_total_inserts_ge `{!Inhabited A} l i k j :
+  i + length k ≤ j → list_inserts i k l !!! j = l !!! j.
+Proof. intros. by rewrite !list_lookup_total_alt, list_lookup_inserts_ge. Qed.
+Lemma list_lookup_inserts_Some l i k j y :
+  list_inserts i k l !! j = Some y ↔
+    (j < i ∨ i + length k ≤ j) ∧ l !! j = Some y ∨
+    i ≤ j < i + length k ∧ j < length l ∧ k !! (j - i) = Some y.
+Proof.
+  destruct (decide (j < i)).
+  { rewrite list_lookup_inserts_lt by done; intuition lia. }
+  destruct (decide (i + length k ≤ j)).
+  { rewrite list_lookup_inserts_ge by done; intuition lia. }
+  split.
+  - intros Hy. assert (j < length l).
+    { rewrite <-(length_inserts l i k); eauto using lookup_lt_Some. }
+    rewrite list_lookup_inserts in Hy by lia. intuition lia.
+  - intuition. by rewrite list_lookup_inserts by lia.
+Qed.
+Lemma list_insert_inserts_lt l i j x k :
+  i < j → <[i:=x]>(list_inserts j k l) = list_inserts j k (<[i:=x]>l).
+Proof.
+  revert i j. induction k; intros i j ?; simpl;
+    rewrite 1?list_insert_commute by lia; auto with f_equal.
+Qed.
+Lemma list_inserts_app_l l1 l2 l3 i :
+  list_inserts i (l1 ++ l2) l3 = list_inserts (length l1 + i) l2 (list_inserts i l1 l3).
+Proof.
+  revert i; induction l1 as [|x l1 IH]; [done|].
+  intro i. simpl. rewrite IH, Nat.add_succ_r. apply list_insert_inserts_lt. lia.
+Qed.
+Lemma list_inserts_app_r l1 l2 l3 i :
+  list_inserts (length l2 + i) l1 (l2 ++ l3) = l2 ++ list_inserts i l1 l3.
+Proof.
+  revert i; induction l1 as [|x l1 IH]; [done|].
+  intros i. simpl. by rewrite plus_n_Sm, IH, insert_app_r.
+Qed.
+Lemma list_inserts_nil l1 i : list_inserts i l1 [] = [].
+Proof.
+  revert i; induction l1 as [|x l1 IH]; [done|].
+  intro i. simpl. by rewrite IH.
+Qed.
+Lemma list_inserts_cons l1 l2 i x :
+  list_inserts (S i) l1 (x :: l2) = x :: list_inserts i l1 l2.
+Proof.
+  revert i; induction l1 as [|y l1 IH]; [done|].
+  intro i. simpl. by rewrite IH.
+Qed.
+Lemma list_inserts_0_r l1 l2 l3 :
+  length l1 = length l2 → list_inserts 0 l1 (l2 ++ l3) = l1 ++ l3.
+Proof.
+  revert l2. induction l1 as [|x l1 IH]; intros [|y l2] ?; simplify_eq/=; [done|].
+  rewrite list_inserts_cons. simpl. by rewrite IH.
+Qed.
+Lemma list_inserts_0_l l1 l2 l3 :
+  length l1 = length l3 → list_inserts 0 (l1 ++ l2) l3 = l1.
+Proof.
+  revert l3. induction l1 as [|x l1 IH]; intros [|z l3] ?; simplify_eq/=.
+  { by rewrite list_inserts_nil. }
+  rewrite list_inserts_cons. simpl. by rewrite IH.
+Qed.
+
+(** ** Properties of the [reverse] function *)
+Lemma reverse_nil : reverse [] =@{list A} [].
+Proof. done. Qed.
+Lemma reverse_singleton x : reverse [x] = [x].
+Proof. done. Qed.
+Lemma reverse_cons l x : reverse (x :: l) = reverse l ++ [x].
+Proof. unfold reverse. by rewrite <-!rev_alt. Qed.
+Lemma reverse_snoc l x : reverse (l ++ [x]) = x :: reverse l.
+Proof. unfold reverse. by rewrite <-!rev_alt, rev_unit. Qed.
+Lemma reverse_app l1 l2 : reverse (l1 ++ l2) = reverse l2 ++ reverse l1.
+Proof. unfold reverse. rewrite <-!rev_alt. apply rev_app_distr. Qed.
+Lemma length_reverse l : length (reverse l) = length l.
+Proof.
+  induction l as [|x l IH]; [done|].
+  rewrite reverse_cons, length_app, IH. simpl. lia.
+Qed.
+Lemma reverse_involutive l : reverse (reverse l) = l.
+Proof. unfold reverse. rewrite <-!rev_alt. apply rev_involutive. Qed.
+Lemma reverse_lookup l i :
+  i < length l →
+  reverse l !! i = l !! (length l - S i).
+Proof.
+  revert i. induction l as [|x l IH]; simpl; intros i Hi; [done|].
+  rewrite reverse_cons.
+  destruct (decide (i = length l)); subst.
+  + by rewrite list_lookup_middle, Nat.sub_diag by by rewrite length_reverse.
+  + rewrite lookup_app_l by (rewrite length_reverse; lia).
+    rewrite IH by lia.
+    by assert (length l - i = S (length l - S i)) as -> by lia.
+Qed.
+Lemma reverse_lookup_Some l i x :
+  reverse l !! i = Some x ↔ l !! (length l - S i) = Some x ∧ i < length l.
+Proof.
+  split.
+  - destruct (decide (i < length l)); [ by rewrite reverse_lookup|].
+    rewrite lookup_ge_None_2; [done|]. rewrite length_reverse. lia.
+  - intros [??]. by rewrite reverse_lookup.
+Qed.
+Global Instance: Inj (=) (=) (@reverse A).
+Proof.
+  intros l1 l2 Hl.
+  by rewrite <-(reverse_involutive l1), <-(reverse_involutive l2), Hl.
+Qed.
+
+(** ** Properties of the [elem_of] predicate *)
+Lemma not_elem_of_nil x : x ∉ [].
+Proof. by inv 1. Qed.
+Lemma elem_of_nil x : x ∈ [] ↔ False.
+Proof. intuition. by destruct (not_elem_of_nil x). Qed.
+Lemma elem_of_nil_inv l : (∀ x, x ∉ l) → l = [].
+Proof. destruct l; [done|]. by edestruct 1; constructor. Qed.
+Lemma elem_of_not_nil x l : x ∈ l → l ≠ [].
+Proof. intros ? ->. by apply (elem_of_nil x). Qed.
+Lemma elem_of_cons l x y : x ∈ y :: l ↔ x = y ∨ x ∈ l.
+Proof. by split; [inv 1; subst|intros [->|?]]; constructor. Qed.
+Lemma not_elem_of_cons l x y : x ∉ y :: l ↔ x ≠ y ∧ x ∉ l.
+Proof. rewrite elem_of_cons. tauto. Qed.
+Lemma elem_of_app l1 l2 x : x ∈ l1 ++ l2 ↔ x ∈ l1 ∨ x ∈ l2.
+Proof.
+  induction l1 as [|y l1 IH]; simpl.
+  - rewrite elem_of_nil. naive_solver.
+  - rewrite !elem_of_cons, IH. naive_solver.
+Qed.
+Lemma not_elem_of_app l1 l2 x : x ∉ l1 ++ l2 ↔ x ∉ l1 ∧ x ∉ l2.
+Proof. rewrite elem_of_app. tauto. Qed.
+Lemma elem_of_list_singleton x y : x ∈ [y] ↔ x = y.
+Proof. rewrite elem_of_cons, elem_of_nil. tauto. Qed.
+Lemma elem_of_reverse_2 x l : x ∈ l → x ∈ reverse l.
+Proof.
+  induction 1; rewrite reverse_cons, elem_of_app,
+    ?elem_of_list_singleton; intuition.
+Qed.
+Lemma elem_of_reverse x l : x ∈ reverse l ↔ x ∈ l.
+Proof.
+  split; auto using elem_of_reverse_2.
+  intros. rewrite <-(reverse_involutive l). by apply elem_of_reverse_2.
+Qed.
+
+Lemma elem_of_list_lookup_1 l x : x ∈ l → ∃ i, l !! i = Some x.
+Proof.
+  induction 1 as [|???? IH]; [by exists 0 |].
+  destruct IH as [i ?]; auto. by exists (S i).
+Qed.
+Lemma elem_of_list_lookup_total_1 `{!Inhabited A} l x :
+  x ∈ l → ∃ i, i < length l ∧ l !!! i = x.
+Proof.
+  intros [i Hi]%elem_of_list_lookup_1.
+  eauto using lookup_lt_Some, list_lookup_total_correct.
+Qed.
+Lemma elem_of_list_lookup_2 l i x : l !! i = Some x → x ∈ l.
+Proof.
+  revert i. induction l; intros [|i] ?; simplify_eq/=; constructor; eauto.
+Qed.
+Lemma elem_of_list_lookup_total_2 `{!Inhabited A} l i :
+  i < length l → l !!! i ∈ l.
+Proof. intros. by eapply elem_of_list_lookup_2, list_lookup_lookup_total_lt. Qed.
+Lemma elem_of_list_lookup l x : x ∈ l ↔ ∃ i, l !! i = Some x.
+Proof. firstorder eauto using elem_of_list_lookup_1, elem_of_list_lookup_2. Qed.
+Lemma elem_of_list_lookup_total `{!Inhabited A} l x :
+  x ∈ l ↔ ∃ i, i < length l ∧ l !!! i = x.
+Proof.
+  naive_solver eauto using elem_of_list_lookup_total_1, elem_of_list_lookup_total_2.
+Qed.
+Lemma elem_of_list_split_length l i x :
+  l !! i = Some x → ∃ l1 l2, l = l1 ++ x :: l2 ∧ i = length l1.
+Proof.
+  revert i; induction l as [|y l IH]; intros [|i] Hl; simplify_eq/=.
+  - exists []; eauto.
+  - destruct (IH _ Hl) as (?&?&?&?); simplify_eq/=.
+    eexists (y :: _); eauto.
+Qed.
+Lemma elem_of_list_split l x : x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2.
+Proof.
+  intros [? (?&?&?&_)%elem_of_list_split_length]%elem_of_list_lookup_1; eauto.
+Qed.
+Lemma elem_of_list_split_l `{EqDecision A} l x :
+  x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2 ∧ x ∉ l1.
+Proof.
+  induction 1 as [x l|x y l ? IH].
+  { exists [], l. rewrite elem_of_nil. naive_solver. }
+  destruct (decide (x = y)) as [->|?].
+  - exists [], l. rewrite elem_of_nil. naive_solver.
+  - destruct IH as (l1 & l2 & -> & ?).
+    exists (y :: l1), l2. rewrite elem_of_cons. naive_solver.
+Qed.
+Lemma elem_of_list_split_r `{EqDecision A} l x :
+  x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2 ∧ x ∉ l2.
+Proof.
+  induction l as [|y l IH] using rev_ind.
+  { by rewrite elem_of_nil. }
+  destruct (decide (x = y)) as [->|].
+  - exists l, []. rewrite elem_of_nil. naive_solver.
+  - rewrite elem_of_app, elem_of_list_singleton. intros [?| ->]; try done.
+    destruct IH as (l1 & l2 & -> & ?); auto.
+    exists l1, (l2 ++ [y]).
+    rewrite elem_of_app, elem_of_list_singleton, <-(assoc_L (++)). naive_solver.
+Qed.
+Lemma list_elem_of_insert l i x : i < length l → x ∈ <[i:=x]>l.
+Proof. intros. by eapply elem_of_list_lookup_2, list_lookup_insert. Qed.
+Lemma nth_elem_of l i d : i < length l → nth i l d ∈ l.
+Proof.
+  intros; eapply elem_of_list_lookup_2.
+  destruct (nth_lookup_or_length l i d); [done | by lia].
+Qed.
+
+Lemma not_elem_of_app_cons_inv_l x y l1 l2 k1 k2 :
+  x ∉ k1 → y ∉ l1 →
+  l1 ++ x :: l2 = k1 ++ y :: k2 →
+  l1 = k1 ∧ x = y ∧ l2 = k2.
+Proof.
+  revert k1. induction l1 as [|x' l1 IH]; intros [|y' k1] Hx Hy ?; simplify_eq/=;
+    try apply not_elem_of_cons in Hx as [??];
+    try apply not_elem_of_cons in Hy as [??]; naive_solver.
+Qed.
+Lemma not_elem_of_app_cons_inv_r x y l1 l2 k1 k2 :
+  x ∉ k2 → y ∉ l2 →
+  l1 ++ x :: l2 = k1 ++ y :: k2 →
+  l1 = k1 ∧ x = y ∧ l2 = k2.
+Proof.
+  intros. destruct (not_elem_of_app_cons_inv_l x y (reverse l2) (reverse l1)
+    (reverse k2) (reverse k1)); [..|naive_solver].
+  - by rewrite elem_of_reverse.
+  - by rewrite elem_of_reverse.
+  - rewrite <-!reverse_snoc, <-!reverse_app, <-!(assoc_L (++)). by f_equal.
+Qed.
+
+(** ** Set operations on lists *)
+Section list_set.
+  Lemma elem_of_list_intersection_with f l k x :
+    x ∈ list_intersection_with f l k ↔ ∃ x1 x2,
+        x1 ∈ l ∧ x2 ∈ k ∧ f x1 x2 = Some x.
+  Proof.
+    split.
+    - induction l as [|x1 l IH]; simpl; [by rewrite elem_of_nil|].
+      intros Hx. setoid_rewrite elem_of_cons.
+      cut ((∃ x2, x2 ∈ k ∧ f x1 x2 = Some x)
+           ∨ x ∈ list_intersection_with f l k); [naive_solver|].
+      clear IH. revert Hx. generalize (list_intersection_with f l k).
+      induction k; simpl; [by auto|].
+      case_match; setoid_rewrite elem_of_cons; naive_solver.
+    - intros (x1&x2&Hx1&Hx2&Hx). induction Hx1 as [x1 l|x1 ? l ? IH]; simpl.
+      + generalize (list_intersection_with f l k).
+        induction Hx2; simpl; [by rewrite Hx; left |].
+        case_match; simpl; try setoid_rewrite elem_of_cons; auto.
+      + generalize (IH Hx). clear Hx IH Hx2.
+        generalize (list_intersection_with f l k).
+        induction k; simpl; intros; [done|].
+        case_match; simpl; rewrite ?elem_of_cons; auto.
+  Qed.
+
+  Context `{!EqDecision A}.
+  Lemma elem_of_list_difference l k x : x ∈ list_difference l k ↔ x ∈ l ∧ x ∉ k.
+  Proof.
+    split; induction l; simpl; try case_decide;
+      rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
+  Qed.
+  Lemma elem_of_list_union l k x : x ∈ list_union l k ↔ x ∈ l ∨ x ∈ k.
+  Proof.
+    unfold list_union. rewrite elem_of_app, elem_of_list_difference.
+    intuition. case (decide (x ∈ k)); intuition.
+  Qed.
+  Lemma elem_of_list_intersection l k x :
+    x ∈ list_intersection l k ↔ x ∈ l ∧ x ∈ k.
+  Proof.
+    split; induction l; simpl; repeat case_decide;
+      rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
+  Qed.
+End list_set.
+
+(** ** Properties of the [last] function *)
+Lemma last_nil : last [] =@{option A} None.
+Proof. done. Qed.
+Lemma last_singleton x : last [x] = Some x.
+Proof. done. Qed.
+Lemma last_cons_cons x1 x2 l : last (x1 :: x2 :: l) = last (x2 :: l).
+Proof. done. Qed.
+Lemma last_app_cons l1 l2 x :
+  last (l1 ++ x :: l2) = last (x :: l2).
+Proof. induction l1 as [|y [|y' l1] IHl]; done. Qed.
+Lemma last_snoc x l : last (l ++ [x]) = Some x.
+Proof. induction l as [|? []]; simpl; auto. Qed.
+Lemma last_None l : last l = None ↔ l = [].
+Proof.
+  split; [|by intros ->].
+  induction l as [|x1 [|x2 l] IH]; naive_solver.
+Qed.
+Lemma last_Some l x : last l = Some x ↔ ∃ l', l = l' ++ [x].
+Proof.
+  split.
+  - destruct l as [|x' l'] using rev_ind; [done|].
+    rewrite last_snoc. naive_solver.
+  - intros [l' ->]. by rewrite last_snoc.
+Qed.
+Lemma last_is_Some l : is_Some (last l) ↔ l ≠ [].
+Proof. rewrite <-not_eq_None_Some, last_None. naive_solver. Qed.
+Lemma last_app l1 l2 :
+  last (l1 ++ l2) = match last l2 with Some y => Some y | None => last l1 end.
+Proof.
+  destruct l2 as [|x l2 _] using rev_ind.
+  - by rewrite (right_id_L _ (++)).
+  - by rewrite (assoc_L (++)), !last_snoc.
+Qed.
+Lemma last_app_Some l1 l2 x :
+  last (l1 ++ l2) = Some x ↔ last l2 = Some x ∨ last l2 = None ∧ last l1 = Some x.
+Proof. rewrite last_app. destruct (last l2); naive_solver. Qed.
+Lemma last_app_None l1 l2 :
+  last (l1 ++ l2) = None ↔ last l1 = None ∧ last l2 = None.
+Proof. rewrite last_app. destruct (last l2); naive_solver. Qed.
+Lemma last_cons x l :
+  last (x :: l) = match last l with Some y => Some y | None => Some x end.
+Proof. by apply (last_app [x]). Qed.
+Lemma last_cons_Some_ne x y l :
+  x ≠ y → last (x :: l) = Some y → last l = Some y.
+Proof. rewrite last_cons. destruct (last l); naive_solver. Qed.
+Lemma last_lookup l : last l = l !! pred (length l).
+Proof. by induction l as [| ?[]]. Qed.
+Lemma last_reverse l : last (reverse l) = head l.
+Proof. destruct l as [|x l]; simpl; by rewrite ?reverse_cons, ?last_snoc. Qed.
+Lemma last_Some_elem_of l x :
+  last l = Some x → x ∈ l.
+Proof.
+  rewrite last_Some. intros [l' ->]. apply elem_of_app. right.
+  by apply elem_of_list_singleton.
+Qed.
+
+(** ** Properties of the [head] function *)
+Lemma head_nil : head [] =@{option A} None.
+Proof. done. Qed.
+Lemma head_cons x l : head (x :: l) = Some x.
+Proof. done. Qed.
+
+Lemma head_None l : head l = None ↔ l = [].
+Proof. split; [|by intros ->]. by destruct l. Qed.
+Lemma head_Some l x : head l = Some x ↔ ∃ l', l = x :: l'.
+Proof. split; [destruct l as [|x' l]; naive_solver | by intros [l' ->]]. Qed.
+Lemma head_is_Some l : is_Some (head l) ↔ l ≠ [].
+Proof. rewrite <-not_eq_None_Some, head_None. naive_solver. Qed.
+
+Lemma head_snoc x l :
+  head (l ++ [x]) = match head l with Some y => Some y | None => Some x end.
+Proof. by destruct l. Qed.
+Lemma head_snoc_snoc x1 x2 l :
+  head (l ++ [x1; x2]) = head (l ++ [x1]).
+Proof. by destruct l. Qed.
+Lemma head_lookup l : head l = l !! 0.
+Proof. by destruct l. Qed.
+
+Lemma head_app l1 l2 :
+  head (l1 ++ l2) = match head l1 with Some y => Some y | None => head l2 end.
+Proof. by destruct l1. Qed.
+Lemma head_app_Some l1 l2 x :
+  head (l1 ++ l2) = Some x ↔ head l1 = Some x ∨ head l1 = None ∧ head l2 = Some x.
+Proof. rewrite head_app. destruct (head l1); naive_solver. Qed.
+Lemma head_app_None l1 l2 :
+  head (l1 ++ l2) = None ↔ head l1 = None ∧ head l2 = None.
+Proof. rewrite head_app. destruct (head l1); naive_solver. Qed.
+Lemma head_reverse l : head (reverse l) = last l.
+Proof. by rewrite <-last_reverse, reverse_involutive. Qed.
+Lemma head_Some_elem_of l x :
+  head l = Some x → x ∈ l.
+Proof. rewrite head_Some. intros [l' ->]. left. Qed.
+
+(** ** Properties of the [take] function *)
+Definition take_drop i l : take i l ++ drop i l = l := firstn_skipn i l.
+Lemma take_drop_middle l i x :
+  l !! i = Some x → take i l ++ x :: drop (S i) l = l.
+Proof.
+  revert i x. induction l; intros [|?] ??; simplify_eq/=; f_equal; auto.
+Qed.
+Lemma take_0 l : take 0 l = [].
+Proof. reflexivity. Qed.
+Lemma take_nil n : take n [] =@{list A} [].
+Proof. by destruct n. Qed.
+Lemma take_S_r l n x : l !! n = Some x → take (S n) l = take n l ++ [x].
+Proof. revert n. induction l; intros []; naive_solver eauto with f_equal. Qed.
+Lemma take_ge l n : length l ≤ n → take n l = l.
+Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed.
+
+(** [take_app] is the most general lemma for [take] and [app]. Below that we
+establish a number of useful corollaries. *)
+Lemma take_app l k n : take n (l ++ k) = take n l ++ take (n - length l) k.
+Proof. apply firstn_app. Qed.
+
+Lemma take_app_ge l k n :
+  length l ≤ n → take n (l ++ k) = l ++ take (n - length l) k.
+Proof. intros. by rewrite take_app, take_ge. Qed.
+Lemma take_app_le l k n : n ≤ length l → take n (l ++ k) = take n l.
+Proof.
+  intros. by rewrite take_app, (proj2 (Nat.sub_0_le _ _)), take_0, (right_id _ _).
+Qed.
+Lemma take_app_add l k m :
+  take (length l + m) (l ++ k) = l ++ take m k.
+Proof. rewrite take_app, take_ge by lia. repeat f_equal; lia. Qed.
+Lemma take_app_add' l k n m :
+  n = length l → take (n + m) (l ++ k) = l ++ take m k.
+Proof. intros ->. apply take_app_add. Qed.
+Lemma take_app_length l k : take (length l) (l ++ k) = l.
+Proof. by rewrite take_app, take_ge, Nat.sub_diag, take_0, (right_id _ _). Qed.
+Lemma take_app_length' l k n : n = length l → take n (l ++ k) = l.
+Proof. intros ->. by apply take_app_length. Qed.
+Lemma take_app3_length l1 l2 l3 : take (length l1) ((l1 ++ l2) ++ l3) = l1.
+Proof. by rewrite <-(assoc_L (++)), take_app_length. Qed.
+Lemma take_app3_length' l1 l2 l3 n :
+  n = length l1 → take n ((l1 ++ l2) ++ l3) = l1.
+Proof. intros ->. by apply take_app3_length. Qed.
+
+Lemma take_take l n m : take n (take m l) = take (min n m) l.
+Proof. revert n m. induction l; intros [|?] [|?]; f_equal/=; auto. Qed.
+Lemma take_idemp l n : take n (take n l) = take n l.
+Proof. by rewrite take_take, Nat.min_id. Qed.
+Lemma length_take l n : length (take n l) = min n (length l).
+Proof. revert n. induction l; intros [|?]; f_equal/=; done. Qed.
+Lemma length_take_le l n : n ≤ length l → length (take n l) = n.
+Proof. rewrite length_take. apply Nat.min_l. Qed.
+Lemma length_take_ge l n : length l ≤ n → length (take n l) = length l.
+Proof. rewrite length_take. apply Nat.min_r. Qed.
+Lemma take_drop_commute l n m : take n (drop m l) = drop m (take (m + n) l).
+Proof.
+  revert n m. induction l; intros [|?][|?]; simpl; auto using take_nil with lia.
+Qed.
+
+Lemma lookup_take l n i : i < n → take n l !! i = l !! i.
+Proof. revert n i. induction l; intros [|n] [|i] ?; simpl; auto with lia. Qed.
+Lemma lookup_total_take `{!Inhabited A} l n i : i < n → take n l !!! i = l !!! i.
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_take. Qed.
+Lemma lookup_take_ge l n i : n ≤ i → take n l !! i = None.
+Proof. revert n i. induction l; intros [|?] [|?] ?; simpl; auto with lia. Qed.
+Lemma lookup_total_take_ge `{!Inhabited A} l n i : n ≤ i → take n l !!! i = inhabitant.
+Proof. intros. by rewrite list_lookup_total_alt, lookup_take_ge. Qed.
+Lemma lookup_take_Some l n i a : take n l !! i = Some a ↔ l !! i = Some a ∧ i < n.
+Proof.
+  split.
+  - destruct (decide (i < n)).
+    + rewrite lookup_take; naive_solver.
+    + rewrite lookup_take_ge; [done|lia].
+  - intros [??]. by rewrite lookup_take.
+Qed.
+
+Lemma elem_of_take x n l : x ∈ take n l ↔ ∃ i, l !! i = Some x ∧ i < n.
+Proof.
+  rewrite elem_of_list_lookup. setoid_rewrite lookup_take_Some. naive_solver.
+Qed.
+
+Lemma take_alter f l n i : n ≤ i → take n (alter f i l) = take n l.
+Proof.
+  intros. apply list_eq. intros j. destruct (le_lt_dec n j).
+  - by rewrite !lookup_take_ge.
+  - by rewrite !lookup_take, !list_lookup_alter_ne by lia.
+Qed.
+Lemma take_insert l n i x : n ≤ i → take n (<[i:=x]>l) = take n l.
+Proof.
+  intros. apply list_eq. intros j. destruct (le_lt_dec n j).
+  - by rewrite !lookup_take_ge.
+  - by rewrite !lookup_take, !list_lookup_insert_ne by lia.
+Qed.
+Lemma take_insert_lt l n i x : i < n → take n (<[i:=x]>l) = <[i:=x]>(take n l).
+Proof.
+  revert l i. induction n as [|? IHn]; auto; simpl.
+  intros [|] [|] ?; auto; simpl. by rewrite IHn by lia.
+Qed.
+
+(** ** Properties of the [drop] function *)
+Lemma drop_0 l : drop 0 l = l.
+Proof. done. Qed.
+Lemma drop_nil n : drop n [] =@{list A} [].
+Proof. by destruct n. Qed.
+Lemma drop_S l x n :
+  l !! n = Some x → drop n l = x :: drop (S n) l.
+Proof. revert n. induction l; intros []; naive_solver. Qed.
+Lemma length_drop l n : length (drop n l) = length l - n.
+Proof. revert n. by induction l; intros [|i]; f_equal/=. Qed.
+Lemma drop_ge l n : length l ≤ n → drop n l = [].
+Proof. revert n. induction l; intros [|?]; simpl in *; auto with lia. Qed.
+Lemma drop_all l : drop (length l) l = [].
+Proof. by apply drop_ge. Qed.
+Lemma drop_drop l n1 n2 : drop n1 (drop n2 l) = drop (n2 + n1) l.
+Proof. revert n2. induction l; intros [|?]; simpl; rewrite ?drop_nil; auto. Qed.
+
+(** [drop_app] is the most general lemma for [drop] and [app]. Below we prove a
+number of useful corollaries. *)
+Lemma drop_app l k n : drop n (l ++ k) = drop n l ++ drop (n - length l) k.
+Proof. apply skipn_app. Qed.
+
+Lemma drop_app_ge l k n :
+  length l ≤ n → drop n (l ++ k) = drop (n - length l) k.
+Proof. intros. by rewrite drop_app, drop_ge. Qed.
+Lemma drop_app_le l k n :
+  n ≤ length l → drop n (l ++ k) = drop n l ++ k.
+Proof. intros. by rewrite drop_app, (proj2 (Nat.sub_0_le _ _)), drop_0. Qed.
+Lemma drop_app_add l k m :
+  drop (length l + m) (l ++ k) = drop m k.
+Proof. rewrite drop_app, drop_ge by lia. simpl. f_equal; lia. Qed.
+Lemma drop_app_add' l k n m :
+  n = length l → drop (n + m) (l ++ k) = drop m k.
+Proof. intros ->. apply drop_app_add. Qed.
+Lemma drop_app_length l k : drop (length l) (l ++ k) = k.
+Proof. by rewrite drop_app_le, drop_all. Qed.
+Lemma drop_app_length' l k n : n = length l → drop n (l ++ k) = k.
+Proof. intros ->. by apply drop_app_length. Qed.
+Lemma drop_app3_length l1 l2 l3 :
+  drop (length l1) ((l1 ++ l2) ++ l3) = l2 ++ l3.
+Proof. by rewrite <-(assoc_L (++)), drop_app_length. Qed.
+Lemma drop_app3_length' l1 l2 l3 n :
+  n = length l1 → drop n ((l1 ++ l2) ++ l3) = l2 ++ l3.
+Proof. intros ->. apply drop_app3_length. Qed.
+
+Lemma lookup_drop l n i : drop n l !! i = l !! (n + i).
+Proof. revert n i. induction l; intros [|i] ?; simpl; auto. Qed.
+Lemma lookup_total_drop `{!Inhabited A} l n i : drop n l !!! i = l !!! (n + i).
+Proof. by rewrite !list_lookup_total_alt, lookup_drop. Qed.
+Lemma drop_alter f l n i : i < n → drop n (alter f i l) = drop n l.
+Proof.
+  intros. apply list_eq. intros j.
+  by rewrite !lookup_drop, !list_lookup_alter_ne by lia.
+Qed.
+Lemma drop_insert_le l n i x : n ≤ i → drop n (<[i:=x]>l) = <[i-n:=x]>(drop n l).
+Proof. revert i n. induction l; intros [] []; naive_solver lia. Qed.
+Lemma drop_insert_gt l n i x : i < n → drop n (<[i:=x]>l) = drop n l.
+Proof.
+  intros. apply list_eq. intros j.
+  by rewrite !lookup_drop, !list_lookup_insert_ne by lia.
+Qed.
+Lemma delete_take_drop l i : delete i l = take i l ++ drop (S i) l.
+Proof. revert i. induction l; intros [|?]; f_equal/=; auto. Qed.
+Lemma take_take_drop l n m : take n l ++ take m (drop n l) = take (n + m) l.
+Proof. revert n m. induction l; intros [|?] [|?]; f_equal/=; auto. Qed.
+Lemma drop_take_drop l n m : n ≤ m → drop n (take m l) ++ drop m l = drop n l.
+Proof.
+  revert n m. induction l; intros [|?] [|?] ?;
+    f_equal/=; auto using take_drop with lia.
+Qed.
+Lemma insert_take_drop l i x :
+  i < length l →
+  <[i:=x]> l = take i l ++ x :: drop (S i) l.
+Proof.
+  intros Hi.
+  rewrite <-(take_drop_middle (<[i:=x]> l) i x).
+  2:{ by rewrite list_lookup_insert. }
+  rewrite take_insert by done.
+  rewrite drop_insert_gt by lia.
+  done.
+Qed.
+
+(** ** Interaction between the [take]/[drop]/[reverse] functions *)
+Lemma take_reverse l n : take n (reverse l) = reverse (drop (length l - n) l).
+Proof. unfold reverse; rewrite <-!rev_alt. apply firstn_rev. Qed.
+Lemma drop_reverse l n : drop n (reverse l) = reverse (take (length l - n) l).
+Proof. unfold reverse; rewrite <-!rev_alt. apply skipn_rev. Qed.
+Lemma reverse_take l n : reverse (take n l) = drop (length l - n) (reverse l).
+Proof.
+  rewrite drop_reverse. destruct (decide (n ≤ length l)).
+  - repeat f_equal; lia.
+  - by rewrite !take_ge by lia.
+Qed.
+Lemma reverse_drop l n : reverse (drop n l) = take (length l - n) (reverse l).
+Proof.
+  rewrite take_reverse. destruct (decide (n ≤ length l)).
+  - repeat f_equal; lia.
+  - by rewrite !drop_ge by lia.
+Qed.
+
+(** ** Other lemmas that use [take]/[drop] in their proof. *)
+Lemma app_eq_inv l1 l2 k1 k2 :
+  l1 ++ l2 = k1 ++ k2 →
+  (∃ k, l1 = k1 ++ k ∧ k2 = k ++ l2) ∨ (∃ k, k1 = l1 ++ k ∧ l2 = k ++ k2).
+Proof.
+  intros Hlk. destruct (decide (length l1 < length k1)).
+  - right. rewrite <-(take_drop (length l1) k1), <-(assoc_L _) in Hlk.
+    apply app_inj_1 in Hlk as [Hl1 Hl2]; [|rewrite length_take; lia].
+    exists (drop (length l1) k1). by rewrite Hl1 at 1; rewrite take_drop.
+  - left. rewrite <-(take_drop (length k1) l1), <-(assoc_L _) in Hlk.
+    apply app_inj_1 in Hlk as [Hk1 Hk2]; [|rewrite length_take; lia].
+    exists (drop (length k1) l1). by rewrite <-Hk1 at 1; rewrite take_drop.
+Qed.
+
+(** ** Properties of the [replicate] function *)
+Lemma length_replicate n x : length (replicate n x) = n.
+Proof. induction n; simpl; auto. Qed.
+Lemma lookup_replicate n x y i :
+  replicate n x !! i = Some y ↔ y = x ∧ i < n.
+Proof.
+  split.
+  - revert i. induction n; intros [|?]; naive_solver auto with lia.
+  - intros [-> Hi]. revert i Hi.
+    induction n; intros [|?]; naive_solver auto with lia.
+Qed.
+Lemma elem_of_replicate n x y : y ∈ replicate n x ↔ y = x ∧ n ≠ 0.
+Proof.
+  rewrite elem_of_list_lookup, Nat.neq_0_lt_0.
+  setoid_rewrite lookup_replicate; naive_solver eauto with lia.
+Qed.
+Lemma lookup_replicate_1 n x y i :
+  replicate n x !! i = Some y → y = x ∧ i < n.
+Proof. by rewrite lookup_replicate. Qed.
+Lemma lookup_replicate_2 n x i : i < n → replicate n x !! i = Some x.
+Proof. by rewrite lookup_replicate. Qed.
+Lemma lookup_total_replicate_2 `{!Inhabited A} n x i :
+  i < n → replicate n x !!! i = x.
+Proof. intros. by rewrite list_lookup_total_alt, lookup_replicate_2. Qed.
+Lemma lookup_replicate_None n x i : n ≤ i ↔ replicate n x !! i = None.
+Proof.
+  rewrite eq_None_not_Some, Nat.le_ngt. split.
+  - intros Hin [x' Hx']; destruct Hin. rewrite lookup_replicate in Hx'; tauto.
+  - intros Hx ?. destruct Hx. exists x; auto using lookup_replicate_2.
+Qed.
+Lemma insert_replicate x n i : <[i:=x]>(replicate n x) = replicate n x.
+Proof. revert i. induction n; intros [|?]; f_equal/=; auto. Qed.
+Lemma insert_replicate_lt x y n i :
+  i < n →
+  <[i:=y]>(replicate n x) = replicate i x ++ y :: replicate (n - S i) x.
+Proof.
+  revert i. induction n as [|n IH]; intros [|i] Hi; simpl; [lia..| |].
+  - by rewrite Nat.sub_0_r.
+  - by rewrite IH by lia.
+Qed.
+Lemma elem_of_replicate_inv x n y : x ∈ replicate n y → x = y.
+Proof. induction n; simpl; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed.
+Lemma replicate_S n x : replicate (S n) x = x :: replicate n x.
+Proof. done. Qed.
+Lemma replicate_S_end n x : replicate (S n) x = replicate n x ++ [x].
+Proof. induction n; f_equal/=; auto. Qed.
+Lemma replicate_add n m x :
+  replicate (n + m) x = replicate n x ++ replicate m x.
+Proof. induction n; f_equal/=; auto. Qed.
+Lemma replicate_cons_app n x :
+  x :: replicate n x = replicate n x ++ [x].
+Proof. induction n; f_equal/=; eauto.  Qed.
+Lemma take_replicate n m x : take n (replicate m x) = replicate (min n m) x.
+Proof. revert m. by induction n; intros [|?]; f_equal/=. Qed.
+Lemma take_replicate_add n m x : take n (replicate (n + m) x) = replicate n x.
+Proof. by rewrite take_replicate, min_l by lia. Qed.
+Lemma drop_replicate n m x : drop n (replicate m x) = replicate (m - n) x.
+Proof. revert m. by induction n; intros [|?]; f_equal/=. Qed.
+Lemma drop_replicate_add n m x : drop n (replicate (n + m) x) = replicate m x.
+Proof. rewrite drop_replicate. f_equal. lia. Qed.
+Lemma replicate_as_elem_of x n l :
+  replicate n x = l ↔ length l = n ∧ ∀ y, y ∈ l → y = x.
+Proof.
+  split; [intros <-; eauto using elem_of_replicate_inv, length_replicate|].
+  intros [<- Hl]. symmetry. induction l as [|y l IH]; f_equal/=.
+  - apply Hl. by left.
+  - apply IH. intros ??. apply Hl. by right.
+Qed.
+Lemma reverse_replicate n x : reverse (replicate n x) = replicate n x.
+Proof.
+  symmetry. apply replicate_as_elem_of.
+  rewrite length_reverse, length_replicate. split; auto.
+  intros y. rewrite elem_of_reverse. by apply elem_of_replicate_inv.
+Qed.
+Lemma replicate_false βs n : length βs = n → replicate n false =.>* βs.
+Proof. intros <-. by induction βs; simpl; constructor. Qed.
+Lemma tail_replicate x n : tail (replicate n x) = replicate (pred n) x.
+Proof. by destruct n. Qed.
+Lemma head_replicate_Some x n : head (replicate n x) = Some x ↔ 0 < n.
+Proof. destruct n; naive_solver lia. Qed.
+
+(** ** Properties of the [filter] function *)
+Section filter.
+  Context (P : A → Prop) `{∀ x, Decision (P x)}.
+  Local Arguments filter {_ _ _} _ {_} !_ /.
+
+  Lemma filter_nil : filter P [] = [].
+  Proof. done. Qed.
+  Lemma filter_cons x l :
+    filter P (x :: l) = if decide (P x) then x :: filter P l else filter P l.
+  Proof. done. Qed.
+  Lemma filter_cons_True x l : P x → filter P (x :: l) = x :: filter P l.
+  Proof. intros. by rewrite filter_cons, decide_True. Qed.
+  Lemma filter_cons_False x l : ¬P x → filter P (x :: l) = filter P l.
+  Proof. intros. by rewrite filter_cons, decide_False. Qed.
+
+  Lemma filter_app l1 l2 : filter P (l1 ++ l2) = filter P l1 ++ filter P l2.
+  Proof.
+    induction l1 as [|x l1 IH]; simpl; [done| ].
+    case_decide; [|done].
+    by rewrite IH.
+  Qed.
+
+  Lemma elem_of_list_filter l x : x ∈ filter P l ↔ P x ∧ x ∈ l.
+  Proof.
+    induction l; simpl; repeat case_decide;
+      rewrite ?elem_of_nil, ?elem_of_cons; naive_solver.
+  Qed.
+
+  Lemma length_filter l : length (filter P l) ≤ length l.
+  Proof. induction l; simpl; repeat case_decide; simpl; lia. Qed.
+  Lemma length_filter_lt l x : x ∈ l → ¬P x → length (filter P l) < length l.
+  Proof.
+    intros (l1 & l2 & ->)%elem_of_list_split ?.
+    rewrite filter_app, !length_app, filter_cons, decide_False by done.
+    pose proof (length_filter l1); pose proof (length_filter l2). simpl. lia.
+  Qed.
+
+  Lemma filter_nil_not_elem_of l x : filter P l = [] → P x → x ∉ l.
+  Proof. induction 3; simplify_eq/=; case_decide; naive_solver. Qed.
+  Lemma filter_reverse l : filter P (reverse l) = reverse (filter P l).
+  Proof.
+    induction l as [|x l IHl]; [done|].
+    rewrite reverse_cons, filter_app, IHl, !filter_cons.
+    case_decide; [by rewrite reverse_cons|by rewrite filter_nil, app_nil_r].
+  Qed.
+End filter.
+
+Lemma list_filter_iff (P1 P2 : A → Prop)
+    `{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
+  (∀ x, P1 x ↔ P2 x) →
+  filter P1 l = filter P2 l.
+Proof.
+  intros HPiff. induction l as [|a l IH]; [done|].
+  destruct (decide (P1 a)).
+  - rewrite !filter_cons_True by naive_solver. by rewrite IH.
+  - rewrite !filter_cons_False by naive_solver. by rewrite IH.
+Qed.
+
+Lemma list_filter_filter (P1 P2 : A → Prop)
+    `{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
+  filter P1 (filter P2 l) = filter (λ a, P1 a ∧ P2 a) l.
+Proof.
+  induction l as [|x l IH]; [done|].
+  rewrite !filter_cons. case (decide (P2 x)) as [HP2|HP2].
+  - rewrite filter_cons, IH. apply decide_ext. naive_solver.
+  - rewrite IH. symmetry. apply decide_False. by intros [_ ?].
+Qed.
+
+Lemma list_filter_filter_l (P1 P2 : A → Prop)
+    `{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
+  (∀ x, P1 x → P2 x) →
+  filter P1 (filter P2 l) = filter P1 l.
+Proof.
+  intros HPimp. rewrite list_filter_filter.
+  apply list_filter_iff. naive_solver.
+Qed.
+
+Lemma list_filter_filter_r (P1 P2 : A → Prop)
+    `{!∀ x, Decision (P1 x), !∀ x, Decision (P2 x)} (l : list A) :
+  (∀ x, P2 x → P1 x) →
+  filter P1 (filter P2 l) = filter P2 l.
+Proof.
+  intros HPimp. rewrite list_filter_filter.
+  apply list_filter_iff. naive_solver.
+Qed.
+End general_properties.
+
+(** * Basic tactics on lists *)
+(** These are used already in [list_relations] so we cannot have them in
+[list_tactics]. *)
+
+(** The tactic [discriminate_list] discharges a goal if there is a hypothesis
+[l1 = l2] where [l1] and [l2] have different lengths. The tactic is guaranteed
+to work if [l1] and [l2] contain solely [ [] ], [(::)] and [(++)]. *)
+Tactic Notation "discriminate_list" hyp(H) :=
+  apply (f_equal length) in H;
+  repeat (csimpl in H || rewrite length_app in H); exfalso; lia.
+Tactic Notation "discriminate_list" :=
+  match goal with H : _ =@{list _} _ |- _ => discriminate_list H end.
+
+(** The tactic [simplify_list_eq] simplifies hypotheses involving
+equalities on lists using injectivity of [(::)] and [(++)]. Also, it simplifies
+lookups in singleton lists. *)
+Ltac simplify_list_eq :=
+  repeat match goal with
+  | _ => progress simplify_eq/=
+  | H : _ ++ _ = _ ++ _ |- _ => first
+    [ apply app_inv_head in H | apply app_inv_tail in H
+    | apply app_inj_1 in H; [destruct H|done]
+    | apply app_inj_2 in H; [destruct H|done] ]
+  | H : [?x] !! ?i = Some ?y |- _ =>
+    destruct i; [change (Some x = Some y) in H | discriminate]
+  end.

stdpp/list_misc.v

+From Coq Require Export Permutation.
+From stdpp Require Export numbers base option list_basics list_relations list_monad.
+From stdpp Require Import options.
+
+(** The function [list_find P l] returns the first index [i] whose element
+satisfies the predicate [P]. *)
+Definition list_find {A} P `{∀ x, Decision (P x)} : list A → option (nat * A) :=
+  fix go l :=
+  match l with
+  | [] => None
+  | x :: l => if decide (P x) then Some (0,x) else prod_map S id <$> go l
+  end.
+Global Instance: Params (@list_find) 3 := {}.
+
+(** The function [resize n y l] takes the first [n] elements of [l] in case
+[length l ≤ n], and otherwise appends elements with value [x] to [l] to obtain
+a list of length [n]. *)
+Fixpoint resize {A} (n : nat) (y : A) (l : list A) : list A :=
+  match l with
+  | [] => replicate n y
+  | x :: l => match n with 0 => [] | S n => x :: resize n y l end
+  end.
+Global Arguments resize {_} !_ _ !_ : assert.
+Global Instance: Params (@resize) 2 := {}.
+
+(** The function [rotate n l] rotates the list [l] by [n], e.g., [rotate 1
+[x0; x1; ...; xm]] becomes [x1; ...; xm; x0]. Rotating by a multiple of
+[length l] is the identity function. **)
+Definition rotate {A} (n : nat) (l : list A) : list A :=
+  drop (n `mod` length l) l ++ take (n `mod` length l) l.
+Global Instance: Params (@rotate) 2 := {}.
+
+(** The function [rotate_take s e l] returns the range between the
+indices [s] (inclusive) and [e] (exclusive) of [l]. If [e ≤ s], all
+elements after [s] and before [e] are returned. *)
+Definition rotate_take {A} (s e : nat) (l : list A) : list A :=
+  take (rotate_nat_sub s e (length l)) (rotate s l).
+Global Instance: Params (@rotate_take) 3 := {}.
+
+(** The function [reshape k l] transforms [l] into a list of lists whose sizes
+are specified by [k]. In case [l] is too short, the resulting list will be
+padded with empty lists. In case [l] is too long, it will be truncated. *)
+Fixpoint reshape {A} (szs : list nat) (l : list A) : list (list A) :=
+  match szs with
+  | [] => [] | sz :: szs => take sz l :: reshape szs (drop sz l)
+  end.
+Global Instance: Params (@reshape) 2 := {}.
+
+Definition sublist_lookup {A} (i n : nat) (l : list A) : option (list A) :=
+  guard (i + n ≤ length l);; Some (take n (drop i l)).
+Definition sublist_alter {A} (f : list A → list A)
+    (i n : nat) (l : list A) : list A :=
+  take i l ++ f (take n (drop i l)) ++ drop (i + n) l.
+
+(** The function [mask f βs l] applies the function [f] to elements in [l] at
+positions that are [true] in [βs]. *)
+Fixpoint mask {A} (f : A → A) (βs : list bool) (l : list A) : list A :=
+  match βs, l with
+  | β :: βs, x :: l => (if β then f x else x) :: mask f βs l
+  | _, _ => l
+  end.
+
+(** These next functions allow to efficiently encode lists of positives (bit
+strings) into a single positive and go in the other direction as well. This is
+for example used for the countable instance of lists and in namespaces.
+ The main functions are [positives_flatten] and [positives_unflatten]. *)
+Fixpoint positives_flatten_go (xs : list positive) (acc : positive) : positive :=
+  match xs with
+  | [] => acc
+  | x :: xs => positives_flatten_go xs (acc~1~0 ++ Pos.reverse (Pos.dup x))
+  end.
+
+(** Flatten a list of positives into a single positive by duplicating the bits
+of each element, so that:
+
+- [0 -> 00]
+- [1 -> 11]
+
+and then separating each element with [10]. *)
+Definition positives_flatten (xs : list positive) : positive :=
+  positives_flatten_go xs 1.
+
+Fixpoint positives_unflatten_go
+        (p : positive)
+        (acc_xs : list positive)
+        (acc_elm : positive)
+  : option (list positive) :=
+  match p with
+  | 1 => Some acc_xs
+  | p'~0~0 => positives_unflatten_go p' acc_xs (acc_elm~0)
+  | p'~1~1 => positives_unflatten_go p' acc_xs (acc_elm~1)
+  | p'~1~0 => positives_unflatten_go p' (acc_elm :: acc_xs) 1
+  | _ => None
+  end%positive.
+
+(** Unflatten a positive into a list of positives, assuming the encoding
+used by [positives_flatten]. *)
+Definition positives_unflatten (p : positive) : option (list positive) :=
+  positives_unflatten_go p [] 1.
+
+Section general_properties.
+Context {A : Type}.
+Implicit Types x y z : A.
+Implicit Types l k : list A.
+
+(** * Properties of the [find] function *)
+Section find.
+  Context (P : A → Prop) `{!∀ x, Decision (P x)}.
+
+  Lemma list_find_Some l i x  :
+    list_find P l = Some (i,x) ↔
+      l !! i = Some x ∧ P x ∧ ∀ j y, l !! j = Some y → j < i → ¬P y.
+  Proof.
+    revert i. induction l as [|y l IH]; intros i; csimpl; [naive_solver|].
+    case_decide.
+    - split; [naive_solver lia|]. intros (Hi&HP&Hlt).
+      destruct i as [|i]; simplify_eq/=; [done|].
+      destruct (Hlt 0 y); naive_solver lia.
+    - split.
+      + intros ([i' x']&Hl&?)%fmap_Some; simplify_eq/=.
+        apply IH in Hl as (?&?&Hlt). split_and!; [done..|].
+        intros [|j] ?; naive_solver lia.
+      + intros (?&?&Hlt). destruct i as [|i]; simplify_eq/=; [done|].
+        rewrite (proj2 (IH i)); [done|]. split_and!; [done..|].
+        intros j z ???. destruct (Hlt (S j) z); naive_solver lia.
+  Qed.
+
+  Lemma list_find_elem_of l x : x ∈ l → P x → is_Some (list_find P l).
+  Proof.
+    induction 1 as [|x y l ? IH]; intros; simplify_option_eq; eauto.
+    by destruct IH as [[i x'] ->]; [|exists (S i, x')].
+  Qed.
+
+  Lemma list_find_None l :
+    list_find P l = None ↔ Forall (λ x, ¬P x) l.
+  Proof.
+    rewrite eq_None_not_Some, Forall_forall. split.
+    - intros Hl x Hx HP. destruct Hl. eauto using list_find_elem_of.
+    - intros HP [[i x] (?%elem_of_list_lookup_2&?&?)%list_find_Some]; naive_solver.
+  Qed.
+
+  Lemma list_find_app_None l1 l2 :
+    list_find P (l1 ++ l2) = None ↔ list_find P l1 = None ∧ list_find P l2 = None.
+  Proof. by rewrite !list_find_None, Forall_app. Qed.
+
+  Lemma list_find_app_Some l1 l2 i x :
+    list_find P (l1 ++ l2) = Some (i,x) ↔
+      list_find P l1 = Some (i,x) ∨
+      length l1 ≤ i ∧ list_find P l1 = None ∧ list_find P l2 = Some (i - length l1,x).
+  Proof.
+    split.
+    - intros ([?|[??]]%lookup_app_Some&?&Hleast)%list_find_Some.
+      + left. apply list_find_Some; eauto using lookup_app_l_Some.
+      + right. split; [lia|]. split.
+        { apply list_find_None, Forall_lookup. intros j z ??.
+          assert (j < length l1) by eauto using lookup_lt_Some.
+          naive_solver eauto using lookup_app_l_Some with lia. }
+        apply list_find_Some. split_and!; [done..|].
+        intros j z ??. eapply (Hleast (length l1 + j)); [|lia].
+        by rewrite lookup_app_r, Nat.add_sub' by lia.
+    - intros [(?&?&Hleast)%list_find_Some|(?&Hl1&(?&?&Hleast)%list_find_Some)].
+      + apply list_find_Some. split_and!; [by auto using lookup_app_l_Some..|].
+        assert (i < length l1) by eauto using lookup_lt_Some.
+        intros j y ?%lookup_app_Some; naive_solver eauto with lia.
+      + rewrite list_find_Some, lookup_app_Some. split_and!; [by auto..|].
+        intros j y [?|?]%lookup_app_Some ?; [|naive_solver auto with lia].
+        by eapply (Forall_lookup_1 (not ∘ P) l1); [by apply list_find_None|..].
+  Qed.
+  Lemma list_find_app_l l1 l2 i x:
+    list_find P l1 = Some (i, x) → list_find P (l1 ++ l2) = Some (i, x).
+  Proof. rewrite list_find_app_Some. auto. Qed.
+  Lemma list_find_app_r l1 l2:
+    list_find P l1 = None →
+    list_find P (l1 ++ l2) = prod_map (λ n, n + length l1) id <$> list_find P l2.
+  Proof.
+    intros. apply option_eq; intros [j y]. rewrite list_find_app_Some. split.
+    - intros [?|(?&?&->)]; naive_solver auto with f_equal lia.
+    - intros ([??]&->&?)%fmap_Some; naive_solver auto with f_equal lia.
+  Qed.
+
+  Lemma list_find_insert_Some l i j x y :
+    list_find P (<[i:=x]> l) = Some (j,y) ↔
+      (j < i ∧ list_find P l = Some (j,y)) ∨
+      (i = j ∧ x = y ∧ j < length l ∧ P x ∧ ∀ i' z, l !! i' = Some z → i' < i → ¬P z) ∨
+      (i < j ∧ ¬P x ∧ list_find P l = Some (j,y) ∧ ∀ z, l !! i = Some z → ¬P z) ∨
+      (∃ z, i < j ∧ ¬P x ∧ P y ∧ P z ∧ l !! i = Some z ∧ l !! j = Some y ∧
+            ∀ i' z, l !! i' = Some z → i' ≠ i → i' < j → ¬P z).
+   Proof.
+     split.
+     - intros ([(->&->&?)|[??]]%list_lookup_insert_Some&?&Hleast)%list_find_Some.
+       { right; left. split_and!; [done..|]. intros k z ??.
+         apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia. }
+       assert (j < i ∨ i < j) as [?|?] by lia.
+       { left. rewrite list_find_Some. split_and!; [by auto..|]. intros k z ??.
+         apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia. }
+       right; right. assert (j < length l) by eauto using lookup_lt_Some.
+       destruct (lookup_lt_is_Some_2 l i) as [z ?]; [lia|].
+       destruct (decide (P z)).
+       { right. exists z. split_and!; [done| |done..|].
+         + apply (Hleast i); [|done]. by rewrite list_lookup_insert by lia.
+         + intros k z' ???.
+           apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia. }
+       left. split_and!; [done|..|naive_solver].
+       + apply (Hleast i); [|done]. by rewrite list_lookup_insert by lia.
+       + apply list_find_Some. split_and!; [by auto..|]. intros k z' ??.
+         destruct (decide (k = i)) as [->|]; [naive_solver|].
+         apply (Hleast k); [|lia]. by rewrite list_lookup_insert_ne by lia.
+     - intros [[? Hl]|[(->&->&?&?&Hleast)|[(?&?&Hl&Hnot)|(z&?&?&?&?&?&?&?Hleast)]]];
+         apply list_find_Some.
+       + apply list_find_Some in Hl as (?&?&Hleast).
+         rewrite list_lookup_insert_ne by lia. split_and!; [done..|].
+         intros k z [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
+       + rewrite list_lookup_insert by done. split_and!; [by auto..|].
+         intros k z [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
+       + apply list_find_Some in Hl as (?&?&Hleast).
+         rewrite list_lookup_insert_ne by lia. split_and!; [done..|].
+         intros k z [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
+       + rewrite list_lookup_insert_ne by lia. split_and!; [done..|].
+         intros k z' [(->&->&?)|[??]]%list_lookup_insert_Some; eauto with lia.
+  Qed.
+
+  Lemma list_find_ext (Q : A → Prop) `{∀ x, Decision (Q x)} l :
+    (∀ x, P x ↔ Q x) →
+    list_find P l = list_find Q l.
+  Proof.
+    intros HPQ. induction l as [|x l IH]; simpl; [done|].
+    by rewrite (decide_ext (P x) (Q x)), IH by done.
+  Qed.
+End find.
+
+Lemma list_find_fmap {B} (f : A → B) (P : B → Prop)
+    `{!∀ y : B, Decision (P y)} (l : list A) :
+  list_find P (f <$> l) = prod_map id f <$> list_find (P ∘ f) l.
+Proof.
+  induction l as [|x l IH]; [done|]; csimpl. (* csimpl re-folds fmap *)
+  case_decide; [done|].
+  rewrite IH. by destruct (list_find (P ∘ f) l).
+Qed.
+
+(** ** Properties of the [resize] function *)
+Lemma resize_spec l n x : resize n x l = take n l ++ replicate (n - length l) x.
+Proof. revert n. induction l; intros [|?]; f_equal/=; auto. Qed.
+Lemma resize_0 l x : resize 0 x l = [].
+Proof. by destruct l. Qed.
+Lemma resize_nil n x : resize n x [] = replicate n x.
+Proof. rewrite resize_spec. rewrite take_nil. f_equal/=. lia. Qed.
+Lemma resize_ge l n x :
+  length l ≤ n → resize n x l = l ++ replicate (n - length l) x.
+Proof. intros. by rewrite resize_spec, take_ge. Qed.
+Lemma resize_le l n x : n ≤ length l → resize n x l = take n l.
+Proof.
+  intros. rewrite resize_spec, (proj2 (Nat.sub_0_le _ _)) by done.
+  simpl. by rewrite (right_id_L [] (++)).
+Qed.
+Lemma resize_all l x : resize (length l) x l = l.
+Proof. intros. by rewrite resize_le, take_ge. Qed.
+Lemma resize_all_alt l n x : n = length l → resize n x l = l.
+Proof. intros ->. by rewrite resize_all. Qed.
+Lemma resize_add l n m x :
+  resize (n + m) x l = resize n x l ++ resize m x (drop n l).
+Proof.
+  revert n m. induction l; intros [|?] [|?]; f_equal/=; auto.
+  - by rewrite Nat.add_0_r, (right_id_L [] (++)).
+  - by rewrite replicate_add.
+Qed.
+Lemma resize_add_eq l n m x :
+  length l = n → resize (n + m) x l = l ++ replicate m x.
+Proof. intros <-. by rewrite resize_add, resize_all, drop_all, resize_nil. Qed.
+Lemma resize_app_le l1 l2 n x :
+  n ≤ length l1 → resize n x (l1 ++ l2) = resize n x l1.
+Proof.
+  intros. by rewrite !resize_le, take_app_le by (rewrite ?length_app; lia).
+Qed.
+Lemma resize_app l1 l2 n x : n = length l1 → resize n x (l1 ++ l2) = l1.
+Proof. intros ->. by rewrite resize_app_le, resize_all. Qed.
+Lemma resize_app_ge l1 l2 n x :
+  length l1 ≤ n → resize n x (l1 ++ l2) = l1 ++ resize (n - length l1) x l2.
+Proof.
+  intros. rewrite !resize_spec, take_app_ge, (assoc_L (++)) by done.
+  do 2 f_equal. rewrite length_app. lia.
+Qed.
+Lemma length_resize l n x : length (resize n x l) = n.
+Proof. rewrite resize_spec, length_app, length_replicate, length_take. lia. Qed.
+Lemma resize_replicate x n m : resize n x (replicate m x) = replicate n x.
+Proof. revert m. induction n; intros [|?]; f_equal/=; auto. Qed.
+Lemma resize_resize l n m x : n ≤ m → resize n x (resize m x l) = resize n x l.
+Proof.
+  revert n m. induction l; simpl.
+  - intros. by rewrite !resize_nil, resize_replicate.
+  - intros [|?] [|?] ?; f_equal/=; auto with lia.
+Qed.
+Lemma resize_idemp l n x : resize n x (resize n x l) = resize n x l.
+Proof. by rewrite resize_resize. Qed.
+Lemma resize_take_le l n m x : n ≤ m → resize n x (take m l) = resize n x l.
+Proof. revert n m. induction l; intros [|?][|?] ?; f_equal/=; auto with lia. Qed.
+Lemma resize_take_eq l n x : resize n x (take n l) = resize n x l.
+Proof. by rewrite resize_take_le. Qed.
+Lemma take_resize l n m x : take n (resize m x l) = resize (min n m) x l.
+Proof.
+  revert n m. induction l; intros [|?][|?]; f_equal/=; auto using take_replicate.
+Qed.
+Lemma take_resize_le l n m x : n ≤ m → take n (resize m x l) = resize n x l.
+Proof. intros. by rewrite take_resize, Nat.min_l. Qed.
+Lemma take_resize_eq l n x : take n (resize n x l) = resize n x l.
+Proof. intros. by rewrite take_resize, Nat.min_l. Qed.
+Lemma take_resize_add l n m x : take n (resize (n + m) x l) = resize n x l.
+Proof. by rewrite take_resize, min_l by lia. Qed.
+Lemma drop_resize_le l n m x :
+  n ≤ m → drop n (resize m x l) = resize (m - n) x (drop n l).
+Proof.
+  revert n m. induction l; simpl.
+  - intros. by rewrite drop_nil, !resize_nil, drop_replicate.
+  - intros [|?] [|?] ?; simpl; try case_match; auto with lia.
+Qed.
+Lemma drop_resize_add l n m x :
+  drop n (resize (n + m) x l) = resize m x (drop n l).
+Proof. rewrite drop_resize_le by lia. f_equal. lia. Qed.
+Lemma lookup_resize l n x i : i < n → i < length l → resize n x l !! i = l !! i.
+Proof.
+  intros ??. destruct (decide (n < length l)).
+  - by rewrite resize_le, lookup_take by lia.
+  - by rewrite resize_ge, lookup_app_l by lia.
+Qed.
+Lemma lookup_total_resize `{!Inhabited A} l n x i :
+  i < n → i < length l → resize n x l !!! i = l !!! i.
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_resize. Qed.
+Lemma lookup_resize_new l n x i :
+  length l ≤ i → i < n → resize n x l !! i = Some x.
+Proof.
+  intros ??. rewrite resize_ge by lia.
+  replace i with (length l + (i - length l)) by lia.
+  by rewrite lookup_app_r, lookup_replicate_2 by lia.
+Qed.
+Lemma lookup_total_resize_new `{!Inhabited A} l n x i :
+  length l ≤ i → i < n → resize n x l !!! i = x.
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_resize_new. Qed.
+Lemma lookup_resize_old l n x i : n ≤ i → resize n x l !! i = None.
+Proof. intros ?. apply lookup_ge_None_2. by rewrite length_resize. Qed.
+Lemma lookup_total_resize_old `{!Inhabited A} l n x i :
+  n ≤ i → resize n x l !!! i = inhabitant.
+Proof. intros. by rewrite !list_lookup_total_alt, lookup_resize_old. Qed.
+Lemma Forall_resize P n x l : P x → Forall P l → Forall P (resize n x l).
+Proof.
+  intros ? Hl. revert n.
+  induction Hl; intros [|?]; simpl; auto using Forall_replicate.
+Qed.
+Lemma fmap_resize {B} (f : A → B) n x l : f <$> resize n x l = resize n (f x) (f <$> l).
+Proof.
+  revert n. induction l; intros [|?]; f_equal/=; auto using fmap_replicate.
+Qed.
+Lemma Forall_resize_inv P n x l :
+  length l ≤ n → Forall P (resize n x l) → Forall P l.
+Proof. intros ?. rewrite resize_ge, Forall_app by done. by intros []. Qed.
+
+(** ** Properties of the [rotate] function *)
+Lemma rotate_replicate n1 n2 x:
+  rotate n1 (replicate n2 x) = replicate n2 x.
+Proof.
+  unfold rotate. rewrite drop_replicate, take_replicate, <-replicate_add.
+  f_equal. lia.
+Qed.
+
+Lemma length_rotate l n:
+  length (rotate n l) = length l.
+Proof. unfold rotate. rewrite length_app, length_drop, length_take. lia. Qed.
+
+Lemma lookup_rotate_r l n i:
+  i < length l →
+  rotate n l !! i = l !! rotate_nat_add n i (length l).
+Proof.
+  intros Hlen. pose proof (Nat.mod_upper_bound n (length l)) as ?.
+  unfold rotate. rewrite rotate_nat_add_add_mod, rotate_nat_add_alt by lia.
+  remember (n `mod` length l) as n'.
+  case_decide.
+  - by rewrite lookup_app_l, lookup_drop by (rewrite length_drop; lia).
+  - rewrite lookup_app_r, lookup_take, length_drop by (rewrite length_drop; lia).
+    f_equal. lia.
+Qed.
+
+Lemma lookup_rotate_r_Some l n i x:
+  rotate n l !! i = Some x ↔
+  l !! rotate_nat_add n i (length l) = Some x ∧ i < length l.
+Proof.
+  split.
+  - intros Hl. pose proof (lookup_lt_Some _ _ _ Hl) as Hlen.
+    rewrite length_rotate in Hlen. by rewrite <-lookup_rotate_r.
+  - intros [??]. by rewrite lookup_rotate_r.
+Qed.
+
+Lemma lookup_rotate_l l n i:
+  i < length l → rotate n l !! rotate_nat_sub n i (length l) = l !! i.
+Proof.
+  intros ?. rewrite lookup_rotate_r, rotate_nat_add_sub;[done..|].
+  apply rotate_nat_sub_lt. lia.
+Qed.
+
+Lemma elem_of_rotate l n x:
+  x ∈ rotate n l ↔ x ∈ l.
+Proof.
+  unfold rotate. rewrite <-(take_drop (n `mod` length l) l) at 5.
+  rewrite !elem_of_app. naive_solver.
+Qed.
+
+Lemma rotate_insert_l l n i x:
+  i < length l →
+  rotate n (<[rotate_nat_add n i (length l):=x]> l) = <[i:=x]> (rotate n l).
+Proof.
+  intros Hlen. pose proof (Nat.mod_upper_bound n (length l)) as ?. unfold rotate.
+  rewrite length_insert, rotate_nat_add_add_mod, rotate_nat_add_alt by lia.
+  remember (n `mod` length l) as n'.
+  case_decide.
+  - rewrite take_insert, drop_insert_le, insert_app_l
+      by (rewrite ?length_drop; lia). do 2 f_equal. lia.
+  - rewrite take_insert_lt, drop_insert_gt, insert_app_r_alt, length_drop
+      by (rewrite ?length_drop; lia). do 2 f_equal. lia.
+Qed.
+
+Lemma rotate_insert_r l n i x:
+  i < length l →
+  rotate n (<[i:=x]> l) = <[rotate_nat_sub n i (length l):=x]> (rotate n l).
+Proof.
+  intros ?. rewrite <-rotate_insert_l, rotate_nat_add_sub;[done..|].
+  apply rotate_nat_sub_lt. lia.
+Qed.
+
+(** ** Properties of the [rotate_take] function *)
+Lemma rotate_take_insert l s e i x:
+  i < length l →
+  rotate_take s e (<[i:=x]>l) =
+  if decide (rotate_nat_sub s i (length l) < rotate_nat_sub s e (length l)) then
+    <[rotate_nat_sub s i (length l):=x]> (rotate_take s e l) else rotate_take s e l.
+Proof.
+  intros ?. unfold rotate_take. rewrite rotate_insert_r, length_insert by done.
+  case_decide; [rewrite take_insert_lt | rewrite take_insert]; naive_solver lia.
+Qed.
+
+Lemma rotate_take_add l b i :
+  i < length l →
+  rotate_take b (rotate_nat_add b i (length l)) l = take i (rotate b l).
+Proof. intros ?. unfold rotate_take. by rewrite rotate_nat_sub_add. Qed.
+
+(** ** Properties of the [reshape] function *)
+Lemma length_reshape szs l : length (reshape szs l) = length szs.
+Proof. revert l. by induction szs; intros; f_equal/=. Qed.
+Lemma Forall_reshape P l szs : Forall P l → Forall (Forall P) (reshape szs l).
+Proof.
+  revert l. induction szs; simpl; auto using Forall_take, Forall_drop.
+Qed.
+
+(** ** Properties of [sublist_lookup] and [sublist_alter] *)
+Lemma sublist_lookup_length l i n k :
+  sublist_lookup i n l = Some k → length k = n.
+Proof.
+  unfold sublist_lookup; intros; simplify_option_eq.
+  rewrite length_take, length_drop; lia.
+Qed.
+Lemma sublist_lookup_all l n : length l = n → sublist_lookup 0 n l = Some l.
+Proof.
+  intros. unfold sublist_lookup; case_guard; [|lia].
+  by rewrite take_ge by (rewrite length_drop; lia).
+Qed.
+Lemma sublist_lookup_Some l i n :
+  i + n ≤ length l → sublist_lookup i n l = Some (take n (drop i l)).
+Proof. by unfold sublist_lookup; intros; simplify_option_eq. Qed.
+Lemma sublist_lookup_Some' l i n l' :
+  sublist_lookup i n l = Some l' ↔ l' = take n (drop i l) ∧ i + n ≤ length l.
+Proof. unfold sublist_lookup. case_guard; naive_solver lia. Qed.
+Lemma sublist_lookup_None l i n :
+  length l < i + n → sublist_lookup i n l = None.
+Proof. by unfold sublist_lookup; intros; simplify_option_eq by lia. Qed.
+Lemma sublist_eq l k n :
+  (n | length l) → (n | length k) →
+  (∀ i, sublist_lookup (i * n) n l = sublist_lookup (i * n) n k) → l = k.
+Proof.
+  revert l k. assert (∀ l i,
+    n ≠ 0 → (n | length l) → ¬n * i `div` n + n ≤ length l → length l ≤ i).
+  { intros l i ? [j ->] Hjn. apply Nat.nlt_ge; contradict Hjn.
+    rewrite <-Nat.mul_succ_r, (Nat.mul_comm n).
+    apply Nat.mul_le_mono_r, Nat.le_succ_l, Nat.div_lt_upper_bound; lia. }
+  intros l k Hl Hk Hlookup. destruct (decide (n = 0)) as [->|].
+  { by rewrite (nil_length_inv l),
+      (nil_length_inv k) by eauto using Nat.divide_0_l. }
+  apply list_eq; intros i. specialize (Hlookup (i `div` n)).
+  rewrite (Nat.mul_comm _ n) in Hlookup.
+  unfold sublist_lookup in *; simplify_option_eq;
+    [|by rewrite !lookup_ge_None_2 by auto].
+  apply (f_equal (.!! i `mod` n)) in Hlookup.
+  by rewrite !lookup_take, !lookup_drop, <-!Nat.div_mod in Hlookup
+    by (auto using Nat.mod_upper_bound with lia).
+Qed.
+Lemma sublist_eq_same_length l k j n :
+  length l = j * n → length k = j * n →
+  (∀ i,i < j → sublist_lookup (i * n) n l = sublist_lookup (i * n) n k) → l = k.
+Proof.
+  intros Hl Hk ?. destruct (decide (n = 0)) as [->|].
+  { by rewrite (nil_length_inv l), (nil_length_inv k) by lia. }
+  apply sublist_eq with n; [by exists j|by exists j|].
+  intros i. destruct (decide (i < j)); [by auto|].
+  assert (∀ m, m = j * n → m < i * n + n).
+  { intros ? ->. replace (i * n + n) with (S i * n) by lia.
+    apply Nat.mul_lt_mono_pos_r; lia. }
+  by rewrite !sublist_lookup_None by auto.
+Qed.
+Lemma sublist_lookup_reshape l i n m :
+  0 < n → length l = m * n →
+  reshape (replicate m n) l !! i = sublist_lookup (i * n) n l.
+Proof.
+  intros Hn Hl. unfold sublist_lookup.  apply option_eq; intros x; split.
+  - intros Hx. case_guard as Hi; simplify_eq/=.
+    { f_equal. clear Hi. revert i l Hl Hx.
+      induction m as [|m IH]; intros [|i] l ??; simplify_eq/=; auto.
+      rewrite <-drop_drop. apply IH; rewrite ?length_drop; auto with lia. }
+    destruct Hi. rewrite Hl, <-Nat.mul_succ_l.
+    apply Nat.mul_le_mono_r, Nat.le_succ_l. apply lookup_lt_Some in Hx.
+    by rewrite length_reshape, length_replicate in Hx.
+  - intros Hx. case_guard as Hi; simplify_eq/=.
+    revert i l Hl Hi. induction m as [|m IH]; [auto with lia|].
+    intros [|i] l ??; simpl; [done|]. rewrite <-drop_drop.
+    rewrite IH; rewrite ?length_drop; auto with lia.
+Qed.
+Lemma sublist_lookup_compose l1 l2 l3 i n j m :
+  sublist_lookup i n l1 = Some l2 → sublist_lookup j m l2 = Some l3 →
+  sublist_lookup (i + j) m l1 = Some l3.
+Proof.
+  unfold sublist_lookup; intros; simplify_option_eq;
+    repeat match goal with
+    | H : _ ≤ length _ |- _ => rewrite length_take, length_drop in H
+    end; rewrite ?take_drop_commute, ?drop_drop, ?take_take,
+      ?Nat.min_l, Nat.add_assoc by lia; auto with lia.
+Qed.
+Lemma length_sublist_alter f l i n k :
+  sublist_lookup i n l = Some k → length (f k) = n →
+  length (sublist_alter f i n l) = length l.
+Proof.
+  unfold sublist_alter, sublist_lookup. intros Hk ?; simplify_option_eq.
+  rewrite !length_app, Hk, !length_take, !length_drop; lia.
+Qed.
+Lemma sublist_lookup_alter f l i n k :
+  sublist_lookup i n l = Some k → length (f k) = n →
+  sublist_lookup i n (sublist_alter f i n l) = f <$> sublist_lookup i n l.
+Proof.
+  unfold sublist_lookup. intros Hk ?. erewrite length_sublist_alter by eauto.
+  unfold sublist_alter; simplify_option_eq.
+  by rewrite Hk, drop_app_length', take_app_length' by (rewrite ?length_take; lia).
+Qed.
+Lemma sublist_lookup_alter_ne f l i j n k :
+  sublist_lookup j n l = Some k → length (f k) = n → i + n ≤ j ∨ j + n ≤ i →
+  sublist_lookup i n (sublist_alter f j n l) = sublist_lookup i n l.
+Proof.
+  unfold sublist_lookup. intros Hk Hi ?. erewrite length_sublist_alter by eauto.
+  unfold sublist_alter; simplify_option_eq; f_equal; rewrite Hk.
+  apply list_eq; intros ii.
+  destruct (decide (ii < length (f k))); [|by rewrite !lookup_take_ge by lia].
+  rewrite !lookup_take, !lookup_drop by done. destruct (decide (i + ii < j)).
+  { by rewrite lookup_app_l, lookup_take by (rewrite ?length_take; lia). }
+  rewrite lookup_app_r by (rewrite length_take; lia).
+  rewrite length_take_le, lookup_app_r, lookup_drop by lia. f_equal; lia.
+Qed.
+Lemma sublist_alter_all f l n : length l = n → sublist_alter f 0 n l = f l.
+Proof.
+  intros <-. unfold sublist_alter; simpl.
+  by rewrite drop_all, (right_id_L [] (++)), take_ge.
+Qed.
+Lemma sublist_alter_compose f g l i n k :
+  sublist_lookup i n l = Some k → length (f k) = n → length (g k) = n →
+  sublist_alter (f ∘ g) i n l = sublist_alter f i n (sublist_alter g i n l).
+Proof.
+  unfold sublist_alter, sublist_lookup. intros Hk ??; simplify_option_eq.
+  by rewrite !take_app_length', drop_app_length', !(assoc_L (++)), drop_app_length',
+    take_app_length' by (rewrite ?length_app, ?length_take, ?Hk; lia).
+Qed.
+Lemma Forall_sublist_lookup P l i n k :
+  sublist_lookup i n l = Some k → Forall P l → Forall P k.
+Proof.
+  unfold sublist_lookup. intros; simplify_option_eq.
+  auto using Forall_take, Forall_drop.
+Qed.
+Lemma Forall_sublist_alter P f l i n k :
+  Forall P l → sublist_lookup i n l = Some k → Forall P (f k) →
+  Forall P (sublist_alter f i n l).
+Proof.
+  unfold sublist_alter, sublist_lookup. intros; simplify_option_eq.
+  auto using Forall_app_2, Forall_drop, Forall_take.
+Qed.
+Lemma Forall_sublist_alter_inv P f l i n k :
+  sublist_lookup i n l = Some k →
+  Forall P (sublist_alter f i n l) → Forall P (f k).
+Proof.
+  unfold sublist_alter, sublist_lookup. intros ?; simplify_option_eq.
+  rewrite !Forall_app; tauto.
+Qed.
+End general_properties.
+
+Lemma zip_with_sublist_alter {A B} (f : A → B → A) g l k i n l' k' :
+  length l = length k →
+  sublist_lookup i n l = Some l' → sublist_lookup i n k = Some k' →
+  length (g l') = length k' → zip_with f (g l') k' = g (zip_with f l' k') →
+  zip_with f (sublist_alter g i n l) k = sublist_alter g i n (zip_with f l k).
+Proof.
+  unfold sublist_lookup, sublist_alter. intros Hlen; rewrite Hlen.
+  intros ?? Hl' Hk'. simplify_option_eq.
+  by rewrite !zip_with_app_l, !zip_with_drop, Hl', drop_drop, !zip_with_take,
+    !length_take_le, Hk' by (rewrite ?length_drop; auto with lia).
+Qed.
+
+(** Interaction of [Forall2] with the above operations (needs to be outside the
+section since the operations are used at different types). *)
+Section Forall2.
+  Context {A B} (P : A → B → Prop).
+  Implicit Types x : A.
+  Implicit Types y : B.
+  Implicit Types l : list A.
+  Implicit Types k : list B.
+
+  Lemma Forall2_resize l (k : list B) x (y : B) n :
+    P x y → Forall2 P l k → Forall2 P (resize n x l) (resize n y k).
+  Proof.
+    intros. rewrite !resize_spec, (Forall2_length P l k) by done.
+    auto using Forall2_app, Forall2_take, Forall2_replicate.
+  Qed.
+  Lemma Forall2_resize_l l k x y n m :
+    P x y → Forall (flip P y) l →
+    Forall2 P (resize n x l) k → Forall2 P (resize m x l) (resize m y k).
+  Proof.
+    intros. destruct (decide (m ≤ n)).
+    { rewrite <-(resize_resize l m n) by done. by apply Forall2_resize. }
+    intros. assert (n = length k); subst.
+    { by rewrite <-(Forall2_length P (resize n x l) k), length_resize. }
+    rewrite (Nat.le_add_sub (length k) m), !resize_add,
+      resize_all, drop_all, resize_nil by lia.
+    auto using Forall2_app, Forall2_replicate_r,
+      Forall_resize, Forall_drop, length_resize.
+  Qed.
+  Lemma Forall2_resize_r l k x y n m :
+    P x y → Forall (P x) k →
+    Forall2 P l (resize n y k) → Forall2 P (resize m x l) (resize m y k).
+  Proof.
+    intros. destruct (decide (m ≤ n)).
+    { rewrite <-(resize_resize k m n) by done. by apply Forall2_resize. }
+    assert (n = length l); subst.
+    { by rewrite (Forall2_length P l (resize n y k)), length_resize. }
+    rewrite (Nat.le_add_sub (length l) m), !resize_add,
+      resize_all, drop_all, resize_nil by lia.
+    auto using Forall2_app, Forall2_replicate_l,
+      Forall_resize, Forall_drop, length_resize.
+  Qed.
+  Lemma Forall2_resize_r_flip l k x y n m :
+    P x y → Forall (P x) k →
+    length k = m → Forall2 P l (resize n y k) → Forall2 P (resize m x l) k.
+  Proof.
+    intros ?? <- ?. rewrite <-(resize_all k y) at 2.
+    apply Forall2_resize_r with n; auto using Forall_true.
+  Qed.
+
+  Lemma Forall2_rotate n l k :
+    Forall2 P l k → Forall2 P (rotate n l) (rotate n k).
+  Proof.
+    intros HAll. unfold rotate. rewrite (Forall2_length _ _ _ HAll).
+    eauto using Forall2_app, Forall2_take, Forall2_drop.
+  Qed.
+
+  Lemma Forall2_rotate_take s e l k :
+    Forall2 P l k → Forall2 P (rotate_take s e l) (rotate_take s e k).
+  Proof.
+    intros HAll. unfold rotate_take. rewrite (Forall2_length _ _ _ HAll).
+    eauto using Forall2_take, Forall2_rotate.
+  Qed.
+
+  Lemma Forall2_sublist_lookup_l l k n i l' :
+    Forall2 P l k → sublist_lookup n i l = Some l' →
+    ∃ k', sublist_lookup n i k = Some k' ∧ Forall2 P l' k'.
+  Proof.
+    unfold sublist_lookup. intros Hlk Hl.
+    exists (take i (drop n k)); simplify_option_eq.
+    - auto using Forall2_take, Forall2_drop.
+    - apply Forall2_length in Hlk; lia.
+  Qed.
+  Lemma Forall2_sublist_lookup_r l k n i k' :
+    Forall2 P l k → sublist_lookup n i k = Some k' →
+    ∃ l', sublist_lookup n i l = Some l' ∧ Forall2 P l' k'.
+  Proof.
+    intro. unfold sublist_lookup.
+    erewrite (Forall2_length P) by eauto; intros; simplify_option_eq.
+    eauto using Forall2_take, Forall2_drop.
+  Qed.
+  Lemma Forall2_sublist_alter f g l k i n l' k' :
+    Forall2 P l k → sublist_lookup i n l = Some l' →
+    sublist_lookup i n k = Some k' → Forall2 P (f l') (g k') →
+    Forall2 P (sublist_alter f i n l) (sublist_alter g i n k).
+  Proof.
+    intro. unfold sublist_alter, sublist_lookup.
+    erewrite Forall2_length by eauto; intros; simplify_option_eq.
+    auto using Forall2_app, Forall2_drop, Forall2_take.
+  Qed.
+  Lemma Forall2_sublist_alter_l f l k i n l' k' :
+    Forall2 P l k → sublist_lookup i n l = Some l' →
+    sublist_lookup i n k = Some k' → Forall2 P (f l') k' →
+    Forall2 P (sublist_alter f i n l) k.
+  Proof.
+    intro. unfold sublist_lookup, sublist_alter.
+    erewrite <-(Forall2_length P) by eauto; intros; simplify_option_eq.
+    apply Forall2_app_l;
+      rewrite ?length_take_le by lia; auto using Forall2_take.
+    apply Forall2_app_l; erewrite Forall2_length, length_take,
+      length_drop, <-Forall2_length, Nat.min_l by eauto with lia; [done|].
+    rewrite drop_drop; auto using Forall2_drop.
+  Qed.
+
+End Forall2.
+
+Section Forall2_proper.
+  Context {A} (R : relation A).
+
+  Global Instance: ∀ n, Proper (R ==> Forall2 R ==> Forall2 R) (resize n).
+  Proof. repeat intro. eauto using Forall2_resize. Qed.
+  Global Instance resize_proper `{!Equiv A} n : Proper ((≡) ==> (≡) ==> (≡@{list A})) (resize n).
+  Proof.
+    induction n; destruct 2; simpl; repeat (constructor || f_equiv); auto.
+  Qed.
+
+  Global Instance : ∀ n, Proper (Forall2 R ==> Forall2 R) (rotate n).
+  Proof. repeat intro. eauto using Forall2_rotate. Qed.
+  Global Instance rotate_proper `{!Equiv A} n : Proper ((≡@{list A}) ==> (≡)) (rotate n).
+  Proof. intros ??. rewrite !list_equiv_Forall2. by apply Forall2_rotate. Qed.
+
+  Global Instance: ∀ s e, Proper (Forall2 R ==> Forall2 R) (rotate_take s e).
+  Proof. repeat intro. eauto using Forall2_rotate_take. Qed.
+  Global Instance rotate_take_proper `{!Equiv A} s e : Proper ((≡@{list A}) ==> (≡)) (rotate_take s e).
+  Proof. intros ??. rewrite !list_equiv_Forall2. by apply Forall2_rotate_take. Qed.
+End Forall2_proper.
+
+Section more_general_properties.
+Context {A : Type}.
+Implicit Types x y z : A.
+Implicit Types l k : list A.
+
+(** ** Properties of the [mask] function *)
+Lemma mask_nil f βs : mask f βs [] =@{list A} [].
+Proof. by destruct βs. Qed.
+Lemma length_mask f βs l : length (mask f βs l) = length l.
+Proof. revert βs. induction l; intros [|??]; f_equal/=; auto. Qed.
+Lemma mask_true f l n : length l ≤ n → mask f (replicate n true) l = f <$> l.
+Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed.
+Lemma mask_false f l n : mask f (replicate n false) l = l.
+Proof. revert l. induction n; intros [|??]; f_equal/=; auto. Qed.
+Lemma mask_app f βs1 βs2 l :
+  mask f (βs1 ++ βs2) l
+  = mask f βs1 (take (length βs1) l) ++ mask f βs2 (drop (length βs1) l).
+Proof. revert l. induction βs1;intros [|??]; f_equal/=; auto using mask_nil. Qed.
+Lemma mask_app_2 f βs l1 l2 :
+  mask f βs (l1 ++ l2)
+  = mask f (take (length l1) βs) l1 ++ mask f (drop (length l1) βs) l2.
+Proof. revert βs. induction l1; intros [|??]; f_equal/=; auto. Qed.
+Lemma take_mask f βs l n : take n (mask f βs l) = mask f (take n βs) (take n l).
+Proof. revert n βs. induction l; intros [|?] [|[] ?]; f_equal/=; auto. Qed.
+Lemma drop_mask f βs l n : drop n (mask f βs l) = mask f (drop n βs) (drop n l).
+Proof.
+  revert n βs. induction l; intros [|?] [|[] ?]; f_equal/=; auto using mask_nil.
+Qed.
+Lemma sublist_lookup_mask f βs l i n :
+  sublist_lookup i n (mask f βs l)
+  = mask f (take n (drop i βs)) <$> sublist_lookup i n l.
+Proof.
+  unfold sublist_lookup; rewrite length_mask; simplify_option_eq; auto.
+  by rewrite drop_mask, take_mask.
+Qed.
+Lemma mask_mask f g βs1 βs2 l :
+  (∀ x, f (g x) = f x) → βs1 =.>* βs2 →
+  mask f βs2 (mask g βs1 l) = mask f βs2 l.
+Proof.
+  intros ? Hβs. revert l. by induction Hβs as [|[] []]; intros [|??]; f_equal/=.
+Qed.
+Lemma lookup_mask f βs l i :
+  βs !! i = Some true → mask f βs l !! i = f <$> l !! i.
+Proof.
+  revert i βs. induction l; intros [] [] ?; simplify_eq/=; f_equal; auto.
+Qed.
+Lemma lookup_mask_notin f βs l i :
+  βs !! i ≠ Some true → mask f βs l !! i = l !! i.
+Proof.
+  revert i βs. induction l; intros [] [|[]] ?; simplify_eq/=; auto.
+Qed.
+End more_general_properties.
+
+(** Lemmas about [positives_flatten] and [positives_unflatten]. *)
+Section positives_flatten_unflatten.
+  Local Open Scope positive_scope.
+
+  Lemma positives_flatten_go_app xs acc :
+    positives_flatten_go xs acc = acc ++ positives_flatten_go xs 1.
+  Proof.
+    revert acc.
+    induction xs as [|x xs IH]; intros acc; simpl.
+    - reflexivity.
+    - rewrite IH.
+      rewrite (IH (6 ++ _)).
+      rewrite 2!(assoc_L (++)).
+      reflexivity.
+  Qed.
+
+  Lemma positives_unflatten_go_app p suffix xs acc :
+    positives_unflatten_go (suffix ++ Pos.reverse (Pos.dup p)) xs acc =
+    positives_unflatten_go suffix xs (acc ++ p).
+  Proof.
+    revert suffix acc.
+    induction p as [p IH|p IH|]; intros acc suffix; simpl.
+    - rewrite 2!Pos.reverse_xI.
+      rewrite 2!(assoc_L (++)).
+      rewrite IH.
+      reflexivity.
+    - rewrite 2!Pos.reverse_xO.
+      rewrite 2!(assoc_L (++)).
+      rewrite IH.
+      reflexivity.
+    - reflexivity.
+  Qed.
+
+  Lemma positives_unflatten_flatten_go suffix xs acc :
+    positives_unflatten_go (suffix ++ positives_flatten_go xs 1) acc 1 =
+    positives_unflatten_go suffix (xs ++ acc) 1.
+  Proof.
+    revert suffix acc.
+    induction xs as [|x xs IH]; intros suffix acc; simpl.
+    - reflexivity.
+    - rewrite positives_flatten_go_app.
+      rewrite (assoc_L (++)).
+      rewrite IH.
+      rewrite (assoc_L (++)).
+      rewrite positives_unflatten_go_app.
+      simpl.
+      rewrite (left_id_L 1 (++)).
+      reflexivity.
+  Qed.
+
+  Lemma positives_unflatten_flatten xs :
+    positives_unflatten (positives_flatten xs) = Some xs.
+  Proof.
+    unfold positives_flatten, positives_unflatten.
+    replace (positives_flatten_go xs 1)
+      with (1 ++ positives_flatten_go xs 1)
+      by apply (left_id_L 1 (++)).
+    rewrite positives_unflatten_flatten_go.
+    simpl.
+    rewrite (right_id_L [] (++)%list).
+    reflexivity.
+  Qed.
+
+  Lemma positives_flatten_app xs ys :
+    positives_flatten (xs ++ ys) = positives_flatten xs ++ positives_flatten ys.
+  Proof.
+    unfold positives_flatten.
+    revert ys.
+    induction xs as [|x xs IH]; intros ys; simpl.
+    - rewrite (left_id_L 1 (++)).
+      reflexivity.
+    - rewrite positives_flatten_go_app, (positives_flatten_go_app xs).
+      rewrite IH.
+      rewrite (assoc_L (++)).
+      reflexivity.
+  Qed.
+
+  Lemma positives_flatten_cons x xs :
+    positives_flatten (x :: xs)
+    = 1~1~0 ++ Pos.reverse (Pos.dup x) ++ positives_flatten xs.
+  Proof.
+    change (x :: xs) with ([x] ++ xs)%list.
+    rewrite positives_flatten_app.
+    rewrite (assoc_L (++)).
+    reflexivity.
+  Qed.
+
+  Lemma positives_flatten_suffix (l k : list positive) :
+    l `suffix_of` k → ∃ q, positives_flatten k = q ++ positives_flatten l.
+  Proof.
+    intros [l' ->].
+    exists (positives_flatten l').
+    apply positives_flatten_app.
+  Qed.
+
+  Lemma positives_flatten_suffix_eq p1 p2 (xs ys : list positive) :
+    length xs = length ys →
+    p1 ++ positives_flatten xs = p2 ++ positives_flatten ys →
+    xs = ys.
+  Proof.
+    revert p1 p2 ys; induction xs as [|x xs IH];
+      intros p1 p2 [|y ys] ?; simplify_eq/=; auto.
+    rewrite !positives_flatten_cons, !(assoc _); intros Hl.
+    assert (xs = ys) as <- by eauto; clear IH; f_equal.
+    apply (inj (.++ positives_flatten xs)) in Hl.
+    rewrite 2!Pos.reverse_dup in Hl.
+    apply (Pos.dup_suffix_eq _ _ p1 p2) in Hl.
+    by apply (inj Pos.reverse).
+  Qed.
+End positives_flatten_unflatten.

stdpp/list_monad.v

+From Coq Require Export Permutation.
+From stdpp Require Export numbers base option list_basics list_relations.
+From stdpp Require Import options.
+
+(** The monadic operations. *)
+Global Instance list_ret: MRet list := λ A x, x :: @nil A.
+Global Instance list_fmap : FMap list := λ A B f,
+  fix go (l : list A) := match l with [] => [] | x :: l => f x :: go l end.
+Global Instance list_omap : OMap list := λ A B f,
+  fix go (l : list A) :=
+  match l with
+  | [] => []
+  | x :: l => match f x with Some y => y :: go l | None => go l end
+  end.
+Global Instance list_bind : MBind list := λ A B f,
+  fix go (l : list A) := match l with [] => [] | x :: l => f x ++ go l end.
+Global Instance list_join: MJoin list :=
+  fix go A (ls : list (list A)) : list A :=
+  match ls with [] => [] | l :: ls => l ++ @mjoin _ go _ ls end.
+
+Definition mapM `{MBind M, MRet M} {A B} (f : A → M B) : list A → M (list B) :=
+  fix go l :=
+  match l with [] => mret [] | x :: l => y ← f x; k ← go l; mret (y :: k) end.
+Global Instance: Params (@mapM) 5 := {}.
+
+(** We define stronger variants of the map function that allow the mapped
+function to use the index of the elements. *)
+Fixpoint imap {A B} (f : nat → A → B) (l : list A) : list B :=
+  match l with
+  | [] => []
+  | x :: l => f 0 x :: imap (f ∘ S) l
+  end.
+Global Instance: Params (@imap) 2 := {}.
+
+Definition zipped_map {A B} (f : list A → list A → A → B) :
+    list A → list A → list B := fix go l k :=
+  match k with
+  | [] => []
+  | x :: k => f l k x :: go (x :: l) k
+  end.
+Global Instance: Params (@zipped_map) 2 := {}.
+
+Fixpoint imap2 {A B C} (f : nat → A → B → C) (l : list A) (k : list B) : list C :=
+  match l, k with
+  | [], _ | _, [] => []
+  | x :: l, y :: k => f 0 x y :: imap2 (f ∘ S) l k
+  end.
+Global Instance: Params (@imap2) 3 := {}.
+
+Inductive zipped_Forall {A} (P : list A → list A → A → Prop) :
+    list A → list A → Prop :=
+  | zipped_Forall_nil l : zipped_Forall P l []
+  | zipped_Forall_cons l k x :
+     P l k x → zipped_Forall P (x :: l) k → zipped_Forall P l (x :: k).
+Global Arguments zipped_Forall_nil {_ _} _ : assert.
+Global Arguments zipped_Forall_cons {_ _} _ _ _ _ _ : assert.
+
+(** The Cartesian product on lists satisfies (lemma [elem_of_list_cprod]):
+
+  x ∈ cprod l k ↔ x.1 ∈ l ∧ x.2 ∈ k
+
+There are little meaningful things to say about the order of the elements in
+[cprod] (so there are no lemmas for that). It thus only makes sense to use
+[cprod] when treating the lists as a set-like structure (i.e., up to duplicates
+and permutations). *)
+Global Instance list_cprod {A B} : CProd (list A) (list B) (list (A * B)) :=
+  λ l k, x ← l; (x,.) <$> k.
+
+(** The function [permutations l] yields all permutations of [l]. *)
+Fixpoint interleave {A} (x : A) (l : list A) : list (list A) :=
+  match l with
+  | [] => [[x]]| y :: l => (x :: y :: l) :: ((y ::.) <$> interleave x l)
+  end.
+Fixpoint permutations {A} (l : list A) : list (list A) :=
+  match l with [] => [[]] | x :: l => permutations l ≫= interleave x end.
+
+Section general_properties.
+Context {A : Type}.
+Implicit Types x y z : A.
+Implicit Types l k : list A.
+
+(** The Cartesian product *)
+(** Correspondence to [list_prod] from the stdlib, a version that does not use
+the [CProd] class for the interface, nor the monad classes for the definition *)
+Lemma list_cprod_list_prod {B} l (k : list B) : cprod l k = list_prod l k.
+Proof. unfold cprod, list_cprod. induction l; f_equal/=; auto. Qed.
+
+Lemma elem_of_list_cprod {B} l (k : list B) (x : A * B) :
+  x ∈ cprod l k ↔ x.1 ∈ l ∧ x.2 ∈ k.
+Proof.
+  rewrite list_cprod_list_prod, !elem_of_list_In.
+  destruct x. apply in_prod_iff.
+Qed.
+
+End general_properties.
+
+(** * Properties of the monadic operations *)
+Lemma list_fmap_id {A} (l : list A) : id <$> l = l.
+Proof. induction l; f_equal/=; auto. Qed.
+
+Global Instance list_fmap_proper `{!Equiv A, !Equiv B} :
+  Proper (((≡) ==> (≡)) ==> (≡@{list A}) ==> (≡@{list B})) fmap.
+Proof. induction 2; csimpl; constructor; auto. Qed.
+
+Section fmap.
+  Context {A B : Type} (f : A → B).
+  Implicit Types l : list A.
+
+  Lemma list_fmap_compose {C} (g : B → C) l : g ∘ f <$> l = g <$> (f <$> l).
+  Proof. induction l; f_equal/=; auto. Qed.
+
+  Lemma list_fmap_inj_1 f' l x :
+    f <$> l = f' <$> l → x ∈ l → f x = f' x.
+  Proof. intros Hf Hin. induction Hin; naive_solver. Qed.
+
+  Definition fmap_nil : f <$> [] = [] := eq_refl.
+  Definition fmap_cons x l : f <$> x :: l = f x :: (f <$> l) := eq_refl.
+
+  Lemma list_fmap_singleton x : f <$> [x] = [f x].
+  Proof. reflexivity. Qed.
+  Lemma fmap_app l1 l2 : f <$> l1 ++ l2 = (f <$> l1) ++ (f <$> l2).
+  Proof. by induction l1; f_equal/=. Qed.
+  Lemma fmap_snoc l x : f <$> l ++ [x] = (f <$> l) ++ [f x].
+  Proof. rewrite fmap_app, list_fmap_singleton. done. Qed.
+  Lemma fmap_nil_inv k :  f <$> k = [] → k = [].
+  Proof. by destruct k. Qed.
+  Lemma fmap_cons_inv y l k :
+    f <$> l = y :: k → ∃ x l', y = f x ∧ k = f <$> l' ∧ l = x :: l'.
+  Proof. intros. destruct l; simplify_eq/=; eauto. Qed.
+  Lemma fmap_app_inv l k1 k2 :
+    f <$> l = k1 ++ k2 → ∃ l1 l2, k1 = f <$> l1 ∧ k2 = f <$> l2 ∧ l = l1 ++ l2.
+  Proof.
+    revert l. induction k1 as [|y k1 IH]; simpl; [intros l ?; by eexists [],l|].
+    intros [|x l] ?; simplify_eq/=.
+    destruct (IH l) as (l1&l2&->&->&->); [done|]. by exists (x :: l1), l2.
+  Qed.
+  Lemma fmap_option_list mx :
+    f <$> (option_list mx) = option_list (f <$> mx).
+  Proof. by destruct mx. Qed.
+
+  Lemma list_fmap_alt l :
+    f <$> l = omap (λ x, Some (f x)) l.
+  Proof. induction l; simplify_eq/=; done. Qed.
+
+  Lemma length_fmap l : length (f <$> l) = length l.
+  Proof. by induction l; f_equal/=. Qed.
+  Lemma fmap_reverse l : f <$> reverse l = reverse (f <$> l).
+  Proof.
+    induction l as [|?? IH]; csimpl; by rewrite ?reverse_cons, ?fmap_app, ?IH.
+  Qed.
+  Lemma fmap_tail l : f <$> tail l = tail (f <$> l).
+  Proof. by destruct l. Qed.
+  Lemma fmap_last l : last (f <$> l) = f <$> last l.
+  Proof. induction l as [|? []]; simpl; auto. Qed.
+  Lemma fmap_replicate n x :  f <$> replicate n x = replicate n (f x).
+  Proof. by induction n; f_equal/=. Qed.
+  Lemma fmap_take n l : f <$> take n l = take n (f <$> l).
+  Proof. revert n. by induction l; intros [|?]; f_equal/=. Qed.
+  Lemma fmap_drop n l : f <$> drop n l = drop n (f <$> l).
+  Proof. revert n. by induction l; intros [|?]; f_equal/=. Qed.
+  Lemma const_fmap (l : list A) (y : B) :
+    (∀ x, f x = y) → f <$> l = replicate (length l) y.
+  Proof. intros; induction l; f_equal/=; auto. Qed.
+  Lemma list_lookup_fmap l i : (f <$> l) !! i = f <$> (l !! i).
+  Proof. revert i. induction l; intros [|n]; by try revert n. Qed.
+  Lemma list_lookup_fmap_Some l i x :
+    (f <$> l) !! i =  Some x ↔ ∃ y, l !! i = Some y ∧ x = f y.
+  Proof. by rewrite list_lookup_fmap, fmap_Some. Qed.
+  Lemma list_lookup_total_fmap `{!Inhabited A, !Inhabited B} l i :
+    i < length l → (f <$> l) !!! i = f (l !!! i).
+  Proof.
+    intros [x Hx]%lookup_lt_is_Some_2.
+    by rewrite !list_lookup_total_alt, list_lookup_fmap, Hx.
+  Qed.
+  Lemma list_lookup_fmap_inv l i x :
+    (f <$> l) !! i = Some x → ∃ y, x = f y ∧ l !! i = Some y.
+  Proof.
+    intros Hi. rewrite list_lookup_fmap in Hi.
+    destruct (l !! i) eqn:?; simplify_eq/=; eauto.
+  Qed.
+  Lemma list_fmap_insert l i x: f <$> <[i:=x]>l = <[i:=f x]>(f <$> l).
+  Proof. revert i. by induction l; intros [|i]; f_equal/=. Qed.
+  Lemma list_alter_fmap (g : A → A) (h : B → B) l i :
+    Forall (λ x, f (g x) = h (f x)) l → f <$> alter g i l = alter h i (f <$> l).
+  Proof. intros Hl. revert i. by induction Hl; intros [|i]; f_equal/=. Qed.
+  Lemma list_fmap_delete l i : f <$> (delete i l) = delete i (f <$> l).
+  Proof.
+    revert i. induction l; intros i; destruct i; csimpl; eauto.
+    naive_solver congruence.
+  Qed.
+
+  Lemma elem_of_list_fmap_1 l x : x ∈ l → f x ∈ f <$> l.
+  Proof. induction 1; csimpl; rewrite elem_of_cons; intuition. Qed.
+  Lemma elem_of_list_fmap_1_alt l x y : x ∈ l → y = f x → y ∈ f <$> l.
+  Proof. intros. subst. by apply elem_of_list_fmap_1. Qed.
+  Lemma elem_of_list_fmap_2 l x : x ∈ f <$> l → ∃ y, x = f y ∧ y ∈ l.
+  Proof.
+    induction l as [|y l IH]; simpl; inv 1.
+    - exists y. split; [done | by left].
+    - destruct IH as [z [??]]; [done|]. exists z. split; [done | by right].
+  Qed.
+  Lemma elem_of_list_fmap l x : x ∈ f <$> l ↔ ∃ y, x = f y ∧ y ∈ l.
+  Proof.
+    naive_solver eauto using elem_of_list_fmap_1_alt, elem_of_list_fmap_2.
+  Qed.
+  Lemma elem_of_list_fmap_2_inj `{!Inj (=) (=) f} l x : f x ∈ f <$> l → x ∈ l.
+  Proof.
+    intros (y, (E, I))%elem_of_list_fmap_2. by rewrite (inj f) in I.
+  Qed.
+  Lemma elem_of_list_fmap_inj `{!Inj (=) (=) f} l x : f x ∈ f <$> l ↔ x ∈ l.
+  Proof.
+    naive_solver eauto using elem_of_list_fmap_1, elem_of_list_fmap_2_inj.
+  Qed.
+
+  Lemma list_fmap_inj R1 R2 :
+    Inj R1 R2 f → Inj (Forall2 R1) (Forall2 R2) (fmap f).
+  Proof.
+    intros ? l1. induction l1; intros [|??]; inv 1; constructor; auto.
+  Qed.
+  Global Instance list_fmap_eq_inj : Inj (=) (=) f → Inj (=@{list A}) (=) (fmap f).
+  Proof.
+    intros ?%list_fmap_inj ?? ?%list_eq_Forall2%(inj _). by apply list_eq_Forall2.
+  Qed.
+  Global Instance list_fmap_equiv_inj `{!Equiv A, !Equiv B} :
+    Inj (≡) (≡) f → Inj (≡@{list A}) (≡) (fmap f).
+  Proof.
+    intros ?%list_fmap_inj ?? ?%list_equiv_Forall2%(inj _).
+    by apply list_equiv_Forall2.
+  Qed.
+
+  (** A version of [NoDup_fmap_2] that does not require [f] to be injective for
+      *all* inputs. *)
+  Lemma NoDup_fmap_2_strong l :
+    (∀ x y, x ∈ l → y ∈ l → f x = f y → x = y) →
+    NoDup l →
+    NoDup (f <$> l).
+  Proof.
+    intros Hinj. induction 1 as [|x l ?? IH]; simpl; constructor.
+    - intros [y [Hxy ?]]%elem_of_list_fmap.
+      apply Hinj in Hxy; [by subst|by constructor..].
+    - apply IH. clear- Hinj.
+      intros x' y Hx' Hy. apply Hinj; by constructor.
+  Qed.
+
+  Lemma NoDup_fmap_1 l : NoDup (f <$> l) → NoDup l.
+  Proof.
+    induction l; simpl; inv 1; constructor; auto.
+    rewrite elem_of_list_fmap in *. naive_solver.
+  Qed.
+  Lemma NoDup_fmap_2 `{!Inj (=) (=) f} l : NoDup l → NoDup (f <$> l).
+  Proof. apply NoDup_fmap_2_strong. intros ?? _ _. apply (inj f). Qed.
+  Lemma NoDup_fmap `{!Inj (=) (=) f} l : NoDup (f <$> l) ↔ NoDup l.
+  Proof. split; auto using NoDup_fmap_1, NoDup_fmap_2. Qed.
+
+  Global Instance fmap_sublist: Proper (sublist ==> sublist) (fmap f).
+  Proof. induction 1; simpl; econstructor; eauto. Qed.
+  Global Instance fmap_submseteq: Proper (submseteq ==> submseteq) (fmap f).
+  Proof. induction 1; simpl; econstructor; eauto. Qed.
+  Global Instance fmap_Permutation: Proper ((≡ₚ) ==> (≡ₚ)) (fmap f).
+  Proof. induction 1; simpl; econstructor; eauto. Qed.
+
+  Lemma Forall_fmap_ext_1 (g : A → B) (l : list A) :
+    Forall (λ x, f x = g x) l → fmap f l = fmap g l.
+  Proof. by induction 1; f_equal/=. Qed.
+  Lemma Forall_fmap_ext (g : A → B) (l : list A) :
+    Forall (λ x, f x = g x) l ↔ fmap f l = fmap g l.
+  Proof.
+    split; [auto using Forall_fmap_ext_1|].
+    induction l; simpl; constructor; simplify_eq; auto.
+  Qed.
+  Lemma Forall_fmap (P : B → Prop) l : Forall P (f <$> l) ↔ Forall (P ∘ f) l.
+  Proof. split; induction l; inv 1; constructor; auto. Qed.
+  Lemma Exists_fmap (P : B → Prop) l : Exists P (f <$> l) ↔ Exists (P ∘ f) l.
+  Proof. split; induction l; inv 1; constructor; by auto. Qed.
+
+  Lemma Forall2_fmap_l {C} (P : B → C → Prop) l k :
+    Forall2 P (f <$> l) k ↔ Forall2 (P ∘ f) l k.
+  Proof.
+    split; revert k; induction l; inv 1; constructor; auto.
+  Qed.
+  Lemma Forall2_fmap_r {C} (P : C → B → Prop) k l :
+    Forall2 P k (f <$> l) ↔ Forall2 (λ x, P x ∘ f) k l.
+  Proof.
+    split; revert k; induction l; inv 1; constructor; auto.
+  Qed.
+  Lemma Forall2_fmap_1 {C D} (g : C → D) (P : B → D → Prop) l k :
+    Forall2 P (f <$> l) (g <$> k) → Forall2 (λ x1 x2, P (f x1) (g x2)) l k.
+  Proof. revert k; induction l; intros [|??]; inv 1; auto. Qed.
+  Lemma Forall2_fmap_2 {C D} (g : C → D) (P : B → D → Prop) l k :
+    Forall2 (λ x1 x2, P (f x1) (g x2)) l k → Forall2 P (f <$> l) (g <$> k).
+  Proof. induction 1; csimpl; auto. Qed.
+  Lemma Forall2_fmap {C D} (g : C → D) (P : B → D → Prop) l k :
+    Forall2 P (f <$> l) (g <$> k) ↔ Forall2 (λ x1 x2, P (f x1) (g x2)) l k.
+  Proof. split; auto using Forall2_fmap_1, Forall2_fmap_2. Qed.
+
+  Lemma list_fmap_bind {C} (g : B → list C) l : (f <$> l) ≫= g = l ≫= g ∘ f.
+  Proof. by induction l; f_equal/=. Qed.
+End fmap.
+
+Section ext.
+  Context {A B : Type}.
+  Implicit Types l : list A.
+
+  Lemma list_fmap_ext (f g : A → B) l :
+    (∀ i x, l !! i = Some x → f x = g x) → f <$> l = g <$> l.
+  Proof.
+    intros Hfg. apply list_eq; intros i. rewrite !list_lookup_fmap.
+    destruct (l !! i) eqn:?; f_equal/=; eauto.
+  Qed.
+  Lemma list_fmap_equiv_ext `{!Equiv B} (f g : A → B) l :
+    (∀ i x, l !! i = Some x → f x ≡ g x) → f <$> l ≡ g <$> l.
+  Proof.
+    intros Hl. apply list_equiv_lookup; intros i. rewrite !list_lookup_fmap.
+    destruct (l !! i) eqn:?; simpl; constructor; eauto.
+  Qed.
+End ext.
+
+Lemma list_alter_fmap_mono {A} (f : A → A) (g : A → A) l i :
+  Forall (λ x, f (g x) = g (f x)) l → f <$> alter g i l = alter g i (f <$> l).
+Proof. auto using list_alter_fmap. Qed.
+Lemma NoDup_fmap_fst {A B} (l : list (A * B)) :
+  (∀ x y1 y2, (x,y1) ∈ l → (x,y2) ∈ l → y1 = y2) → NoDup l → NoDup (l.*1).
+Proof.
+  intros Hunique. induction 1 as [|[x1 y1] l Hin Hnodup IH]; csimpl; constructor.
+  - rewrite elem_of_list_fmap.
+    intros [[x2 y2] [??]]; simpl in *; subst. destruct Hin.
+    rewrite (Hunique x2 y1 y2); rewrite ?elem_of_cons; auto.
+  - apply IH. intros. eapply Hunique; rewrite ?elem_of_cons; eauto.
+Qed.
+
+Global Instance list_omap_proper `{!Equiv A, !Equiv B} :
+  Proper (((≡) ==> (≡)) ==> (≡@{list A}) ==> (≡@{list B})) omap.
+Proof.
+  intros f1 f2 Hf. induction 1 as [|x1 x2 l1 l2 Hx Hl]; csimpl; [constructor|].
+  destruct (Hf _ _ Hx); by repeat f_equiv.
+Qed.
+
+Section omap.
+  Context {A B : Type} (f : A → option B).
+  Implicit Types l : list A.
+
+  Lemma list_fmap_omap {C} (g : B → C) l :
+    g <$> omap f l = omap (λ x, g <$> (f x)) l.
+  Proof.
+    induction l as [|x y IH]; [done|]. csimpl.
+    destruct (f x); csimpl; [|done]. by f_equal.
+  Qed.
+  Lemma list_omap_ext {A'} (g : A' → option B) l1 (l2 : list A') :
+    Forall2 (λ a b, f a = g b) l1 l2 →
+    omap f l1 = omap g l2.
+  Proof.
+    induction 1 as [|x y l l' Hfg ? IH]; [done|].
+    csimpl. rewrite Hfg. destruct (g y); [|done]. by f_equal.
+  Qed.
+  Lemma elem_of_list_omap l y : y ∈ omap f l ↔ ∃ x, x ∈ l ∧ f x = Some y.
+  Proof.
+    split.
+    - induction l as [|x l]; csimpl; repeat case_match;
+        repeat (setoid_rewrite elem_of_nil || setoid_rewrite elem_of_cons);
+        naive_solver.
+    - intros (x&Hx&?). by induction Hx; csimpl; repeat case_match;
+        simplify_eq; try constructor; auto.
+  Qed.
+  Global Instance omap_Permutation : Proper ((≡ₚ) ==> (≡ₚ)) (omap f).
+  Proof. induction 1; simpl; repeat case_match; econstructor; eauto. Qed.
+
+  Lemma omap_app l1 l2 :
+    omap f (l1 ++ l2) = omap f l1 ++ omap f l2.
+  Proof. induction l1; csimpl; repeat case_match; naive_solver congruence. Qed.
+  Lemma omap_option_list mx :
+    omap f (option_list mx) = option_list (mx ≫= f).
+  Proof. by destruct mx. Qed.
+End omap.
+
+Global Instance list_bind_proper `{!Equiv A, !Equiv B} :
+  Proper (((≡) ==> (≡)) ==> (≡@{list A}) ==> (≡@{list B})) mbind.
+Proof. induction 2; csimpl; constructor || f_equiv; auto. Qed.
+
+Section bind.
+  Context {A B : Type} (f : A → list B).
+
+  Lemma list_bind_ext (g : A → list B) l1 l2 :
+    (∀ x, f x = g x) → l1 = l2 → l1 ≫= f = l2 ≫= g.
+  Proof. intros ? <-. by induction l1; f_equal/=. Qed.
+  Lemma Forall_bind_ext (g : A → list B) (l : list A) :
+    Forall (λ x, f x = g x) l → l ≫= f = l ≫= g.
+  Proof. by induction 1; f_equal/=. Qed.
+  Global Instance bind_sublist: Proper (sublist ==> sublist) (mbind f).
+  Proof.
+    induction 1; simpl; auto;
+      [by apply sublist_app|by apply sublist_inserts_l].
+  Qed.
+  Global Instance bind_submseteq: Proper (submseteq ==> submseteq) (mbind f).
+  Proof.
+    induction 1; csimpl; auto.
+    - by apply submseteq_app.
+    - by rewrite !(assoc_L (++)), (comm (++) (f _)).
+    - by apply submseteq_inserts_l.
+    - etrans; eauto.
+  Qed.
+  Global Instance bind_Permutation: Proper ((≡ₚ) ==> (≡ₚ)) (mbind f).
+  Proof.
+    induction 1; csimpl; auto.
+    - by f_equiv.
+    - by rewrite !(assoc_L (++)), (comm (++) (f _)).
+    - etrans; eauto.
+  Qed.
+  Lemma bind_cons x l : (x :: l) ≫= f = f x ++ l ≫= f.
+  Proof. done. Qed.
+  Lemma bind_singleton x : [x] ≫= f = f x.
+  Proof. csimpl. by rewrite (right_id_L _ (++)). Qed.
+  Lemma bind_app l1 l2 : (l1 ++ l2) ≫= f = (l1 ≫= f) ++ (l2 ≫= f).
+  Proof. by induction l1; csimpl; rewrite <-?(assoc_L (++)); f_equal. Qed.
+  Lemma elem_of_list_bind (x : B) (l : list A) :
+    x ∈ l ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ l.
+  Proof.
+    split.
+    - induction l as [|y l IH]; csimpl; [inv 1|].
+      rewrite elem_of_app. intros [?|?].
+      + exists y. split; [done | by left].
+      + destruct IH as [z [??]]; [done|]. exists z. split; [done | by right].
+    - intros [y [Hx Hy]]. induction Hy; csimpl; rewrite elem_of_app; intuition.
+  Qed.
+  Lemma Forall_bind (P : B → Prop) l :
+    Forall P (l ≫= f) ↔ Forall (Forall P ∘ f) l.
+  Proof.
+    split.
+    - induction l; csimpl; rewrite ?Forall_app; constructor; csimpl; intuition.
+    - induction 1; csimpl; rewrite ?Forall_app; auto.
+  Qed.
+  Lemma Forall2_bind {C D} (g : C → list D) (P : B → D → Prop) l1 l2 :
+    Forall2 (λ x1 x2, Forall2 P (f x1) (g x2)) l1 l2 →
+    Forall2 P (l1 ≫= f) (l2 ≫= g).
+  Proof. induction 1; csimpl; auto using Forall2_app. Qed.
+  Lemma NoDup_bind l :
+    (∀ x1 x2 y, x1 ∈ l → x2 ∈ l → y ∈ f x1 → y ∈ f x2 → x1 = x2) →
+    (∀ x, x ∈ l → NoDup (f x)) → NoDup l → NoDup (l ≫= f).
+  Proof.
+    intros Hinj Hf. induction 1 as [|x l ?? IH]; csimpl; [constructor|].
+    apply NoDup_app. split_and!.
+    - eauto 10 using elem_of_list_here.
+    - intros y ? (x'&?&?)%elem_of_list_bind.
+      destruct (Hinj x x' y); auto using elem_of_list_here, elem_of_list_further.
+    - eauto 10 using elem_of_list_further.
+  Qed.
+End bind.
+
+Global Instance list_join_proper `{!Equiv A} :
+  Proper ((≡) ==> (≡@{list A})) mjoin.
+Proof. induction 1; simpl; [constructor|solve_proper]. Qed.
+
+Section ret_join.
+  Context {A : Type}.
+
+  Lemma list_join_bind (ls : list (list A)) : mjoin ls = ls ≫= id.
+  Proof. by induction ls; f_equal/=. Qed.
+  Global Instance join_Permutation : Proper ((≡ₚ@{list A}) ==> (≡ₚ)) mjoin.
+  Proof. intros ?? E. by rewrite !list_join_bind, E. Qed.
+  Lemma elem_of_list_ret (x y : A) : x ∈ @mret list _ A y ↔ x = y.
+  Proof. apply elem_of_list_singleton. Qed.
+  Lemma elem_of_list_join (x : A) (ls : list (list A)) :
+    x ∈ mjoin ls ↔ ∃ l : list A, x ∈ l ∧ l ∈ ls.
+  Proof. by rewrite list_join_bind, elem_of_list_bind. Qed.
+  Lemma join_nil (ls : list (list A)) : mjoin ls = [] ↔ Forall (.= []) ls.
+  Proof.
+    split; [|by induction 1 as [|[|??] ?]].
+    by induction ls as [|[|??] ?]; constructor; auto.
+  Qed.
+  Lemma join_nil_1 (ls : list (list A)) : mjoin ls = [] → Forall (.= []) ls.
+  Proof. by rewrite join_nil. Qed.
+  Lemma join_nil_2 (ls : list (list A)) : Forall (.= []) ls → mjoin ls = [].
+  Proof. by rewrite join_nil. Qed.
+
+  Lemma join_app (l1 l2 : list (list A)) :
+    mjoin (l1 ++ l2) = mjoin l1 ++ mjoin l2.
+  Proof.
+    induction l1 as [|x l1 IH]; simpl; [done|]. by rewrite <-(assoc_L _ _), IH.
+  Qed.
+
+  Lemma Forall_join (P : A → Prop) (ls: list (list A)) :
+    Forall (Forall P) ls → Forall P (mjoin ls).
+  Proof. induction 1; simpl; auto using Forall_app_2. Qed.
+  Lemma Forall2_join {B} (P : A → B → Prop) ls1 ls2 :
+    Forall2 (Forall2 P) ls1 ls2 → Forall2 P (mjoin ls1) (mjoin ls2).
+  Proof. induction 1; simpl; auto using Forall2_app. Qed.
+End ret_join.
+
+Global Instance mapM_proper `{!Equiv A, !Equiv B} :
+  Proper (((≡) ==> (≡)) ==> (≡@{list A}) ==> (≡@{option (list B)})) mapM.
+Proof.
+  induction 2; csimpl; repeat (f_equiv || constructor || intro || auto).
+Qed.
+
+Section mapM.
+  Context {A B : Type} (f : A → option B).
+
+  Lemma mapM_ext (g : A → option B) l : (∀ x, f x = g x) → mapM f l = mapM g l.
+  Proof. intros Hfg. by induction l as [|?? IHl]; simpl; rewrite ?Hfg, ?IHl. Qed.
+
+  Lemma Forall2_mapM_ext (g : A → option B) l k :
+    Forall2 (λ x y, f x = g y) l k → mapM f l = mapM g k.
+  Proof. induction 1 as [|???? Hfg ? IH]; simpl; [done|]. by rewrite Hfg, IH. Qed.
+  Lemma Forall_mapM_ext (g : A → option B) l :
+    Forall (λ x, f x = g x) l → mapM f l = mapM g l.
+  Proof. induction 1 as [|?? Hfg ? IH]; simpl; [done|]. by rewrite Hfg, IH. Qed.
+
+  Lemma mapM_Some_1 l k : mapM f l = Some k → Forall2 (λ x y, f x = Some y) l k.
+  Proof.
+    revert k. induction l as [|x l]; intros [|y k]; simpl; try done.
+    - destruct (f x); simpl; [|discriminate]. by destruct (mapM f l).
+    - destruct (f x) eqn:?; intros; simplify_option_eq; auto.
+  Qed.
+  Lemma mapM_Some_2 l k : Forall2 (λ x y, f x = Some y) l k → mapM f l = Some k.
+  Proof.
+    induction 1 as [|???? Hf ? IH]; simpl; [done |].
+    rewrite Hf. simpl. by rewrite IH.
+  Qed.
+  Lemma mapM_Some l k : mapM f l = Some k ↔ Forall2 (λ x y, f x = Some y) l k.
+  Proof. split; auto using mapM_Some_1, mapM_Some_2. Qed.
+  Lemma length_mapM l k : mapM f l = Some k → length l = length k.
+  Proof. intros. by eapply Forall2_length, mapM_Some_1. Qed.
+  Lemma mapM_None_1 l : mapM f l = None → Exists (λ x, f x = None) l.
+  Proof.
+    induction l as [|x l IH]; simpl; [done|].
+    destruct (f x) eqn:?; simpl; eauto. by destruct (mapM f l); eauto.
+  Qed.
+  Lemma mapM_None_2 l : Exists (λ x, f x = None) l → mapM f l = None.
+  Proof.
+    induction 1 as [x l Hx|x l ? IH]; simpl; [by rewrite Hx|].
+    by destruct (f x); simpl; rewrite ?IH.
+  Qed.
+  Lemma mapM_None l : mapM f l = None ↔ Exists (λ x, f x = None) l.
+  Proof. split; auto using mapM_None_1, mapM_None_2. Qed.
+  Lemma mapM_is_Some_1 l : is_Some (mapM f l) → Forall (is_Some ∘ f) l.
+  Proof.
+    unfold compose. setoid_rewrite <-not_eq_None_Some.
+    rewrite mapM_None. apply (not_Exists_Forall _).
+  Qed.
+  Lemma mapM_is_Some_2 l : Forall (is_Some ∘ f) l → is_Some (mapM f l).
+  Proof.
+    unfold compose. setoid_rewrite <-not_eq_None_Some.
+    rewrite mapM_None. apply (Forall_not_Exists _).
+  Qed.
+  Lemma mapM_is_Some l : is_Some (mapM f l) ↔ Forall (is_Some ∘ f) l.
+  Proof. split; auto using mapM_is_Some_1, mapM_is_Some_2. Qed.
+
+  Lemma mapM_fmap_Forall_Some (g : B → A) (l : list B) :
+    Forall (λ x, f (g x) = Some x) l → mapM f (g <$> l) = Some l.
+  Proof. by induction 1; simpl; simplify_option_eq. Qed.
+  Lemma mapM_fmap_Some (g : B → A) (l : list B) :
+    (∀ x, f (g x) = Some x) → mapM f (g <$> l) = Some l.
+  Proof. intros. by apply mapM_fmap_Forall_Some, Forall_true. Qed.
+
+  Lemma mapM_fmap_Forall2_Some_inv (g : B → A) (l : list A) (k : list B) :
+    mapM f l = Some k → Forall2 (λ x y, f x = Some y → g y = x) l k → g <$> k = l.
+  Proof. induction 2; simplify_option_eq; naive_solver. Qed.
+  Lemma mapM_fmap_Some_inv (g : B → A) (l : list A) (k : list B) :
+    mapM f l = Some k → (∀ x y, f x = Some y → g y = x) → g <$> k = l.
+  Proof. eauto using mapM_fmap_Forall2_Some_inv, Forall2_true, length_mapM. Qed.
+End mapM.
+
+Lemma imap_const {A B} (f : A → B) l : imap (const f) l = f <$> l.
+Proof. induction l; f_equal/=; auto. Qed.
+
+Global Instance imap_proper `{!Equiv A, !Equiv B} :
+  Proper (pointwise_relation _ ((≡) ==> (≡)) ==> (≡@{list A}) ==> (≡@{list B}))
+         imap.
+Proof.
+  intros f f' Hf l l' Hl. revert f f' Hf.
+  induction Hl as [|x1 x2 l1 l2 ?? IH]; intros f f' Hf; simpl; constructor.
+  - by apply Hf.
+  - apply IH. intros i y y' ?; simpl. by apply Hf.
+Qed.
+
+Section imap.
+  Context {A B : Type} (f : nat → A → B).
+
+  Lemma imap_ext g l :
+    (∀ i x, l !! i = Some x → f i x = g i x) → imap f l = imap g l.
+  Proof. revert f g; induction l as [|x l IH]; intros; f_equal/=; eauto. Qed.
+
+  Lemma imap_nil : imap f [] = [].
+  Proof. done. Qed.
+  Lemma imap_app l1 l2 :
+    imap f (l1 ++ l2) = imap f l1 ++ imap (λ n, f (length l1 + n)) l2.
+  Proof.
+    revert f. induction l1 as [|x l1 IH]; intros f; f_equal/=.
+    by rewrite IH.
+  Qed.
+  Lemma imap_cons x l : imap f (x :: l) = f 0 x :: imap (f ∘ S) l.
+  Proof. done. Qed.
+
+  Lemma imap_fmap {C} (g : C → A) l : imap f (g <$> l) = imap (λ n, f n ∘ g) l.
+  Proof. revert f. induction l; intros; f_equal/=; eauto. Qed.
+  Lemma fmap_imap {C} (g : B → C) l : g <$> imap f l = imap (λ n, g ∘ f n) l.
+  Proof. revert f. induction l; intros; f_equal/=; eauto. Qed.
+
+  Lemma list_lookup_imap l i : imap f l !! i = f i <$> l !! i.
+  Proof.
+    revert f i. induction l as [|x l IH]; intros f [|i]; f_equal/=; auto.
+    by rewrite IH.
+  Qed.
+  Lemma list_lookup_imap_Some l i x :
+    imap f l !! i = Some x ↔ ∃ y, l !! i = Some y ∧ x = f i y.
+  Proof. by rewrite list_lookup_imap, fmap_Some. Qed.
+  Lemma list_lookup_total_imap `{!Inhabited A, !Inhabited B} l i :
+    i < length l → imap f l !!! i = f i (l !!! i).
+  Proof.
+    intros [x Hx]%lookup_lt_is_Some_2.
+    by rewrite !list_lookup_total_alt, list_lookup_imap, Hx.
+  Qed.
+
+  Lemma length_imap l : length (imap f l) = length l.
+  Proof. revert f. induction l; simpl; eauto. Qed.
+
+  Lemma elem_of_lookup_imap_1 l x :
+    x ∈ imap f l → ∃ i y, x = f i y ∧ l !! i = Some y.
+  Proof.
+    intros [i Hin]%elem_of_list_lookup. rewrite list_lookup_imap in Hin.
+    simplify_option_eq; naive_solver.
+  Qed.
+  Lemma elem_of_lookup_imap_2 l x i : l !! i = Some x → f i x ∈ imap f l.
+  Proof.
+    intros Hl. rewrite elem_of_list_lookup.
+    exists i. by rewrite list_lookup_imap, Hl.
+  Qed.
+  Lemma elem_of_lookup_imap l x :
+    x ∈ imap f l ↔ ∃ i y, x = f i y ∧ l !! i = Some y.
+  Proof. naive_solver eauto using elem_of_lookup_imap_1, elem_of_lookup_imap_2. Qed.
+End imap.
+
+(** ** Properties of the [permutations] function *)
+Section permutations.
+  Context {A : Type}.
+  Implicit Types x y z : A.
+  Implicit Types l : list A.
+
+  Lemma interleave_cons x l : x :: l ∈ interleave x l.
+  Proof. destruct l; simpl; rewrite elem_of_cons; auto. Qed.
+  Lemma interleave_Permutation x l l' : l' ∈ interleave x l → l' ≡ₚ x :: l.
+  Proof.
+    revert l'. induction l as [|y l IH]; intros l'; simpl.
+    - rewrite elem_of_list_singleton. by intros ->.
+    - rewrite elem_of_cons, elem_of_list_fmap. intros [->|[? [-> H]]]; [done|].
+      rewrite (IH _ H). constructor.
+  Qed.
+  Lemma permutations_refl l : l ∈ permutations l.
+  Proof.
+    induction l; simpl; [by apply elem_of_list_singleton|].
+    apply elem_of_list_bind. eauto using interleave_cons.
+  Qed.
+  Lemma permutations_skip x l l' :
+    l ∈ permutations l' → x :: l ∈ permutations (x :: l').
+  Proof. intro. apply elem_of_list_bind; eauto using interleave_cons. Qed.
+  Lemma permutations_swap x y l : y :: x :: l ∈ permutations (x :: y :: l).
+  Proof.
+    simpl. apply elem_of_list_bind. exists (y :: l). split; simpl.
+    - destruct l; csimpl; rewrite !elem_of_cons; auto.
+    - apply elem_of_list_bind. simpl.
+      eauto using interleave_cons, permutations_refl.
+  Qed.
+  Lemma permutations_nil l : l ∈ permutations [] ↔ l = [].
+  Proof. simpl. by rewrite elem_of_list_singleton. Qed.
+  Lemma interleave_interleave_toggle x1 x2 l1 l2 l3 :
+    l1 ∈ interleave x1 l2 → l2 ∈ interleave x2 l3 → ∃ l4,
+      l1 ∈ interleave x2 l4 ∧ l4 ∈ interleave x1 l3.
+  Proof.
+    revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl.
+    { rewrite !elem_of_list_singleton. intros ? ->. exists [x1].
+      change (interleave x2 [x1]) with ([[x2; x1]] ++ [[x1; x2]]).
+      by rewrite (comm (++)), elem_of_list_singleton. }
+    rewrite elem_of_cons, elem_of_list_fmap.
+    intros Hl1 [? | [l2' [??]]]; simplify_eq/=.
+    - rewrite !elem_of_cons, elem_of_list_fmap in Hl1.
+      destruct Hl1 as [? | [? | [l4 [??]]]]; subst.
+      + exists (x1 :: y :: l3). csimpl. rewrite !elem_of_cons. tauto.
+      + exists (x1 :: y :: l3). csimpl. rewrite !elem_of_cons. tauto.
+      + exists l4. simpl. rewrite elem_of_cons. auto using interleave_cons.
+    - rewrite elem_of_cons, elem_of_list_fmap in Hl1.
+      destruct Hl1 as [? | [l1' [??]]]; subst.
+      + exists (x1 :: y :: l3). csimpl.
+        rewrite !elem_of_cons, !elem_of_list_fmap.
+        split; [| by auto]. right. right. exists (y :: l2').
+        rewrite elem_of_list_fmap. naive_solver.
+      + destruct (IH l1' l2') as [l4 [??]]; auto. exists (y :: l4). simpl.
+        rewrite !elem_of_cons, !elem_of_list_fmap. naive_solver.
+  Qed.
+  Lemma permutations_interleave_toggle x l1 l2 l3 :
+    l1 ∈ permutations l2 → l2 ∈ interleave x l3 → ∃ l4,
+      l1 ∈ interleave x l4 ∧ l4 ∈ permutations l3.
+  Proof.
+    revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl.
+    { rewrite elem_of_list_singleton. intros Hl1 ->. eexists [].
+      by rewrite elem_of_list_singleton. }
+    rewrite elem_of_cons, elem_of_list_fmap.
+    intros Hl1 [? | [l2' [? Hl2']]]; simplify_eq/=.
+    - rewrite elem_of_list_bind in Hl1.
+      destruct Hl1 as [l1' [??]]. by exists l1'.
+    - rewrite elem_of_list_bind in Hl1. setoid_rewrite elem_of_list_bind.
+      destruct Hl1 as [l1' [??]]. destruct (IH l1' l2') as (l1''&?&?); auto.
+      destruct (interleave_interleave_toggle y x l1 l1' l1'') as (?&?&?); eauto.
+  Qed.
+  Lemma permutations_trans l1 l2 l3 :
+    l1 ∈ permutations l2 → l2 ∈ permutations l3 → l1 ∈ permutations l3.
+  Proof.
+    revert l1 l2. induction l3 as [|x l3 IH]; intros l1 l2; simpl.
+    - rewrite !elem_of_list_singleton. intros Hl1 ->; simpl in *.
+      by rewrite elem_of_list_singleton in Hl1.
+    - rewrite !elem_of_list_bind. intros Hl1 [l2' [Hl2 Hl2']].
+      destruct (permutations_interleave_toggle x l1 l2 l2') as [? [??]]; eauto.
+  Qed.
+  Lemma permutations_Permutation l l' : l' ∈ permutations l ↔ l ≡ₚ l'.
+  Proof.
+    split.
+    - revert l'. induction l; simpl; intros l''.
+      + rewrite elem_of_list_singleton. by intros ->.
+      + rewrite elem_of_list_bind. intros [l' [Hl'' ?]].
+        rewrite (interleave_Permutation _ _ _ Hl''). constructor; auto.
+    - induction 1; eauto using permutations_refl,
+        permutations_skip, permutations_swap, permutations_trans.
+  Qed.
+End permutations.
+
+(** ** Properties of the folding functions *)
+(** Note that [foldr] has much better support, so when in doubt, it should be
+preferred over [foldl]. *)
+Definition foldr_app := @fold_right_app.
+
+Lemma foldr_cons {A B} (f : B → A → A) (a : A) l x :
+  foldr f a (x :: l) = f x (foldr f a l).
+Proof. done. Qed.
+Lemma foldr_snoc {A B} (f : B → A → A) (a : A) l x :
+  foldr f a (l ++ [x]) = foldr f (f x a) l.
+Proof. rewrite foldr_app. done. Qed.
+
+Lemma foldr_fmap {A B C} (f : B → A → A) x (l : list C) g :
+  foldr f x (g <$> l) = foldr (λ b a, f (g b) a) x l.
+Proof. induction l; f_equal/=; auto. Qed.
+Lemma foldr_ext {A B} (f1 f2 : B → A → A) x1 x2 l1 l2 :
+  (∀ b a, f1 b a = f2 b a) → l1 = l2 → x1 = x2 → foldr f1 x1 l1 = foldr f2 x2 l2.
+Proof. intros Hf -> ->. induction l2 as [|x l2 IH]; f_equal/=; by rewrite Hf, IH. Qed.
+
+Lemma foldr_permutation {A B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (b : B) `{Hf : !∀ x, Proper (R ==> R) (f x)} (l1 l2 : list A) :
+  (∀ j1 a1 j2 a2 b,
+    j1 ≠ j2 → l1 !! j1 = Some a1 → l1 !! j2 = Some a2 →
+    R (f a1 (f a2 b)) (f a2 (f a1 b))) →
+  l1 ≡ₚ l2 → R (foldr f b l1) (foldr f b l2).
+Proof.
+  intros Hf'. induction 1 as [|x l1 l2 _ IH|x y l|l1 l2 l3 Hl12 IH _ IH']; simpl.
+  - done.
+  - apply Hf, IH; eauto.
+  - apply (Hf' 0 _ 1); eauto.
+  - etrans; [eapply IH, Hf'|].
+    apply IH'; intros j1 a1 j2 a2 b' ???.
+    symmetry in Hl12; apply Permutation_inj in Hl12 as [_ (g&?&Hg)].
+    apply (Hf' (g j1) _ (g j2)); [naive_solver|by rewrite <-Hg..].
+Qed.
+
+Lemma foldr_permutation_proper {A B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (b : B) `{!∀ x, Proper (R ==> R) (f x)}
+    (Hf : ∀ a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) :
+  Proper ((≡ₚ) ==> R) (foldr f b).
+Proof. intros l1 l2 Hl. apply foldr_permutation; auto. Qed.
+Global Instance foldr_permutation_proper' {A} (R : relation A) `{!PreOrder R}
+    (f : A → A → A) (a : A) `{!∀ a, Proper (R ==> R) (f a), !Assoc R f, !Comm R f} :
+  Proper ((≡ₚ) ==> R) (foldr f a).
+Proof.
+  apply (foldr_permutation_proper R f); [solve_proper|].
+  assert (Proper (R ==> R ==> R) f).
+  { intros a1 a2 Ha b1 b2 Hb. by rewrite Hb, (comm f a1), Ha, (comm f). }
+  intros a1 a2 b.
+  by rewrite (assoc f), (comm f _ b), (assoc f), (comm f b), (comm f _ a2).
+Qed.
+
+Lemma foldr_cons_permute_strong {A B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (b : B) `{!∀ a, Proper (R ==> R) (f a)} x l :
+  (∀ j1 a1 j2 a2 b,
+    j1 ≠ j2 → (x :: l) !! j1 = Some a1 → (x :: l) !! j2 = Some a2 →
+    R (f a1 (f a2 b)) (f a2 (f a1 b))) →
+  R (foldr f b (x :: l)) (foldr f (f x b) l).
+Proof.
+  intros. rewrite <-foldr_snoc.
+  apply (foldr_permutation _ f b); [done|]. by rewrite Permutation_app_comm.
+Qed.
+Lemma foldr_cons_permute {A} (f : A → A → A) (a : A) x l :
+  Assoc (=) f →
+  Comm (=) f →
+  foldr f a (x :: l) = foldr f (f x a) l.
+Proof.
+  intros. apply (foldr_cons_permute_strong (=) f a).
+  intros j1 a1 j2 a2 b _ _ _. by rewrite !(assoc_L f), (comm_L f a1).
+Qed.
+
+(** The following lemma shows that folding over a list twice (using the result
+of the first fold as input for the second fold) is equivalent to folding over
+the list once, *if* the function is idempotent for the elements of the list
+and does not care about the order in which elements are processed. *)
+Lemma foldr_idemp_strong {A B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (b : B) `{!∀ x, Proper (R ==> R) (f x)} (l : list A) :
+  (∀ j a b,
+    (** This is morally idempotence for elements of [l] *)
+    l !! j = Some a →
+    R (f a (f a b)) (f a b)) →
+  (∀ j1 a1 j2 a2 b,
+    (** This is morally commutativity + associativity for elements of [l] *)
+    j1 ≠ j2 → l !! j1 = Some a1 → l !! j2 = Some a2 →
+    R (f a1 (f a2 b)) (f a2 (f a1 b))) →
+  R (foldr f (foldr f b l) l) (foldr f b l).
+Proof.
+  intros Hfidem Hfcomm. induction l as [|x l IH]; simpl; [done|].
+  trans (f x (f x (foldr f (foldr f b l) l))).
+  { f_equiv. rewrite <-foldr_snoc, <-foldr_cons.
+    apply (foldr_permutation (flip R) f).
+    - solve_proper.
+    - intros j1 a1 j2 a2 b' ???. by apply (Hfcomm j2 _ j1).
+    - by rewrite <-Permutation_cons_append. }
+  rewrite <-foldr_cons.
+  trans (f x (f x (foldr f b l))); [|by apply (Hfidem 0)].
+  simpl. do 2 f_equiv. apply IH.
+  - intros j a b' ?. by apply (Hfidem (S j)).
+  - intros j1 a1 j2 a2 b' ???. apply (Hfcomm (S j1) _ (S j2)); auto with lia.
+Qed.
+Lemma foldr_idemp {A} (f : A → A → A) (a : A) (l : list A) :
+  IdemP (=) f →
+  Assoc (=) f →
+  Comm (=) f →
+  foldr f (foldr f a l) l = foldr f a l.
+Proof.
+  intros. apply (foldr_idemp_strong (=) f a).
+  - intros j a1 a2 _. by rewrite (assoc_L f), (idemp f).
+  - intros x1 a1 x2 a2 a3 _ _ _. by rewrite !(assoc_L f), (comm_L f a1).
+Qed.
+
+Lemma foldr_comm_acc_strong {A B} (R : relation B) `{!PreOrder R}
+    (f : A → B → B) (g : B → B) b l :
+  (∀ x, Proper (R ==> R) (f x)) →
+  (∀ x y, x ∈ l → R (f x (g y)) (g (f x y))) →
+  R (foldr f (g b) l) (g (foldr f b l)).
+Proof.
+  intros ? Hcomm. induction l as [|x l IH]; simpl; [done|].
+  rewrite <-Hcomm by eauto using elem_of_list_here.
+  by rewrite IH by eauto using elem_of_list_further.
+Qed.
+Lemma foldr_comm_acc {A B} (f : A → B → B) (g : B → B) (b : B) l :
+  (∀ x y, f x (g y) = g (f x y)) →
+  foldr f (g b) l = g (foldr f b l).
+Proof. intros. apply (foldr_comm_acc_strong _); [solve_proper|done]. Qed.
+
+Lemma foldl_app {A B} (f : A → B → A) (l k : list B) (a : A) :
+  foldl f a (l ++ k) = foldl f (foldl f a l) k.
+Proof. revert a. induction l; simpl; auto. Qed.
+Lemma foldl_snoc {A B} (f : A → B → A) (a : A) l x :
+  foldl f a (l ++ [x]) = f (foldl f a l) x.
+Proof. rewrite foldl_app. done. Qed.
+Lemma foldl_fmap {A B C} (f : A → B → A) x (l : list C) g :
+  foldl f x (g <$> l) = foldl (λ a b, f a (g b)) x l.
+Proof. revert x. induction l; f_equal/=; auto. Qed.
+
+(** ** Properties of the [zip_with] and [zip] functions *)
+Global Instance zip_with_proper `{!Equiv A, !Equiv B, !Equiv C} :
+  Proper (((≡) ==> (≡) ==> (≡)) ==>
+          (≡@{list A}) ==> (≡@{list B}) ==> (≡@{list C})) zip_with.
+Proof.
+  intros f1 f2 Hf. induction 1; destruct 1; simpl; [constructor..|].
+  f_equiv; [|by auto]. by apply Hf.
+Qed.
+
+Section zip_with.
+  Context {A B C : Type} (f : A → B → C).
+  Implicit Types x : A.
+  Implicit Types y : B.
+  Implicit Types l : list A.
+  Implicit Types k : list B.
+
+  Lemma zip_with_nil_r l : zip_with f l [] = [].
+  Proof. by destruct l. Qed.
+  Lemma zip_with_app l1 l2 k1 k2 :
+    length l1 = length k1 →
+    zip_with f (l1 ++ l2) (k1 ++ k2) = zip_with f l1 k1 ++ zip_with f l2 k2.
+  Proof. rewrite <-Forall2_same_length. induction 1; f_equal/=; auto. Qed.
+  Lemma zip_with_app_l l1 l2 k :
+    zip_with f (l1 ++ l2) k
+    = zip_with f l1 (take (length l1) k) ++ zip_with f l2 (drop (length l1) k).
+  Proof.
+    revert k. induction l1; intros [|??]; f_equal/=; auto. by destruct l2.
+  Qed.
+  Lemma zip_with_app_r l k1 k2 :
+    zip_with f l (k1 ++ k2)
+    = zip_with f (take (length k1) l) k1 ++ zip_with f (drop (length k1) l) k2.
+  Proof. revert l. induction k1; intros [|??]; f_equal/=; auto. Qed.
+  Lemma zip_with_flip l k : zip_with (flip f) k l = zip_with f l k.
+  Proof. revert k. induction l; intros [|??]; f_equal/=; auto. Qed.
+  Lemma zip_with_ext (g : A → B → C) l1 l2 k1 k2 :
+    (∀ x y, f x y = g x y) → l1 = l2 → k1 = k2 →
+    zip_with f l1 k1 = zip_with g l2 k2.
+  Proof. intros ? <-<-. revert k1. by induction l1; intros [|??]; f_equal/=. Qed.
+  Lemma Forall_zip_with_ext_l (g : A → B → C) l k1 k2 :
+    Forall (λ x, ∀ y, f x y = g x y) l → k1 = k2 →
+    zip_with f l k1 = zip_with g l k2.
+  Proof. intros Hl <-. revert k1. by induction Hl; intros [|??]; f_equal/=. Qed.
+  Lemma Forall_zip_with_ext_r (g : A → B → C) l1 l2 k :
+    l1 = l2 → Forall (λ y, ∀ x, f x y = g x y) k →
+    zip_with f l1 k = zip_with g l2 k.
+  Proof. intros <- Hk. revert l1. by induction Hk; intros [|??]; f_equal/=. Qed.
+  Lemma zip_with_fmap_l {D} (g : D → A) lD k :
+    zip_with f (g <$> lD) k = zip_with (λ z, f (g z)) lD k.
+  Proof. revert k. by induction lD; intros [|??]; f_equal/=. Qed.
+  Lemma zip_with_fmap_r {D} (g : D → B) l kD :
+    zip_with f l (g <$> kD) = zip_with (λ x z, f x (g z)) l kD.
+  Proof. revert kD. by induction l; intros [|??]; f_equal/=. Qed.
+  Lemma zip_with_nil_inv l k : zip_with f l k = [] → l = [] ∨ k = [].
+  Proof. destruct l, k; intros; simplify_eq/=; auto. Qed.
+  Lemma zip_with_cons_inv l k z lC :
+    zip_with f l k = z :: lC →
+    ∃ x y l' k', z = f x y ∧ lC = zip_with f l' k' ∧ l = x :: l' ∧ k = y :: k'.
+  Proof. intros. destruct l, k; simplify_eq/=; repeat eexists. Qed.
+  Lemma zip_with_app_inv l k lC1 lC2 :
+    zip_with f l k = lC1 ++ lC2 →
+    ∃ l1 k1 l2 k2, lC1 = zip_with f l1 k1 ∧ lC2 = zip_with f l2 k2 ∧
+      l = l1 ++ l2 ∧ k = k1 ++ k2 ∧ length l1 = length k1.
+  Proof.
+    revert l k. induction lC1 as [|z lC1 IH]; simpl.
+    { intros l k ?. by eexists [], [], l, k. }
+    intros [|x l] [|y k] ?; simplify_eq/=.
+    destruct (IH l k) as (l1&k1&l2&k2&->&->&->&->&?); [done |].
+    exists (x :: l1), (y :: k1), l2, k2; simpl; auto with congruence.
+  Qed.
+  Lemma zip_with_inj `{!Inj2 (=) (=) (=) f} l1 l2 k1 k2 :
+    length l1 = length k1 → length l2 = length k2 →
+    zip_with f l1 k1 = zip_with f l2 k2 → l1 = l2 ∧ k1 = k2.
+  Proof.
+    rewrite <-!Forall2_same_length. intros Hl. revert l2 k2.
+    induction Hl; intros ?? [] ?; f_equal; naive_solver.
+  Qed.
+  Lemma length_zip_with l k :
+    length (zip_with f l k) = min (length l) (length k).
+  Proof. revert k. induction l; intros [|??]; simpl; auto with lia. Qed.
+  Lemma length_zip_with_l l k :
+    length l ≤ length k → length (zip_with f l k) = length l.
+  Proof. rewrite length_zip_with; lia. Qed.
+  Lemma length_zip_with_l_eq l k :
+    length l = length k → length (zip_with f l k) = length l.
+  Proof. rewrite length_zip_with; lia. Qed.
+  Lemma length_zip_with_r l k :
+    length k ≤ length l → length (zip_with f l k) = length k.
+  Proof. rewrite length_zip_with; lia. Qed.
+  Lemma length_zip_with_r_eq l k :
+    length k = length l → length (zip_with f l k) = length k.
+  Proof. rewrite length_zip_with; lia. Qed.
+  Lemma length_zip_with_same_l P l k :
+    Forall2 P l k → length (zip_with f l k) = length l.
+  Proof. induction 1; simpl; auto. Qed.
+  Lemma length_zip_with_same_r P l k :
+    Forall2 P l k → length (zip_with f l k) = length k.
+  Proof. induction 1; simpl; auto. Qed.
+  Lemma lookup_zip_with l k i :
+    zip_with f l k !! i = (x ← l !! i; y ← k !! i; Some (f x y)).
+  Proof.
+    revert k i. induction l; intros [|??] [|?]; f_equal/=; auto.
+    by destruct (_ !! _).
+  Qed.
+  Lemma lookup_total_zip_with `{!Inhabited A, !Inhabited B, !Inhabited C} l k i :
+    i < length l → i < length k → zip_with f l k !!! i = f (l !!! i) (k !!! i).
+  Proof.
+    intros [x Hx]%lookup_lt_is_Some_2 [y Hy]%lookup_lt_is_Some_2.
+    by rewrite !list_lookup_total_alt, lookup_zip_with, Hx, Hy.
+  Qed.
+  Lemma lookup_zip_with_Some l k i z :
+    zip_with f l k !! i = Some z
+    ↔ ∃ x y, z = f x y ∧ l !! i = Some x ∧ k !! i = Some y.
+  Proof. rewrite lookup_zip_with. destruct (l !! i), (k !! i); naive_solver. Qed.
+  Lemma lookup_zip_with_None l k i  :
+    zip_with f l k !! i = None
+    ↔ l !! i = None ∨ k !! i = None.
+  Proof. rewrite lookup_zip_with. destruct (l !! i), (k !! i); naive_solver. Qed.
+  Lemma insert_zip_with l k i x y :
+    <[i:=f x y]>(zip_with f l k) = zip_with f (<[i:=x]>l) (<[i:=y]>k).
+  Proof. revert i k. induction l; intros [|?] [|??]; f_equal/=; auto. Qed.
+  Lemma fmap_zip_with_l (g : C → A) l k :
+    (∀ x y, g (f x y) = x) → length l ≤ length k → g <$> zip_with f l k = l.
+  Proof. revert k. induction l; intros [|??] ??; f_equal/=; auto with lia. Qed.
+  Lemma fmap_zip_with_r (g : C → B) l k :
+    (∀ x y, g (f x y) = y) → length k ≤ length l → g <$> zip_with f l k = k.
+  Proof. revert l. induction k; intros [|??] ??; f_equal/=; auto with lia. Qed.
+  Lemma zip_with_zip l k : zip_with f l k = uncurry f <$> zip l k.
+  Proof. revert k. by induction l; intros [|??]; f_equal/=. Qed.
+  Lemma zip_with_fst_snd lk : zip_with f (lk.*1) (lk.*2) = uncurry f <$> lk.
+  Proof. by induction lk as [|[]]; f_equal/=. Qed.
+  Lemma zip_with_replicate n x y :
+    zip_with f (replicate n x) (replicate n y) = replicate n (f x y).
+  Proof. by induction n; f_equal/=. Qed.
+  Lemma zip_with_replicate_l n x k :
+    length k ≤ n → zip_with f (replicate n x) k = f x <$> k.
+  Proof. revert n. induction k; intros [|?] ?; f_equal/=; auto with lia. Qed.
+  Lemma zip_with_replicate_r n y l :
+    length l ≤ n → zip_with f l (replicate n y) = flip f y <$> l.
+  Proof. revert n. induction l; intros [|?] ?; f_equal/=; auto with lia. Qed.
+  Lemma zip_with_replicate_r_eq n y l :
+    length l = n → zip_with f l (replicate n y) = flip f y <$> l.
+  Proof. intros; apply zip_with_replicate_r; lia. Qed.
+  Lemma zip_with_take n l k :
+    take n (zip_with f l k) = zip_with f (take n l) (take n k).
+  Proof. revert n k. by induction l; intros [|?] [|??]; f_equal/=. Qed.
+  Lemma zip_with_drop n l k :
+    drop n (zip_with f l k) = zip_with f (drop n l) (drop n k).
+  Proof.
+    revert n k. induction l; intros [] []; f_equal/=; auto using zip_with_nil_r.
+  Qed.
+  Lemma zip_with_take_l' n l k :
+    length l `min` length k ≤ n → zip_with f (take n l) k = zip_with f l k.
+  Proof. revert n k. induction l; intros [] [] ?; f_equal/=; auto with lia. Qed.
+  Lemma zip_with_take_l l k :
+    zip_with f (take (length k) l) k = zip_with f l k.
+  Proof. apply zip_with_take_l'; lia. Qed.
+  Lemma zip_with_take_r' n l k :
+    length l `min` length k ≤ n → zip_with f l (take n k) = zip_with f l k.
+  Proof. revert n k. induction l; intros [] [] ?; f_equal/=; auto with lia. Qed.
+  Lemma zip_with_take_r l k :
+    zip_with f l (take (length l) k) = zip_with f l k.
+  Proof. apply zip_with_take_r'; lia. Qed.
+  Lemma zip_with_take_both' n1 n2 l k :
+    length l `min` length k ≤ n1 → length l `min` length k ≤ n2 →
+    zip_with f (take n1 l) (take n2 k) = zip_with f l k.
+  Proof.
+    intros.
+    rewrite zip_with_take_l'; [apply zip_with_take_r' | rewrite length_take]; lia.
+  Qed.
+  Lemma zip_with_take_both l k :
+    zip_with f (take (length k) l) (take (length l) k) = zip_with f l k.
+  Proof. apply zip_with_take_both'; lia. Qed.
+  Lemma Forall_zip_with_fst (P : A → Prop) (Q : C → Prop) l k :
+    Forall P l → Forall (λ y, ∀ x, P x → Q (f x y)) k →
+    Forall Q (zip_with f l k).
+  Proof. intros Hl. revert k. induction Hl; destruct 1; simpl in *; auto. Qed.
+  Lemma Forall_zip_with_snd (P : B → Prop) (Q : C → Prop) l k :
+    Forall (λ x, ∀ y, P y → Q (f x y)) l → Forall P k →
+    Forall Q (zip_with f l k).
+  Proof. intros Hl. revert k. induction Hl; destruct 1; simpl in *; auto. Qed.
+
+  Lemma elem_of_lookup_zip_with_1 l k (z : C) :
+    z ∈ zip_with f l k → ∃ i x y, z = f x y ∧ l !! i = Some x ∧ k !! i = Some y.
+  Proof.
+    intros [i Hin]%elem_of_list_lookup. rewrite lookup_zip_with in Hin.
+    simplify_option_eq; naive_solver.
+  Qed.
+
+  Lemma elem_of_lookup_zip_with_2 l k x y (z : C) i :
+    l !! i = Some x → k !! i = Some y → f x y ∈ zip_with f l k.
+  Proof.
+    intros Hl Hk. rewrite elem_of_list_lookup.
+    exists i. by rewrite lookup_zip_with, Hl, Hk.
+  Qed.
+
+  Lemma elem_of_lookup_zip_with l k (z : C) :
+    z ∈ zip_with f l k ↔ ∃ i x y, z = f x y ∧ l !! i = Some x ∧ k !! i = Some y.
+  Proof.
+    naive_solver eauto using
+                 elem_of_lookup_zip_with_1, elem_of_lookup_zip_with_2.
+  Qed.
+
+  Lemma elem_of_zip_with l k (z : C) :
+    z ∈ zip_with f l k → ∃ x y, z = f x y ∧ x ∈ l ∧ y ∈ k.
+  Proof.
+    intros ?%elem_of_lookup_zip_with.
+    naive_solver eauto using elem_of_list_lookup_2.
+  Qed.
+
+End zip_with.
+
+Lemma zip_with_diag {A C} (f : A → A → C) l :
+  zip_with f l l = (λ x, f x x) <$> l.
+Proof. induction l as [|?? IH]; [done|]. simpl. rewrite IH. done. Qed.
+
+Section zip.
+  Context {A B : Type}.
+  Implicit Types l : list A.
+  Implicit Types k : list B.
+
+  Lemma fst_zip l k : length l ≤ length k → (zip l k).*1 = l.
+  Proof. by apply fmap_zip_with_l. Qed.
+  Lemma snd_zip l k : length k ≤ length l → (zip l k).*2 = k.
+  Proof. by apply fmap_zip_with_r. Qed.
+  Lemma zip_fst_snd (lk : list (A * B)) : zip (lk.*1) (lk.*2) = lk.
+  Proof. by induction lk as [|[]]; f_equal/=. Qed.
+  Lemma Forall2_fst P l1 l2 k1 k2 :
+    length l2 = length k2 → Forall2 P l1 k1 →
+    Forall2 (λ x y, P (x.1) (y.1)) (zip l1 l2) (zip k1 k2).
+  Proof.
+    rewrite <-Forall2_same_length. intros Hlk2 Hlk1. revert l2 k2 Hlk2.
+    induction Hlk1; intros ?? [|??????]; simpl; auto.
+  Qed.
+  Lemma Forall2_snd P l1 l2 k1 k2 :
+    length l1 = length k1 → Forall2 P l2 k2 →
+    Forall2 (λ x y, P (x.2) (y.2)) (zip l1 l2) (zip k1 k2).
+  Proof.
+    rewrite <-Forall2_same_length. intros Hlk1 Hlk2. revert l1 k1 Hlk1.
+    induction Hlk2; intros ?? [|??????]; simpl; auto.
+  Qed.
+
+  Lemma elem_of_zip_l x1 x2 l k :
+    (x1, x2) ∈ zip l k → x1 ∈ l.
+  Proof. intros ?%elem_of_zip_with. naive_solver. Qed.
+  Lemma elem_of_zip_r x1 x2 l k :
+    (x1, x2) ∈ zip l k → x2 ∈ k.
+  Proof. intros ?%elem_of_zip_with. naive_solver. Qed.
+  Lemma length_zip l k :
+    length (zip l k) = min (length l) (length k).
+  Proof. by rewrite length_zip_with. Qed.
+  Lemma zip_nil_inv l k :
+    zip l k = [] → l = [] ∨ k = [].
+  Proof. intros. by eapply zip_with_nil_inv. Qed.
+  Lemma lookup_zip_Some l k i x y :
+    zip l k !! i = Some (x, y) ↔ l !! i = Some x ∧ k !! i = Some y.
+  Proof. rewrite lookup_zip_with_Some. naive_solver. Qed.
+  Lemma lookup_zip_None l k i :
+    zip l k !! i = None ↔ l !! i = None ∨ k !! i = None.
+  Proof. by rewrite lookup_zip_with_None. Qed.
+End zip.
+
+Lemma zip_diag {A} (l : list A) :
+  zip l l = (λ x, (x, x)) <$> l.
+Proof. apply zip_with_diag. Qed.
+
+Lemma elem_of_zipped_map {A B} (f : list A → list A → A → B) l k x :
+  x ∈ zipped_map f l k ↔
+    ∃ k' k'' y, k = k' ++ [y] ++ k'' ∧ x = f (reverse k' ++ l) k'' y.
+Proof.
+  split.
+  - revert l. induction k as [|z k IH]; simpl; intros l; inv 1.
+    { by eexists [], k, z. }
+    destruct (IH (z :: l)) as (k'&k''&y&->&->); [done |].
+    eexists (z :: k'), k'', y. by rewrite reverse_cons, <-(assoc_L (++)).
+  - intros (k'&k''&y&->&->). revert l. induction k' as [|z k' IH]; [by left|].
+    intros l; right. by rewrite reverse_cons, <-!(assoc_L (++)).
+Qed.
+Section zipped_list_ind.
+  Context {A} (P : list A → list A → Prop).
+  Context (Pnil : ∀ l, P l []) (Pcons : ∀ l k x, P (x :: l) k → P l (x :: k)).
+  Fixpoint zipped_list_ind l k : P l k :=
+    match k with
+    | [] => Pnil _ | x :: k => Pcons _ _ _ (zipped_list_ind (x :: l) k)
+    end.
+End zipped_list_ind.
+Lemma zipped_Forall_app {A} (P : list A → list A → A → Prop) l k k' :
+  zipped_Forall P l (k ++ k') → zipped_Forall P (reverse k ++ l) k'.
+Proof.
+  revert l. induction k as [|x k IH]; simpl; [done |].
+  inv 1. rewrite reverse_cons, <-(assoc_L (++)). by apply IH.
+Qed.

theories/list_numbers.v → stdpp/list_numbers.v

 (** This file collects general purpose definitions and theorems on
 lists of numbers that are not in the Coq standard library. *)
-From stdpp Require Export list.
+From stdpp Require Export list_basics list_monad list_misc list_tactics.
 From stdpp Require Import options.
 
 (** * Definitions *)
@@ -51,6 +51,12 @@ Fixpoint little_endian_to_Z (n : Z) (bs : list Z) : Z :=
 Section seq.
   Implicit Types m n i j : nat.
 
+  (* TODO: Coq 8.20 has the same lemma under the same name, so remove our version
+  once we require Coq 8.20. In Coq 8.19 and before, this lemma is called
+  [seq_length]. *)
+  Lemma length_seq m n : length (seq m n) = n.
+  Proof. revert m. induction n; intros; f_equal/=; auto. Qed.
+
   Lemma fmap_add_seq j j' n : Nat.add j <$> seq j' n = seq (j + j') n.
   Proof.
     revert j'. induction n as [|n IH]; intros j'; csimpl; [reflexivity|].
@@ -87,26 +93,44 @@ Section seq.
   Qed.
   Lemma NoDup_seq j n : NoDup (seq j n).
   Proof. apply NoDup_ListNoDup, seq_NoDup. Qed.
-  (* FIXME: This lemma is in the stdlib since Coq 8.12 *)
-  Lemma seq_S n j : seq j (S n) = seq j n ++ [j + n].
-  Proof.
-    revert j. induction n as [|n IH]; intros j; f_equal/=; [done |].
-    by rewrite IH, Nat.add_succ_r.
-  Qed.
 
   Lemma elem_of_seq j n k :
     k ∈ seq j n ↔ j ≤ k < j + n.
   Proof. rewrite elem_of_list_In, in_seq. done. Qed.
 
+  Lemma seq_nil n m : seq n m = [] ↔ m = 0.
+  Proof. by destruct m. Qed.
+
+  Lemma seq_subseteq_mono m n1 n2 : n1 ≤ n2 → seq m n1 ⊆ seq m n2.
+  Proof. by intros Hle i Hi%elem_of_seq; apply elem_of_seq; lia. Qed.
+
   Lemma Forall_seq (P : nat → Prop) i n :
     Forall P (seq i n) ↔ ∀ j, i ≤ j < i + n → P j.
   Proof. rewrite Forall_forall. setoid_rewrite elem_of_seq. auto with lia. Qed.
+
+  Lemma drop_seq j n m :
+    drop m (seq j n) = seq (j + m) (n - m).
+  Proof.
+    revert j m. induction n as [|n IH]; simpl; intros j m.
+    - rewrite drop_nil. done.
+    - destruct m; simpl.
+      + rewrite Nat.add_0_r. done.
+      + rewrite IH. f_equal; lia.
+  Qed.
+  Lemma take_seq j n m :
+    take m (seq j n) = seq j (m `min` n).
+  Proof.
+    revert j m. induction n as [|n IH]; simpl; intros j m.
+    - rewrite take_nil. replace (m `min` 0) with 0 by lia. done.
+    - destruct m; simpl; auto with f_equal.
+  Qed.
+
 End seq.
 
 (** ** Properties of the [seqZ] function *)
 Section seqZ.
   Implicit Types (m n : Z) (i j : nat).
-  Local Open Scope Z.
+  Local Open Scope Z_scope.
 
   Lemma seqZ_nil m n : n ≤ 0 → seqZ m n = [].
   Proof. by destruct n. Qed.
@@ -117,11 +141,11 @@ Section seqZ.
     rewrite <-fmap_S_seq, <-list_fmap_compose.
     apply map_ext; naive_solver lia.
   Qed.
-  Lemma seqZ_length m n : length (seqZ m n) = Z.to_nat n.
-  Proof. unfold seqZ; by rewrite fmap_length, seq_length. Qed.
+  Lemma length_seqZ m n : length (seqZ m n) = Z.to_nat n.
+  Proof. unfold seqZ; by rewrite length_fmap, length_seq. Qed.
   Lemma fmap_add_seqZ m m' n : Z.add m <$> seqZ m' n = seqZ (m + m') n.
   Proof.
-    revert m'. induction n as [|n ? IH|] using (Z_succ_pred_induction 0); intros m'.
+    revert m'. induction n as [|n ? IH|] using (Z.succ_pred_induction 0); intros m'.
     - by rewrite seqZ_nil.
     - rewrite (seqZ_cons m') by lia. rewrite (seqZ_cons (m + m')) by lia.
       f_equal/=. rewrite Z.pred_succ, IH; simpl. f_equal; lia.
@@ -129,7 +153,7 @@ Section seqZ.
   Qed.
   Lemma lookup_seqZ_lt m n i : Z.of_nat i < n → seqZ m n !! i = Some (m + Z.of_nat i).
   Proof.
-    revert m i. induction n as [|n ? IH|] using (Z_succ_pred_induction 0);
+    revert m i. induction n as [|n ? IH|] using (Z.succ_pred_induction 0);
       intros m i Hi; [lia| |lia].
     rewrite seqZ_cons by lia. destruct i as [|i]; simpl.
     - f_equal; lia.
@@ -140,7 +164,7 @@ Section seqZ.
   Lemma lookup_seqZ_ge m n i : n ≤ Z.of_nat i → seqZ m n !! i = None.
   Proof.
     revert m i.
-    induction n as [|n ? IH|] using (Z_succ_pred_induction 0); intros m i Hi; try lia.
+    induction n as [|n ? IH|] using (Z.succ_pred_induction 0); intros m i Hi; try lia.
     - by rewrite seqZ_nil.
     - rewrite seqZ_cons by lia.
       destruct i as [|i]; simpl; [lia|]. by rewrite Z.pred_succ, IH by lia.
@@ -164,7 +188,7 @@ Section seqZ.
   Proof.
     intros. unfold seqZ. rewrite Z2Nat.inj_add, seq_app, fmap_app by done.
     f_equal. rewrite Nat.add_comm, <-!fmap_add_seq, <-list_fmap_compose.
-    apply list_fmap_ext; [|done]; intros j; simpl.
+    apply list_fmap_ext; intros j n; simpl.
     rewrite Nat2Z.inj_add, Z2Nat.id by done. lia.
   Qed.
 
@@ -206,12 +230,68 @@ Section sum_list.
     sum_list szs = length l → mjoin (reshape szs l) = l.
   Proof.
     revert l. induction szs as [|sz szs IH]; simpl; intros l Hl; [by destruct l|].
-    by rewrite IH, take_drop by (rewrite drop_length; lia).
+    by rewrite IH, take_drop by (rewrite length_drop; lia).
   Qed.
   Lemma sum_list_replicate n m : sum_list (replicate m n) = m * n.
   Proof. induction m; simpl; auto. Qed.
+  Lemma sum_list_fmap_same n l f :
+    Forall (λ x, f x = n) l →
+    sum_list (f <$> l) = length l * n.
+  Proof. induction 1; csimpl; lia. Qed.
+  Lemma sum_list_fmap_const l n :
+    sum_list ((λ _, n) <$> l) = length l * n.
+  Proof. by apply sum_list_fmap_same, Forall_true. Qed.
 End sum_list.
 
+(** ** Properties of the [mjoin] function that rely on [sum_list] *)
+Section mjoin.
+  Context {A : Type}.
+  Implicit Types x y z : A.
+  Implicit Types l k : list A.
+  Implicit Types ls : list (list A).
+
+  Lemma length_join ls:
+    length (mjoin ls) = sum_list (length <$> ls).
+  Proof. induction ls; [done|]; csimpl. rewrite length_app. lia. Qed.
+
+  Lemma join_lookup_Some ls i x :
+    mjoin ls !! i = Some x ↔ ∃ j l i', ls !! j = Some l ∧ l !! i' = Some x
+                                     ∧ i = sum_list (length <$> take j ls) + i'.
+  Proof.
+    revert i. induction ls as [|l ls IH]; csimpl; intros i.
+    { setoid_rewrite lookup_nil. naive_solver. }
+    rewrite lookup_app_Some, IH. split.
+    - destruct 1 as [?|(?&?&?&?&?&?&?)].
+      + eexists 0. naive_solver.
+      + eexists (S _); naive_solver lia.
+    - destruct 1 as [[|?] ?]; naive_solver lia.
+  Qed.
+
+  Lemma join_lookup_Some_same_length n ls i x :
+    Forall (λ l, length l = n) ls →
+    mjoin ls !! i = Some x ↔ ∃ j l i', ls !! j = Some l ∧ l !! i' = Some x
+                                     ∧ i = j * n + i'.
+  Proof.
+    intros Hl. rewrite join_lookup_Some.
+    f_equiv; intros j. f_equiv; intros l. f_equiv; intros i'.
+    assert (ls !! j = Some l → j < length ls) by eauto using lookup_lt_Some.
+    rewrite (sum_list_fmap_same n), length_take by auto using Forall_take.
+    naive_solver lia.
+  Qed.
+
+  Lemma join_lookup_Some_same_length' n ls j i x :
+    Forall (λ l, length l = n) ls →
+    i < n →
+    mjoin ls !! (j * n + i) = Some x ↔ ∃ l, ls !! j = Some l ∧ l !! i = Some x.
+  Proof.
+    intros. rewrite join_lookup_Some_same_length by done.
+    split; [|naive_solver].
+    destruct 1 as (j'&l'&i'&?&?&Hj); decompose_Forall.
+    assert (i' < length l') by eauto using lookup_lt_Some.
+    apply Nat.mul_split_l in Hj; naive_solver.
+  Qed.
+End mjoin.
+
 (** ** Properties of the [max_list] function *)
 Section max_list.
   Context {A : Type}.
@@ -239,6 +319,9 @@ Section Z_little_endian.
   Local Open Scope Z_scope.
   Implicit Types m n z : Z.
 
+  Lemma Z_to_little_endian_0 n z : Z_to_little_endian 0 n z = [].
+  Proof. done. Qed.
+
   Lemma Z_to_little_endian_succ m n z :
     0 ≤ m →
     Z_to_little_endian (Z.succ m) n z
@@ -248,7 +331,7 @@ Section Z_little_endian.
     by rewrite !iter_nat_of_Z, Zabs2Nat.inj_succ by lia.
   Qed.
 
-  Lemma Z_to_little_endian_to_Z m n bs:
+  Lemma Z_to_little_endian_to_Z m n bs :
     m = Z.of_nat (length bs) → 0 ≤ n →
     Forall (λ b, 0 ≤ b < 2 ^ n) bs →
     Z_to_little_endian m n (little_endian_to_Z n bs) = bs.
@@ -256,71 +339,107 @@ Section Z_little_endian.
     intros -> ?. induction 1 as [|b bs ? ? IH]; [done|]; simpl.
     rewrite Nat2Z.inj_succ, Z_to_little_endian_succ by lia. f_equal.
     - apply Z.bits_inj_iff'. intros z' ?.
-      rewrite !Z.land_spec, Z.lor_spec, Z_ones_spec by lia.
+      rewrite !Z.land_spec, Z.lor_spec, Z.ones_spec by lia.
       case_bool_decide.
       + rewrite andb_true_r, Z.shiftl_spec_low, orb_false_r by lia. done.
       + rewrite andb_false_r.
-        symmetry. eapply (Z_bounded_iff_bits_nonneg n); lia.
+        symmetry. eapply (Z.bounded_iff_bits_nonneg n); lia.
     - rewrite <-IH at 3. f_equal.
       apply Z.bits_inj_iff'. intros z' ?.
       rewrite Z.shiftr_spec, Z.lor_spec, Z.shiftl_spec by lia.
       assert (Z.testbit b (z' + n) = false) as ->.
-      { apply (Z_bounded_iff_bits_nonneg n); lia. }
+      { apply (Z.bounded_iff_bits_nonneg n); lia. }
       rewrite orb_false_l. f_equal. lia.
   Qed.
 
-  (* TODO: replace the calls to [nia] by [lia] after dropping support for Coq 8.10.2. *)
-  Lemma little_endian_to_Z_to_little_endian m n z:
+  Lemma little_endian_to_Z_to_little_endian m n z :
     0 ≤ n → 0 ≤ m →
     little_endian_to_Z n (Z_to_little_endian m n z) = z `mod` 2 ^ (m * n).
   Proof.
-    intros ? Hm. rewrite <-Z.land_ones by nia.
+    intros ? Hm. rewrite <-Z.land_ones by lia.
     revert z.
-    induction m as [|m ? IH|] using (Z_succ_pred_induction 0); intros z; [..|lia].
+    induction m as [|m ? IH|] using (Z.succ_pred_induction 0); intros z; [..|lia].
     { Z.bitwise. by rewrite andb_false_r. }
     rewrite Z_to_little_endian_succ by lia; simpl. rewrite IH by lia.
     apply Z.bits_inj_iff'. intros z' ?.
     rewrite Z.land_spec, Z.lor_spec, Z.shiftl_spec, !Z.land_spec by lia.
-    rewrite (Z_ones_spec n z') by lia. case_bool_decide.
+    rewrite (Z.ones_spec n z') by lia. case_bool_decide.
     - rewrite andb_true_r, (Z.testbit_neg_r _ (z' - n)), orb_false_r by lia. simpl.
-      by rewrite Z_ones_spec, bool_decide_true, andb_true_r by nia.
+      by rewrite Z.ones_spec, bool_decide_true, andb_true_r by lia.
     - rewrite andb_false_r, orb_false_l.
       rewrite Z.shiftr_spec by lia. f_equal; [f_equal; lia|].
-      rewrite !Z_ones_spec by nia. apply bool_decide_iff. lia.
+      rewrite !Z.ones_spec by lia. apply bool_decide_ext. lia.
   Qed.
 
-  Lemma Z_to_little_endian_length m n z :
+  Lemma length_Z_to_little_endian m n z :
     0 ≤ m →
     Z.of_nat (length (Z_to_little_endian m n z)) = m.
   Proof.
     intros. revert z. induction m as [|m ? IH|]
-      using (Z_succ_pred_induction 0); intros z; [done| |lia].
+      using (Z.succ_pred_induction 0); intros z; [done| |lia].
     rewrite Z_to_little_endian_succ by lia. simpl. by rewrite Nat2Z.inj_succ, IH.
   Qed.
 
-  Lemma Z_to_little_endian_bound m n z:
+  Lemma Z_to_little_endian_bound m n z :
     0 ≤ n → 0 ≤ m →
     Forall (λ b, 0 ≤ b < 2 ^ n) (Z_to_little_endian m n z).
   Proof.
     intros. revert z.
-    induction m as [|m ? IH|] using (Z_succ_pred_induction 0); intros z; [..|lia].
+    induction m as [|m ? IH|] using (Z.succ_pred_induction 0); intros z; [..|lia].
     { by constructor. }
     rewrite Z_to_little_endian_succ by lia.
     constructor; [|by apply IH]. rewrite Z.land_ones by lia.
     apply Z.mod_pos_bound, Z.pow_pos_nonneg; lia.
   Qed.
 
-  Lemma little_endian_to_Z_bound n bs:
+  Lemma little_endian_to_Z_bound n bs :
     0 ≤ n →
     Forall (λ b, 0 ≤ b < 2 ^ n) bs →
     0 ≤ little_endian_to_Z n bs < 2 ^ (Z.of_nat (length bs) * n).
   Proof.
     intros ?. induction 1 as [|b bs Hb ? IH]; [done|]; simpl.
-    apply Z_bounded_iff_bits_nonneg'; [nia|..].
+    apply Z.bounded_iff_bits_nonneg'; [lia|..].
     { apply Z.lor_nonneg. split; [lia|]. apply Z.shiftl_nonneg. lia. }
     intros z' ?. rewrite Z.lor_spec.
-    rewrite Z_bounded_iff_bits_nonneg' in Hb by lia.
-    rewrite Hb, orb_false_l, Z.shiftl_spec by nia.
-    apply (Z_bounded_iff_bits_nonneg' (Z.of_nat (length bs) * n)); nia.
+    rewrite Z.bounded_iff_bits_nonneg' in Hb by lia.
+    rewrite Hb, orb_false_l, Z.shiftl_spec by lia.
+    apply (Z.bounded_iff_bits_nonneg' (Z.of_nat (length bs) * n)); lia.
+  Qed.
+
+  Lemma Z_to_little_endian_lookup_Some m n z (i : nat) x :
+    0 ≤ m → 0 ≤ n →
+    Z_to_little_endian m n z !! i = Some x ↔
+    Z.of_nat i < m ∧ x = Z.land (z ≫ (Z.of_nat i * n)) (Z.ones n).
+  Proof.
+    revert z i. induction m as [|m ? IH|] using (Z.succ_pred_induction 0);
+      intros z i ??; [..|lia].
+    { destruct i; simpl; naive_solver lia. }
+    rewrite Z_to_little_endian_succ by lia. destruct i as [|i]; simpl.
+    { naive_solver lia. }
+    rewrite IH, Z.shiftr_shiftr by lia.
+    naive_solver auto with f_equal lia.
+  Qed.
+
+  Lemma little_endian_to_Z_spec n bs i b :
+    0 ≤ i → 0 < n →
+    Forall (λ b, 0 ≤ b < 2 ^ n) bs →
+    bs !! Z.to_nat (i `div` n) = Some b →
+    Z.testbit (little_endian_to_Z n bs) i = Z.testbit b (i `mod` n).
+  Proof.
+    intros Hi Hn Hbs. revert i Hi.
+    induction Hbs as [|b' bs [??] ? IH]; intros i ? Hlookup; simplify_eq/=.
+    destruct (decide (i < n)).
+    - rewrite Z.div_small in Hlookup by lia. simplify_eq/=.
+      rewrite Z.lor_spec, Z.shiftl_spec, Z.mod_small by lia.
+      by rewrite (Z.testbit_neg_r _ (i - n)), orb_false_r by lia.
+    - assert (Z.to_nat (i `div` n) = S (Z.to_nat ((i - n) `div` n))) as Hdiv.
+      { rewrite <-Z2Nat.inj_succ by (apply Z.div_pos; lia).
+        rewrite <-Z.add_1_r, <-Z.div_add by lia.
+        do 2 f_equal. lia. }
+      rewrite Hdiv in Hlookup; simplify_eq/=.
+      rewrite Z.lor_spec, Z.shiftl_spec, IH by auto with lia.
+      assert (Z.testbit b' i = false) as ->.
+      { apply (Z.bounded_iff_bits_nonneg n); lia. }
+      by rewrite <-Zminus_mod_idemp_r, Z_mod_same_full, Z.sub_0_r.
   Qed.
 End Z_little_endian.