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 *)
 (** [seqZ m n] generates the sequence [m], [m + 1], ..., [m + n - 1]
 over integers, provided [0 ≤ n]. If [n < 0], then the range is empty. **)
 Definition seqZ (m len: Z) : list Z :=
-  (λ i: nat, Z.add i m) <$> (seq 0 (Z.to_nat len)).
-Arguments seqZ : simpl never.
+  (λ i: nat, Z.add (Z.of_nat i) m) <$> (seq 0 (Z.to_nat len)).
+Global Arguments seqZ : simpl never.
 
 Definition sum_list_with {A} (f : A → nat) : list A → nat :=
   fix go l :=
@@ -26,11 +26,37 @@ Definition max_list_with {A} (f : A → nat) : list A → nat :=
   end.
 Notation max_list := (max_list_with id).
 
+(** ** Conversion of integers to and from little endian *)
+(** [Z_to_little_endian m n z] converts [z] into a list of [m] [n]-bit
+integers in the little endian format. A negative [z] is encoded using
+two's-complement. If [z] uses more than [m * n] bits, these additional
+bits are discarded (see [Z_to_little_endian_to_Z]). [m] and [n] should be
+non-negative. *)
+Definition Z_to_little_endian (m n : Z) : Z → list Z :=
+  Z.iter m (λ rec z, Z.land z (Z.ones n) :: rec (z ≫ n)%Z) (λ _, []).
+Global Arguments Z_to_little_endian : simpl never.
+
+(** [little_endian_to_Z n bs] converts the list [bs] of [n]-bit integers
+into a number by interpreting [bs] as the little endian encoding.
+The integers [b] in [bs] should be in the range [0 ≤ b < 2 ^ n]. *)
+Fixpoint little_endian_to_Z (n : Z) (bs : list Z) : Z :=
+  match bs with
+  | [] => 0
+  | b :: bs => Z.lor b (little_endian_to_Z n bs ≪ n)
+  end.
+
+
 (** * Properties *)
 (** ** Properties of the [seq] function *)
 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|].
@@ -67,25 +93,44 @@ Section seq.
   Qed.
   Lemma NoDup_seq j n : NoDup (seq j n).
   Proof. apply NoDup_ListNoDup, seq_NoDup. Qed.
-  Lemma seq_S_end_app j n : seq j (S n) = seq j n ++ [j + n].
-  Proof.
-    revert j. induction n as [|n IH]; intros j; simpl in *; 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.
-    rewrite Forall_lookup. split.
-    - intros H j [??]. apply (H (j - i)), lookup_seq. lia.
-    - intros H j x [-> ?]%lookup_seq. auto with lia.
+    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.
@@ -96,57 +141,77 @@ 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.
     - by rewrite !seqZ_nil by lia.
   Qed.
-  Lemma lookup_seqZ_lt m n i : i < n → seqZ m n !! i = Some (m + i).
+  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.
     - rewrite Z.pred_succ, IH by lia. f_equal; lia.
   Qed.
-  Lemma lookup_total_seqZ_lt m n i : i < n → seqZ m n !!! i = m + i.
+  Lemma lookup_total_seqZ_lt m n i : Z.of_nat i < n → seqZ m n !!! i = m + Z.of_nat i.
   Proof. intros. by rewrite !list_lookup_total_alt, lookup_seqZ_lt. Qed.
-  Lemma lookup_seqZ_ge m n i : n ≤ i → seqZ m n !! i = None.
+  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.
     - by rewrite seqZ_nil by lia.
   Qed.
-  Lemma lookup_total_seqZ_ge m n i : n ≤ i → seqZ m n !!! i = inhabitant.
+  Lemma lookup_total_seqZ_ge m n i : n ≤ Z.of_nat i → seqZ m n !!! i = inhabitant.
   Proof. intros. by rewrite !list_lookup_total_alt, lookup_seqZ_ge. Qed.
-  Lemma lookup_seqZ m n i m' : seqZ m n !! i = Some m' ↔ m' = m + i ∧ i < n.
+  Lemma lookup_seqZ m n i m' : seqZ m n !! i = Some m' ↔ m' = m + Z.of_nat i ∧ Z.of_nat i < n.
   Proof.
-    destruct (Z_le_gt_dec n i).
+    destruct (Z_le_gt_dec n (Z.of_nat i)).
     - rewrite lookup_seqZ_ge by lia. naive_solver lia.
     - rewrite lookup_seqZ_lt by lia. naive_solver lia.
   Qed.
   Lemma NoDup_seqZ m n : NoDup (seqZ m n).
   Proof. apply NoDup_fmap_2, NoDup_seq. intros ???; lia. Qed.
 
-  Lemma Forall_seqZ (P : Z → Prop) m n :
-    Forall P (seqZ m n) ↔ ∀ m', m ≤ m' < m + n → P m'.
+  Lemma seqZ_app m n1 n2 :
+    0 ≤ n1 →
+    0 ≤ n2 →
+    seqZ m (n1 + n2) = seqZ m n1 ++ seqZ (m + n1) n2.
   Proof.
-    rewrite Forall_lookup. split.
-    - intros H j [??]. apply (H (Z.to_nat (j - m))), lookup_seqZ.
-      rewrite !Z2Nat.id by lia. lia.
-    - intros H j x [-> ?]%lookup_seqZ. auto with lia.
+    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; intros j n; simpl.
+    rewrite Nat2Z.inj_add, Z2Nat.id by done. lia.
   Qed.
+
+  Lemma seqZ_S m i : seqZ m (Z.of_nat (S i)) = seqZ m (Z.of_nat i) ++ [m + Z.of_nat i].
+  Proof.
+    unfold seqZ. rewrite !Nat2Z.id, seq_S, fmap_app.
+    simpl. by rewrite Z.add_comm.
+  Qed.
+
+  Lemma elem_of_seqZ m n k :
+    k ∈ seqZ m n ↔ m ≤ k < m + n.
+  Proof.
+    rewrite elem_of_list_lookup.
+    setoid_rewrite lookup_seqZ. split; [naive_solver lia|].
+    exists (Z.to_nat (k - m)). rewrite Z2Nat.id by lia. lia.
+  Qed.
+
+  Lemma Forall_seqZ (P : Z → Prop) m n :
+    Forall P (seqZ m n) ↔ ∀ m', m ≤ m' < m + n → P m'.
+  Proof. rewrite Forall_forall. setoid_rewrite elem_of_seqZ. auto with lia. Qed.
 End seqZ.
 
-(** ** Properties of the [sum_list] and [max_list] functions *)
+(** ** Properties of the [sum_list] function *)
 Section sum_list.
   Context {A : Type}.
   Implicit Types x y z : A.
@@ -159,15 +224,222 @@ Section sum_list.
   Proof.
     induction l; simpl; rewrite ?reverse_cons, ?sum_list_with_app; simpl; lia.
   Qed.
+  Lemma sum_list_with_in x (f : A → nat) ls : x ∈ ls → f x ≤ sum_list_with f ls.
+  Proof. induction 1; simpl; lia. Qed.
   Lemma join_reshape szs l :
     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 max_list_elem_of_le n ns:
+  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}.
+
+  Lemma max_list_elem_of_le n ns :
     n ∈ ns → n ≤ max_list ns.
   Proof. induction 1; simpl; lia. Qed.
-End sum_list.
+
+  Lemma max_list_not_elem_of_gt n ns : max_list ns < n → n ∉ ns.
+  Proof. intros ??%max_list_elem_of_le. lia. Qed.
+
+  Lemma max_list_elem_of ns : ns ≠ [] → max_list ns ∈ ns.
+  Proof.
+    intros. induction ns as [|n ns IHns]; [done|]. simpl.
+    destruct (Nat.max_spec n (max_list ns)) as [[? ->]|[? ->]].
+    - destruct ns.
+      + simpl in *. lia.
+      + by apply elem_of_list_further, IHns.
+    - apply elem_of_list_here.
+  Qed.
+End max_list.
+
+(** ** Properties of the [Z_to_little_endian] and [little_endian_to_Z] functions *)
+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
+    = Z.land z (Z.ones n) :: Z_to_little_endian m n (z ≫ n).
+  Proof.
+    unfold Z_to_little_endian. intros.
+    by rewrite !iter_nat_of_Z, Zabs2Nat.inj_succ by lia.
+  Qed.
+
+  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.
+  Proof.
+    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.
+      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.
+    - 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. }
+      rewrite orb_false_l. f_equal. lia.
+  Qed.
+
+  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 lia.
+    revert z.
+    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 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 lia.
+    - rewrite andb_false_r, orb_false_l.
+      rewrite Z.shiftr_spec by lia. f_equal; [f_equal; lia|].
+      rewrite !Z.ones_spec by lia. apply bool_decide_ext. lia.
+  Qed.
+
+  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].
+    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 :
+    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].
+    { 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 :
+    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'; [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 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.

stdpp/list_relations.v

+From Coq Require Export Permutation.
+From stdpp Require Export numbers base option list_basics.
+From stdpp Require Import options.
+
+Global Instance: Params (@Forall) 1 := {}.
+Global Instance: Params (@Exists) 1 := {}.
+Global Instance: Params (@NoDup) 1 := {}.
+
+Global Arguments Permutation {_} _ _ : assert.
+Global Arguments Forall_cons {_} _ _ _ _ _ : assert.
+
+Infix "≡ₚ" := Permutation (at level 70, no associativity) : stdpp_scope.
+Notation "(≡ₚ)" := Permutation (only parsing) : stdpp_scope.
+Notation "( x ≡ₚ.)" := (Permutation x) (only parsing) : stdpp_scope.
+Notation "(.≡ₚ x )" := (λ y, y ≡ₚ x) (only parsing) : stdpp_scope.
+Notation "(≢ₚ)" := (λ x y, ¬x ≡ₚ y) (only parsing) : stdpp_scope.
+Notation "x ≢ₚ y":= (¬x ≡ₚ y) (at level 70, no associativity) : stdpp_scope.
+Notation "( x ≢ₚ.)" := (λ y, x ≢ₚ y) (only parsing) : stdpp_scope.
+Notation "(.≢ₚ x )" := (λ y, y ≢ₚ x) (only parsing) : stdpp_scope.
+
+Infix "≡ₚ@{ A }" :=
+  (@Permutation A) (at level 70, no associativity, only parsing) : stdpp_scope.
+Notation "(≡ₚ@{ A } )" := (@Permutation A) (only parsing) : stdpp_scope.
+
+(** Setoid equality lifted to lists *)
+Inductive list_equiv `{Equiv A} : Equiv (list A) :=
+  | nil_equiv : [] ≡ []
+  | cons_equiv x y l k : x ≡ y → l ≡ k → x :: l ≡ y :: k.
+Global Existing Instance list_equiv.
+
+(** The predicate [suffix] holds if the first list is a suffix of the second.
+The predicate [prefix] holds if the first list is a prefix of the second. *)
+Definition suffix {A} : relation (list A) := λ l1 l2, ∃ k, l2 = k ++ l1.
+Definition prefix {A} : relation (list A) := λ l1 l2, ∃ k, l2 = l1 ++ k.
+Infix "`suffix_of`" := suffix (at level 70) : stdpp_scope.
+Infix "`prefix_of`" := prefix (at level 70) : stdpp_scope.
+Global Hint Extern 0 (_ `prefix_of` _) => reflexivity : core.
+Global Hint Extern 0 (_ `suffix_of` _) => reflexivity : core.
+
+(** A list is a "subset" of another if each element of the first also appears
+somewhere in the second. *)
+Global Instance list_subseteq {A} : SubsetEq (list A) := λ l1 l2, ∀ x, x ∈ l1 → x ∈ l2.
+
+(** A list [l1] is a sublist of [l2] if [l2] is obtained by removing elements
+from [l1] without changing the order. *)
+Inductive sublist {A} : relation (list A) :=
+  | sublist_nil : sublist [] []
+  | sublist_skip x l1 l2 : sublist l1 l2 → sublist (x :: l1) (x :: l2)
+  | sublist_cons x l1 l2 : sublist l1 l2 → sublist l1 (x :: l2).
+Infix "`sublist_of`" := sublist (at level 70) : stdpp_scope.
+Global Hint Extern 0 (_ `sublist_of` _) => reflexivity : core.
+
+(** A list [l2] submseteq a list [l1] if [l2] is obtained by removing elements
+from [l1] while possibly changing the order. *)
+Inductive submseteq {A} : relation (list A) :=
+  | submseteq_nil : submseteq [] []
+  | submseteq_skip x l1 l2 : submseteq l1 l2 → submseteq (x :: l1) (x :: l2)
+  | submseteq_swap x y l : submseteq (y :: x :: l) (x :: y :: l)
+  | submseteq_cons x l1 l2 : submseteq l1 l2 → submseteq l1 (x :: l2)
+  | submseteq_trans l1 l2 l3 : submseteq l1 l2 → submseteq l2 l3 → submseteq l1 l3.
+Infix "⊆+" := submseteq (at level 70) : stdpp_scope.
+Global Hint Extern 0 (_ ⊆+ _) => reflexivity : core.
+
+Section prefix_suffix_ops.
+  Context `{EqDecision A}.
+
+  Definition max_prefix : list A → list A → list A * list A * list A :=
+    fix go l1 l2 :=
+    match l1, l2 with
+    | [], l2 => ([], l2, [])
+    | l1, [] => (l1, [], [])
+    | x1 :: l1, x2 :: l2 =>
+      if decide_rel (=) x1 x2
+      then prod_map id (x1 ::.) (go l1 l2) else (x1 :: l1, x2 :: l2, [])
+    end.
+  Definition max_suffix (l1 l2 : list A) : list A * list A * list A :=
+    match max_prefix (reverse l1) (reverse l2) with
+    | (k1, k2, k3) => (reverse k1, reverse k2, reverse k3)
+    end.
+  Definition strip_prefix (l1 l2 : list A) := (max_prefix l1 l2).1.2.
+  Definition strip_suffix (l1 l2 : list A) := (max_suffix l1 l2).1.2.
+End prefix_suffix_ops.
+
+Inductive Forall3 {A B C} (P : A → B → C → Prop) :
+     list A → list B → list C → Prop :=
+  | Forall3_nil : Forall3 P [] [] []
+  | Forall3_cons x y z l k k' :
+     P x y z → Forall3 P l k k' → Forall3 P (x :: l) (y :: k) (z :: k').
+
+Section general_properties.
+Context {A : Type}.
+Implicit Types x y z : A.
+Implicit Types l k : list A.
+
+(** ** Properties of the [NoDup] predicate *)
+Lemma NoDup_nil : NoDup (@nil A) ↔ True.
+Proof. split; constructor. Qed.
+Lemma NoDup_cons x l : NoDup (x :: l) ↔ x ∉ l ∧ NoDup l.
+Proof. split; [by inv 1|]. intros [??]. by constructor. Qed.
+Lemma NoDup_cons_1_1 x l : NoDup (x :: l) → x ∉ l.
+Proof. rewrite NoDup_cons. by intros [??]. Qed.
+Lemma NoDup_cons_1_2 x l : NoDup (x :: l) → NoDup l.
+Proof. rewrite NoDup_cons. by intros [??]. Qed.
+Lemma NoDup_singleton x : NoDup [x].
+Proof. constructor; [apply not_elem_of_nil | constructor]. Qed.
+Lemma NoDup_app l k : NoDup (l ++ k) ↔ NoDup l ∧ (∀ x, x ∈ l → x ∉ k) ∧ NoDup k.
+Proof.
+  induction l; simpl.
+  - rewrite NoDup_nil. setoid_rewrite elem_of_nil. naive_solver.
+  - rewrite !NoDup_cons.
+    setoid_rewrite elem_of_cons. setoid_rewrite elem_of_app. naive_solver.
+Qed.
+Lemma NoDup_lookup l i j x :
+  NoDup l → l !! i = Some x → l !! j = Some x → i = j.
+Proof.
+  intros Hl. revert i j. induction Hl as [|x' l Hx Hl IH].
+  { intros; simplify_eq. }
+  intros [|i] [|j] ??; simplify_eq/=; eauto with f_equal;
+    exfalso; eauto using elem_of_list_lookup_2.
+Qed.
+Lemma NoDup_alt l :
+  NoDup l ↔ ∀ i j x, l !! i = Some x → l !! j = Some x → i = j.
+Proof.
+  split; eauto using NoDup_lookup.
+  induction l as [|x l IH]; intros Hl; constructor.
+  - rewrite elem_of_list_lookup. intros [i ?].
+    opose proof* (Hl (S i) 0); by auto.
+  - apply IH. intros i j x' ??. by apply (inj S), (Hl (S i) (S j) x').
+Qed.
+
+Lemma NoDup_filter (P : A → Prop) `{∀ x, Decision (P x)} l :
+  NoDup l → NoDup (filter P l).
+Proof.
+  induction 1; rewrite ?filter_cons; repeat case_decide;
+    rewrite ?NoDup_nil, ?NoDup_cons, ?elem_of_list_filter; tauto.
+Qed.
+
+Section no_dup_dec.
+  Context `{!EqDecision A}.
+  Global Instance NoDup_dec: ∀ l, Decision (NoDup l) :=
+    fix NoDup_dec l :=
+    match l return Decision (NoDup l) with
+    | [] => left NoDup_nil_2
+    | x :: l =>
+      match decide_rel (∈) x l with
+      | left Hin => right (λ H, NoDup_cons_1_1 _ _ H Hin)
+      | right Hin =>
+        match NoDup_dec l with
+        | left H => left (NoDup_cons_2 _ _ Hin H)
+        | right H => right (H ∘ NoDup_cons_1_2 _ _)
+        end
+      end
+    end.
+  Lemma elem_of_remove_dups l x : x ∈ remove_dups l ↔ x ∈ l.
+  Proof.
+    split; induction l; simpl; repeat case_decide;
+      rewrite ?elem_of_cons; intuition (simplify_eq; auto).
+  Qed.
+  Lemma NoDup_remove_dups l : NoDup (remove_dups l).
+  Proof.
+    induction l; simpl; repeat case_decide; try constructor; auto.
+    by rewrite elem_of_remove_dups.
+  Qed.
+
+  Lemma NoDup_list_difference l k : NoDup l → NoDup (list_difference l k).
+  Proof.
+    induction 1; simpl; try case_decide.
+    - constructor.
+    - done.
+    - constructor; [|done]. rewrite elem_of_list_difference; intuition.
+  Qed.
+  Lemma NoDup_list_union l k : NoDup l → NoDup k → NoDup (list_union l k).
+  Proof.
+    intros. apply NoDup_app. repeat split.
+    - by apply NoDup_list_difference.
+    - intro. rewrite elem_of_list_difference. intuition.
+    - done.
+  Qed.
+  Lemma NoDup_list_intersection l k : NoDup l → NoDup (list_intersection l k).
+  Proof.
+    induction 1; simpl; try case_decide.
+    - constructor.
+    - constructor; [|done]. rewrite elem_of_list_intersection; intuition.
+    - done.
+  Qed.
+
+End no_dup_dec.
+
+(** ** Properties of the [Permutation] predicate *)
+Lemma Permutation_nil_r l : l ≡ₚ [] ↔ l = [].
+Proof. split; [by intro; apply Permutation_nil | by intros ->]. Qed.
+Lemma Permutation_singleton_r l x : l ≡ₚ [x] ↔ l = [x].
+Proof. split; [by intro; apply Permutation_length_1_inv | by intros ->]. Qed.
+Lemma Permutation_nil_l l : [] ≡ₚ l ↔ [] = l.
+Proof. by rewrite (symmetry_iff (≡ₚ)), Permutation_nil_r. Qed.
+Lemma Permutation_singleton_l l x : [x] ≡ₚ l ↔ [x] = l.
+Proof. by rewrite (symmetry_iff (≡ₚ)), Permutation_singleton_r. Qed.
+
+Lemma Permutation_skip x l l' : l ≡ₚ l' → x :: l ≡ₚ x :: l'.
+Proof. apply perm_skip. Qed.
+Lemma Permutation_swap x y l : y :: x :: l ≡ₚ x :: y :: l.
+Proof. apply perm_swap. Qed.
+Lemma Permutation_singleton_inj x y : [x] ≡ₚ [y] → x = y.
+Proof. apply Permutation_length_1. Qed.
+
+Global Instance length_Permutation_proper : Proper ((≡ₚ) ==> (=)) (@length A).
+Proof. induction 1; simpl; auto with lia. Qed.
+Global Instance elem_of_Permutation_proper x : Proper ((≡ₚ) ==> iff) (x ∈.).
+Proof. induction 1; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed.
+Global Instance NoDup_Permutation_proper: Proper ((≡ₚ) ==> iff) (@NoDup A).
+Proof.
+  induction 1 as [|x l k Hlk IH | |].
+  - by rewrite !NoDup_nil.
+  - by rewrite !NoDup_cons, IH, Hlk.
+  - rewrite !NoDup_cons, !elem_of_cons. intuition.
+  - intuition.
+Qed.
+
+Global Instance app_Permutation_comm : Comm (≡ₚ) (@app A).
+Proof.
+  intros l1. induction l1 as [|x l1 IH]; intros l2; simpl.
+  - by rewrite (right_id_L [] (++)).
+  - rewrite Permutation_middle, IH. simpl. by rewrite Permutation_middle.
+Qed.
+
+Global Instance cons_Permutation_inj_r x : Inj (≡ₚ) (≡ₚ) (x ::.).
+Proof. red. eauto using Permutation_cons_inv. Qed.
+Global Instance app_Permutation_inj_r k : Inj (≡ₚ) (≡ₚ) (k ++.).
+Proof.
+  induction k as [|x k IH]; intros l1 l2; simpl; auto.
+  intros. by apply IH, (inj (x ::.)).
+Qed.
+Global Instance cons_Permutation_inj_l k : Inj (=) (≡ₚ) (.:: k).
+Proof.
+  intros x1 x2 Hperm. apply Permutation_singleton_inj.
+  apply (inj (k ++.)). by rewrite !(comm (++) k).
+Qed.
+Global Instance app_Permutation_inj_l k : Inj (≡ₚ) (≡ₚ) (.++ k).
+Proof. intros l1 l2. rewrite !(comm (++) _ k). by apply (inj (k ++.)). Qed.
+
+Lemma replicate_Permutation n x l : replicate n x ≡ₚ l → replicate n x = l.
+Proof.
+  intros Hl. apply replicate_as_elem_of. split.
+  - by rewrite <-Hl, length_replicate.
+  - intros y. rewrite <-Hl. by apply elem_of_replicate_inv.
+Qed.
+Lemma reverse_Permutation l : reverse l ≡ₚ l.
+Proof.
+  induction l as [|x l IH]; [done|].
+  by rewrite reverse_cons, (comm (++)), IH.
+Qed.
+Lemma delete_Permutation l i x : l !! i = Some x → l ≡ₚ x :: delete i l.
+Proof.
+  revert i; induction l as [|y l IH]; intros [|i] ?; simplify_eq/=; auto.
+  by rewrite Permutation_swap, <-(IH i).
+Qed.
+Lemma elem_of_Permutation l x : x ∈ l ↔ ∃ k, l ≡ₚ x :: k.
+Proof.
+  split.
+  - intros [i ?]%elem_of_list_lookup. eexists. by apply delete_Permutation.
+  - intros [k ->]. by left.
+Qed.
+
+Lemma Permutation_cons_inv_r l k x :
+  k ≡ₚ x :: l → ∃ k1 k2, k = k1 ++ x :: k2 ∧ l ≡ₚ k1 ++ k2.
+Proof.
+  intros Hk. assert (∃ i, k !! i = Some x) as [i Hi].
+  { apply elem_of_list_lookup. rewrite Hk, elem_of_cons; auto. }
+  exists (take i k), (drop (S i) k). split.
+  - by rewrite take_drop_middle.
+  - rewrite <-delete_take_drop. apply (inj (x ::.)).
+    by rewrite <-Hk, <-(delete_Permutation k) by done.
+Qed.
+Lemma Permutation_cons_inv_l l k x :
+  x :: l ≡ₚ k → ∃ k1 k2, k = k1 ++ x :: k2 ∧ l ≡ₚ k1 ++ k2.
+Proof. by intros ?%(symmetry_iff (≡ₚ))%Permutation_cons_inv_r. Qed.
+
+Lemma Permutation_cross_split (la lb lc ld : list A) :
+  la ++ lb ≡ₚ lc ++ ld →
+  ∃ lac lad lbc lbd,
+    lac ++ lad ≡ₚ la ∧ lbc ++ lbd ≡ₚ lb ∧ lac ++ lbc ≡ₚ lc ∧ lad ++ lbd ≡ₚ ld.
+Proof.
+  revert lc ld.
+  induction la as [|x la IH]; simpl; intros lc ld Hperm.
+  { exists [], [], lc, ld. by rewrite !(right_id_L [] (++)). }
+  assert (x ∈ lc ++ ld)
+    as [[lc' Hlc]%elem_of_Permutation|[ld' Hld]%elem_of_Permutation]%elem_of_app.
+  { rewrite <-Hperm, elem_of_cons. auto. }
+  - rewrite Hlc in Hperm. simpl in Hperm. apply (inj (x ::.)) in Hperm.
+    apply IH in Hperm as (lac&lad&lbc&lbd&Ha&Hb&Hc&Hd).
+    exists (x :: lac), lad, lbc, lbd; simpl. by rewrite Ha, Hb, Hc, Hd.
+  - rewrite Hld, <-Permutation_middle in Hperm. apply (inj (x ::.)) in Hperm.
+    apply IH in Hperm as (lac&lad&lbc&lbd&Ha&Hb&Hc&Hd).
+    exists lac, (x :: lad), lbc, lbd; simpl.
+    by rewrite <-Permutation_middle, Ha, Hb, Hc, Hd.
+Qed.
+
+Lemma Permutation_inj l1 l2 :
+  Permutation l1 l2 ↔
+    length l1 = length l2 ∧
+    ∃ f : nat → nat, Inj (=) (=) f ∧ ∀ i, l1 !! i = l2 !! f i.
+Proof.
+  split.
+  - intros Hl; split; [by apply Permutation_length|].
+    induction Hl as [|x l1 l2 _ [f [??]]|x y l|l1 l2 l3 _ [f [? Hf]] _ [g [? Hg]]].
+    + exists id; split; [apply _|done].
+    + exists (λ i, match i with 0 => 0 | S i => S (f i) end); split.
+      * by intros [|i] [|j] ?; simplify_eq/=.
+      * intros [|i]; simpl; auto.
+    + exists (λ i, match i with 0 => 1 | 1 => 0 | _ => i end); split.
+      * intros [|[|i]] [|[|j]]; congruence.
+      * by intros [|[|i]].
+    + exists (g ∘ f); split; [apply _|]. intros i; simpl. by rewrite <-Hg, <-Hf.
+  - intros (Hlen & f & Hf & Hl). revert l2 f Hlen Hf Hl.
+    induction l1 as [|x l1 IH]; intros l2 f Hlen Hf Hl; [by destruct l2|].
+    rewrite (delete_Permutation l2 (f 0) x) by (by rewrite <-Hl).
+    pose (g n := let m := f (S n) in if lt_eq_lt_dec m (f 0) then m else m - 1).
+    apply Permutation_skip, (IH _ g).
+    + rewrite length_delete by (rewrite <-Hl; eauto); simpl in *; lia.
+    + unfold g. intros i j Hg.
+      repeat destruct (lt_eq_lt_dec _ _) as [[?|?]|?]; simplify_eq/=; try lia.
+      apply (inj S), (inj f); lia.
+    + intros i. unfold g. destruct (lt_eq_lt_dec _ _) as [[?|?]|?].
+      * by rewrite lookup_delete_lt, <-Hl.
+      * simplify_eq.
+      * rewrite lookup_delete_ge, <-Nat.sub_succ_l by lia; simpl.
+        by rewrite Nat.sub_0_r, <-Hl.
+Qed.
+
+Global Instance filter_Permutation (P : A → Prop) `{∀ x, Decision (P x)} :
+  Proper ((≡ₚ) ==> (≡ₚ)) (filter P).
+Proof.
+  induction 1; rewrite ?filter_cons;
+    repeat (simpl; repeat case_decide); by econstructor.
+Qed.
+
+(** ** Properties of the [prefix] and [suffix] predicates *)
+Global Instance: PartialOrder (@prefix A).
+Proof.
+  split; [split|].
+  - intros ?. eexists []. by rewrite (right_id_L [] (++)).
+  - intros ???[k1->] [k2->]. exists (k1 ++ k2). by rewrite (assoc_L (++)).
+  - intros l1 l2 [k1 ?] [[|x2 k2] ->]; [|discriminate_list].
+    by rewrite (right_id_L _ _).
+Qed.
+Lemma prefix_nil l : [] `prefix_of` l.
+Proof. by exists l. Qed.
+Lemma prefix_nil_inv l : l `prefix_of` [] → l = [].
+Proof. intros [k ?]. by destruct l. Qed.
+Lemma prefix_nil_not x l : ¬x :: l `prefix_of` [].
+Proof. by intros [k ?]. Qed.
+Lemma prefix_cons x l1 l2 : l1 `prefix_of` l2 → x :: l1 `prefix_of` x :: l2.
+Proof. intros [k ->]. by exists k. Qed.
+Lemma prefix_cons_alt x y l1 l2 :
+  x = y → l1 `prefix_of` l2 → x :: l1 `prefix_of` y :: l2.
+Proof. intros ->. apply prefix_cons. Qed.
+Lemma prefix_cons_inv_1 x y l1 l2 : x :: l1 `prefix_of` y :: l2 → x = y.
+Proof. by intros [k ?]; simplify_eq/=. Qed.
+Lemma prefix_cons_inv_2 x y l1 l2 :
+  x :: l1 `prefix_of` y :: l2 → l1 `prefix_of` l2.
+Proof. intros [k ?]; simplify_eq/=. by exists k. Qed.
+Lemma prefix_app k l1 l2 : l1 `prefix_of` l2 → k ++ l1 `prefix_of` k ++ l2.
+Proof. intros [k' ->]. exists k'. by rewrite (assoc_L (++)). Qed.
+Lemma prefix_app_alt k1 k2 l1 l2 :
+  k1 = k2 → l1 `prefix_of` l2 → k1 ++ l1 `prefix_of` k2 ++ l2.
+Proof. intros ->. apply prefix_app. Qed.
+Lemma prefix_app_inv k l1 l2 :
+  k ++ l1 `prefix_of` k ++ l2 → l1 `prefix_of` l2.
+Proof.
+  intros [k' E]. exists k'. rewrite <-(assoc_L (++)) in E. by simplify_list_eq.
+Qed.
+Lemma prefix_app_l l1 l2 l3 : l1 ++ l3 `prefix_of` l2 → l1 `prefix_of` l2.
+Proof. intros [k ->]. exists (l3 ++ k). by rewrite (assoc_L (++)). Qed.
+Lemma prefix_app_r l1 l2 l3 : l1 `prefix_of` l2 → l1 `prefix_of` l2 ++ l3.
+Proof. intros [k ->]. exists (k ++ l3). by rewrite (assoc_L (++)). Qed.
+Lemma prefix_take l n : take n l `prefix_of` l.
+Proof. rewrite <-(take_drop n l) at 2. apply prefix_app_r. done. Qed.
+Lemma prefix_lookup_lt l1 l2 i :
+  i < length l1 → l1 `prefix_of` l2 → l1 !! i = l2 !! i.
+Proof. intros ? [? ->]. by rewrite lookup_app_l. Qed.
+Lemma prefix_lookup_Some l1 l2 i x :
+  l1 !! i = Some x → l1 `prefix_of` l2 → l2 !! i = Some x.
+Proof. intros ? [k ->]. rewrite lookup_app_l; eauto using lookup_lt_Some. Qed.
+Lemma prefix_length l1 l2 : l1 `prefix_of` l2 → length l1 ≤ length l2.
+Proof. intros [? ->]. rewrite length_app. lia. Qed.
+Lemma prefix_snoc_not l x : ¬l ++ [x] `prefix_of` l.
+Proof. intros [??]. discriminate_list. Qed.
+Lemma elem_of_prefix l1 l2 x :
+  x ∈ l1 → l1 `prefix_of` l2 → x ∈ l2.
+Proof. intros Hin [l' ->]. apply elem_of_app. by left. Qed.
+(* [prefix] is not a total order, but [l1] and [l2] are always comparable if
+  they are both prefixes of some [l3]. *)
+Lemma prefix_weak_total l1 l2 l3 :
+  l1 `prefix_of` l3 → l2 `prefix_of` l3 → l1 `prefix_of` l2 ∨ l2 `prefix_of` l1.
+Proof.
+  intros [k1 H1] [k2 H2]. rewrite H2 in H1.
+  apply app_eq_inv in H1 as [(k&?&?)|(k&?&?)]; [left|right]; exists k; eauto.
+Qed.
+Global Instance: PartialOrder (@suffix A).
+Proof.
+  split; [split|].
+  - intros ?. by eexists [].
+  - intros ???[k1->] [k2->]. exists (k2 ++ k1). by rewrite (assoc_L (++)).
+  - intros l1 l2 [k1 ?] [[|x2 k2] ->]; [done|discriminate_list].
+Qed.
+Global Instance prefix_dec `{!EqDecision A} : RelDecision prefix :=
+  fix go l1 l2 :=
+  match l1, l2  with
+  | [], _ => left (prefix_nil _)
+  | _, [] => right (prefix_nil_not _ _)
+  | x :: l1, y :: l2 =>
+    match decide_rel (=) x y with
+    | left Hxy =>
+      match go l1 l2 with
+      | left Hl1l2 => left (prefix_cons_alt _ _ _ _ Hxy Hl1l2)
+      | right Hl1l2 => right (Hl1l2 ∘ prefix_cons_inv_2 _ _ _ _)
+      end
+    | right Hxy => right (Hxy ∘ prefix_cons_inv_1 _ _ _ _)
+    end
+  end.
+Lemma prefix_not_elem_of_app_cons_inv x y l1 l2 k1 k2 :
+  x ∉ k1 → y ∉ l1 →
+  (l1 ++ x :: l2) `prefix_of` (k1 ++ y :: k2) →
+  l1 = k1 ∧ x = y ∧ l2 `prefix_of` k2.
+Proof.
+  intros Hin1 Hin2 [k Hle]. rewrite <-(assoc_L (++)) in Hle.
+  apply not_elem_of_app_cons_inv_l in Hle; [|done..]. unfold prefix. naive_solver.
+Qed.
+
+Lemma prefix_length_eq l1 l2 :
+  l1 `prefix_of` l2 → length l2 ≤ length l1 → l1 = l2.
+Proof.
+  intros Hprefix Hlen. assert (length l1 = length l2).
+  { apply prefix_length in Hprefix. lia. }
+  eapply list_eq_same_length with (length l1); [done..|].
+  intros i x y _ ??. assert (l2 !! i = Some x) by eauto using prefix_lookup_Some.
+  congruence.
+Qed.
+
+Section prefix_ops.
+  Context `{!EqDecision A}.
+  Lemma max_prefix_fst l1 l2 :
+    l1 = (max_prefix l1 l2).2 ++ (max_prefix l1 l2).1.1.
+  Proof.
+    revert l2. induction l1; intros [|??]; simpl;
+      repeat case_decide; f_equal/=; auto.
+  Qed.
+  Lemma max_prefix_fst_alt l1 l2 k1 k2 k3 :
+    max_prefix l1 l2 = (k1, k2, k3) → l1 = k3 ++ k1.
+  Proof.
+    intros. pose proof (max_prefix_fst l1 l2).
+    by destruct (max_prefix l1 l2) as [[]?]; simplify_eq.
+  Qed.
+  Lemma max_prefix_fst_prefix l1 l2 : (max_prefix l1 l2).2 `prefix_of` l1.
+  Proof. eexists. apply max_prefix_fst. Qed.
+  Lemma max_prefix_fst_prefix_alt l1 l2 k1 k2 k3 :
+    max_prefix l1 l2 = (k1, k2, k3) → k3 `prefix_of` l1.
+  Proof. eexists. eauto using max_prefix_fst_alt. Qed.
+  Lemma max_prefix_snd l1 l2 :
+    l2 = (max_prefix l1 l2).2 ++ (max_prefix l1 l2).1.2.
+  Proof.
+    revert l2. induction l1; intros [|??]; simpl;
+      repeat case_decide; f_equal/=; auto.
+  Qed.
+  Lemma max_prefix_snd_alt l1 l2 k1 k2 k3 :
+    max_prefix l1 l2 = (k1, k2, k3) → l2 = k3 ++ k2.
+  Proof.
+    intro. pose proof (max_prefix_snd l1 l2).
+    by destruct (max_prefix l1 l2) as [[]?]; simplify_eq.
+  Qed.
+  Lemma max_prefix_snd_prefix l1 l2 : (max_prefix l1 l2).2 `prefix_of` l2.
+  Proof. eexists. apply max_prefix_snd. Qed.
+  Lemma max_prefix_snd_prefix_alt l1 l2 k1 k2 k3 :
+    max_prefix l1 l2 = (k1,k2,k3) → k3 `prefix_of` l2.
+  Proof. eexists. eauto using max_prefix_snd_alt. Qed.
+  Lemma max_prefix_max l1 l2 k :
+    k `prefix_of` l1 → k `prefix_of` l2 → k `prefix_of` (max_prefix l1 l2).2.
+  Proof.
+    intros [l1' ->] [l2' ->]. by induction k; simpl; repeat case_decide;
+      simpl; auto using prefix_nil, prefix_cons.
+  Qed.
+  Lemma max_prefix_max_alt l1 l2 k1 k2 k3 k :
+    max_prefix l1 l2 = (k1,k2,k3) →
+    k `prefix_of` l1 → k `prefix_of` l2 → k `prefix_of` k3.
+  Proof.
+    intro. pose proof (max_prefix_max l1 l2 k).
+    by destruct (max_prefix l1 l2) as [[]?]; simplify_eq.
+  Qed.
+  Lemma max_prefix_max_snoc l1 l2 k1 k2 k3 x1 x2 :
+    max_prefix l1 l2 = (x1 :: k1, x2 :: k2, k3) → x1 ≠ x2.
+  Proof.
+    intros Hl ->. destruct (prefix_snoc_not k3 x2).
+    eapply max_prefix_max_alt; eauto.
+    - rewrite (max_prefix_fst_alt _ _ _ _ _ Hl).
+      apply prefix_app, prefix_cons, prefix_nil.
+    - rewrite (max_prefix_snd_alt _ _ _ _ _ Hl).
+      apply prefix_app, prefix_cons, prefix_nil.
+  Qed.
+End prefix_ops.
+
+Lemma prefix_suffix_reverse l1 l2 :
+  l1 `prefix_of` l2 ↔ reverse l1 `suffix_of` reverse l2.
+Proof.
+  split; intros [k E]; exists (reverse k).
+  - by rewrite E, reverse_app.
+  - by rewrite <-(reverse_involutive l2), E, reverse_app, reverse_involutive.
+Qed.
+Lemma suffix_prefix_reverse l1 l2 :
+  l1 `suffix_of` l2 ↔ reverse l1 `prefix_of` reverse l2.
+Proof. by rewrite prefix_suffix_reverse, !reverse_involutive. Qed.
+Lemma suffix_nil l : [] `suffix_of` l.
+Proof. exists l. by rewrite (right_id_L [] (++)). Qed.
+Lemma suffix_nil_inv l : l `suffix_of` [] → l = [].
+Proof. by intros [[|?] ?]; simplify_list_eq. Qed.
+Lemma suffix_cons_nil_inv x l : ¬x :: l `suffix_of` [].
+Proof. by intros [[] ?]. Qed.
+Lemma suffix_snoc l1 l2 x :
+  l1 `suffix_of` l2 → l1 ++ [x] `suffix_of` l2 ++ [x].
+Proof. intros [k ->]. exists k. by rewrite (assoc_L (++)). Qed.
+Lemma suffix_snoc_alt x y l1 l2 :
+  x = y → l1 `suffix_of` l2 → l1 ++ [x] `suffix_of` l2 ++ [y].
+Proof. intros ->. apply suffix_snoc. Qed.
+Lemma suffix_app l1 l2 k : l1 `suffix_of` l2 → l1 ++ k `suffix_of` l2 ++ k.
+Proof. intros [k' ->]. exists k'. by rewrite (assoc_L (++)). Qed.
+Lemma suffix_app_alt l1 l2 k1 k2 :
+  k1 = k2 → l1 `suffix_of` l2 → l1 ++ k1 `suffix_of` l2 ++ k2.
+Proof. intros ->. apply suffix_app. Qed.
+Lemma suffix_snoc_inv_1 x y l1 l2 :
+  l1 ++ [x] `suffix_of` l2 ++ [y] → x = y.
+Proof. intros [k' E]. rewrite (assoc_L (++)) in E. by simplify_list_eq. Qed.
+Lemma suffix_snoc_inv_2 x y l1 l2 :
+  l1 ++ [x] `suffix_of` l2 ++ [y] → l1 `suffix_of` l2.
+Proof.
+  intros [k' E]. exists k'. rewrite (assoc_L (++)) in E. by simplify_list_eq.
+Qed.
+Lemma suffix_app_inv l1 l2 k :
+  l1 ++ k `suffix_of` l2 ++ k → l1 `suffix_of` l2.
+Proof.
+  intros [k' E]. exists k'. rewrite (assoc_L (++)) in E. by simplify_list_eq.
+Qed.
+Lemma suffix_cons_l l1 l2 x : x :: l1 `suffix_of` l2 → l1 `suffix_of` l2.
+Proof. intros [k ->]. exists (k ++ [x]). by rewrite <-(assoc_L (++)). Qed.
+Lemma suffix_app_l l1 l2 l3 : l3 ++ l1 `suffix_of` l2 → l1 `suffix_of` l2.
+Proof. intros [k ->]. exists (k ++ l3). by rewrite <-(assoc_L (++)). Qed.
+Lemma suffix_cons_r l1 l2 x : l1 `suffix_of` l2 → l1 `suffix_of` x :: l2.
+Proof. intros [k ->]. by exists (x :: k). Qed.
+Lemma suffix_app_r l1 l2 l3 : l1 `suffix_of` l2 → l1 `suffix_of` l3 ++ l2.
+Proof. intros [k ->]. exists (l3 ++ k). by rewrite (assoc_L (++)). Qed.
+Lemma suffix_drop l n : drop n l `suffix_of` l.
+Proof. rewrite <-(take_drop n l) at 2. apply suffix_app_r. done. Qed.
+Lemma suffix_cons_inv l1 l2 x y :
+  x :: l1 `suffix_of` y :: l2 → x :: l1 = y :: l2 ∨ x :: l1 `suffix_of` l2.
+Proof.
+  intros [[|? k] E]; [by left|]. right. simplify_eq/=. by apply suffix_app_r.
+Qed.
+Lemma suffix_lookup_lt l1 l2 i :
+  i < length l1 →
+  l1 `suffix_of` l2 →
+  l1 !! i = l2 !! (i + (length l2 - length l1)).
+Proof.
+  intros Hi [k ->]. rewrite length_app, lookup_app_r by lia. f_equal; lia.
+Qed.
+Lemma suffix_lookup_Some l1 l2 i x :
+  l1 !! i = Some x →
+  l1 `suffix_of` l2 →
+  l2 !! (i + (length l2 - length l1)) = Some x.
+Proof. intros. by rewrite <-suffix_lookup_lt by eauto using lookup_lt_Some. Qed.
+Lemma suffix_length l1 l2 : l1 `suffix_of` l2 → length l1 ≤ length l2.
+Proof. intros [? ->]. rewrite length_app. lia. Qed.
+Lemma suffix_cons_not x l : ¬x :: l `suffix_of` l.
+Proof. intros [??]. discriminate_list. Qed.
+Lemma elem_of_suffix l1 l2 x :
+  x ∈ l1 → l1 `suffix_of` l2 → x ∈ l2.
+Proof. intros Hin [l' ->]. apply elem_of_app. by right. Qed.
+(* [suffix] is not a total order, but [l1] and [l2] are always comparable if
+  they are both suffixes of some [l3]. *)
+Lemma suffix_weak_total l1 l2 l3 :
+  l1 `suffix_of` l3 → l2 `suffix_of` l3 → l1 `suffix_of` l2 ∨ l2 `suffix_of` l1.
+Proof.
+  intros [k1 Hl1] [k2 Hl2]. rewrite Hl1 in Hl2.
+  apply app_eq_inv in Hl2 as [(k&?&?)|(k&?&?)]; [left|right]; exists k; eauto.
+Qed.
+Global Instance suffix_dec `{!EqDecision A} : RelDecision (@suffix A).
+Proof.
+  refine (λ l1 l2, cast_if (decide_rel prefix (reverse l1) (reverse l2)));
+   abstract (by rewrite suffix_prefix_reverse).
+Defined.
+Lemma suffix_not_elem_of_app_cons_inv x y l1 l2 k1 k2 :
+  x ∉ k2 → y ∉ l2 →
+  (l1 ++ x :: l2) `suffix_of` (k1 ++ y :: k2) →
+  l1 `suffix_of` k1 ∧ x = y ∧ l2 = k2.
+Proof.
+  intros Hin1 Hin2 [k Hle]. rewrite (assoc_L (++)) in Hle.
+  apply not_elem_of_app_cons_inv_r in Hle; [|done..]. unfold suffix. naive_solver.
+Qed.
+
+Lemma suffix_length_eq l1 l2 :
+  l1 `suffix_of` l2 → length l2 ≤ length l1 → l1 = l2.
+Proof.
+  intros. apply (inj reverse), prefix_length_eq.
+  - by apply suffix_prefix_reverse.
+  - by rewrite !length_reverse.
+Qed.
+
+Section max_suffix.
+  Context `{!EqDecision A}.
+
+  Lemma max_suffix_fst l1 l2 :
+    l1 = (max_suffix l1 l2).1.1 ++ (max_suffix l1 l2).2.
+  Proof.
+    rewrite <-(reverse_involutive l1) at 1.
+    rewrite (max_prefix_fst (reverse l1) (reverse l2)). unfold max_suffix.
+    destruct (max_prefix (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
+    by rewrite reverse_app.
+  Qed.
+  Lemma max_suffix_fst_alt l1 l2 k1 k2 k3 :
+    max_suffix l1 l2 = (k1, k2, k3) → l1 = k1 ++ k3.
+  Proof.
+    intro. pose proof (max_suffix_fst l1 l2).
+    by destruct (max_suffix l1 l2) as [[]?]; simplify_eq.
+  Qed.
+  Lemma max_suffix_fst_suffix l1 l2 : (max_suffix l1 l2).2 `suffix_of` l1.
+  Proof. eexists. apply max_suffix_fst. Qed.
+  Lemma max_suffix_fst_suffix_alt l1 l2 k1 k2 k3 :
+    max_suffix l1 l2 = (k1, k2, k3) → k3 `suffix_of` l1.
+  Proof. eexists. eauto using max_suffix_fst_alt. Qed.
+  Lemma max_suffix_snd l1 l2 :
+    l2 = (max_suffix l1 l2).1.2 ++ (max_suffix l1 l2).2.
+  Proof.
+    rewrite <-(reverse_involutive l2) at 1.
+    rewrite (max_prefix_snd (reverse l1) (reverse l2)). unfold max_suffix.
+    destruct (max_prefix (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
+    by rewrite reverse_app.
+  Qed.
+  Lemma max_suffix_snd_alt l1 l2 k1 k2 k3 :
+    max_suffix l1 l2 = (k1,k2,k3) → l2 = k2 ++ k3.
+  Proof.
+    intro. pose proof (max_suffix_snd l1 l2).
+    by destruct (max_suffix l1 l2) as [[]?]; simplify_eq.
+  Qed.
+  Lemma max_suffix_snd_suffix l1 l2 : (max_suffix l1 l2).2 `suffix_of` l2.
+  Proof. eexists. apply max_suffix_snd. Qed.
+  Lemma max_suffix_snd_suffix_alt l1 l2 k1 k2 k3 :
+    max_suffix l1 l2 = (k1,k2,k3) → k3 `suffix_of` l2.
+  Proof. eexists. eauto using max_suffix_snd_alt. Qed.
+  Lemma max_suffix_max l1 l2 k :
+    k `suffix_of` l1 → k `suffix_of` l2 → k `suffix_of` (max_suffix l1 l2).2.
+  Proof.
+    generalize (max_prefix_max (reverse l1) (reverse l2)).
+    rewrite !suffix_prefix_reverse. unfold max_suffix.
+    destruct (max_prefix (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
+    rewrite reverse_involutive. auto.
+  Qed.
+  Lemma max_suffix_max_alt l1 l2 k1 k2 k3 k :
+    max_suffix l1 l2 = (k1, k2, k3) →
+    k `suffix_of` l1 → k `suffix_of` l2 → k `suffix_of` k3.
+  Proof.
+    intro. pose proof (max_suffix_max l1 l2 k).
+    by destruct (max_suffix l1 l2) as [[]?]; simplify_eq.
+  Qed.
+  Lemma max_suffix_max_snoc l1 l2 k1 k2 k3 x1 x2 :
+    max_suffix l1 l2 = (k1 ++ [x1], k2 ++ [x2], k3) → x1 ≠ x2.
+  Proof.
+    intros Hl ->. destruct (suffix_cons_not x2 k3).
+    eapply max_suffix_max_alt; eauto.
+    - rewrite (max_suffix_fst_alt _ _ _ _ _ Hl).
+      by apply (suffix_app [x2]), suffix_app_r.
+    - rewrite (max_suffix_snd_alt _ _ _ _ _ Hl).
+      by apply (suffix_app [x2]), suffix_app_r.
+  Qed.
+End max_suffix.
+
+(** ** Properties of the [sublist] predicate *)
+Lemma sublist_length l1 l2 : l1 `sublist_of` l2 → length l1 ≤ length l2.
+Proof. induction 1; simpl; auto with arith. Qed.
+Lemma sublist_nil_l l : [] `sublist_of` l.
+Proof. induction l; try constructor; auto. Qed.
+Lemma sublist_nil_r l : l `sublist_of` [] ↔ l = [].
+Proof. split; [by inv 1|]. intros ->. constructor. Qed.
+Lemma sublist_app l1 l2 k1 k2 :
+  l1 `sublist_of` l2 → k1 `sublist_of` k2 → l1 ++ k1 `sublist_of` l2 ++ k2.
+Proof. induction 1; simpl; try constructor; auto. Qed.
+Lemma sublist_inserts_l k l1 l2 : l1 `sublist_of` l2 → l1 `sublist_of` k ++ l2.
+Proof. induction k; try constructor; auto. Qed.
+Lemma sublist_inserts_r k l1 l2 : l1 `sublist_of` l2 → l1 `sublist_of` l2 ++ k.
+Proof. induction 1; simpl; try constructor; auto using sublist_nil_l. Qed.
+Lemma sublist_cons_r x l k :
+  l `sublist_of` x :: k ↔ l `sublist_of` k ∨ ∃ l', l = x :: l' ∧ l' `sublist_of` k.
+Proof. split; [inv 1; eauto|]. intros [?|(?&->&?)]; constructor; auto. Qed.
+Lemma sublist_cons_l x l k :
+  x :: l `sublist_of` k ↔ ∃ k1 k2, k = k1 ++ x :: k2 ∧ l `sublist_of` k2.
+Proof.
+  split.
+  - intros Hlk. induction k as [|y k IH]; inv Hlk.
+    + eexists [], k. by repeat constructor.
+    + destruct IH as (k1&k2&->&?); auto. by exists (y :: k1), k2.
+  - intros (k1&k2&->&?). by apply sublist_inserts_l, sublist_skip.
+Qed.
+Lemma sublist_app_r l k1 k2 :
+  l `sublist_of` k1 ++ k2 ↔
+    ∃ l1 l2, l = l1 ++ l2 ∧ l1 `sublist_of` k1 ∧ l2 `sublist_of` k2.
+Proof.
+  split.
+  - revert l k2. induction k1 as [|y k1 IH]; intros l k2; simpl.
+    { eexists [], l. by repeat constructor. }
+    rewrite sublist_cons_r. intros [?|(l' & ? &?)]; subst.
+    + destruct (IH l k2) as (l1&l2&?&?&?); trivial; subst.
+      exists l1, l2. auto using sublist_cons.
+    + destruct (IH l' k2) as (l1&l2&?&?&?); trivial; subst.
+      exists (y :: l1), l2. auto using sublist_skip.
+  - intros (?&?&?&?&?); subst. auto using sublist_app.
+Qed.
+Lemma sublist_app_l l1 l2 k :
+  l1 ++ l2 `sublist_of` k ↔
+    ∃ k1 k2, k = k1 ++ k2 ∧ l1 `sublist_of` k1 ∧ l2 `sublist_of` k2.
+Proof.
+  split.
+  - revert l2 k. induction l1 as [|x l1 IH]; intros l2 k; simpl.
+    { eexists [], k. by repeat constructor. }
+    rewrite sublist_cons_l. intros (k1 & k2 &?&?); subst.
+    destruct (IH l2 k2) as (h1 & h2 &?&?&?); trivial; subst.
+    exists (k1 ++ x :: h1), h2. rewrite <-(assoc_L (++)).
+    auto using sublist_inserts_l, sublist_skip.
+  - intros (?&?&?&?&?); subst. auto using sublist_app.
+Qed.
+Lemma sublist_app_inv_l k l1 l2 : k ++ l1 `sublist_of` k ++ l2 → l1 `sublist_of` l2.
+Proof.
+  induction k as [|y k IH]; simpl; [done |].
+  rewrite sublist_cons_r. intros [Hl12|(?&?&?)]; [|simplify_eq; eauto].
+  rewrite sublist_cons_l in Hl12. destruct Hl12 as (k1&k2&Hk&?).
+  apply IH. rewrite Hk. eauto using sublist_inserts_l, sublist_cons.
+Qed.
+Lemma sublist_app_inv_r k l1 l2 : l1 ++ k `sublist_of` l2 ++ k → l1 `sublist_of` l2.
+Proof.
+  revert l1 l2. induction k as [|y k IH]; intros l1 l2.
+  { by rewrite !(right_id_L [] (++)). }
+  intros. opose proof* (IH (l1 ++ [_]) (l2 ++ [_])) as Hl12.
+  { by rewrite <-!(assoc_L (++)). }
+  rewrite sublist_app_l in Hl12. destruct Hl12 as (k1&k2&E&?&Hk2).
+  destruct k2 as [|z k2] using rev_ind; [inv Hk2|].
+  rewrite (assoc_L (++)) in E; simplify_list_eq.
+  eauto using sublist_inserts_r.
+Qed.
+Global Instance: PartialOrder (@sublist A).
+Proof.
+  split; [split|].
+  - intros l. induction l; constructor; auto.
+  - intros l1 l2 l3 Hl12. revert l3. induction Hl12.
+    + auto using sublist_nil_l.
+    + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst.
+      eauto using sublist_inserts_l, sublist_skip.
+    + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst.
+      eauto using sublist_inserts_l, sublist_cons.
+  - intros l1 l2 Hl12 Hl21. apply sublist_length in Hl21.
+    induction Hl12 as [| |??? Hl12]; f_equal/=; auto with arith.
+    apply sublist_length in Hl12. lia.
+Qed.
+Lemma sublist_take l i : take i l `sublist_of` l.
+Proof. rewrite <-(take_drop i l) at 2. by apply sublist_inserts_r. Qed.
+Lemma sublist_drop l i : drop i l `sublist_of` l.
+Proof. rewrite <-(take_drop i l) at 2. by apply sublist_inserts_l. Qed.
+Lemma sublist_delete l i : delete i l `sublist_of` l.
+Proof. revert i. by induction l; intros [|?]; simpl; constructor. Qed.
+Lemma sublist_foldr_delete l is : foldr delete l is `sublist_of` l.
+Proof.
+  induction is as [|i is IH]; simpl; [done |].
+  trans (foldr delete l is); auto using sublist_delete.
+Qed.
+Lemma sublist_alt l1 l2 : l1 `sublist_of` l2 ↔ ∃ is, l1 = foldr delete l2 is.
+Proof.
+  split; [|intros [is ->]; apply sublist_foldr_delete].
+  intros Hl12. cut (∀ k, ∃ is, k ++ l1 = foldr delete (k ++ l2) is).
+  { intros help. apply (help []). }
+  induction Hl12 as [|x l1 l2 _ IH|x l1 l2 _ IH]; intros k.
+  - by eexists [].
+  - destruct (IH (k ++ [x])) as [is His]. exists is.
+    by rewrite <-!(assoc_L (++)) in His.
+  - destruct (IH k) as [is His]. exists (is ++ [length k]).
+    rewrite fold_right_app. simpl. by rewrite delete_middle.
+Qed.
+Lemma Permutation_sublist l1 l2 l3 :
+  l1 ≡ₚ l2 → l2 `sublist_of` l3 → ∃ l4, l1 `sublist_of` l4 ∧ l4 ≡ₚ l3.
+Proof.
+  intros Hl1l2. revert l3.
+  induction Hl1l2 as [|x l1 l2 ? IH|x y l1|l1 l1' l2 ? IH1 ? IH2].
+  - intros l3. by exists l3.
+  - intros l3. rewrite sublist_cons_l. intros (l3'&l3''&?&?); subst.
+    destruct (IH l3'') as (l4&?&Hl4); auto. exists (l3' ++ x :: l4).
+    split.
+    + by apply sublist_inserts_l, sublist_skip.
+    + by rewrite Hl4.
+  - intros l3. rewrite sublist_cons_l. intros (l3'&l3''&?& Hl3); subst.
+    rewrite sublist_cons_l in Hl3. destruct Hl3 as (l5'&l5''&?& Hl5); subst.
+    exists (l3' ++ y :: l5' ++ x :: l5''). split.
+    + by do 2 apply sublist_inserts_l, sublist_skip.
+    + by rewrite !Permutation_middle, Permutation_swap.
+  - intros l3 ?. destruct (IH2 l3) as (l3'&?&?); trivial.
+    destruct (IH1 l3') as (l3'' &?&?); trivial. exists l3''.
+    split; [done|]. etrans; eauto.
+Qed.
+Lemma sublist_Permutation l1 l2 l3 :
+  l1 `sublist_of` l2 → l2 ≡ₚ l3 → ∃ l4, l1 ≡ₚ l4 ∧ l4 `sublist_of` l3.
+Proof.
+  intros Hl1l2 Hl2l3. revert l1 Hl1l2.
+  induction Hl2l3 as [|x l2 l3 ? IH|x y l2|l2 l2' l3 ? IH1 ? IH2].
+  - intros l1. by exists l1.
+  - intros l1. rewrite sublist_cons_r. intros [?|(l1'&l1''&?)]; subst.
+    { destruct (IH l1) as (l4&?&?); trivial.
+      exists l4. split.
+      - done.
+      - by constructor. }
+    destruct (IH l1') as (l4&?&Hl4); auto. exists (x :: l4).
+    split; [ by constructor | by constructor ].
+  - intros l1. rewrite sublist_cons_r. intros [Hl1|(l1'&l1''&Hl1)]; subst.
+    { exists l1. split; [done|]. rewrite sublist_cons_r in Hl1.
+      destruct Hl1 as [?|(l1'&?&?)]; subst; by repeat constructor. }
+    rewrite sublist_cons_r in Hl1. destruct Hl1 as [?|(l1''&?&?)]; subst.
+    + exists (y :: l1'). by repeat constructor.
+    + exists (x :: y :: l1''). by repeat constructor.
+  - intros l1 ?. destruct (IH1 l1) as (l3'&?&?); trivial.
+    destruct (IH2 l3') as (l3'' &?&?); trivial. exists l3''.
+    split; [|done]. etrans; eauto.
+Qed.
+
+(** Properties of the [submseteq] predicate *)
+Lemma submseteq_length l1 l2 : l1 ⊆+ l2 → length l1 ≤ length l2.
+Proof. induction 1; simpl; auto with lia. Qed.
+Lemma submseteq_nil_l l : [] ⊆+ l.
+Proof. induction l; constructor; auto. Qed.
+Lemma submseteq_nil_r l : l ⊆+ [] ↔ l = [].
+Proof.
+  split; [|intros ->; constructor].
+  intros Hl. apply submseteq_length in Hl. destruct l; simpl in *; auto with lia.
+Qed.
+Global Instance: PreOrder (@submseteq A).
+Proof.
+  split.
+  - intros l. induction l; constructor; auto.
+  - red. apply submseteq_trans.
+Qed.
+Lemma Permutation_submseteq l1 l2 : l1 ≡ₚ l2 → l1 ⊆+ l2.
+Proof. induction 1; econstructor; eauto. Qed.
+Lemma sublist_submseteq l1 l2 : l1 `sublist_of` l2 → l1 ⊆+ l2.
+Proof. induction 1; constructor; auto. Qed.
+Lemma submseteq_Permutation l1 l2 : l1 ⊆+ l2 → ∃ k, l2 ≡ₚ l1 ++ k.
+Proof.
+  induction 1 as
+    [|x y l ? [k Hk]| |x l1 l2 ? [k Hk]|l1 l2 l3 ? [k Hk] ? [k' Hk']].
+  - by eexists [].
+  - exists k. by rewrite Hk.
+  - eexists []. rewrite (right_id_L [] (++)). by constructor.
+  - exists (x :: k). by rewrite Hk, Permutation_middle.
+  - exists (k ++ k'). by rewrite Hk', Hk, (assoc_L (++)).
+Qed.
+
+Global Instance: Proper ((≡ₚ) ==> (≡ₚ) ==> iff) (@submseteq A).
+Proof.
+  intros l1 l2 ? k1 k2 ?. split; intros.
+  - trans l1; [by apply Permutation_submseteq|].
+    trans k1; [done|]. by apply Permutation_submseteq.
+  - trans l2; [by apply Permutation_submseteq|].
+    trans k2; [done|]. by apply Permutation_submseteq.
+Qed.
+
+Lemma submseteq_length_Permutation l1 l2 :
+  l1 ⊆+ l2 → length l2 ≤ length l1 → l1 ≡ₚ l2.
+Proof.
+  intros Hsub Hlen. destruct (submseteq_Permutation l1 l2) as [[|??] Hk]; auto.
+  - by rewrite Hk, (right_id_L [] (++)).
+  - rewrite Hk, length_app in Hlen. simpl in *; lia.
+Qed.
+
+Global Instance: AntiSymm (≡ₚ) (@submseteq A).
+Proof.
+  intros l1 l2 ??.
+  apply submseteq_length_Permutation; auto using submseteq_length.
+Qed.
+
+Lemma elem_of_submseteq l k x : x ∈ l → l ⊆+ k → x ∈ k.
+Proof. intros ? [l' ->]%submseteq_Permutation. apply elem_of_app; auto. Qed.
+Lemma lookup_submseteq l k i x :
+  l !! i = Some x →
+  l ⊆+ k →
+  ∃ j, k !! j = Some x.
+Proof.
+  intros Hsub Hlook.
+  eapply elem_of_list_lookup_1, elem_of_submseteq;
+    eauto using elem_of_list_lookup_2.
+Qed.
+
+Lemma submseteq_take l i : take i l ⊆+ l.
+Proof. auto using sublist_take, sublist_submseteq. Qed.
+Lemma submseteq_drop l i : drop i l ⊆+ l.
+Proof. auto using sublist_drop, sublist_submseteq. Qed.
+Lemma submseteq_delete l i : delete i l ⊆+ l.
+Proof. auto using sublist_delete, sublist_submseteq. Qed.
+Lemma submseteq_foldr_delete l is : foldr delete l is `sublist_of` l.
+Proof. auto using sublist_foldr_delete, sublist_submseteq. Qed.
+Lemma submseteq_sublist_l l1 l3 : l1 ⊆+ l3 ↔ ∃ l2, l1 `sublist_of` l2 ∧ l2 ≡ₚ l3.
+Proof.
+  split.
+  { intros Hl13. elim Hl13; clear l1 l3 Hl13.
+    - by eexists [].
+    - intros x l1 l3 ? (l2&?&?). exists (x :: l2). by repeat constructor.
+    - intros x y l. exists (y :: x :: l). by repeat constructor.
+    - intros x l1 l3 ? (l2&?&?). exists (x :: l2). by repeat constructor.
+    - intros l1 l3 l5 ? (l2&?&?) ? (l4&?&?).
+      destruct (Permutation_sublist l2 l3 l4) as (l3'&?&?); trivial.
+      exists l3'. split; etrans; eauto. }
+  intros (l2&?&?).
+  trans l2; auto using sublist_submseteq, Permutation_submseteq.
+Qed.
+Lemma submseteq_sublist_r l1 l3 :
+  l1 ⊆+ l3 ↔ ∃ l2, l1 ≡ₚ l2 ∧ l2 `sublist_of` l3.
+Proof.
+  rewrite submseteq_sublist_l.
+  split; intros (l2&?&?); eauto using sublist_Permutation, Permutation_sublist.
+Qed.
+Lemma submseteq_inserts_l k l1 l2 : l1 ⊆+ l2 → l1 ⊆+ k ++ l2.
+Proof. induction k; try constructor; auto. Qed.
+Lemma submseteq_inserts_r k l1 l2 : l1 ⊆+ l2 → l1 ⊆+ l2 ++ k.
+Proof. rewrite (comm (++)). apply submseteq_inserts_l. Qed.
+Lemma submseteq_skips_l k l1 l2 : l1 ⊆+ l2 → k ++ l1 ⊆+ k ++ l2.
+Proof. induction k; try constructor; auto. Qed.
+Lemma submseteq_skips_r k l1 l2 : l1 ⊆+ l2 → l1 ++ k ⊆+ l2 ++ k.
+Proof. rewrite !(comm (++) _ k). apply submseteq_skips_l. Qed.
+Lemma submseteq_app l1 l2 k1 k2 : l1 ⊆+ l2 → k1 ⊆+ k2 → l1 ++ k1 ⊆+ l2 ++ k2.
+Proof. trans (l1 ++ k2); auto using submseteq_skips_l, submseteq_skips_r. Qed.
+Lemma submseteq_cons_r x l k :
+  l ⊆+ x :: k ↔ l ⊆+ k ∨ ∃ l', l ≡ₚ x :: l' ∧ l' ⊆+ k.
+Proof.
+  split.
+  - rewrite submseteq_sublist_r. intros (l'&E&Hl').
+    rewrite sublist_cons_r in Hl'. destruct Hl' as [?|(?&?&?)]; subst.
+    + left. rewrite E. eauto using sublist_submseteq.
+    + right. eauto using sublist_submseteq.
+  - intros [?|(?&E&?)]; [|rewrite E]; by constructor.
+Qed.
+Lemma submseteq_cons_l x l k : x :: l ⊆+ k ↔ ∃ k', k ≡ₚ x :: k' ∧ l ⊆+ k'.
+Proof.
+  split.
+  - rewrite submseteq_sublist_l. intros (l'&Hl'&E).
+    rewrite sublist_cons_l in Hl'. destruct Hl' as (k1&k2&?&?); subst.
+    exists (k1 ++ k2). split; eauto using submseteq_inserts_l, sublist_submseteq.
+    by rewrite Permutation_middle.
+  - intros (?&E&?). rewrite E. by constructor.
+Qed.
+Lemma submseteq_app_r l k1 k2 :
+  l ⊆+ k1 ++ k2 ↔ ∃ l1 l2, l ≡ₚ l1 ++ l2 ∧ l1 ⊆+ k1 ∧ l2 ⊆+ k2.
+Proof.
+  split.
+  - rewrite submseteq_sublist_r. intros (l'&E&Hl').
+    rewrite sublist_app_r in Hl'. destruct Hl' as (l1&l2&?&?&?); subst.
+    exists l1, l2. eauto using sublist_submseteq.
+  - intros (?&?&E&?&?). rewrite E. eauto using submseteq_app.
+Qed.
+Lemma submseteq_app_l l1 l2 k :
+  l1 ++ l2 ⊆+ k ↔ ∃ k1 k2, k ≡ₚ k1 ++ k2 ∧ l1 ⊆+ k1 ∧ l2 ⊆+ k2.
+Proof.
+  split.
+  - rewrite submseteq_sublist_l. intros (l'&Hl'&E).
+    rewrite sublist_app_l in Hl'. destruct Hl' as (k1&k2&?&?&?); subst.
+    exists k1, k2. split; [done|]. eauto using sublist_submseteq.
+  - intros (?&?&E&?&?). rewrite E. eauto using submseteq_app.
+Qed.
+Lemma submseteq_app_inv_l l1 l2 k : k ++ l1 ⊆+ k ++ l2 → l1 ⊆+ l2.
+Proof.
+  induction k as [|y k IH]; simpl; [done |]. rewrite submseteq_cons_l.
+  intros (?&E%(inj (cons y))&?). apply IH. by rewrite E.
+Qed.
+Lemma submseteq_app_inv_r l1 l2 k : l1 ++ k ⊆+ l2 ++ k → l1 ⊆+ l2.
+Proof. rewrite <-!(comm (++) k). apply submseteq_app_inv_l. Qed.
+Lemma submseteq_cons_middle x l k1 k2 : l ⊆+ k1 ++ k2 → x :: l ⊆+ k1 ++ x :: k2.
+Proof. rewrite <-Permutation_middle. by apply submseteq_skip. Qed.
+Lemma submseteq_app_middle l1 l2 k1 k2 :
+  l2 ⊆+ k1 ++ k2 → l1 ++ l2 ⊆+ k1 ++ l1 ++ k2.
+Proof.
+  rewrite !(assoc (++)), (comm (++) k1 l1), <-(assoc_L (++)).
+  by apply submseteq_skips_l.
+Qed.
+Lemma submseteq_middle l k1 k2 : l ⊆+ k1 ++ l ++ k2.
+Proof. by apply submseteq_inserts_l, submseteq_inserts_r. Qed.
+
+Lemma NoDup_submseteq l k : NoDup l → (∀ x, x ∈ l → x ∈ k) → l ⊆+ k.
+Proof.
+  intros Hl. revert k. induction Hl as [|x l Hx ? IH].
+  { intros k Hk. by apply submseteq_nil_l. }
+  intros k Hlk. destruct (elem_of_list_split k x) as (l1&l2&?); subst.
+  { apply Hlk. by constructor. }
+  rewrite <-Permutation_middle. apply submseteq_skip, IH.
+  intros y Hy. rewrite elem_of_app.
+  specialize (Hlk y). rewrite elem_of_app, !elem_of_cons in Hlk.
+  by destruct Hlk as [?|[?|?]]; subst; eauto.
+Qed.
+Lemma NoDup_Permutation l k : NoDup l → NoDup k → (∀ x, x ∈ l ↔ x ∈ k) → l ≡ₚ k.
+Proof.
+  intros. apply (anti_symm submseteq); apply NoDup_submseteq; naive_solver.
+Qed.
+
+Lemma submseteq_insert l1 l2 i j x y :
+  l1 !! i = Some x →
+  l2 !! j = Some x →
+  l1 ⊆+ l2 →
+  (<[i := y]> l1) ⊆+ (<[j := y]> l2).
+Proof.
+  intros ?? Hsub.
+  rewrite !insert_take_drop,
+    <-!Permutation_middle by eauto using lookup_lt_Some.
+  rewrite <-(take_drop_middle l1 i x), <-(take_drop_middle l2 j x),
+    <-!Permutation_middle in Hsub by done.
+  by apply submseteq_skip, (submseteq_app_inv_l _ _ [x]).
+Qed.
+
+Lemma singleton_submseteq_l l x :
+  [x] ⊆+ l ↔ x ∈ l.
+Proof.
+  split.
+  - intros Hsub. eapply elem_of_submseteq; [|done].
+    apply elem_of_list_singleton. done.
+  - intros (l1&l2&->)%elem_of_list_split.
+    apply submseteq_cons_middle, submseteq_nil_l.
+Qed.
+Lemma singleton_submseteq x y :
+  [x] ⊆+ [y] ↔ x = y.
+Proof. rewrite singleton_submseteq_l. apply elem_of_list_singleton. Qed.
+
+Section submseteq_dec.
+  Context `{!EqDecision A}.
+
+  Local Program Fixpoint elem_of_or_Permutation x l :
+      (x ∉ l) + { k | l ≡ₚ x :: k } :=
+    match l with
+    | [] => inl _
+    | y :: l =>
+       if decide (x = y) then inr (l ↾ _) else
+       match elem_of_or_Permutation x l return _ with
+       | inl _ => inl _ | inr (k ↾ _) => inr ((y :: k) ↾ _)
+       end
+    end.
+  Next Obligation. inv 2. Qed.
+  Next Obligation. naive_solver. Qed.
+  Next Obligation. intros ? x y l <- ??. by rewrite not_elem_of_cons. Qed.
+  Next Obligation.
+    intros ? x y l <- ? _ k Hl. simpl. by rewrite Hl, Permutation_swap.
+  Qed.
+
+  Global Program Instance submseteq_dec : RelDecision (@submseteq A) :=
+    fix go l1 l2 :=
+    match l1 with
+    | [] => left _
+    | x :: l1 =>
+       match elem_of_or_Permutation x l2 return _ with
+       | inl _ => right _
+       | inr (l2 ↾ _) => cast_if (go l1 l2)
+       end
+    end.
+  Next Obligation. intros _ l1 l2 _. apply submseteq_nil_l. Qed.
+  Next Obligation.
+    intros _ ? l2 x l1 <- Hx Hxl1. eapply Hx, elem_of_submseteq, Hxl1. by left.
+  Qed.
+  Next Obligation. intros _ ?? x l1 <- _ l2 -> Hl. by apply submseteq_skip. Qed.
+  Next Obligation.
+    intros _ ?? x l1 <- _ l2 -> Hl (l2' & Hl2%(inj _) & ?)%submseteq_cons_l.
+    apply Hl. by rewrite Hl2.
+  Qed.
+
+  Global Instance Permutation_dec : RelDecision (≡ₚ@{A}).
+  Proof using Type*.
+    refine (λ l1 l2, cast_if_and
+      (decide (l1 ⊆+ l2)) (decide (length l2 ≤ length l1)));
+      [by apply submseteq_length_Permutation
+      |abstract (intros He; by rewrite He in *)..].
+  Defined.
+End submseteq_dec.
+
+
+(** ** Properties of the [Forall] and [Exists] predicate *)
+Lemma Forall_Exists_dec (P Q : A → Prop) (dec : ∀ x, {P x} + {Q x}) :
+  ∀ l, {Forall P l} + {Exists Q l}.
+Proof.
+ refine (
+  fix go l :=
+  match l return {Forall P l} + {Exists Q l} with
+  | [] => left _
+  | x :: l => cast_if_and (dec x) (go l)
+  end); clear go; intuition.
+Defined.
+
+(** Export the Coq stdlib constructors under different names,
+because we use [Forall_nil] and [Forall_cons] for a version with a biimplication. *)
+Definition Forall_nil_2 := @Forall_nil A.
+Definition Forall_cons_2 := @Forall_cons A.
+Global Instance Forall_proper:
+  Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Forall A).
+Proof. split; subst; induction 1; constructor; by firstorder auto. Qed.
+Global Instance Exists_proper:
+  Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Exists A).
+Proof. split; subst; induction 1; constructor; by firstorder auto. Qed.
+
+Section Forall_Exists.
+  Context (P : A → Prop).
+
+  Lemma Forall_forall l : Forall P l ↔ ∀ x, x ∈ l → P x.
+  Proof.
+    split; [induction 1; inv 1; auto|].
+    intros Hin; induction l as [|x l IH]; constructor; [apply Hin; constructor|].
+    apply IH. intros ??. apply Hin. by constructor.
+  Qed.
+  Lemma Forall_nil : Forall P [] ↔ True.
+  Proof. done. Qed.
+  Lemma Forall_cons_1 x l : Forall P (x :: l) → P x ∧ Forall P l.
+  Proof. by inv 1. Qed.
+  Lemma Forall_cons x l : Forall P (x :: l) ↔ P x ∧ Forall P l.
+  Proof. split; [by inv 1|]. intros [??]. by constructor. Qed.
+  Lemma Forall_singleton x : Forall P [x] ↔ P x.
+  Proof. rewrite Forall_cons, Forall_nil; tauto. Qed.
+  Lemma Forall_app_2 l1 l2 : Forall P l1 → Forall P l2 → Forall P (l1 ++ l2).
+  Proof. induction 1; simpl; auto. Qed.
+  Lemma Forall_app l1 l2 : Forall P (l1 ++ l2) ↔ Forall P l1 ∧ Forall P l2.
+  Proof.
+    split; [induction l1; inv 1; naive_solver|].
+    intros [??]; auto using Forall_app_2.
+  Qed.
+  Lemma Forall_true l : (∀ x, P x) → Forall P l.
+  Proof. intros ?. induction l; auto. Defined.
+  Lemma Forall_impl (Q : A → Prop) l :
+    Forall P l → (∀ x, P x → Q x) → Forall Q l.
+  Proof. intros H ?. induction H; auto. Defined.
+  Lemma Forall_iff l (Q : A → Prop) :
+    (∀ x, P x ↔ Q x) → Forall P l ↔ Forall Q l.
+  Proof. intros H. apply Forall_proper. { red; apply H. } done. Qed.
+  Lemma Forall_not l : length l ≠ 0 → Forall (not ∘ P) l → ¬Forall P l.
+  Proof. by destruct 2; inv 1. Qed.
+  Lemma Forall_and {Q} l : Forall (λ x, P x ∧ Q x) l ↔ Forall P l ∧ Forall Q l.
+  Proof.
+    split; [induction 1; constructor; naive_solver|].
+    intros [Hl Hl']; revert Hl'; induction Hl; inv 1; auto.
+  Qed.
+  Lemma Forall_and_l {Q} l : Forall (λ x, P x ∧ Q x) l → Forall P l.
+  Proof. rewrite Forall_and; tauto. Qed.
+  Lemma Forall_and_r {Q} l : Forall (λ x, P x ∧ Q x) l → Forall Q l.
+  Proof. rewrite Forall_and; tauto. Qed.
+  Lemma Forall_delete l i : Forall P l → Forall P (delete i l).
+  Proof. intros H. revert i. by induction H; intros [|i]; try constructor. Qed.
+
+  Lemma Forall_lookup l : Forall P l ↔ ∀ i x, l !! i = Some x → P x.
+  Proof.
+    rewrite Forall_forall. setoid_rewrite elem_of_list_lookup. naive_solver.
+  Qed.
+  Lemma Forall_lookup_total `{!Inhabited A} l :
+    Forall P l ↔ ∀ i, i < length l → P (l !!! i).
+  Proof. rewrite Forall_lookup. setoid_rewrite list_lookup_alt. naive_solver. Qed.
+  Lemma Forall_lookup_1 l i x : Forall P l → l !! i = Some x → P x.
+  Proof. rewrite Forall_lookup. eauto. Qed.
+  Lemma Forall_lookup_total_1 `{!Inhabited A} l i :
+    Forall P l → i < length l → P (l !!! i).
+  Proof. rewrite Forall_lookup_total. eauto. Qed.
+  Lemma Forall_lookup_2 l : (∀ i x, l !! i = Some x → P x) → Forall P l.
+  Proof. by rewrite Forall_lookup. Qed.
+  Lemma Forall_lookup_total_2 `{!Inhabited A} l :
+    (∀ i, i < length l → P (l !!! i)) → Forall P l.
+  Proof. by rewrite Forall_lookup_total. Qed.
+  Lemma Forall_nth d l : Forall P l ↔ ∀ i, i < length l → P (nth i l d).
+  Proof.
+    rewrite Forall_lookup. split.
+    - intros Hl ? [x Hl']%lookup_lt_is_Some_2.
+      rewrite (nth_lookup_Some _ _ _ _ Hl'). by eapply Hl.
+    - intros Hl i x Hl'. specialize (Hl _ (lookup_lt_Some _ _ _ Hl')).
+      by rewrite (nth_lookup_Some _ _ _ _ Hl') in Hl.
+  Qed.
+
+  Lemma Forall_reverse l : Forall P (reverse l) ↔ Forall P l.
+  Proof.
+    induction l as [|x l IH]; simpl; [done|].
+    rewrite reverse_cons, Forall_cons, Forall_app, Forall_singleton. naive_solver.
+  Qed.
+  Lemma Forall_tail l : Forall P l → Forall P (tail l).
+  Proof. destruct 1; simpl; auto. Qed.
+  Lemma Forall_alter f l i :
+    Forall P l → (∀ x, l !! i = Some x → P x → P (f x)) → Forall P (alter f i l).
+  Proof.
+    intros Hl. revert i. induction Hl; simpl; intros [|i]; constructor; auto.
+  Qed.
+  Lemma Forall_alter_inv f l i :
+    Forall P (alter f i l) → (∀ x, l !! i = Some x → P (f x) → P x) → Forall P l.
+  Proof.
+    revert i. induction l; intros [|?]; simpl;
+      inv 1; constructor; eauto.
+  Qed.
+  Lemma Forall_insert l i x : Forall P l → P x → Forall P (<[i:=x]>l).
+  Proof. rewrite list_insert_alter; auto using Forall_alter. Qed.
+  Lemma Forall_inserts l i k :
+    Forall P l → Forall P k → Forall P (list_inserts i k l).
+  Proof.
+    intros Hl Hk; revert i.
+    induction Hk; simpl; auto using Forall_insert.
+  Qed.
+  Lemma Forall_replicate n x : P x → Forall P (replicate n x).
+  Proof. induction n; simpl; constructor; auto. Qed.
+  Lemma Forall_replicate_eq n (x : A) : Forall (x =.) (replicate n x).
+  Proof using -(P). induction n; simpl; constructor; auto. Qed.
+  Lemma Forall_take n l : Forall P l → Forall P (take n l).
+  Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+  Lemma Forall_drop n l : Forall P l → Forall P (drop n l).
+  Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+  Lemma Forall_rev_ind (Q : list A → Prop) :
+    Q [] → (∀ x l, P x → Forall P l → Q l → Q (l ++ [x])) →
+    ∀ l, Forall P l → Q l.
+  Proof.
+    intros ?? l. induction l using rev_ind; auto.
+    rewrite Forall_app, Forall_singleton; intros [??]; auto.
+  Qed.
+
+  Lemma Exists_exists l : Exists P l ↔ ∃ x, x ∈ l ∧ P x.
+  Proof.
+    split.
+    - induction 1 as [x|y ?? [x [??]]]; exists x; by repeat constructor.
+    - intros [x [Hin ?]]. induction l; [by destruct (not_elem_of_nil x)|].
+      inv Hin; subst; [left|right]; auto.
+  Qed.
+  Lemma Exists_inv x l : Exists P (x :: l) → P x ∨ Exists P l.
+  Proof. inv 1; intuition trivial. Qed.
+  Lemma Exists_app l1 l2 : Exists P (l1 ++ l2) ↔ Exists P l1 ∨ Exists P l2.
+  Proof.
+    split.
+    - induction l1; inv 1; naive_solver.
+    - intros [H|H]; [induction H | induction l1]; simpl; intuition.
+  Qed.
+  Lemma Exists_impl (Q : A → Prop) l :
+    Exists P l → (∀ x, P x → Q x) → Exists Q l.
+  Proof. intros H ?. induction H; auto. Defined.
+
+  Lemma Exists_not_Forall l : Exists (not ∘ P) l → ¬Forall P l.
+  Proof. induction 1; inv 1; contradiction. Qed.
+  Lemma Forall_not_Exists l : Forall (not ∘ P) l → ¬Exists P l.
+  Proof. induction 1; inv 1; contradiction. Qed.
+
+  Lemma Forall_list_difference `{!EqDecision A} l k :
+    Forall P l → Forall P (list_difference l k).
+  Proof.
+    rewrite !Forall_forall.
+    intros ? x; rewrite elem_of_list_difference; naive_solver.
+  Qed.
+  Lemma Forall_list_union `{!EqDecision A} l k :
+    Forall P l → Forall P k → Forall P (list_union l k).
+  Proof. intros. apply Forall_app; auto using Forall_list_difference. Qed.
+  Lemma Forall_list_intersection `{!EqDecision A} l k :
+    Forall P l → Forall P (list_intersection l k).
+  Proof.
+    rewrite !Forall_forall.
+    intros ? x; rewrite elem_of_list_intersection; naive_solver.
+  Qed.
+
+  Context {dec : ∀ x, Decision (P x)}.
+  Lemma not_Forall_Exists l : ¬Forall P l → Exists (not ∘ P) l.
+  Proof using Type*. intro. by destruct (Forall_Exists_dec P (not ∘ P) dec l). Qed.
+  Lemma not_Exists_Forall l : ¬Exists P l → Forall (not ∘ P) l.
+  Proof using Type*.
+    by destruct (Forall_Exists_dec (not ∘ P) P
+        (λ x : A, swap_if (decide (P x))) l).
+  Qed.
+  Global Instance Forall_dec l : Decision (Forall P l) :=
+    match Forall_Exists_dec P (not ∘ P) dec l with
+    | left H => left H
+    | right H => right (Exists_not_Forall _ H)
+    end.
+  Global Instance Exists_dec l : Decision (Exists P l) :=
+    match Forall_Exists_dec (not ∘ P) P (λ x, swap_if (decide (P x))) l with
+    | left H => right (Forall_not_Exists _ H)
+    | right H => left H
+    end.
+End Forall_Exists.
+
+Global Instance Forall_Permutation :
+  Proper (pointwise_relation _ (↔) ==> (≡ₚ) ==> (↔)) (@Forall A).
+Proof.
+  intros P1 P2 HP l1 l2 Hl. rewrite !Forall_forall.
+  apply forall_proper; intros x. by rewrite Hl, (HP x).
+Qed.
+Global Instance Exists_Permutation :
+  Proper (pointwise_relation _ (↔) ==> (≡ₚ) ==> (↔)) (@Exists A).
+Proof.
+  intros P1 P2 HP l1 l2 Hl. rewrite !Exists_exists.
+  f_equiv; intros x. by rewrite Hl, (HP x).
+Qed.
+
+Lemma head_filter_Some P `{!∀ x : A, Decision (P x)} l x :
+  head (filter P l) = Some x →
+  ∃ l1 l2, l = l1 ++ x :: l2 ∧ Forall (λ z, ¬P z) l1.
+Proof.
+  intros Hl. induction l as [|x' l IH]; [done|].
+  rewrite filter_cons in Hl. case_decide; simplify_eq/=.
+  - exists [], l. repeat constructor.
+  - destruct IH as (l1&l2&->&?); [done|].
+    exists (x' :: l1), l2. by repeat constructor.
+Qed.
+Lemma last_filter_Some P `{!∀ x : A, Decision (P x)} l x :
+  last (filter P l) = Some x →
+  ∃ l1 l2, l = l1 ++ x :: l2 ∧ Forall (λ z, ¬P z) l2.
+Proof.
+  rewrite <-(reverse_involutive (filter P l)), last_reverse, <-filter_reverse.
+  intros (l1&l2&Heq&Hl)%head_filter_Some.
+  exists (reverse l2), (reverse l1).
+  rewrite <-(reverse_involutive l), Heq, reverse_app, reverse_cons, <-(assoc_L (++)).
+  split; [done|by apply Forall_reverse].
+Qed.
+
+Lemma list_exist_dec P l :
+  (∀ x, Decision (P x)) → Decision (∃ x, x ∈ l ∧ P x).
+Proof.
+  refine (λ _, cast_if (decide (Exists P l))); by rewrite <-Exists_exists.
+Defined.
+Lemma list_forall_dec P l :
+  (∀ x, Decision (P x)) → Decision (∀ x, x ∈ l → P x).
+Proof.
+  refine (λ _, cast_if (decide (Forall P l))); by rewrite <-Forall_forall.
+Defined.
+
+Lemma forallb_True (f : A → bool) xs : forallb f xs ↔ Forall f xs.
+Proof.
+  split.
+  - induction xs; naive_solver.
+  - induction 1; naive_solver.
+Qed.
+Lemma existb_True (f : A → bool) xs : existsb f xs ↔ Exists f xs.
+Proof.
+  split.
+  - induction xs; naive_solver.
+  - induction 1; naive_solver.
+Qed.
+
+Lemma replicate_as_Forall (x : A) n l :
+  replicate n x = l ↔ length l = n ∧ Forall (x =.) l.
+Proof. rewrite replicate_as_elem_of, Forall_forall. naive_solver. Qed.
+Lemma replicate_as_Forall_2 (x : A) n l :
+  length l = n → Forall (x =.) l → replicate n x = l.
+Proof. by rewrite replicate_as_Forall. Qed.
+End general_properties.
+
+Lemma Forall_swap {A B} (Q : A → B → Prop) l1 l2 :
+  Forall (λ y, Forall (Q y) l1) l2 ↔ Forall (λ x, Forall (flip Q x) l2) l1.
+Proof. repeat setoid_rewrite Forall_forall. simpl. split; eauto. Qed.
+
+(** ** Properties of the [Forall2] predicate *)
+Lemma Forall_Forall2_diag {A} (Q : A → A → Prop) l :
+  Forall (λ x, Q x x) l → Forall2 Q l l.
+Proof. induction 1; constructor; auto. Qed.
+
+Lemma Forall2_forall `{Inhabited A} B C (Q : A → B → C → Prop) l k :
+  Forall2 (λ x y, ∀ z, Q z x y) l k ↔ ∀ z, Forall2 (Q z) l k.
+Proof.
+  split; [induction 1; constructor; auto|].
+  intros Hlk. induction (Hlk inhabitant) as [|x y l k _ _ IH]; constructor.
+  - intros z. by oinv Hlk.
+  - apply IH. intros z. by oinv Hlk.
+Qed.
+
+Lemma Forall2_same_length {A B} (l : list A) (k : list B) :
+  Forall2 (λ _ _, True) l k ↔ length l = length k.
+Proof.
+  split; [by induction 1; f_equal/=|].
+  revert k. induction l; intros [|??] ?; simplify_eq/=; auto.
+Qed.
+
+Lemma Forall2_Forall {A} P (l1 l2 : list A) :
+  Forall2 P l1 l2 → Forall (uncurry P) (zip l1 l2).
+Proof. induction 1; constructor; auto. Qed.
+
+(** Export the Coq stdlib constructors under a different name,
+because we use [Forall2_nil] and [Forall2_cons] for a version with a biimplication. *)
+Definition Forall2_nil_2 := @Forall2_nil.
+Definition Forall2_cons_2 := @Forall2_cons.
+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_length l k : Forall2 P l k → length l = length k.
+  Proof. by induction 1; f_equal/=. Qed.
+  Lemma Forall2_length_l l k n : Forall2 P l k → length l = n → length k = n.
+  Proof. intros ? <-; symmetry. by apply Forall2_length. Qed.
+  Lemma Forall2_length_r l k n : Forall2 P l k → length k = n → length l = n.
+  Proof. intros ? <-. by apply Forall2_length. Qed.
+
+  Lemma Forall2_true l k : (∀ x y, P x y) → length l = length k → Forall2 P l k.
+  Proof. rewrite <-Forall2_same_length. induction 2; naive_solver. Qed.
+  Lemma Forall2_flip l k : Forall2 (flip P) k l ↔ Forall2 P l k.
+  Proof. split; induction 1; constructor; auto. Qed.
+  Lemma Forall2_transitive {C} (Q : B → C → Prop) (R : A → C → Prop) l k lC :
+    (∀ x y z, P x y → Q y z → R x z) →
+    Forall2 P l k → Forall2 Q k lC → Forall2 R l lC.
+  Proof. intros ? Hl. revert lC. induction Hl; inv 1; eauto. Qed.
+  Lemma Forall2_impl (Q : A → B → Prop) l k :
+    Forall2 P l k → (∀ x y, P x y → Q x y) → Forall2 Q l k.
+  Proof. intros H ?. induction H; auto. Defined.
+  Lemma Forall2_unique l k1 k2 :
+    Forall2 P l k1 → Forall2 P l k2 →
+    (∀ x y1 y2, P x y1 → P x y2 → y1 = y2) → k1 = k2.
+  Proof.
+    intros H. revert k2. induction H; inv 1; intros; f_equal; eauto.
+  Qed.
+
+  Lemma Forall_Forall2_l l k :
+    length l = length k → Forall (λ x, ∀ y, P x y) l → Forall2 P l k.
+  Proof. rewrite <-Forall2_same_length. induction 1; inv 1; auto. Qed.
+  Lemma Forall_Forall2_r l k :
+    length l = length k → Forall (λ y, ∀ x, P x y) k → Forall2 P l k.
+  Proof. rewrite <-Forall2_same_length. induction 1; inv 1; auto. Qed.
+
+  Lemma Forall2_Forall_l (Q : A → Prop) l k :
+    Forall2 P l k → Forall (λ y, ∀ x, P x y → Q x) k → Forall Q l.
+  Proof. induction 1; inv 1; eauto. Qed.
+  Lemma Forall2_Forall_r (Q : B → Prop) l k :
+    Forall2 P l k → Forall (λ x, ∀ y, P x y → Q y) l → Forall Q k.
+  Proof. induction 1; inv 1; eauto. Qed.
+
+  Lemma Forall2_nil_inv_l k : Forall2 P [] k → k = [].
+  Proof. by inv 1. Qed.
+  Lemma Forall2_nil_inv_r l : Forall2 P l [] → l = [].
+  Proof. by inv 1. Qed.
+  Lemma Forall2_nil : Forall2 P [] [] ↔ True.
+  Proof. done. Qed.
+
+  Lemma Forall2_cons_1 x l y k :
+    Forall2 P (x :: l) (y :: k) → P x y ∧ Forall2 P l k.
+  Proof. by inv 1. Qed.
+  Lemma Forall2_cons_inv_l x l k :
+    Forall2 P (x :: l) k → ∃ y k', P x y ∧ Forall2 P l k' ∧ k = y :: k'.
+  Proof. inv 1; eauto. Qed.
+  Lemma Forall2_cons_inv_r l k y :
+    Forall2 P l (y :: k) → ∃ x l', P x y ∧ Forall2 P l' k ∧ l = x :: l'.
+  Proof. inv 1; eauto. Qed.
+  Lemma Forall2_cons_nil_inv x l : Forall2 P (x :: l) [] → False.
+  Proof. by inv 1. Qed.
+  Lemma Forall2_nil_cons_inv y k : Forall2 P [] (y :: k) → False.
+  Proof. by inv 1. Qed.
+
+  Lemma Forall2_cons x l y k :
+    Forall2 P (x :: l) (y :: k) ↔ P x y ∧ Forall2 P l k.
+  Proof.
+    split; [by apply Forall2_cons_1|]. intros []. by apply Forall2_cons_2.
+  Qed.
+
+  Lemma Forall2_app_l l1 l2 k :
+    Forall2 P l1 (take (length l1) k) → Forall2 P l2 (drop (length l1) k) →
+    Forall2 P (l1 ++ l2) k.
+  Proof. intros. rewrite <-(take_drop (length l1) k). by apply Forall2_app. Qed.
+  Lemma Forall2_app_r l k1 k2 :
+    Forall2 P (take (length k1) l) k1 → Forall2 P (drop (length k1) l) k2 →
+    Forall2 P l (k1 ++ k2).
+  Proof. intros. rewrite <-(take_drop (length k1) l). by apply Forall2_app. Qed.
+  Lemma Forall2_app_inv l1 l2 k1 k2 :
+    length l1 = length k1 →
+    Forall2 P (l1 ++ l2) (k1 ++ k2) → Forall2 P l1 k1 ∧ Forall2 P l2 k2.
+  Proof.
+    rewrite <-Forall2_same_length. induction 1; inv 1; naive_solver.
+  Qed.
+  Lemma Forall2_app_inv_l l1 l2 k :
+    Forall2 P (l1 ++ l2) k ↔
+      ∃ k1 k2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ k = k1 ++ k2.
+  Proof.
+    split; [|intros (?&?&?&?&->); by apply Forall2_app].
+    revert k. induction l1; inv 1; naive_solver.
+  Qed.
+  Lemma Forall2_app_inv_r l k1 k2 :
+    Forall2 P l (k1 ++ k2) ↔
+      ∃ l1 l2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ l = l1 ++ l2.
+  Proof.
+    split; [|intros (?&?&?&?&->); by apply Forall2_app].
+    revert l. induction k1; inv 1; naive_solver.
+  Qed.
+
+  Lemma Forall2_tail l k : Forall2 P l k → Forall2 P (tail l) (tail k).
+  Proof. destruct 1; simpl; auto. Qed.
+  Lemma Forall2_take l k n : Forall2 P l k → Forall2 P (take n l) (take n k).
+  Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+  Lemma Forall2_drop l k n : Forall2 P l k → Forall2 P (drop n l) (drop n k).
+  Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+
+  Lemma Forall2_lookup l k :
+    Forall2 P l k ↔ ∀ i, option_Forall2 P (l !! i) (k !! i).
+  Proof.
+    split; [induction 1; intros [|?]; simpl; try constructor; eauto|].
+    revert k. induction l as [|x l IH]; intros [| y k] H.
+    - done.
+    - oinv (H 0).
+    - oinv (H 0).
+    - constructor; [by oinv (H 0)|]. apply (IH _ $ λ i, H (S i)).
+  Qed.
+  Lemma Forall2_lookup_lr l k i x y :
+    Forall2 P l k → l !! i = Some x → k !! i = Some y → P x y.
+  Proof. rewrite Forall2_lookup; intros H; destruct (H i); naive_solver. Qed.
+  Lemma Forall2_lookup_l l k i x :
+    Forall2 P l k → l !! i = Some x → ∃ y, k !! i = Some y ∧ P x y.
+  Proof. rewrite Forall2_lookup; intros H; destruct (H i); naive_solver. Qed.
+  Lemma Forall2_lookup_r l k i y :
+    Forall2 P l k → k !! i = Some y → ∃ x, l !! i = Some x ∧ P x y.
+  Proof. rewrite Forall2_lookup; intros H; destruct (H i); naive_solver. Qed.
+  Lemma Forall2_same_length_lookup_2 l k :
+    length l = length k →
+    (∀ i x y, l !! i = Some x → k !! i = Some y → P x y) → Forall2 P l k.
+  Proof.
+    rewrite <-Forall2_same_length. intros Hl Hlookup.
+    induction Hl as [|?????? IH]; constructor; [by apply (Hlookup 0)|].
+    apply IH. apply (λ i, Hlookup (S i)).
+  Qed.
+  Lemma Forall2_same_length_lookup l k :
+    Forall2 P l k ↔
+      length l = length k ∧
+      (∀ i x y, l !! i = Some x → k !! i = Some y → P x y).
+  Proof.
+    naive_solver eauto using Forall2_length,
+      Forall2_lookup_lr, Forall2_same_length_lookup_2.
+  Qed.
+
+  Lemma Forall2_alter_l f l k i :
+    Forall2 P l k →
+    (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P (f x) y) →
+    Forall2 P (alter f i l) k.
+  Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+  Lemma Forall2_alter_r f l k i :
+    Forall2 P l k →
+    (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P x (f y)) →
+    Forall2 P l (alter f i k).
+  Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+  Lemma Forall2_alter f g l k i :
+    Forall2 P l k →
+    (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P (f x) (g y)) →
+    Forall2 P (alter f i l) (alter g i k).
+  Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+
+  Lemma Forall2_insert l k x y i :
+    Forall2 P l k → P x y → Forall2 P (<[i:=x]> l) (<[i:=y]> k).
+  Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+  Lemma Forall2_inserts l k l' k' i :
+    Forall2 P l k → Forall2 P l' k' →
+    Forall2 P (list_inserts i l' l) (list_inserts i k' k).
+  Proof. intros ? H. revert i. induction H; eauto using Forall2_insert. Qed.
+
+  Lemma Forall2_delete l k i :
+    Forall2 P l k → Forall2 P (delete i l) (delete i k).
+  Proof. intros Hl. revert i. induction Hl; intros [|]; simpl; intuition. Qed.
+  Lemma Forall2_option_list mx my :
+    option_Forall2 P mx my → Forall2 P (option_list mx) (option_list my).
+  Proof. destruct 1; by constructor. Qed.
+
+  Lemma Forall2_filter Q1 Q2 `{∀ x, Decision (Q1 x), ∀ y, Decision (Q2 y)} l k:
+    (∀ x y, P x y → Q1 x ↔ Q2 y) →
+    Forall2 P l k → Forall2 P (filter Q1 l) (filter Q2 k).
+  Proof.
+    intros HP; induction 1 as [|x y l k]; unfold filter; simpl; auto.
+    simplify_option_eq by (by rewrite <-(HP x y)); repeat constructor; auto.
+  Qed.
+
+  Lemma Forall2_replicate_l k n x :
+    length k = n → Forall (P x) k → Forall2 P (replicate n x) k.
+  Proof. intros <-. induction 1; simpl; auto. Qed.
+  Lemma Forall2_replicate_r l n y :
+    length l = n → Forall (flip P y) l → Forall2 P l (replicate n y).
+  Proof. intros <-. induction 1; simpl; auto. Qed.
+  Lemma Forall2_replicate n x y :
+    P x y → Forall2 P (replicate n x) (replicate n y).
+  Proof. induction n; simpl; constructor; auto. Qed.
+
+  Lemma Forall2_reverse l k : Forall2 P l k → Forall2 P (reverse l) (reverse k).
+  Proof.
+    induction 1; rewrite ?reverse_nil, ?reverse_cons; eauto using Forall2_app.
+  Qed.
+  Lemma Forall2_last l k : Forall2 P l k → option_Forall2 P (last l) (last k).
+  Proof. induction 1 as [|????? []]; simpl; repeat constructor; auto. Qed.
+
+
+  Global Instance Forall2_dec `{dec : ∀ x y, Decision (P x y)} :
+    RelDecision (Forall2 P).
+  Proof.
+   refine (
+    fix go l k : Decision (Forall2 P l k) :=
+    match l, k with
+    | [], [] => left _
+    | x :: l, y :: k => cast_if_and (decide (P x y)) (go l k)
+    | _, _ => right _
+    end); clear dec go; abstract first [by constructor | by inv 1].
+  Defined.
+End Forall2.
+
+Section Forall2_proper.
+  Context  {A} (R : relation A).
+
+  Global Instance: Reflexive R → Reflexive (Forall2 R).
+  Proof. intros ? l. induction l; by constructor. Qed.
+  Global Instance: Symmetric R → Symmetric (Forall2 R).
+  Proof. intros. induction 1; constructor; auto. Qed.
+  Global Instance: Transitive R → Transitive (Forall2 R).
+  Proof. intros ????. apply Forall2_transitive. by apply @transitivity. Qed.
+  Global Instance: Equivalence R → Equivalence (Forall2 R).
+  Proof. split; apply _. Qed.
+  Global Instance: PreOrder R → PreOrder (Forall2 R).
+  Proof. split; apply _. Qed.
+  Global Instance: AntiSymm (=) R → AntiSymm (=) (Forall2 R).
+  Proof. induction 2; inv 1; f_equal; auto. Qed.
+
+  Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (::).
+  Proof. by constructor. Qed.
+  Global Instance: Proper (Forall2 R ==> Forall2 R ==> Forall2 R) (++).
+  Proof. repeat intro. by apply Forall2_app. Qed.
+  Global Instance: Proper (Forall2 R ==> (=)) length.
+  Proof. repeat intro. eauto using Forall2_length. Qed.
+  Global Instance: Proper (Forall2 R ==> Forall2 R) tail.
+  Proof. repeat intro. eauto using Forall2_tail. Qed.
+  Global Instance: ∀ n, Proper (Forall2 R ==> Forall2 R) (take n).
+  Proof. repeat intro. eauto using Forall2_take. Qed.
+  Global Instance: ∀ n, Proper (Forall2 R ==> Forall2 R) (drop n).
+  Proof. repeat intro. eauto using Forall2_drop. Qed.
+
+  Global Instance: ∀ i, Proper (Forall2 R ==> option_Forall2 R) (lookup i).
+  Proof. repeat intro. by apply Forall2_lookup. Qed.
+  Global Instance:
+    Proper ((R ==> R) ==> (=) ==> Forall2 R ==> Forall2 R) (alter (M:=list A)).
+  Proof. repeat intro. subst. eauto using Forall2_alter. Qed.
+  Global Instance: ∀ i, Proper (R ==> Forall2 R ==> Forall2 R) (insert i).
+  Proof. repeat intro. eauto using Forall2_insert. Qed.
+  Global Instance: ∀ i,
+    Proper (Forall2 R ==> Forall2 R ==> Forall2 R) (list_inserts i).
+  Proof. repeat intro. eauto using Forall2_inserts. Qed.
+  Global Instance: ∀ i, Proper (Forall2 R ==> Forall2 R) (delete i).
+  Proof. repeat intro. eauto using Forall2_delete. Qed.
+
+  Global Instance: Proper (option_Forall2 R ==> Forall2 R) option_list.
+  Proof. repeat intro. eauto using Forall2_option_list. Qed.
+  Global Instance: ∀ P `{∀ x, Decision (P x)},
+    Proper (R ==> iff) P → Proper (Forall2 R ==> Forall2 R) (filter P).
+  Proof. repeat intro; eauto using Forall2_filter. Qed.
+
+  Global Instance: ∀ n, Proper (R ==> Forall2 R) (replicate n).
+  Proof. repeat intro. eauto using Forall2_replicate. Qed.
+  Global Instance: Proper (Forall2 R ==> Forall2 R) reverse.
+  Proof. repeat intro. eauto using Forall2_reverse. Qed.
+  Global Instance: Proper (Forall2 R ==> option_Forall2 R) last.
+  Proof. repeat intro. eauto using Forall2_last. Qed.
+End Forall2_proper.
+
+Section Forall3.
+  Context {A B C} (P : A → B → C → Prop).
+  Local Hint Extern 0 (Forall3 _ _ _ _) => constructor : core.
+
+  Lemma Forall3_app l1 l2 k1 k2 k1' k2' :
+    Forall3 P l1 k1 k1' → Forall3 P l2 k2 k2' →
+    Forall3 P (l1 ++ l2) (k1 ++ k2) (k1' ++ k2').
+  Proof. induction 1; simpl; auto. Qed.
+  Lemma Forall3_cons_inv_l x l k k' :
+    Forall3 P (x :: l) k k' → ∃ y k2 z k2',
+      k = y :: k2 ∧ k' = z :: k2' ∧ P x y z ∧ Forall3 P l k2 k2'.
+  Proof. inv 1; naive_solver. Qed.
+  Lemma Forall3_app_inv_l l1 l2 k k' :
+    Forall3 P (l1 ++ l2) k k' → ∃ k1 k2 k1' k2',
+     k = k1 ++ k2 ∧ k' = k1' ++ k2' ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'.
+  Proof.
+    revert k k'. induction l1 as [|x l1 IH]; simpl; inv 1.
+    - by repeat eexists; eauto.
+    - by repeat eexists; eauto.
+    - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver.
+  Qed.
+  Lemma Forall3_cons_inv_m l y k k' :
+    Forall3 P l (y :: k) k' → ∃ x l2 z k2',
+      l = x :: l2 ∧ k' = z :: k2' ∧ P x y z ∧ Forall3 P l2 k k2'.
+  Proof. inv 1; naive_solver. Qed.
+  Lemma Forall3_app_inv_m l k1 k2 k' :
+    Forall3 P l (k1 ++ k2) k' → ∃ l1 l2 k1' k2',
+     l = l1 ++ l2 ∧ k' = k1' ++ k2' ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'.
+  Proof.
+    revert l k'. induction k1 as [|x k1 IH]; simpl; inv 1.
+    - by repeat eexists; eauto.
+    - by repeat eexists; eauto.
+    - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver.
+  Qed.
+  Lemma Forall3_cons_inv_r l k z k' :
+    Forall3 P l k (z :: k') → ∃ x l2 y k2,
+      l = x :: l2 ∧ k = y :: k2 ∧ P x y z ∧ Forall3 P l2 k2 k'.
+  Proof. inv 1; naive_solver. Qed.
+  Lemma Forall3_app_inv_r l k k1' k2' :
+    Forall3 P l k (k1' ++ k2') → ∃ l1 l2 k1 k2,
+      l = l1 ++ l2 ∧ k = k1 ++ k2 ∧ Forall3 P l1 k1 k1' ∧ Forall3 P l2 k2 k2'.
+  Proof.
+    revert l k. induction k1' as [|x k1' IH]; simpl; inv 1.
+    - by repeat eexists; eauto.
+    - by repeat eexists; eauto.
+    - edestruct IH as (?&?&?&?&?&?&?&?); eauto; naive_solver.
+  Qed.
+  Lemma Forall3_impl (Q : A → B → C → Prop) l k k' :
+    Forall3 P l k k' → (∀ x y z, P x y z → Q x y z) → Forall3 Q l k k'.
+  Proof. intros Hl ?; induction Hl; auto. Defined.
+  Lemma Forall3_length_lm l k k' : Forall3 P l k k' → length l = length k.
+  Proof. by induction 1; f_equal/=. Qed.
+  Lemma Forall3_length_lr l k k' : Forall3 P l k k' → length l = length k'.
+  Proof. by induction 1; f_equal/=. Qed.
+  Lemma Forall3_lookup_lmr l k k' i x y z :
+    Forall3 P l k k' →
+    l !! i = Some x → k !! i = Some y → k' !! i = Some z → P x y z.
+  Proof.
+    intros H. revert i. induction H; intros [|?] ???; simplify_eq/=; eauto.
+  Qed.
+  Lemma Forall3_lookup_l l k k' i x :
+    Forall3 P l k k' → l !! i = Some x →
+    ∃ y z, k !! i = Some y ∧ k' !! i = Some z ∧ P x y z.
+  Proof.
+    intros H. revert i. induction H; intros [|?] ?; simplify_eq/=; eauto.
+  Qed.
+  Lemma Forall3_lookup_m l k k' i y :
+    Forall3 P l k k' → k !! i = Some y →
+    ∃ x z, l !! i = Some x ∧ k' !! i = Some z ∧ P x y z.
+  Proof.
+    intros H. revert i. induction H; intros [|?] ?; simplify_eq/=; eauto.
+  Qed.
+  Lemma Forall3_lookup_r l k k' i z :
+    Forall3 P l k k' → k' !! i = Some z →
+    ∃ x y, l !! i = Some x ∧ k !! i = Some y ∧ P x y z.
+  Proof.
+    intros H. revert i. induction H; intros [|?] ?; simplify_eq/=; eauto.
+  Qed.
+  Lemma Forall3_alter_lm f g l k k' i :
+    Forall3 P l k k' →
+    (∀ x y z, l !! i = Some x → k !! i = Some y → k' !! i = Some z →
+      P x y z → P (f x) (g y) z) →
+    Forall3 P (alter f i l) (alter g i k) k'.
+  Proof. intros Hl. revert i. induction Hl; intros [|]; auto. Qed.
+End Forall3.
+
+(** ** Properties of [subseteq] *)
+Section subseteq.
+Context {A : Type}.
+Implicit Types x y z : A.
+Implicit Types l k : list A.
+
+Global Instance list_subseteq_po : PreOrder (⊆@{list A}).
+Proof. split; firstorder. Qed.
+Lemma list_subseteq_nil l : [] ⊆ l.
+Proof. intros x. by rewrite elem_of_nil. Qed.
+Lemma list_nil_subseteq l : l ⊆ [] → l = [].
+Proof.
+  intro Hl. destruct l as [|x l1]; [done|]. exfalso.
+  rewrite <-(elem_of_nil x).
+  apply Hl, elem_of_cons. by left.
+Qed.
+Lemma list_subseteq_skip x l1 l2 : l1 ⊆ l2 → x :: l1 ⊆ x :: l2.
+Proof.
+  intros Hin y Hy%elem_of_cons.
+  destruct Hy as [-> | Hy]; [by left|]. right. by apply Hin.
+Qed.
+Lemma list_subseteq_cons x l1 l2 : l1 ⊆ l2 → l1 ⊆ x :: l2.
+Proof. intros Hin y Hy. right. by apply Hin. Qed.
+Lemma list_subseteq_app_l l1 l2 l : l1 ⊆ l2 → l1 ⊆ l2 ++ l.
+Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_app. naive_solver. Qed.
+Lemma list_subseteq_app_r l1 l2 l : l1 ⊆ l2 → l1 ⊆ l ++ l2.
+Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_app. naive_solver. Qed.
+
+Lemma list_subseteq_app_iff_l l1 l2 l :
+  l1 ++ l2 ⊆ l ↔ l1 ⊆ l ∧ l2 ⊆ l.
+Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_app. naive_solver. Qed.
+Lemma list_subseteq_cons_iff x l1 l2 :
+  x :: l1 ⊆ l2 ↔ x ∈ l2 ∧ l1 ⊆ l2.
+Proof. unfold subseteq, list_subseteq. setoid_rewrite elem_of_cons. naive_solver. Qed.
+
+Lemma list_delete_subseteq i l : delete i l ⊆ l.
+Proof.
+  revert i. induction l as [|x l IHl]; intros i; [done|].
+  destruct i as [|i];
+    [by apply list_subseteq_cons|by apply list_subseteq_skip].
+Qed.
+Lemma list_filter_subseteq P `{!∀ x : A, Decision (P x)} l :
+  filter P l ⊆ l.
+Proof.
+  induction l as [|x l IHl]; [done|]. rewrite filter_cons.
+  destruct (decide (P x));
+    [by apply list_subseteq_skip|by apply list_subseteq_cons].
+Qed.
+Lemma subseteq_drop n l : drop n l ⊆ l.
+Proof. rewrite <-(take_drop n l) at 2. apply list_subseteq_app_r. done. Qed.
+Lemma subseteq_take n l : take n l ⊆ l.
+Proof. rewrite <-(take_drop n l) at 2. apply list_subseteq_app_l. done. Qed.
+
+Global Instance list_subseteq_Permutation:
+  Proper ((≡ₚ) ==> (≡ₚ) ==> (↔)) (⊆@{list A}) .
+Proof.
+  intros l1 l2 Hl k1 k2 Hk. apply forall_proper; intros x. by rewrite Hl, Hk.
+Qed.
+
+Global Program Instance list_subseteq_dec `{!EqDecision A} : RelDecision (⊆@{list A}) :=
+  λ xs ys, cast_if (decide (Forall (λ x, x ∈ ys) xs)).
+Next Obligation. intros ???. by rewrite Forall_forall. Qed.
+Next Obligation. intros ???. by rewrite Forall_forall. Qed.
+End subseteq.
+
+(** Setoids *)
+Section setoid.
+  Context `{Equiv A}.
+  Implicit Types l k : list A.
+
+  Lemma list_equiv_Forall2 l k : l ≡ k ↔ Forall2 (≡) l k.
+  Proof. split; induction 1; constructor; auto. Qed.
+  Lemma list_equiv_lookup l k : l ≡ k ↔ ∀ i, l !! i ≡ k !! i.
+  Proof.
+    rewrite list_equiv_Forall2, Forall2_lookup.
+    by setoid_rewrite option_equiv_Forall2.
+  Qed.
+
+  Global Instance list_equivalence :
+    Equivalence (≡@{A}) → Equivalence (≡@{list A}).
+  Proof.
+    split.
+    - intros l. by apply list_equiv_Forall2.
+    - intros l k; rewrite !list_equiv_Forall2; by intros.
+    - intros l1 l2 l3; rewrite !list_equiv_Forall2; intros; by trans l2.
+  Qed.
+  Global Instance list_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (list A).
+  Proof. induction 1; f_equal; fold_leibniz; auto. Qed.
+
+  Global Instance cons_proper : Proper ((≡) ==> (≡) ==> (≡@{list A})) cons.
+  Proof. by constructor. Qed.
+  Global Instance app_proper : Proper ((≡) ==> (≡) ==> (≡@{list A})) app.
+  Proof. induction 1; intros ???; simpl; try constructor; auto. Qed.
+  Global Instance length_proper : Proper ((≡@{list A}) ==> (=)) length.
+  Proof. induction 1; f_equal/=; auto. Qed.
+  Global Instance tail_proper : Proper ((≡@{list A}) ==> (≡)) tail.
+  Proof. destruct 1; try constructor; auto. Qed.
+  Global Instance take_proper n : Proper ((≡@{list A}) ==> (≡)) (take n).
+  Proof. induction n; destruct 1; constructor; auto. Qed.
+  Global Instance drop_proper n : Proper ((≡@{list A}) ==> (≡)) (drop n).
+  Proof. induction n; destruct 1; simpl; try constructor; auto. Qed.
+  Global Instance list_lookup_proper i : Proper ((≡@{list A}) ==> (≡)) (lookup i).
+  Proof. induction i; destruct 1; simpl; try constructor; auto. Qed.
+  Global Instance list_lookup_total_proper `{!Inhabited A} i :
+    Proper (≡@{A}) inhabitant →
+    Proper ((≡@{list A}) ==> (≡)) (lookup_total i).
+  Proof. intros ?. induction i; destruct 1; simpl; auto. Qed.
+  Global Instance list_alter_proper :
+    Proper (((≡) ==> (≡)) ==> (=) ==> (≡) ==> (≡@{list A})) alter.
+  Proof.
+    intros f1 f2 Hf i ? <-. induction i; destruct 1; constructor; eauto.
+  Qed.
+  Global Instance list_insert_proper i :
+    Proper ((≡) ==> (≡) ==> (≡@{list A})) (insert i).
+  Proof. intros ???; induction i; destruct 1; constructor; eauto. Qed.
+  Global Instance list_inserts_proper i :
+    Proper ((≡) ==> (≡) ==> (≡@{list A})) (list_inserts i).
+  Proof.
+    intros k1 k2 Hk; revert i.
+    induction Hk; intros ????; simpl; try f_equiv; naive_solver.
+  Qed.
+  Global Instance list_delete_proper i :
+    Proper ((≡) ==> (≡@{list A})) (delete i).
+  Proof. induction i; destruct 1; try constructor; eauto. Qed.
+  Global Instance option_list_proper : Proper ((≡) ==> (≡@{list A})) option_list.
+  Proof. destruct 1; repeat constructor; auto. Qed.
+  Global Instance list_filter_proper P `{∀ x, Decision (P x)} :
+    Proper ((≡) ==> iff) P → Proper ((≡) ==> (≡@{list A})) (filter P).
+  Proof. intros ???. rewrite !list_equiv_Forall2. by apply Forall2_filter. Qed.
+  Global Instance replicate_proper n : Proper ((≡@{A}) ==> (≡)) (replicate n).
+  Proof. induction n; constructor; auto. Qed.
+  Global Instance reverse_proper : Proper ((≡) ==> (≡@{list A})) reverse.
+  Proof.
+    induction 1; rewrite ?reverse_cons; simpl; [constructor|].
+    apply app_proper; repeat constructor; auto.
+  Qed.
+  Global Instance last_proper : Proper ((≡) ==> (≡)) (@last A).
+  Proof. induction 1 as [|????? []]; simpl; repeat constructor; auto. Qed.
+
+  Global Instance cons_equiv_inj : Inj2 (≡) (≡) (≡) (@cons A).
+  Proof. inv 1; auto. Qed.
+
+  Lemma nil_equiv_eq l : l ≡ [] ↔ l = [].
+  Proof. split; [by inv 1|intros ->; constructor]. Qed.
+  Lemma cons_equiv_eq l x k : l ≡ x :: k ↔ ∃ x' k', l = x' :: k' ∧ x' ≡ x ∧ k' ≡ k.
+  Proof. split; [inv 1; naive_solver|naive_solver (by constructor)]. Qed.
+  Lemma list_singleton_equiv_eq l x : l ≡ [x] ↔ ∃ x', l = [x'] ∧ x' ≡ x.
+  Proof. rewrite cons_equiv_eq. setoid_rewrite nil_equiv_eq. naive_solver. Qed.
+  Lemma app_equiv_eq l k1 k2 :
+    l ≡ k1 ++ k2 ↔ ∃ k1' k2', l = k1' ++ k2' ∧ k1' ≡ k1 ∧ k2' ≡ k2.
+  Proof.
+    split; [|intros (?&?&->&?&?); by f_equiv].
+    setoid_rewrite list_equiv_Forall2. rewrite Forall2_app_inv_r. naive_solver.
+  Qed.
+
+  Lemma equiv_Permutation l1 l2 l3 :
+    l1 ≡ l2 → l2 ≡ₚ l3 → ∃ l2', l1 ≡ₚ l2' ∧ l2' ≡ l3.
+  Proof.
+    intros Hequiv Hperm. revert l1 Hequiv.
+    induction Hperm as [|x l2 l3 _ IH|x y l2|l2 l3 l4 _ IH1 _ IH2]; intros l1.
+    - intros ?. by exists l1.
+    - intros (x'&l2'&->&?&(l2''&?&?)%IH)%cons_equiv_eq.
+      exists (x' :: l2''). by repeat constructor.
+    - intros (y'&?&->&?&(x'&l2'&->&?&?)%cons_equiv_eq)%cons_equiv_eq.
+      exists (x' :: y' :: l2'). by repeat constructor.
+    - intros (l2'&?&(l3'&?&?)%IH2)%IH1. exists l3'. split; [by etrans|done].
+  Qed.
+
+  Lemma Permutation_equiv `{!Equivalence (≡@{A})} l1 l2 l3 :
+    l1 ≡ₚ l2 → l2 ≡ l3 → ∃ l2', l1 ≡ l2' ∧ l2' ≡ₚ l3.
+  Proof.
+    intros Hperm%symmetry Hequiv%symmetry.
+    destruct (equiv_Permutation _ _  _ Hequiv Hperm) as (l2'&?&?).
+    by exists l2'.
+  Qed.
+End setoid.
+
+Lemma TCForall_Forall {A} (P : A → Prop) xs : TCForall P xs ↔ Forall P xs.
+Proof. split; induction 1; constructor; auto. Qed.
+
+Global Instance TCForall_app {A} (P : A → Prop) xs ys :
+  TCForall P xs → TCForall P ys → TCForall P (xs ++ ys).
+Proof. rewrite !TCForall_Forall. apply Forall_app_2. Qed.
+
+Lemma TCForall2_Forall2 {A B} (P : A → B → Prop) xs ys :
+  TCForall2 P xs ys ↔ Forall2 P xs ys.
+Proof. split; induction 1; constructor; auto. Qed.
+
+Lemma TCExists_Exists {A} (P : A → Prop) l : TCExists P l ↔ Exists P l.
+Proof. split; induction 1; constructor; solve [auto]. Qed.

stdpp/list_tactics.v

+From Coq Require Export Permutation.
+From stdpp Require Export numbers base option list_basics list_relations list_monad.
+From stdpp Require Import options.
+
+(** * Reflection over lists *)
+(** We define a simple data structure [rlist] to capture a syntactic
+representation of lists consisting of constants, applications and the nil list.
+Note that we represent [(x ::.)] as [rapp (rnode [x])]. For now, we abstract
+over the type of constants, but later we use [nat]s and a list representing
+a corresponding environment. *)
+Inductive rlist (A : Type) :=
+  rnil : rlist A | rnode : A → rlist A | rapp : rlist A → rlist A → rlist A.
+Global Arguments rnil {_} : assert.
+Global Arguments rnode {_} _ : assert.
+Global Arguments rapp {_} _ _ : assert.
+
+Module rlist.
+Fixpoint to_list {A} (t : rlist A) : list A :=
+  match t with
+  | rnil => [] | rnode l => [l] | rapp t1 t2 => to_list t1 ++ to_list t2
+  end.
+Notation env A := (list (list A)) (only parsing).
+Definition eval {A} (E : env A) : rlist nat → list A :=
+  fix go t :=
+  match t with
+  | rnil => []
+  | rnode i => default [] (E !! i)
+  | rapp t1 t2 => go t1 ++ go t2
+  end.
+
+(** A simple quoting mechanism using type classes. [QuoteLookup E1 E2 x i]
+means: starting in environment [E1], look up the index [i] corresponding to the
+constant [x]. In case [x] has a corresponding index [i] in [E1], the original
+environment is given back as [E2]. Otherwise, the environment [E2] is extended
+with a binding [i] for [x]. *)
+Section quote_lookup.
+  Context {A : Type}.
+  Class QuoteLookup (E1 E2 : list A) (x : A) (i : nat) := {}.
+  Global Instance quote_lookup_here E x : QuoteLookup (x :: E) (x :: E) x 0 := {}.
+  Global Instance quote_lookup_end x : QuoteLookup [] [x] x 0 := {}.
+  Global Instance quote_lookup_further E1 E2 x i y :
+    QuoteLookup E1 E2 x i → QuoteLookup (y :: E1) (y :: E2) x (S i) | 1000 := {}.
+End quote_lookup.
+
+Section quote.
+  Context {A : Type}.
+  Class Quote (E1 E2 : env A) (l : list A) (t : rlist nat) := {}.
+  Global Instance quote_nil E1 : Quote E1 E1 [] rnil := {}.
+  Global Instance quote_node E1 E2 l i:
+    QuoteLookup E1 E2 l i → Quote E1 E2 l (rnode i) | 1000 := {}.
+  Global Instance quote_cons E1 E2 E3 x l i t :
+    QuoteLookup E1 E2 [x] i →
+    Quote E2 E3 l t → Quote E1 E3 (x :: l) (rapp (rnode i) t) := {}.
+  Global Instance quote_app E1 E2 E3 l1 l2 t1 t2 :
+    Quote E1 E2 l1 t1 → Quote E2 E3 l2 t2 → Quote E1 E3 (l1 ++ l2) (rapp t1 t2) := {}.
+End quote.
+
+Section eval.
+  Context {A} (E : env A).
+
+  Lemma eval_alt t : eval E t = to_list t ≫= default [] ∘ (E !!.).
+  Proof.
+    induction t; csimpl.
+    - done.
+    - by rewrite (right_id_L [] (++)).
+    - rewrite bind_app. by f_equal.
+  Qed.
+  Lemma eval_eq t1 t2 : to_list t1 = to_list t2 → eval E t1 = eval E t2.
+  Proof. intros Ht. by rewrite !eval_alt, Ht. Qed.
+  Lemma eval_Permutation t1 t2 :
+    to_list t1 ≡ₚ to_list t2 → eval E t1 ≡ₚ eval E t2.
+  Proof. intros Ht. by rewrite !eval_alt, Ht. Qed.
+  Lemma eval_submseteq t1 t2 :
+    to_list t1 ⊆+ to_list t2 → eval E t1 ⊆+ eval E t2.
+  Proof. intros Ht. by rewrite !eval_alt, Ht. Qed.
+End eval.
+End rlist.
+
+(** * Tactics *)
+Ltac quote_Permutation :=
+  match goal with
+  | |- ?l1 ≡ₚ ?l2 =>
+    match type of (_ : rlist.Quote [] _ l1 _) with rlist.Quote _ ?E2 _ ?t1 =>
+    match type of (_ : rlist.Quote E2 _ l2 _) with rlist.Quote _ ?E3 _ ?t2 =>
+      change (rlist.eval E3 t1 ≡ₚ rlist.eval E3 t2)
+    end end
+  end.
+Ltac solve_Permutation :=
+  quote_Permutation; apply rlist.eval_Permutation;
+  compute_done.
+
+Ltac quote_submseteq :=
+  match goal with
+  | |- ?l1 ⊆+ ?l2 =>
+    match type of (_ : rlist.Quote [] _ l1 _) with rlist.Quote _ ?E2 _ ?t1 =>
+    match type of (_ : rlist.Quote E2 _ l2 _) with rlist.Quote _ ?E3 _ ?t2 =>
+      change (rlist.eval E3 t1 ⊆+ rlist.eval E3 t2)
+    end end
+  end.
+Ltac solve_submseteq :=
+  quote_submseteq; apply rlist.eval_submseteq;
+  compute_done.
+
+Ltac decompose_elem_of_list := repeat
+  match goal with
+  | H : ?x ∈ [] |- _ => by destruct (not_elem_of_nil x)
+  | H : _ ∈ _ :: _ |- _ => apply elem_of_cons in H; destruct H
+  | H : _ ∈ _ ++ _ |- _ => apply elem_of_app in H; destruct H
+  end.
+Ltac solve_length :=
+  simplify_eq/=;
+  repeat (rewrite length_fmap || rewrite length_app);
+  repeat match goal with
+  | H : _ =@{list _} _ |- _ => apply (f_equal length) in H
+  | H : Forall2 _ _ _ |- _ => apply Forall2_length in H
+  | H : context[length (_ <$> _)] |- _ => rewrite length_fmap in H
+  end; done || congruence.
+Ltac simplify_list_eq ::= repeat
+  match goal with
+  | _ => progress simplify_eq/=
+  | H : [?x] !! ?i = Some ?y |- _ =>
+    destruct i; [change (Some x = Some y) in H | discriminate]
+  | H : _ <$> _ = [] |- _ => apply fmap_nil_inv in H
+  | H : [] = _ <$> _ |- _ => symmetry in H; apply fmap_nil_inv in H
+  | H : zip_with _ _ _ = [] |- _ => apply zip_with_nil_inv in H; destruct H
+  | H : [] = zip_with _ _ _ |- _ => symmetry in H
+  | |- context [(_ ++ _) ++ _] => rewrite <-(assoc_L (++))
+  | H : context [(_ ++ _) ++ _] |- _ => rewrite <-(assoc_L (++)) in H
+  | H : context [_ <$> (_ ++ _)] |- _ => rewrite fmap_app in H
+  | |- context [_ <$> (_ ++ _)]  => rewrite fmap_app
+  | |- context [_ ++ []] => rewrite (right_id_L [] (++))
+  | H : context [_ ++ []] |- _ => rewrite (right_id_L [] (++)) in H
+  | |- context [take _ (_ <$> _)] => rewrite <-fmap_take
+  | H : context [take _ (_ <$> _)] |- _ => rewrite <-fmap_take in H
+  | |- context [drop _ (_ <$> _)] => rewrite <-fmap_drop
+  | H : context [drop _ (_ <$> _)] |- _ => rewrite <-fmap_drop in H
+  | H : _ ++ _ = _ ++ _ |- _ =>
+    repeat (rewrite <-app_comm_cons in H || rewrite <-(assoc_L (++)) in H);
+    apply app_inj_1 in H; [destruct H|solve_length]
+  | H : _ ++ _ = _ ++ _ |- _ =>
+    repeat (rewrite app_comm_cons in H || rewrite (assoc_L (++)) in H);
+    apply app_inj_2 in H; [destruct H|solve_length]
+  | |- context [zip_with _ (_ ++ _) (_ ++ _)] =>
+    rewrite zip_with_app by solve_length
+  | |- context [take _ (_ ++ _)] => rewrite take_app_length' by solve_length
+  | |- context [drop _ (_ ++ _)] => rewrite drop_app_length' by solve_length
+  | H : context [zip_with _ (_ ++ _) (_ ++ _)] |- _ =>
+    rewrite zip_with_app in H by solve_length
+  | H : context [take _ (_ ++ _)] |- _ =>
+    rewrite take_app_length' in H by solve_length
+  | H : context [drop _ (_ ++ _)] |- _ =>
+    rewrite drop_app_length' in H by solve_length
+  | H : ?l !! ?i = _, H2 : context [(_ <$> ?l) !! ?i] |- _ =>
+     rewrite list_lookup_fmap, H in H2
+  end.
+Ltac decompose_Forall_hyps :=
+  repeat match goal with
+  | H : Forall _ [] |- _ => clear H
+  | H : Forall _ (_ :: _) |- _ => rewrite Forall_cons in H; destruct H
+  | H : Forall _ (_ ++ _) |- _ => rewrite Forall_app in H; destruct H
+  | H : Forall2 _ [] [] |- _ => clear H
+  | H : Forall2 _ (_ :: _) [] |- _ => destruct (Forall2_cons_nil_inv _ _ _ H)
+  | H : Forall2 _ [] (_ :: _) |- _ => destruct (Forall2_nil_cons_inv _ _ _ H)
+  | H : Forall2 _ [] ?k |- _ => apply Forall2_nil_inv_l in H
+  | H : Forall2 _ ?l [] |- _ => apply Forall2_nil_inv_r in H
+  | H : Forall2 _ (_ :: _) (_ :: _) |- _ =>
+    apply Forall2_cons_1 in H; destruct H
+  | H : Forall2 _ (_ :: _) ?k |- _ =>
+    let k_hd := fresh k "_hd" in let k_tl := fresh k "_tl" in
+    apply Forall2_cons_inv_l in H; destruct H as (k_hd&k_tl&?&?&->);
+    rename k_tl into k
+  | H : Forall2 _ ?l (_ :: _) |- _ =>
+    let l_hd := fresh l "_hd" in let l_tl := fresh l "_tl" in
+    apply Forall2_cons_inv_r in H; destruct H as (l_hd&l_tl&?&?&->);
+    rename l_tl into l
+  | H : Forall2 _ (_ ++ _) ?k |- _ =>
+    let k1 := fresh k "_1" in let k2 := fresh k "_2" in
+    apply Forall2_app_inv_l in H; destruct H as (k1&k2&?&?&->)
+  | H : Forall2 _ ?l (_ ++ _) |- _ =>
+    let l1 := fresh l "_1" in let l2 := fresh l "_2" in
+    apply Forall2_app_inv_r in H; destruct H as (l1&l2&?&?&->)
+  | _ => progress simplify_eq/=
+  | H : Forall3 _ _ (_ :: _) _ |- _ =>
+    apply Forall3_cons_inv_m in H; destruct H as (?&?&?&?&?&?&?&?)
+  | H : Forall2 _ (_ :: _) ?k |- _ =>
+    apply Forall2_cons_inv_l in H; destruct H as (?&?&?&?&?)
+  | H : Forall2 _ ?l (_ :: _) |- _ =>
+    apply Forall2_cons_inv_r in H; destruct H as (?&?&?&?&?)
+  | H : Forall2 _ (_ ++ _) (_ ++ _) |- _ =>
+    apply Forall2_app_inv in H; [destruct H|solve_length]
+  | H : Forall2 _ ?l (_ ++ _) |- _ =>
+    apply Forall2_app_inv_r in H; destruct H as (?&?&?&?&?)
+  | H : Forall2 _ (_ ++ _) ?k |- _ =>
+    apply Forall2_app_inv_l in H; destruct H as (?&?&?&?&?)
+  | H : Forall3 _ _ (_ ++ _) _ |- _ =>
+    apply Forall3_app_inv_m in H; destruct H as (?&?&?&?&?&?&?&?)
+  | H : Forall ?P ?l, H1 : ?l !! _ = Some ?x |- _ =>
+    (* to avoid some stupid loops, not fool proof *)
+    unless (P x) by auto using Forall_app_2, Forall_nil_2;
+    let E := fresh in
+    assert (P x) as E by (apply (Forall_lookup_1 P _ _ _ H H1)); lazy beta in E
+  | H : Forall2 ?P ?l ?k |- _ =>
+    match goal with
+    | H1 : l !! ?i = Some ?x, H2 : k !! ?i = Some ?y |- _ =>
+      unless (P x y) by done; let E := fresh in
+      assert (P x y) as E by (by apply (Forall2_lookup_lr P l k i x y));
+      lazy beta in E
+    | H1 : l !! ?i = Some ?x |- _ =>
+      try (match goal with _ : k !! i = Some _ |- _ => fail 2 end);
+      destruct (Forall2_lookup_l P _ _ _ _ H H1) as (?&?&?)
+    | H2 : k !! ?i = Some ?y |- _ =>
+      try (match goal with _ : l !! i = Some _ |- _ => fail 2 end);
+      destruct (Forall2_lookup_r P _ _ _ _ H H2) as (?&?&?)
+    end
+  | H : Forall3 ?P ?l ?l' ?k |- _ =>
+    lazymatch goal with
+    | H1:l !! ?i = Some ?x, H2:l' !! ?i = Some ?y, H3:k !! ?i = Some ?z |- _ =>
+      unless (P x y z) by done; let E := fresh in
+      assert (P x y z) as E by (by apply (Forall3_lookup_lmr P l l' k i x y z));
+      lazy beta in E
+    | H1 : l !! _ = Some ?x |- _ =>
+      destruct (Forall3_lookup_l P _ _ _ _ _ H H1) as (?&?&?&?&?)
+    | H2 : l' !! _ = Some ?y |- _ =>
+      destruct (Forall3_lookup_m P _ _ _ _ _ H H2) as (?&?&?&?&?)
+    | H3 : k !! _ = Some ?z |- _ =>
+      destruct (Forall3_lookup_r P _ _ _ _ _ H H3) as (?&?&?&?&?)
+    end
+  end.
+Ltac list_simplifier :=
+  simplify_eq/=;
+  repeat match goal with
+  | _ => progress decompose_Forall_hyps
+  | _ => progress simplify_list_eq
+  | H : _ <$> _ = _ :: _ |- _ =>
+    apply fmap_cons_inv in H; destruct H as (?&?&?&?&?)
+  | H : _ :: _ = _ <$> _ |- _ => symmetry in H
+  | H : _ <$> _ = _ ++ _ |- _ =>
+    apply fmap_app_inv in H; destruct H as (?&?&?&?&?)
+  | H : _ ++ _ = _ <$> _ |- _ => symmetry in H
+  | H : zip_with _ _ _ = _ :: _ |- _ =>
+    apply zip_with_cons_inv in H; destruct H as (?&?&?&?&?&?&?&?)
+  | H : _ :: _ = zip_with _ _ _ |- _ => symmetry in H
+  | H : zip_with _ _ _ = _ ++ _ |- _ =>
+    apply zip_with_app_inv in H; destruct H as (?&?&?&?&?&?&?&?&?)
+  | H : _ ++ _ = zip_with _ _ _ |- _ => symmetry in H
+  end.
+Ltac decompose_Forall := repeat
+  match goal with
+  | |- Forall _ _ => by apply Forall_true
+  | |- Forall _ [] => constructor
+  | |- Forall _ (_ :: _) => constructor
+  | |- Forall _ (_ ++ _) => apply Forall_app_2
+  | |- Forall _ (_ <$> _) => apply Forall_fmap
+  | |- Forall _ (_ ≫= _) => apply Forall_bind
+  | |- Forall2 _ _ _ => apply Forall_Forall2_diag
+  | |- Forall2 _ [] [] => constructor
+  | |- Forall2 _ (_ :: _) (_ :: _) => constructor
+  | |- Forall2 _ (_ ++ _) (_ ++ _) => first
+    [ apply Forall2_app; [by decompose_Forall |]
+    | apply Forall2_app; [| by decompose_Forall]]
+  | |- Forall2 _ (_ <$> _) _ => apply Forall2_fmap_l
+  | |- Forall2 _ _ (_ <$> _) => apply Forall2_fmap_r
+  | _ => progress decompose_Forall_hyps
+  | H : Forall _ (_ <$> _) |- _ => rewrite Forall_fmap in H
+  | H : Forall _ (_ ≫= _) |- _ => rewrite Forall_bind in H
+  | |- Forall _ _ =>
+    apply Forall_lookup_2; intros ???; progress decompose_Forall_hyps
+  | |- Forall2 _ _ _ =>
+    apply Forall2_same_length_lookup_2; [solve_length|];
+    intros ?????; progress decompose_Forall_hyps
+  end.
+
+(** The [simplify_suffix] tactic removes [suffix] hypotheses that are
+tautologies, and simplifies [suffix] hypotheses involving [(::)] and
+[(++)]. *)
+Ltac simplify_suffix := repeat
+  match goal with
+  | H : suffix (_ :: _) _ |- _ => destruct (suffix_cons_not _ _ H)
+  | H : suffix (_ :: _) [] |- _ => apply suffix_nil_inv in H
+  | H : suffix (_ ++ _) (_ ++ _) |- _ => apply suffix_app_inv in H
+  | H : suffix (_ :: _) (_ :: _) |- _ =>
+    destruct (suffix_cons_inv _ _ _ _ H); clear H
+  | H : suffix ?x ?x |- _ => clear H
+  | H : suffix ?x (_ :: ?x) |- _ => clear H
+  | H : suffix ?x (_ ++ ?x) |- _ => clear H
+  | _ => progress simplify_eq/=
+  end.
+
+(** The [solve_suffix] tactic tries to solve goals involving [suffix]. It
+uses [simplify_suffix] to simplify hypotheses and tries to solve [suffix]
+conclusions. This tactic either fails or proves the goal. *)
+Ltac solve_suffix := by intuition (repeat
+  match goal with
+  | _ => done
+  | _ => progress simplify_suffix
+  | |- suffix [] _ => apply suffix_nil
+  | |- suffix _ _ => reflexivity
+  | |- suffix _ (_ :: _) => apply suffix_cons_r
+  | |- suffix _ (_ ++ _) => apply suffix_app_r
+  | H : suffix _ _ → False |- _ => destruct H
+  end).

theories/listset.v → stdpp/listset.v

@@ -4,8 +4,8 @@ From stdpp Require Export sets list.
 From stdpp Require Import options.
 
 Record listset A := Listset { listset_car: list A }.
-Arguments listset_car {_} _ : assert.
-Arguments Listset {_} _ : assert.
+Global Arguments listset_car {_} _ : assert.
+Global Arguments Listset {_} _ : assert.
 
 Section listset.
 Context {A : Type}.
@@ -28,7 +28,7 @@ Lemma listset_empty_alt X : X ≡ ∅ ↔ listset_car X = [].
 Proof.
   destruct X as [l]; split; [|by intros; simplify_eq/=].
   rewrite elem_of_equiv_empty; intros Hl.
-  destruct l as [|x l]; [done|]. feed inversion (Hl x). left.
+  destruct l as [|x l]; [done|]. oinversion Hl. left.
 Qed.
 Global Instance listset_empty_dec (X : listset A) : Decision (X ≡ ∅).
 Proof.
@@ -48,7 +48,7 @@ Global Instance listset_intersection: Intersection (listset A) :=
 Global Instance listset_difference: Difference (listset A) :=
   λ '(Listset l) '(Listset k), Listset (list_difference l k).
 
-Instance listset_set: Set_ A (listset A).
+Local Instance listset_set: Set_ A (listset A).
 Proof.
   split.
   - apply _.
@@ -66,14 +66,14 @@ Proof.
 Qed.
 End listset.
 
-Instance listset_ret: MRet listset := λ A x, {[ x ]}.
-Instance listset_fmap: FMap listset := λ A B f '(Listset l),
+Global Instance listset_ret: MRet listset := λ A x, {[ x ]}.
+Global Instance listset_fmap: FMap listset := λ A B f '(Listset l),
   Listset (f <$> l).
-Instance listset_bind: MBind listset := λ A B f '(Listset l),
+Global Instance listset_bind: MBind listset := λ A B f '(Listset l),
   Listset (mbind (listset_car ∘ f) l).
-Instance listset_join: MJoin listset := λ A, mbind id.
+Global Instance listset_join: MJoin listset := λ A, mbind id.
 
-Instance listset_set_monad : MonadSet listset.
+Global Instance listset_set_monad : MonadSet listset.
 Proof.
   split.
   - intros. apply _.

theories/listset_nodup.v → stdpp/listset_nodup.v

@@ -7,9 +7,9 @@ From stdpp Require Import options.
 Record listset_nodup A := ListsetNoDup {
   listset_nodup_car : list A; listset_nodup_prf : NoDup listset_nodup_car
 }.
-Arguments ListsetNoDup {_} _ _ : assert.
-Arguments listset_nodup_car {_} _ : assert.
-Arguments listset_nodup_prf {_} _ : assert.
+Global Arguments ListsetNoDup {_} _ _ : assert.
+Global Arguments listset_nodup_car {_} _ : assert.
+Global Arguments listset_nodup_prf {_} _ : assert.
 
 Section list_set.
 Context `{EqDecision A}.
@@ -29,7 +29,7 @@ Global Instance listset_nodup_difference: Difference C :=
   λ '(ListsetNoDup l Hl) '(ListsetNoDup k Hk),
     ListsetNoDup _ (NoDup_list_difference _ k Hl).
 
-Instance listset_nodup_set: Set_ A C.
+Local Instance listset_nodup_set: Set_ A C.
 Proof.
   split; [split | | ].
   - by apply not_elem_of_nil.

theories/mapset.v → stdpp/mapset.v

@@ -8,10 +8,16 @@ From stdpp Require Import options.
 locally (or things moved out of sections) as no default works well enough. *)
 Unset Default Proof Using.
 
-Record mapset (M : Type → Type) : Type :=
-  Mapset { mapset_car: M (unit : Type) }.
-Arguments Mapset {_} _ : assert.
-Arguments mapset_car {_} _ : assert.
+(** Given a type of maps [M : Type → Type], we construct sets as [M ()], i.e.,
+maps with unit values. To avoid unnecessary universe constraints, we first
+define [mapset' Munit] with [Munit : Type] as a record, and then [mapset M] with
+[M : Type → Type] as a notation. See [tests/universes.v] for a test case that
+fails otherwise. *)
+Record mapset' (Munit : Type) : Type :=
+  Mapset { mapset_car: Munit }.
+Notation mapset M := (mapset' (M unit)).
+Global Arguments Mapset {_} _ : assert.
+Global Arguments mapset_car {_} _ : assert.
 
 Section mapset.
 Context `{FinMap K M}.
@@ -37,7 +43,7 @@ Proof.
   f_equal. apply map_eq. intros i. apply option_eq. intros []. by apply E.
 Qed.
 
-Instance mapset_set: Set_ K (mapset M).
+Local Instance mapset_set: Set_ K (mapset M).
 Proof.
   split; [split | | ].
   - unfold empty, elem_of, mapset_empty, mapset_elem_of.
@@ -103,11 +109,9 @@ Definition mapset_map_with {A B} (f : bool → A → option B)
     match x, y with
     | Some _, Some a => f true a | None, Some a => f false a | _, None => None
     end) mX.
+
 Definition mapset_dom_with {A} (f : A → bool) (m : M A) : mapset M :=
-  Mapset $ merge (λ x _,
-    match x with
-    | Some a => if f a then Some () else None | None => None
-    end) m (@empty (M A) _).
+  Mapset $ omap (λ a, if f a then Some () else None) m.
 
 Lemma lookup_mapset_map_with {A B} (f : bool → A → option B) X m i :
   mapset_map_with f X m !! i = m !! i ≫= f (bool_decide (i ∈ X)).
@@ -120,20 +124,19 @@ Lemma elem_of_mapset_dom_with {A} (f : A → bool) m i :
   i ∈ mapset_dom_with f m ↔ ∃ x, m !! i = Some x ∧ f x.
 Proof.
   unfold mapset_dom_with, elem_of, mapset_elem_of.
-  simpl. rewrite lookup_merge by done. destruct (m !! i) as [a|].
+  simpl. rewrite lookup_omap. destruct (m !! i) as [a|]; simpl.
   - destruct (Is_true_reflect (f a)); naive_solver.
   - naive_solver.
 Qed.
-Instance mapset_dom {A} : Dom (M A) (mapset M) := mapset_dom_with (λ _, true).
-Instance mapset_dom_spec: FinMapDom K M (mapset M).
+
+Local Instance mapset_dom {A} : Dom (M A) (mapset M) := λ m,
+  Mapset $ fmap (λ _, ()) m.
+Local Instance mapset_dom_spec: FinMapDom K M (mapset M).
 Proof.
-  split; try apply _. intros. unfold dom, mapset_dom, is_Some.
-  rewrite elem_of_mapset_dom_with; naive_solver.
+  split; try apply _. intros A m i.
+  unfold dom, mapset_dom, is_Some, elem_of, mapset_elem_of; simpl.
+  rewrite lookup_fmap. destruct (m !! i); naive_solver.
 Qed.
 End mapset.
 
-(** [mapset_elem_of] internally contains an equality; make sure that tactics do
-not unfold it and try to unify [∈] against goals with [=]. *)
-Opaque mapset_elem_of.
-
-Arguments mapset_eq_dec : simpl never.
+Global Arguments mapset_eq_dec : simpl never.

theories/namespaces.v → stdpp/namespaces.v

@@ -2,29 +2,29 @@ From stdpp Require Export countable coPset.
 From stdpp Require Import options.
 
 Definition namespace := list positive.
-Instance namespace_eq_dec : EqDecision namespace := _.
-Instance namespace_countable : Countable namespace := _.
-Typeclasses Opaque namespace.
+Global Instance namespace_eq_dec : EqDecision namespace := _.
+Global Instance namespace_countable : Countable namespace := _.
+Global Typeclasses Opaque namespace.
 
 Definition nroot : namespace := nil.
 
-Definition ndot_def `{Countable A} (N : namespace) (x : A) : namespace :=
+Local Definition ndot_def `{Countable A} (N : namespace) (x : A) : namespace :=
   encode x :: N.
-Definition ndot_aux : seal (@ndot_def). by eexists. Qed.
+Local Definition ndot_aux : seal (@ndot_def). by eexists. Qed.
 Definition ndot {A A_dec A_count}:= unseal ndot_aux A A_dec A_count.
-Definition ndot_eq : @ndot = @ndot_def := seal_eq ndot_aux.
+Local Definition ndot_unseal : @ndot = @ndot_def := seal_eq ndot_aux.
 
-Definition nclose_def (N : namespace) : coPset :=
+Local Definition nclose_def (N : namespace) : coPset :=
   coPset_suffixes (positives_flatten N).
-Definition nclose_aux : seal (@nclose_def). by eexists. Qed.
-Instance nclose : UpClose namespace coPset := unseal nclose_aux.
-Definition nclose_eq : @nclose = @nclose_def := seal_eq nclose_aux.
+Local Definition nclose_aux : seal (@nclose_def). by eexists. Qed.
+Global Instance nclose : UpClose namespace coPset := unseal nclose_aux.
+Local Definition nclose_unseal : @nclose = @nclose_def := seal_eq nclose_aux.
 
 Notation "N .@ x" := (ndot N x)
   (at level 19, left associativity, format "N .@ x") : stdpp_scope.
 Notation "(.@)" := ndot (only parsing) : stdpp_scope.
 
-Instance ndisjoint : Disjoint namespace := λ N1 N2, nclose N1 ## nclose N2.
+Global Instance ndisjoint : Disjoint namespace := λ N1 N2, nclose N1 ## nclose N2.
 
 Section namespace.
   Context `{Countable A}.
@@ -33,14 +33,14 @@ Section namespace.
   Implicit Types E : coPset.
 
   Global Instance ndot_inj : Inj2 (=) (=) (=) (@ndot A _ _).
-  Proof. intros N1 x1 N2 x2; rewrite !ndot_eq; naive_solver. Qed.
+  Proof. intros N1 x1 N2 x2; rewrite !ndot_unseal; naive_solver. Qed.
 
   Lemma nclose_nroot : ↑nroot = (⊤:coPset).
-  Proof. rewrite nclose_eq. by apply (sig_eq_pi _). Qed.
+  Proof. rewrite nclose_unseal. by apply (sig_eq_pi _). Qed.
 
   Lemma nclose_subseteq N x : ↑N.@x ⊆ (↑N : coPset).
   Proof.
-    intros p. unfold up_close. rewrite !nclose_eq, !ndot_eq.
+    intros p. unfold up_close. rewrite !nclose_unseal, !ndot_unseal.
     unfold nclose_def, ndot_def; rewrite !elem_coPset_suffixes.
     intros [q ->]. destruct (positives_flatten_suffix N (ndot_def N x)) as [q' ?].
     { by exists [encode x]. }
@@ -51,11 +51,11 @@ Section namespace.
   Proof. intros. etrans; eauto using nclose_subseteq. Qed.
 
   Lemma nclose_infinite N : ¬set_finite (↑ N : coPset).
-  Proof. rewrite nclose_eq. apply coPset_suffixes_infinite. Qed.
+  Proof. rewrite nclose_unseal. apply coPset_suffixes_infinite. Qed.
 
   Lemma ndot_ne_disjoint N x y : x ≠ y → N.@x ## N.@y.
   Proof.
-    intros Hxy a. unfold up_close. rewrite !nclose_eq, !ndot_eq.
+    intros Hxy a. unfold up_close. rewrite !nclose_unseal, !ndot_unseal.
     unfold nclose_def, ndot_def; rewrite !elem_coPset_suffixes.
     intros [qx ->] [qy Hqy].
     revert Hqy. by intros [= ?%(inj encode)]%positives_flatten_suffix_eq.
@@ -79,30 +79,61 @@ Create HintDb ndisj discriminated.
 (** If-and-only-if rules. Well, not quite, but for the fragment we are
 considering they are. *)
 Local Definition coPset_subseteq_difference_r := subseteq_difference_r (C:=coPset).
-Hint Resolve coPset_subseteq_difference_r : ndisj.
+Global Hint Resolve coPset_subseteq_difference_r : ndisj.
 Local Definition coPset_empty_subseteq := empty_subseteq (C:=coPset).
-Hint Resolve coPset_empty_subseteq : ndisj.
+Global Hint Resolve coPset_empty_subseteq : ndisj.
 Local Definition coPset_union_least := union_least (C:=coPset).
-Hint Resolve coPset_union_least : ndisj.
+Global Hint Resolve coPset_union_least : ndisj.
+(** For goals like [X ⊆ L ∪ R], backtrack for the two sides. *)
+Local Definition coPset_union_subseteq_l' := union_subseteq_l' (C:=coPset).
+Global Hint Resolve coPset_union_subseteq_l' | 50 : ndisj.
+Local Definition coPset_union_subseteq_r' := union_subseteq_r' (C:=coPset).
+Global Hint Resolve coPset_union_subseteq_r' | 50 : ndisj.
 (** Fallback, loses lots of information but lets other rules make progress. *)
 Local Definition coPset_subseteq_difference_l := subseteq_difference_l (C:=coPset).
-Hint Resolve coPset_subseteq_difference_l | 100 : ndisj.
-Hint Resolve nclose_subseteq' | 100 : ndisj.
+Global Hint Resolve coPset_subseteq_difference_l | 100 : ndisj.
+Global Hint Resolve nclose_subseteq' | 100 : ndisj.
 
 (** Rules for goals of the form [_ ## _] *)
 (** The base rule that we want to ultimately get down to. *)
-Hint Extern 0 (_ ## _) => apply ndot_ne_disjoint; congruence : ndisj.
+Global Hint Extern 0 (_ ## _) => apply ndot_ne_disjoint; congruence : ndisj.
+(** Trivial cases. *)
+Local Definition coPset_disjoint_empty_l := disjoint_empty_l (C:=coPset).
+Global Hint Resolve coPset_disjoint_empty_l : ndisj.
+Local Definition coPset_disjoint_empty_r := disjoint_empty_r (C:=coPset).
+Global Hint Resolve coPset_disjoint_empty_r : ndisj.
+(** If-and-only-if rules for ∪ on the left/right. *)
+Local Definition coPset_disjoint_union_l X1 X2 Y :=
+  proj2 (disjoint_union_l (C:=coPset) X1 X2 Y).
+Global Hint Resolve coPset_disjoint_union_l : ndisj.
+Local Definition coPset_disjoint_union_r X Y1 Y2 :=
+  proj2 (disjoint_union_r (C:=coPset) X Y1 Y2).
+Global Hint Resolve coPset_disjoint_union_r : ndisj.
+(** We prefer ∖ on the left of ## (for the [disjoint_difference] lemmas to
+apply), so try moving it there. *)
+Global Hint Extern 10 (_ ## (_ ∖ _)) =>
+  lazymatch goal with
+  | |- (_ ∖ _) ## _ => fail (* ∖ on both sides, leave it be *)
+  | |- _ => symmetry
+  end : ndisj.
+(** Before we apply disjoint_difference, let's make sure we normalize the goal
+to [_ ∖ (_ ∪ _)]. *)
+Local Lemma coPset_difference_difference (X1 X2 X3 Y : coPset) :
+  X1 ∖ (X2 ∪ X3) ## Y →
+  X1 ∖ X2 ∖ X3 ## Y.
+Proof. set_solver. Qed.
+Global Hint Resolve coPset_difference_difference | 20 : ndisj.
 (** Fallback, loses lots of information but lets other rules make progress.
 Tests show trying [disjoint_difference_l1] first gives better performance. *)
 Local Definition coPset_disjoint_difference_l1 := disjoint_difference_l1 (C:=coPset).
-Hint Resolve coPset_disjoint_difference_l1 | 50 : ndisj.
+Global Hint Resolve coPset_disjoint_difference_l1 | 50 : ndisj.
 Local Definition coPset_disjoint_difference_l2 := disjoint_difference_l2 (C:=coPset).
-Hint Resolve coPset_disjoint_difference_l2 | 100 : ndisj.
-Hint Resolve ndot_preserve_disjoint_l ndot_preserve_disjoint_r | 100 : ndisj.
+Global Hint Resolve coPset_disjoint_difference_l2 | 100 : ndisj.
+Global Hint Resolve ndot_preserve_disjoint_l ndot_preserve_disjoint_r | 100 : ndisj.
 
 Ltac solve_ndisj :=
   repeat match goal with
   | H : _ ∪ _ ⊆ _ |- _ => apply union_subseteq in H as [??]
   end;
   solve [eauto 12 with ndisj].
-Hint Extern 1000 => solve_ndisj : solve_ndisj.
+Global Hint Extern 1000 => solve_ndisj : solve_ndisj.

theories/nat_cancel.v → stdpp/nat_cancel.v

@@ -38,14 +38,14 @@ approach based on reflection would be better, but for small inputs, the overhead
 of reification will probably not be worth it. *)
 
 Class NatCancel (m n m' n' : nat) := nat_cancel : m' + n = m + n'.
-Hint Mode NatCancel ! ! - - : typeclass_instances.
+Global Hint Mode NatCancel ! ! - - : typeclass_instances.
 
 Module nat_cancel.
   Class NatCancelL (m n m' n' : nat) := nat_cancel_l : m' + n = m + n'.
-  Hint Mode NatCancelL ! ! - - : typeclass_instances.
+  Global Hint Mode NatCancelL ! ! - - : typeclass_instances.
   Class NatCancelR (m n m' n' : nat) := nat_cancel_r : NatCancelL m n m' n'.
-  Hint Mode NatCancelR ! ! - - : typeclass_instances.
-  Existing Instance nat_cancel_r | 100.
+  Global Hint Mode NatCancelR ! ! - - : typeclass_instances.
+  Global Existing Instance nat_cancel_r | 100.
 
   (** The implementation of the canceler is highly non-deterministic, but since
   it will always succeed, no backtracking will ever be performed. In order to
@@ -54,49 +54,49 @@ Module nat_cancel.
     https://gitlab.mpi-sws.org/FP/iris-coq/issues/153
 
   we wrap the entire canceler in the [NoBackTrack] class. *)
-  Instance nat_cancel_start m n m' n' :
+  Global Instance nat_cancel_start m n m' n' :
     TCNoBackTrack (NatCancelL m n m' n') → NatCancel m n m' n'.
   Proof. by intros [?]. Qed.
 
   Class MakeNatS (n1 n2 m : nat) := make_nat_S : m = n1 + n2.
-  Instance make_nat_S_0_l n : MakeNatS 0 n n.
+  Global Instance make_nat_S_0_l n : MakeNatS 0 n n.
   Proof. done. Qed.
-  Instance make_nat_S_1 n : MakeNatS 1 n (S n).
+  Global Instance make_nat_S_1 n : MakeNatS 1 n (S n).
   Proof. done. Qed.
 
-  Class MakeNatPlus (n1 n2 m : nat) := make_nat_plus : m = n1 + n2.
-  Instance make_nat_plus_0_l n : MakeNatPlus 0 n n.
+  Class MakeNatAdd (n1 n2 m : nat) := make_nat_add : m = n1 + n2.
+  Global Instance make_nat_add_0_l n : MakeNatAdd 0 n n.
   Proof. done. Qed.
-  Instance make_nat_plus_0_r n : MakeNatPlus n 0 n.
-  Proof. unfold MakeNatPlus. by rewrite Nat.add_0_r. Qed.
-  Instance make_nat_plus_default n1 n2 : MakeNatPlus n1 n2 (n1 + n2) | 100.
+  Global Instance make_nat_add_0_r n : MakeNatAdd n 0 n.
+  Proof. unfold MakeNatAdd. by rewrite Nat.add_0_r. Qed.
+  Global Instance make_nat_add_default n1 n2 : MakeNatAdd n1 n2 (n1 + n2) | 100.
   Proof. done. Qed.
 
-  Instance nat_cancel_leaf_here m : NatCancelR m m 0 0 | 0.
+  Global Instance nat_cancel_leaf_here m : NatCancelR m m 0 0 | 0.
   Proof. by unfold NatCancelR, NatCancelL. Qed.
-  Instance nat_cancel_leaf_else m n : NatCancelR m n m n | 100.
+  Global Instance nat_cancel_leaf_else m n : NatCancelR m n m n | 100.
   Proof. by unfold NatCancelR. Qed.
-  Instance nat_cancel_leaf_plus m m' m'' n1 n2 n1' n2' n1'n2' :
+  Global Instance nat_cancel_leaf_add m m' m'' n1 n2 n1' n2' n1'n2' :
     NatCancelR m n1 m' n1' → NatCancelR m' n2 m'' n2' →
-    MakeNatPlus n1' n2' n1'n2' → NatCancelR m (n1 + n2) m'' n1'n2' | 2.
-  Proof. unfold NatCancelR, NatCancelL, MakeNatPlus. lia. Qed.
-  Instance nat_cancel_leaf_S_here m n m' n' :
+    MakeNatAdd n1' n2' n1'n2' → NatCancelR m (n1 + n2) m'' n1'n2' | 2.
+  Proof. unfold NatCancelR, NatCancelL, MakeNatAdd. lia. Qed.
+  Global Instance nat_cancel_leaf_S_here m n m' n' :
     NatCancelR m n m' n' → NatCancelR (S m) (S n) m' n' | 3.
   Proof. unfold NatCancelR, NatCancelL. lia. Qed.
-  Instance nat_cancel_leaf_S_else m n m' n' :
+  Global Instance nat_cancel_leaf_S_else m n m' n' :
     NatCancelR m n m' n' → NatCancelR m (S n) m' (S n') | 4.
   Proof. unfold NatCancelR, NatCancelL. lia. Qed.
 
   (** The instance [nat_cancel_S_both] is redundant, but may reduce proof search
   quite a bit, e.g. when canceling constants in constants. *)
-  Instance nat_cancel_S_both m n m' n' :
+  Global Instance nat_cancel_S_both m n m' n' :
     NatCancelL m n m' n' → NatCancelL (S m) (S n) m' n' | 1.
   Proof. unfold NatCancelL. lia. Qed.
-  Instance nat_cancel_plus m1 m2 m1' m2' m1'm2' n n' n'' :
+  Global Instance nat_cancel_add m1 m2 m1' m2' m1'm2' n n' n'' :
     NatCancelL m1 n m1' n' → NatCancelL m2 n' m2' n'' →
-    MakeNatPlus m1' m2' m1'm2' → NatCancelL (m1 + m2) n m1'm2' n'' | 2.
-  Proof. unfold NatCancelL, MakeNatPlus. lia. Qed.
-  Instance nat_cancel_S m m' m'' Sm' n n' n'' :
+    MakeNatAdd m1' m2' m1'm2' → NatCancelL (m1 + m2) n m1'm2' n'' | 2.
+  Proof. unfold NatCancelL, MakeNatAdd. lia. Qed.
+  Global Instance nat_cancel_S m m' m'' Sm' n n' n'' :
     NatCancelL m n m' n' → NatCancelR 1 n' m'' n'' →
     MakeNatS m'' m' Sm' → NatCancelL (S m) n Sm' n'' | 3.
   Proof. unfold NatCancelR, NatCancelL, MakeNatS. lia. Qed.

theories/natmap.v → stdpp/natmap.v

@@ -7,7 +7,7 @@ From stdpp Require Import options.
 Notation natmap_raw A := (list (option A)).
 Definition natmap_wf {A} (l : natmap_raw A) :=
   match last l with None => True | Some x => is_Some x end.
-Instance natmap_wf_pi {A} (l : natmap_raw A) : ProofIrrel (natmap_wf l).
+Global Instance natmap_wf_pi {A} (l : natmap_raw A) : ProofIrrel (natmap_wf l).
 Proof. unfold natmap_wf. case_match; apply _. Qed.
 
 Lemma natmap_wf_inv {A} (o : option A) (l : natmap_raw A) :
@@ -26,9 +26,11 @@ Record natmap (A : Type) : Type := NatMap {
   natmap_car : natmap_raw A;
   natmap_prf : natmap_wf natmap_car
 }.
-Arguments NatMap {_} _ _ : assert.
-Arguments natmap_car {_} _ : assert.
-Arguments natmap_prf {_} _ : assert.
+Add Printing Constructor natmap.
+Global Arguments NatMap {_} _ _ : assert.
+Global Arguments natmap_car {_} _ : assert.
+Global Arguments natmap_prf {_} _ : assert.
+
 Lemma natmap_eq {A} (m1 m2 : natmap A) :
   m1 = m2 ↔ natmap_car m1 = natmap_car m2.
 Proof.
@@ -41,8 +43,8 @@ Global Instance natmap_eq_dec `{EqDecision A} : EqDecision (natmap A) := λ m1 m
   | right H => right (H ∘ proj1 (natmap_eq m1 m2))
   end.
 
-Instance natmap_empty {A} : Empty (natmap A) := NatMap [] I.
-Instance natmap_lookup {A} : Lookup nat A (natmap A) := λ i m,
+Global Instance natmap_empty {A} : Empty (natmap A) := NatMap [] I.
+Global Instance natmap_lookup {A} : Lookup nat A (natmap A) := λ i m,
   let (l,_) := m in mjoin (l !! i).
 
 Fixpoint natmap_singleton_raw {A} (i : nat) (x : A) : natmap_raw A :=
@@ -56,7 +58,7 @@ Proof. induction i; simpl; auto. Qed.
 Lemma natmap_lookup_singleton_raw_ne {A} (i j : nat) (x : A) :
   i ≠ j → mjoin (natmap_singleton_raw i x !! j) = None.
 Proof. revert j; induction i; intros [|?]; simpl; auto with congruence. Qed.
-Hint Rewrite @natmap_lookup_singleton_raw : natmap.
+Local Hint Rewrite @natmap_lookup_singleton_raw : natmap.
 
 Definition natmap_cons_canon {A} (o : option A) (l : natmap_raw A) :=
   match o, l with None, [] => [] | _, _ => o :: l end.
@@ -69,9 +71,9 @@ Proof. by destruct o, l. Qed.
 Lemma natmap_cons_canon_S {A} (o : option A) (l : natmap_raw A) i :
   natmap_cons_canon o l !! S i = l !! i.
 Proof. by destruct o, l. Qed.
-Hint Rewrite @natmap_cons_canon_O @natmap_cons_canon_S : natmap.
+Local Hint Rewrite @natmap_cons_canon_O @natmap_cons_canon_S : natmap.
 
-Definition natmap_alter_raw {A} (f : option A → option A) :
+Definition natmap_partial_alter_raw {A} (f : option A → option A) :
     nat → natmap_raw A → natmap_raw A :=
   fix go i l {struct l} :=
   match l with
@@ -84,28 +86,44 @@ Definition natmap_alter_raw {A} (f : option A → option A) :
      | 0 => natmap_cons_canon (f o) l | S i => natmap_cons_canon o (go i l)
      end
   end.
-Lemma natmap_alter_wf {A} (f : option A → option A) i l :
-  natmap_wf l → natmap_wf (natmap_alter_raw f i l).
+Lemma natmap_partial_alter_wf {A} (f : option A → option A) i l :
+  natmap_wf l → natmap_wf (natmap_partial_alter_raw f i l).
 Proof.
   revert i. induction l; [intro | intros [|?]]; simpl; repeat case_match;
     eauto using natmap_singleton_wf, natmap_cons_canon_wf, natmap_wf_inv.
 Qed.
-Instance natmap_alter {A} : PartialAlter nat A (natmap A) := λ f i m,
-  let (l,Hl) := m in NatMap _ (natmap_alter_wf f i l Hl).
-Lemma natmap_lookup_alter_raw {A} (f : option A → option A) i l :
-  mjoin (natmap_alter_raw f i l !! i) = f (mjoin (l !! i)).
+Global Instance natmap_partial_alter {A} : PartialAlter nat A (natmap A) := λ f i m,
+  let (l,Hl) := m in NatMap _ (natmap_partial_alter_wf f i l Hl).
+Lemma natmap_lookup_partial_alter_raw {A} (f : option A → option A) i l :
+  mjoin (natmap_partial_alter_raw f i l !! i) = f (mjoin (l !! i)).
 Proof.
   revert i. induction l; intros [|?]; simpl; repeat case_match; simpl;
     autorewrite with natmap; auto.
 Qed.
-Lemma natmap_lookup_alter_raw_ne {A} (f : option A → option A) i j l :
-  i ≠ j → mjoin (natmap_alter_raw f i l !! j) = mjoin (l !! j).
+Lemma natmap_lookup_partial_alter_raw_ne {A} (f : option A → option A) i j l :
+  i ≠ j → mjoin (natmap_partial_alter_raw f i l !! j) = mjoin (l !! j).
 Proof.
   revert i j. induction l; intros [|?] [|?] ?; simpl;
     repeat case_match; simpl; autorewrite with natmap; auto with congruence.
   rewrite natmap_lookup_singleton_raw_ne; congruence.
 Qed.
 
+Definition natmap_fmap_raw {A B} (f : A → B) : natmap_raw A → natmap_raw B :=
+  fmap (fmap (M:=option) f).
+Lemma natmap_fmap_wf {A B} (f : A → B) l :
+  natmap_wf l → natmap_wf (natmap_fmap_raw f l).
+Proof.
+  unfold natmap_fmap_raw, natmap_wf. rewrite fmap_last.
+  destruct (last l); [|done]. by apply fmap_is_Some.
+Qed.
+Lemma natmap_lookup_fmap_raw {A B} (f : A → B) i l :
+  mjoin (natmap_fmap_raw f l !! i) = f <$> mjoin (l !! i).
+Proof.
+  unfold natmap_fmap_raw. rewrite list_lookup_fmap. by destruct (l !! i).
+Qed.
+Global Instance natmap_fmap : FMap natmap := λ A B f m,
+  let (l,Hl) := m in NatMap (natmap_fmap_raw f l) (natmap_fmap_wf _ _ Hl).
+
 Definition natmap_omap_raw {A B} (f : A → option B) :
     natmap_raw A → natmap_raw B :=
   fix go l :=
@@ -118,7 +136,7 @@ Lemma natmap_lookup_omap_raw {A B} (f : A → option B) l i :
 Proof.
   revert i. induction l; intros [|?]; simpl; autorewrite with natmap; auto.
 Qed.
-Hint Rewrite @natmap_lookup_omap_raw : natmap.
+Local Hint Rewrite @natmap_lookup_omap_raw : natmap.
 Global Instance natmap_omap: OMap natmap := λ A B f m,
   let (l,Hl) := m in NatMap _ (natmap_omap_raw_wf f _ Hl).
 
@@ -128,7 +146,7 @@ Definition natmap_merge_raw {A B C} (f : option A → option B → option C) :
   match l1, l2 with
   | [], l2 => natmap_omap_raw (f None ∘ Some) l2
   | l1, [] => natmap_omap_raw (flip f None ∘ Some) l1
-  | o1 :: l1, o2 :: l2 => natmap_cons_canon (f o1 o2) (go l1 l2)
+  | o1 :: l1, o2 :: l2 => natmap_cons_canon (diag_None f o1 o2) (go l1 l2)
   end.
 Lemma natmap_merge_wf {A B C} (f : option A → option B → option C) l1 l2 :
   natmap_wf l1 → natmap_wf l2 → natmap_wf (natmap_merge_raw f l1 l2).
@@ -136,76 +154,75 @@ Proof.
   revert l2. induction l1; intros [|??]; simpl;
     eauto using natmap_omap_raw_wf, natmap_cons_canon_wf, natmap_wf_inv.
 Qed.
-Lemma natmap_lookup_merge_raw {A B C} (f : option A → option B → option C)
-    l1 l2 i : f None None = None →
-  mjoin (natmap_merge_raw f l1 l2 !! i) = f (mjoin (l1 !! i)) (mjoin (l2 !! i)).
+Lemma natmap_lookup_merge_raw {A B C} (f : option A → option B → option C) l1 l2 i :
+  mjoin (natmap_merge_raw f l1 l2 !! i) = diag_None f (mjoin (l1 !! i)) (mjoin (l2 !! i)).
 Proof.
   intros. revert i l2. induction l1; intros [|?] [|??]; simpl;
     autorewrite with natmap; auto;
     match goal with |- context [?o ≫= _] => by destruct o end.
 Qed.
-Instance natmap_merge: Merge natmap := λ A B C f m1 m2,
+Global Instance natmap_merge: Merge natmap := λ A B C f m1 m2,
   let (l1, Hl1) := m1 in let (l2, Hl2) := m2 in
   NatMap (natmap_merge_raw f l1 l2) (natmap_merge_wf _ _ _ Hl1 Hl2).
 
-Fixpoint natmap_to_list_raw {A} (i : nat) (l : natmap_raw A) : list (nat * A) :=
+Fixpoint natmap_fold_raw {A B} (f : nat → A → B → B)
+    (j : nat) (b : B) (l : natmap_raw A) : B :=
   match l with
-  | [] => []
-  | None :: l => natmap_to_list_raw (S i) l
-  | Some x :: l => (i,x) :: natmap_to_list_raw (S i) l
+  | [] => b
+  | mx :: l => natmap_fold_raw f (S j)
+                 match mx with Some x => f j x b | None => b end l
   end.
-Lemma natmap_elem_of_to_list_raw_aux {A} j (l : natmap_raw A) i x :
-  (i,x) ∈ natmap_to_list_raw j l ↔ ∃ i', i = i' + j ∧ mjoin (l !! i') = Some x.
-Proof.
-  split.
-  - revert j. induction l as [|[y|] l IH]; intros j; simpl.
-    + by rewrite elem_of_nil.
-    + rewrite elem_of_cons. intros [?|?]; simplify_eq.
-      * by exists 0.
-      * destruct (IH (S j)) as (i'&?&?); auto.
-        exists (S i'); simpl; auto with lia.
-    + intros. destruct (IH (S j)) as (i'&?&?); auto.
-      exists (S i'); simpl; auto with lia.
-  - intros (i'&?&Hi'). subst. revert i' j Hi'.
-    induction l as [|[y|] l IH]; intros i j ?; simpl.
-    + done.
-    + destruct i as [|i]; simplify_eq/=; [left|].
-      right. rewrite <-Nat.add_succ_r. by apply (IH i (S j)).
-    + destruct i as [|i]; simplify_eq/=.
-      rewrite <-Nat.add_succ_r. by apply (IH i (S j)).
-Qed.
-Lemma natmap_elem_of_to_list_raw {A} (l : natmap_raw A) i x :
-  (i,x) ∈ natmap_to_list_raw 0 l ↔ mjoin (l !! i) = Some x.
-Proof.
-  rewrite natmap_elem_of_to_list_raw_aux. setoid_rewrite Nat.add_0_r.
-  naive_solver.
-Qed.
-Lemma natmap_to_list_raw_nodup {A} i (l : natmap_raw A) :
-  NoDup (natmap_to_list_raw i l).
-Proof.
-  revert i. induction l as [|[?|] ? IH]; simpl; try constructor; auto.
-  rewrite natmap_elem_of_to_list_raw_aux. intros (?&?&?). lia.
-Qed.
-Instance natmap_to_list {A} : FinMapToList nat A (natmap A) := λ m,
-  let (l,_) := m in natmap_to_list_raw 0 l.
 
-Definition natmap_map_raw {A B} (f : A → B) : natmap_raw A → natmap_raw B :=
-  fmap (fmap f).
-Lemma natmap_map_wf {A B} (f : A → B) l :
-  natmap_wf l → natmap_wf (natmap_map_raw f l).
-Proof.
-  unfold natmap_map_raw, natmap_wf. rewrite fmap_last.
-  destruct (last l); [|done]. by apply fmap_is_Some.
-Qed.
-Lemma natmap_lookup_map_raw {A B} (f : A → B) i l :
-  mjoin (natmap_map_raw f l !! i) = f <$> mjoin (l !! i).
+Lemma natmap_fold_raw_cons_canon {A B} (f : nat → A → B → B) j b mx l :
+  natmap_fold_raw f j b (natmap_cons_canon mx l)
+  = natmap_fold_raw f (S j) match mx with Some x => f j x b | None => b end l.
+Proof. by destruct mx, l. Qed.
+
+Lemma natmap_fold_raw_ind {A} (P : natmap_raw A → Prop) :
+  P [] →
+  (∀ i x l,
+    natmap_wf l →
+    mjoin (l !! i) = None →
+    (∀ j A' B (f : nat → A' → B → B) (g : A → A') b x',
+      natmap_fold_raw f j b
+        (natmap_partial_alter_raw (λ _, Some x') i (natmap_fmap_raw g l))
+      = f (i + j) x' (natmap_fold_raw f j b (natmap_fmap_raw g l))) →
+    P l → P (natmap_partial_alter_raw (λ _, Some x) i l)) →
+  ∀ l, natmap_wf l → P l.
 Proof.
-  unfold natmap_map_raw. rewrite list_lookup_fmap. by destruct (l !! i).
+  intros Hemp Hinsert l Hl. revert P Hemp Hinsert Hl.
+  induction l as [|mx l IH]; intros P Hemp Hinsert Hxl; simpl in *; [done|].
+  assert (natmap_wf l) as Hl by (by destruct l).
+  replace (mx :: l) with (natmap_cons_canon mx l)
+    by (destruct mx, l; done || by destruct Hxl).
+  apply (IH (λ l, P (natmap_cons_canon mx l))); [..|done].
+  { destruct mx as [x|]; [|done].
+    change (natmap_cons_canon (Some x) [])
+      with (natmap_partial_alter_raw (λ _, Some x) 0 []).
+    by apply (Hinsert 0). }
+  intros i x l' Hl' ? Hfold.
+  replace (natmap_cons_canon mx (natmap_partial_alter_raw (λ _, Some x) i l'))
+    with (natmap_partial_alter_raw (λ _, Some x) (S i) (natmap_cons_canon mx l'))
+    by (by destruct i, mx, l').
+  apply Hinsert.
+  - by apply natmap_cons_canon_wf.
+  - by destruct mx, l'.
+  - intros j A' B f g b x'.
+    replace (natmap_partial_alter_raw (λ _, Some x') (S i)
+        (natmap_fmap_raw g (natmap_cons_canon mx l')))
+      with (natmap_cons_canon (g <$> mx)
+        (natmap_partial_alter_raw (λ _, Some x') i (natmap_fmap_raw g l')))
+      by (by destruct i, mx, l').
+    replace (natmap_fmap_raw g (natmap_cons_canon mx l'))
+      with (natmap_cons_canon (g <$> mx) (natmap_fmap_raw g l'))
+      by (by destruct i, mx, l').
+    rewrite !natmap_fold_raw_cons_canon, Nat.add_succ_comm. simpl; auto.
 Qed.
-Instance natmap_map: FMap natmap := λ A B f m,
-  let (l,Hl) := m in NatMap (natmap_map_raw f l) (natmap_map_wf _ _ Hl).
 
-Instance: FinMap nat natmap.
+Global Instance natmap_fold {A} : MapFold nat A (natmap A) := λ B f d m,
+  let (l,_) := m in natmap_fold_raw f 0 d l.
+
+Global Instance natmap_map : FinMap nat natmap.
 Proof.
   split.
   - unfold lookup, natmap_lookup. intros A [l1 Hl1] [l2 Hl2] E.
@@ -224,13 +241,20 @@ Proof.
     + by specialize (E 0).
     + f_equal. apply IH; eauto using natmap_wf_inv. intros i. apply (E (S i)).
   - done.
-  - intros ?? [??] ?. apply natmap_lookup_alter_raw.
-  - intros ?? [??] ??. apply natmap_lookup_alter_raw_ne.
-  - intros ??? [??] ?. apply natmap_lookup_map_raw.
-  - intros ? [??]. by apply natmap_to_list_raw_nodup.
-  - intros ? [??] ??. by apply natmap_elem_of_to_list_raw.
+  - intros ?? [??] ?. apply natmap_lookup_partial_alter_raw.
+  - intros ?? [??] ??. apply natmap_lookup_partial_alter_raw_ne.
+  - intros ??? [??] ?. apply natmap_lookup_fmap_raw.
   - intros ??? [??] ?. by apply natmap_lookup_omap_raw.
-  - intros ????? [??] [??] ?. by apply natmap_lookup_merge_raw.
+  - intros ???? [??] [??] ?. apply natmap_lookup_merge_raw.
+  - done.
+  - intros A P Hemp Hins [l Hl]. refine (natmap_fold_raw_ind
+      (λ l, ∀ Hl, P (NatMap l Hl)) _ _ l Hl Hl); clear l Hl.
+    { intros Hl.
+      by replace (NatMap _ Hl) with (∅ : natmap A) by (by apply natmap_eq). }
+    intros i x l Hl ? Hfold H Hxl.
+    replace (NatMap _ Hxl) with (<[i:=x]> (NatMap _ Hl)) by (by apply natmap_eq).
+    apply Hins; [done| |done].
+    intros A' B f g b x'. rewrite <-(Nat.add_0_r i) at 2. apply (Hfold 0).
 Qed.
 
 Fixpoint strip_Nones {A} (l : list (option A)) : list (option A) :=
@@ -256,8 +280,8 @@ Qed.
 
 (** Finally, we can construct sets of [nat]s satisfying extensional equality. *)
 Notation natset := (mapset natmap).
-Instance natmap_dom {A} : Dom (natmap A) natset := mapset_dom.
-Instance: FinMapDom nat natmap natset := mapset_dom_spec.
+Global Instance natmap_dom {A} : Dom (natmap A) natset := mapset_dom.
+Global Instance: FinMapDom nat natmap natset := mapset_dom_spec.
 
 (* Fixpoint avoids this definition from being unfolded *)
 Definition bools_to_natset (βs : list bool) : natset :=
@@ -282,11 +306,11 @@ Lemma bools_to_natset_union βs1 βs2 :
   bools_to_natset (βs1 ||* βs2) = bools_to_natset βs1 ∪ bools_to_natset βs2.
 Proof.
   rewrite <-Forall2_same_length; intros Hβs.
-  apply elem_of_equiv_L. intros i. rewrite elem_of_union, !elem_of_bools_to_natset.
+  apply set_eq. intros i. rewrite elem_of_union, !elem_of_bools_to_natset.
   revert i. induction Hβs as [|[] []]; intros [|?]; naive_solver.
 Qed.
-Lemma natset_to_bools_length (X : natset) sz : length (natset_to_bools sz X) = sz.
-Proof. apply resize_length. Qed.
+Lemma length_natset_to_bools (X : natset) sz : length (natset_to_bools sz X) = sz.
+Proof. apply length_resize. Qed.
 Lemma lookup_natset_to_bools_ge sz X i : sz ≤ i → natset_to_bools sz X !! i = None.
 Proof. by apply lookup_resize_old. Qed.
 Lemma lookup_natset_to_bools sz X i β :
@@ -296,9 +320,9 @@ Proof.
   intros. destruct (mapset_car X) as [l ?]; simpl.
   destruct (l !! i) as [mu|] eqn:Hmu; simpl.
   { rewrite lookup_resize, list_lookup_fmap, Hmu
-      by (rewrite ?fmap_length; eauto using lookup_lt_Some).
+      by (rewrite ?length_fmap; eauto using lookup_lt_Some).
     destruct mu as [[]|], β; simpl; intuition congruence. }
-  rewrite lookup_resize_new by (rewrite ?fmap_length;
+  rewrite lookup_resize_new by (rewrite ?length_fmap;
     eauto using lookup_ge_None_1); destruct β; intuition congruence.
 Qed.
 Lemma lookup_natset_to_bools_true sz X i :

theories/nmap.v → stdpp/nmap.v

@@ -7,78 +7,68 @@ From stdpp Require Import options.
 Local Open Scope N_scope.
 
 Record Nmap (A : Type) : Type := NMap { Nmap_0 : option A; Nmap_pos : Pmap A }.
-Arguments Nmap_0 {_} _ : assert.
-Arguments Nmap_pos {_} _ : assert.
-Arguments NMap {_} _ _ : assert.
+Add Printing Constructor Nmap.
+Global Arguments Nmap_0 {_} _ : assert.
+Global Arguments Nmap_pos {_} _ : assert.
+Global Arguments NMap {_} _ _ : assert.
 
-Instance Nmap_eq_dec `{EqDecision A} : EqDecision (Nmap A).
+Global Instance Nmap_eq_dec `{EqDecision A} : EqDecision (Nmap A).
 Proof.
  refine (λ t1 t2,
   match t1, t2 with
   | NMap x t1, NMap y t2 => cast_if_and (decide (x = y)) (decide (t1 = t2))
   end); abstract congruence.
 Defined.
-Instance Nempty {A} : Empty (Nmap A) := NMap None ∅.
-Global Opaque Nempty.
-Instance Nlookup {A} : Lookup N A (Nmap A) := λ i t,
+Global Instance Nmap_empty {A} : Empty (Nmap A) := NMap None ∅.
+Global Opaque Nmap_empty.
+Global Instance Nmap_lookup {A} : Lookup N A (Nmap A) := λ i t,
   match i with
-  | N0 => Nmap_0 t
-  | Npos p => Nmap_pos t !! p
+  | 0 => Nmap_0 t
+  | N.pos p => Nmap_pos t !! p
   end.
-Instance Npartial_alter {A} : PartialAlter N A (Nmap A) := λ f i t,
+Global Instance Nmap_partial_alter {A} : PartialAlter N A (Nmap A) := λ f i t,
   match i, t with
-  | N0, NMap o t => NMap (f o) t
-  | Npos p, NMap o t => NMap o (partial_alter f p t)
+  | 0, NMap o t => NMap (f o) t
+  | N.pos p, NMap o t => NMap o (partial_alter f p t)
   end.
-Instance Nto_list {A} : FinMapToList N A (Nmap A) := λ t,
-  match t with
-  | NMap o t =>
-     from_option (λ x, [(0,x)]) [] o ++ (prod_map Npos id <$> map_to_list t)
-  end.
-Instance Nomap: OMap Nmap := λ A B f t,
+Global Instance Nmap_fmap: FMap Nmap := λ A B f t,
+  match t with NMap o t => NMap (f <$> o) (f <$> t) end.
+Global Instance Nmap_omap: OMap Nmap := λ A B f t,
   match t with NMap o t => NMap (o ≫= f) (omap f t) end.
-Instance Nmerge: Merge Nmap := λ A B C f t1 t2,
+Global Instance Nmap_merge: Merge Nmap := λ A B C f t1 t2,
   match t1, t2 with
-  | NMap o1 t1, NMap o2 t2 => NMap (f o1 o2) (merge f t1 t2)
+  | NMap o1 t1, NMap o2 t2 => NMap (diag_None f o1 o2) (merge f t1 t2)
+  end.
+Global Instance Nmap_fold {A} : MapFold N A (Nmap A) := λ B f d t,
+  match t with
+  | NMap mx t =>
+     map_fold (f ∘ N.pos) match mx with Some x => f 0 x d | None => d end t
   end.
-Instance Nfmap: FMap Nmap := λ A B f t,
-  match t with NMap o t => NMap (f <$> o) (f <$> t) end.
 
-Instance: FinMap N Nmap.
+Global Instance Nmap_map: FinMap N Nmap.
 Proof.
   split.
   - intros ? [??] [??] H. f_equal; [apply (H 0)|].
-    apply map_eq. intros i. apply (H (Npos i)).
+    apply map_eq. intros i. apply (H (N.pos i)).
   - by intros ? [|?].
   - intros ? f [? t] [|i]; simpl; [done |]. apply lookup_partial_alter.
   - intros ? f [? t] [|i] [|j]; simpl; try intuition congruence.
     intros. apply lookup_partial_alter_ne. congruence.
   - intros ??? [??] []; simpl; [done|]. apply lookup_fmap.
-  - intros ? [[x|] t]; unfold map_to_list; simpl.
-    + constructor.
-      * rewrite elem_of_list_fmap. by intros [[??] [??]].
-      * by apply (NoDup_fmap _), NoDup_map_to_list.
-    + apply (NoDup_fmap _), NoDup_map_to_list.
-  - intros ? t i x. unfold map_to_list. split.
-    + destruct t as [[y|] t]; simpl.
-      * rewrite elem_of_cons, elem_of_list_fmap.
-        intros [? | [[??] [??]]]; simplify_eq/=; [done |].
-        by apply elem_of_map_to_list.
-      * rewrite elem_of_list_fmap; intros [[??] [??]]; simplify_eq/=.
-        by apply elem_of_map_to_list.
-    + destruct t as [[y|] t]; simpl.
-      * rewrite elem_of_cons, elem_of_list_fmap.
-        destruct i as [|i]; simpl; [intuition congruence |].
-        intros. right. exists (i, x). by rewrite elem_of_map_to_list.
-      * rewrite elem_of_list_fmap.
-        destruct i as [|i]; simpl; [done |].
-        intros. exists (i, x). by rewrite elem_of_map_to_list.
   - intros ?? f [??] [|?]; simpl; [done|]; apply (lookup_omap f).
-  - intros ??? f ? [??] [??] [|?]; simpl; [done|]; apply (lookup_merge f).
+  - intros ??? f [??] [??] [|?]; simpl; [done|]; apply (lookup_merge f).
+  - done.
+  - intros A P Hemp Hins [mx t].
+    induction t as [|i x t ? Hfold IH] using map_fold_fmap_ind.
+    { destruct mx as [x|]; [|done].
+      replace (NMap (Some x) ∅) with (<[0:=x]> ∅ : Nmap _) by done.
+      by apply Hins. }
+    apply (Hins (N.pos i) x (NMap mx t)); [done| |done].
+    intros A' B f g b. apply Hfold.
 Qed.
 
 (** * Finite sets *)
 (** We construct sets of [N]s satisfying extensional equality. *)
 Notation Nset := (mapset Nmap).
-Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom.
-Instance: FinMapDom N Nmap Nset := mapset_dom_spec.
+Global Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom.
+Global Instance: FinMapDom N Nmap Nset := mapset_dom_spec.

stdpp/numbers.v

+(** This file provides various tweaks and extensions to Coq's theory of numbers
+(natural numbers [nat] and [N], positive numbers [positive], integers [Z], and
+rationals [Qc]). In addition, this file defines a new type of positive rational
+numbers [Qp], which is used extensively in Iris to represent fractional
+permissions.
+
+The organization of this file follows mostly Coq's standard library.
+
+- We put all results in modules. For example, the module [Nat] collects the
+  results for type [nat]. Since the Coq stdlib already defines a module [Nat],
+  our module [Nat] exports Coq's module so that our module [Nat] contains the
+  union of the results from the Coq stdlib and std++.
+- We follow the naming convention of Coq's "numbers" library to prefer
+  [succ]/[add]/[sub]/[mul] over [S]/[plus]/[minus]/[mult].
+- One typically does not [Import] modules such as [Nat], and refers to the
+  results using [Nat.lem]. As a consequence, all [Hint]s [Instance]s in the modules in
+  this file are [Global] and not [Export]. Other things like [Arguments] are outside
+  the modules, since for them [Global] works like [Export].
+
+The results for [Qc] are not yet in a module. This is in part because they
+still follow the old/non-module style in Coq's standard library. See also
+https://gitlab.mpi-sws.org/iris/stdpp/-/issues/147. *)
+
+From Coq Require Export EqdepFacts PArith NArith ZArith.
+From Coq Require Import QArith Qcanon.
+From stdpp Require Export base decidable option.
+From stdpp Require Import well_founded.
+From stdpp Require Import options.
+Local Open Scope nat_scope.
+
+Global Instance comparison_eq_dec : EqDecision comparison.
+Proof. solve_decision. Defined.
+
+(** * Notations and properties of [nat] *)
+Global Arguments Nat.sub !_ !_ / : assert.
+Global Arguments Nat.max : simpl nomatch.
+
+(** We do not make [Nat.lt] since it is an alias for [lt], which contains the
+actual definition that we want to make opaque. *)
+Global Typeclasses Opaque lt.
+
+Reserved Notation "x ≤ y ≤ z" (at level 70, y at next level).
+Reserved Notation "x ≤ y < z" (at level 70, y at next level).
+Reserved Notation "x < y < z" (at level 70, y at next level).
+Reserved Notation "x < y ≤ z" (at level 70, y at next level).
+Reserved Notation "x ≤ y ≤ z ≤ z'"
+  (at level 70, y at next level, z at next level).
+
+Infix "≤" := le : nat_scope.
+(** We do *not* add notation for [≥] mapping to [ge], and we do also not use the
+[>] notation from the Coq standard library. Using such notations leads to
+annoying problems: if you have [x < y] in the context and need [y > x] for some
+lemma, [assumption] won't work because [x < y] and [y > x] are not
+definitionally equal. It is just generally frustrating to deal with this
+mismatch, and much preferable to state logically equivalent things in syntactically
+equal ways.
+
+As an alternative, we could define [>] and [≥] as [parsing only] notation that
+maps to [<] and [≤], respectively (similar to math-comp). This would change the
+notation for [<] from the Coq standard library to something that is not
+definitionally equal, so we avoid that as well.
+
+This concern applies to all number types: [nat], [N], [Z], [positive], [Qc] and
+[Qp]. *)
+Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%nat : nat_scope.
+Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%nat : nat_scope.
+Notation "x < y ≤ z" := (x < y ∧ y ≤ z)%nat : nat_scope.
+Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%nat : nat_scope.
+Notation "(≤)" := le (only parsing) : nat_scope.
+Notation "(<)" := lt (only parsing) : nat_scope.
+
+Infix "`div`" := Nat.div (at level 35) : nat_scope.
+Infix "`mod`" := Nat.modulo (at level 35) : nat_scope.
+Infix "`max`" := Nat.max (at level 35) : nat_scope.
+Infix "`min`" := Nat.min (at level 35) : nat_scope.
+
+(** TODO: Consider removing these notations to avoid populting the global
+scope? *)
+Notation lcm := Nat.lcm.
+Notation divide := Nat.divide.
+Notation "( x | y )" := (divide x y) : nat_scope.
+
+Module Nat.
+  Export PeanoNat.Nat.
+
+  Global Instance add_assoc' : Assoc (=) Nat.add := Nat.add_assoc.
+  Global Instance add_comm' : Comm (=) Nat.add := Nat.add_comm.
+  Global Instance add_left_id : LeftId (=) 0 Nat.add := Nat.add_0_l.
+  Global Instance add_right_id : RightId (=) 0 Nat.add := Nat.add_0_r.
+
+  Global Instance sub_right_id : RightId (=) 0 Nat.sub := Nat.sub_0_r.
+
+  Global Instance mul_assoc' : Assoc (=) Nat.mul := Nat.mul_assoc.
+  Global Instance mul_comm' : Comm (=) Nat.mul := Nat.mul_comm.
+  Global Instance mul_left_id : LeftId (=) 1 Nat.mul := Nat.mul_1_l.
+  Global Instance mul_right_id : RightId (=) 1 Nat.mul := Nat.mul_1_r.
+  Global Instance mul_left_absorb : LeftAbsorb (=) 0 Nat.mul := Nat.mul_0_l.
+  Global Instance mul_right_absorb : RightAbsorb (=) 0 Nat.mul := Nat.mul_0_r.
+
+  Global Instance div_right_id : RightId (=) 1 Nat.div := Nat.div_1_r.
+
+  Global Instance eq_dec: EqDecision nat := eq_nat_dec.
+  Global Instance le_dec: RelDecision le := le_dec.
+  Global Instance lt_dec: RelDecision lt := lt_dec.
+  Global Instance inhabited: Inhabited nat := populate 0.
+
+  Global Instance succ_inj: Inj (=) (=) Nat.succ.
+  Proof. by injection 1. Qed.
+
+  Global Instance le_po: PartialOrder (≤).
+  Proof. repeat split; repeat intro; auto with lia. Qed.
+  Global Instance le_total: Total (≤).
+  Proof. repeat intro; lia. Qed.
+
+  Global Instance le_pi: ∀ x y : nat, ProofIrrel (x ≤ y).
+  Proof.
+    assert (∀ x y (p : x ≤ y) y' (q : x ≤ y'),
+      y = y' → eq_dep nat (le x) y p y' q) as aux.
+    { fix FIX 3. intros x ? [|y p] ? [|y' q].
+      - done.
+      - clear FIX. intros; exfalso; auto with lia.
+      - clear FIX. intros; exfalso; auto with lia.
+      - injection 1. intros Hy. by case (FIX x y p y' q Hy). }
+    intros x y p q.
+    by apply (Eqdep_dec.eq_dep_eq_dec (λ x y, decide (x = y))), aux.
+  Qed.
+  Global Instance lt_pi: ∀ x y : nat, ProofIrrel (x < y).
+  Proof. unfold Peano.lt. apply _. Qed.
+
+  (** Given a measure/size [f : B → nat], you can do induction on the size of
+  [b : B] using [induction (lt_wf_0_projected f b)]. *)
+  Lemma lt_wf_0_projected {B} (f : B → nat) : well_founded (λ x y, f x < f y).
+  Proof. by apply (wf_projected (<) f), lt_wf_0. Qed.
+
+  Lemma le_sum (x y : nat) : x ≤ y ↔ ∃ z, y = x + z.
+  Proof. split; [exists (y - x); lia | intros [z ->]; lia]. Qed.
+
+  (** This is similar to but slightly different than Coq's
+      [add_sub : ∀ n m : nat, n + m - m = n]. *)
+  Lemma add_sub' n m : n + m - n = m.
+  Proof. lia. Qed.
+  Lemma le_add_sub n m : n ≤ m → m = n + (m - n).
+  Proof. lia. Qed.
+
+  (** Cancellation for multiplication. Coq's stdlib has these lemmas for [Z],
+  but those for [nat] are missing. We use the naming scheme of Coq's stdlib. *)
+  Lemma mul_reg_l n m p : p ≠ 0 → p * n = p * m → n = m.
+  Proof.
+    pose proof (Z.mul_reg_l (Z.of_nat n) (Z.of_nat m) (Z.of_nat p)). lia.
+  Qed.
+  Lemma mul_reg_r n m p : p ≠ 0 → n * p = m * p → n = m.
+  Proof. rewrite <-!(Nat.mul_comm p). apply mul_reg_l. Qed.
+
+  Lemma lt_succ_succ n : n < S (S n).
+  Proof. auto with arith. Qed.
+  Lemma mul_split_l n x1 x2 y1 y2 :
+    x2 < n → y2 < n → x1 * n + x2 = y1 * n + y2 → x1 = y1 ∧ x2 = y2.
+  Proof.
+    intros Hx2 Hy2 E. cut (x1 = y1); [intros; subst;lia |].
+    revert y1 E. induction x1; simpl; intros [|?]; simpl; auto with lia.
+  Qed.
+  Lemma mul_split_r n x1 x2 y1 y2 :
+    x1 < n → y1 < n → x1 + x2 * n = y1 + y2 * n → x1 = y1 ∧ x2 = y2.
+  Proof. intros. destruct (mul_split_l n x2 x1 y2 y1); auto with lia. Qed.
+
+  Global Instance divide_dec : RelDecision Nat.divide.
+  Proof.
+    refine (λ x y, cast_if (decide (lcm x y = y)));
+      abstract (by rewrite Nat.divide_lcm_iff).
+  Defined.
+  Global Instance divide_po : PartialOrder divide.
+  Proof.
+    repeat split; try apply _. intros ??. apply Nat.divide_antisym; lia.
+  Qed.
+  Global Hint Extern 0 (_ | _) => reflexivity : core.
+
+  Lemma divide_ne_0 x y : (x | y) → y ≠ 0 → x ≠ 0.
+  Proof. intros Hxy Hy ->. by apply Hy, Nat.divide_0_l. Qed.
+
+  Lemma iter_succ {A} n (f: A → A) x : Nat.iter (S n) f x = f (Nat.iter n f x).
+  Proof. done. Qed.
+  Lemma iter_succ_r {A} n (f: A → A) x : Nat.iter (S n) f x = Nat.iter n f (f x).
+  Proof. induction n; by f_equal/=. Qed.
+  Lemma iter_add {A} n1 n2 (f : A → A) x :
+    Nat.iter (n1 + n2) f x = Nat.iter n1 f (Nat.iter n2 f x).
+  Proof. induction n1; by f_equal/=. Qed.
+  Lemma iter_mul {A} n1 n2 (f : A → A) x :
+    Nat.iter (n1 * n2) f x = Nat.iter n1 (Nat.iter n2 f) x.
+  Proof.
+    intros. induction n1 as [|n1 IHn1]; [done|].
+    simpl. by rewrite iter_add, IHn1.
+  Qed.
+
+  Lemma iter_ind {A} (P : A → Prop) f x k :
+    P x → (∀ y, P y → P (f y)) → P (Nat.iter k f x).
+  Proof. induction k; simpl; auto. Qed.
+
+  (** FIXME: Coq 8.17 deprecated some lemmas in https://github.com/coq/coq/pull/16203.
+  We cannot use the intended replacements since we support Coq 8.16. We also do
+  not want to disable [deprecated-syntactic-definition] everywhere, so instead
+  we provide non-deprecated duplicates of those deprecated lemmas that we need
+  in std++ and Iris. *)
+  Local Set Warnings "-deprecated-syntactic-definition".
+  Lemma add_mod_idemp_l a b n : n ≠ 0 → (a mod n + b) mod n = (a + b) mod n.
+  Proof. auto using add_mod_idemp_l. Qed.
+  Lemma div_lt_upper_bound a b q : b ≠ 0 → a < b * q → a / b < q.
+  Proof. auto using div_lt_upper_bound. Qed.
+End Nat.
+
+(** * Notations and properties of [positive] *)
+Local Open Scope positive_scope.
+
+Global Typeclasses Opaque Pos.le.
+Global Typeclasses Opaque Pos.lt.
+
+Infix "≤" := Pos.le : positive_scope.
+Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : positive_scope.
+Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : positive_scope.
+Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : positive_scope.
+Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : positive_scope.
+Notation "(≤)" := Pos.le (only parsing) : positive_scope.
+Notation "(<)" := Pos.lt (only parsing) : positive_scope.
+Notation "(~0)" := xO (only parsing) : positive_scope.
+Notation "(~1)" := xI (only parsing) : positive_scope.
+Infix "`max`" := Pos.max : positive_scope.
+Infix "`min`" := Pos.min : positive_scope.
+
+Global Arguments Pos.pred : simpl never.
+Global Arguments Pos.succ : simpl never.
+Global Arguments Pos.of_nat : simpl never.
+Global Arguments Pos.to_nat : simpl never.
+Global Arguments Pos.mul : simpl never.
+Global Arguments Pos.add : simpl never.
+Global Arguments Pos.sub : simpl never.
+Global Arguments Pos.pow : simpl never.
+Global Arguments Pos.shiftl : simpl never.
+Global Arguments Pos.shiftr : simpl never.
+Global Arguments Pos.gcd : simpl never.
+Global Arguments Pos.min : simpl never.
+Global Arguments Pos.max : simpl never.
+Global Arguments Pos.lor : simpl never.
+Global Arguments Pos.land : simpl never.
+Global Arguments Pos.lxor : simpl never.
+Global Arguments Pos.square : simpl never.
+
+Module Pos.
+  Export BinPos.Pos.
+
+  Global Instance add_assoc' : Assoc (=) Pos.add := Pos.add_assoc.
+  Global Instance add_comm' : Comm (=) Pos.add := Pos.add_comm.
+
+  Global Instance mul_assoc' : Assoc (=) Pos.mul := Pos.mul_assoc.
+  Global Instance mul_comm' : Comm (=) Pos.mul := Pos.mul_comm.
+  Global Instance mul_left_id : LeftId (=) 1 Pos.mul := Pos.mul_1_l.
+  Global Instance mul_right_id : RightId (=) 1 Pos.mul := Pos.mul_1_r.
+
+  Global Instance eq_dec: EqDecision positive := Pos.eq_dec.
+  Global Instance le_dec: RelDecision Pos.le.
+  Proof. refine (λ x y, decide ((x ?= y) ≠ Gt)). Defined.
+  Global Instance lt_dec: RelDecision Pos.lt.
+  Proof. refine (λ x y, decide ((x ?= y) = Lt)). Defined.
+  Global Instance le_total: Total Pos.le.
+  Proof. repeat intro; lia. Qed.
+
+  Global Instance inhabited: Inhabited positive := populate 1.
+
+  Global Instance maybe_xO : Maybe xO := λ p, match p with p~0 => Some p | _ => None end.
+  Global Instance maybe_xI : Maybe xI := λ p, match p with p~1 => Some p | _ => None end.
+  Global Instance xO_inj : Inj (=) (=) (~0).
+  Proof. by injection 1. Qed.
+  Global Instance xI_inj : Inj (=) (=) (~1).
+  Proof. by injection 1. Qed.
+
+  (** Since [positive] represents lists of bits, we define list operations
+  on it. These operations are in reverse, as positives are treated as snoc
+  lists instead of cons lists. *)
+  Fixpoint app (p1 p2 : positive) : positive :=
+    match p2 with
+    | 1 => p1
+    | p2~0 => (app p1 p2)~0
+    | p2~1 => (app p1 p2)~1
+    end.
+
+  Module Import app_notations.
+    Infix "++" := app : positive_scope.
+    Notation "(++)" := app (only parsing) : positive_scope.
+    Notation "( p ++.)" := (app p) (only parsing) : positive_scope.
+    Notation "(.++ q )" := (λ p, app p q) (only parsing) : positive_scope.
+  End app_notations.
+
+  Fixpoint reverse_go (p1 p2 : positive) : positive :=
+    match p2 with
+    | 1 => p1
+    | p2~0 => reverse_go (p1~0) p2
+    | p2~1 => reverse_go (p1~1) p2
+    end.
+  Definition reverse : positive → positive := reverse_go 1.
+
+  Global Instance app_1_l : LeftId (=) 1 (++).
+  Proof. intros p. by induction p; intros; f_equal/=. Qed.
+  Global Instance app_1_r : RightId (=) 1 (++).
+  Proof. done. Qed.
+  Global Instance app_assoc : Assoc (=) (++).
+  Proof. intros ?? p. by induction p; intros; f_equal/=. Qed.
+  Global Instance app_inj p : Inj (=) (=) (.++ p).
+  Proof. intros ???. induction p; simplify_eq; auto. Qed.
+
+  Lemma reverse_go_app p1 p2 p3 :
+    reverse_go p1 (p2 ++ p3) = reverse_go p1 p3 ++ reverse_go 1 p2.
+  Proof.
+    revert p3 p1 p2.
+    cut (∀ p1 p2 p3, reverse_go (p2 ++ p3) p1 = p2 ++ reverse_go p3 p1).
+    { by intros go p3; induction p3; intros p1 p2; simpl; auto; rewrite <-?go. }
+    intros p1; induction p1 as [p1 IH|p1 IH|]; intros p2 p3; simpl; auto.
+    - apply (IH _ (_~1)).
+    - apply (IH _ (_~0)).
+  Qed.
+  Lemma reverse_app p1 p2 : reverse (p1 ++ p2) = reverse p2 ++ reverse p1.
+  Proof. unfold reverse. by rewrite reverse_go_app. Qed.
+  Lemma reverse_xO p : reverse (p~0) = (1~0) ++ reverse p.
+  Proof. apply (reverse_app p (1~0)). Qed.
+  Lemma reverse_xI p : reverse (p~1) = (1~1) ++ reverse p.
+  Proof. apply (reverse_app p (1~1)). Qed.
+
+  Lemma reverse_involutive p : reverse (reverse p) = p.
+  Proof.
+    induction p as [p IH|p IH|]; simpl.
+    - by rewrite reverse_xI, reverse_app, IH.
+    - by rewrite reverse_xO, reverse_app, IH.
+    - reflexivity.
+  Qed.
+
+  Global Instance reverse_inj : Inj (=) (=) reverse.
+  Proof.
+    intros p q eq.
+    rewrite <-(reverse_involutive p).
+    rewrite <-(reverse_involutive q).
+    by rewrite eq.
+  Qed.
+
+  Fixpoint length (p : positive) : nat :=
+    match p with 1 => 0%nat | p~0 | p~1 => S (length p) end.
+  Lemma length_app p1 p2 : length (p1 ++ p2) = (length p2 + length p1)%nat.
+  Proof. by induction p2; f_equal/=. Qed.
+
+  Lemma lt_sum (x y : positive) : x < y ↔ ∃ z, y = x + z.
+  Proof.
+    split.
+    - exists (y - x)%positive. symmetry. apply Pplus_minus. lia.
+    - intros [z ->]. lia.
+  Qed.
+
+  (** Duplicate the bits of a positive, i.e. 1~0~1 -> 1~0~0~1~1 and
+      1~1~0~0 -> 1~1~1~0~0~0~0 *)
+  Fixpoint dup (p : positive) : positive :=
+    match p with
+    | 1 => 1
+    | p'~0 => (dup p')~0~0
+    | p'~1 => (dup p')~1~1
+    end.
+
+  Lemma dup_app p q :
+    dup (p ++ q) = dup p ++ dup q.
+  Proof.
+    revert p.
+    induction q as [p IH|p IH|]; intros q; simpl.
+    - by rewrite IH.
+    - by rewrite IH.
+    - reflexivity.
+  Qed.
+
+  Lemma dup_suffix_eq p q s1 s2 :
+    s1~1~0 ++ dup p = s2~1~0 ++ dup q → p = q.
+  Proof.
+    revert q.
+    induction p as [p IH|p IH|]; intros [q|q|] eq; simplify_eq/=.
+    - by rewrite (IH q).
+    - by rewrite (IH q).
+    - reflexivity.
+  Qed.
+
+  Global Instance dup_inj : Inj (=) (=) dup.
+  Proof.
+    intros p q eq.
+    apply (dup_suffix_eq _ _ 1 1).
+    by rewrite eq.
+  Qed.
+
+  Lemma reverse_dup p :
+    reverse (dup p) = dup (reverse p).
+  Proof.
+    induction p as [p IH|p IH|]; simpl.
+    - rewrite 3!reverse_xI.
+      rewrite (assoc_L (++)).
+      rewrite IH.
+      rewrite dup_app.
+      reflexivity.
+    - rewrite 3!reverse_xO.
+      rewrite (assoc_L (++)).
+      rewrite IH.
+      rewrite dup_app.
+      reflexivity.
+    - reflexivity.
+  Qed.
+End Pos.
+
+Export Pos.app_notations.
+
+Local Close Scope positive_scope.
+
+(** * Notations and properties of [N] *)
+Local Open Scope N_scope.
+
+Global Typeclasses Opaque N.le.
+Global Typeclasses Opaque N.lt.
+
+Infix "≤" := N.le : N_scope.
+Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%N : N_scope.
+Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%N : N_scope.
+Notation "x < y ≤ z" := (x < y ∧ y ≤ z)%N : N_scope.
+Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z')%N : N_scope.
+Notation "(≤)" := N.le (only parsing) : N_scope.
+Notation "(<)" := N.lt (only parsing) : N_scope.
+
+Infix "`div`" := N.div (at level 35) : N_scope.
+Infix "`mod`" := N.modulo (at level 35) : N_scope.
+Infix "`max`" := N.max (at level 35) : N_scope.
+Infix "`min`" := N.min (at level 35) : N_scope.
+
+Global Arguments N.pred : simpl never.
+Global Arguments N.succ : simpl never.
+Global Arguments N.of_nat : simpl never.
+Global Arguments N.to_nat : simpl never.
+Global Arguments N.mul : simpl never.
+Global Arguments N.add : simpl never.
+Global Arguments N.sub : simpl never.
+Global Arguments N.pow : simpl never.
+Global Arguments N.div : simpl never.
+Global Arguments N.modulo : simpl never.
+Global Arguments N.shiftl : simpl never.
+Global Arguments N.shiftr : simpl never.
+Global Arguments N.gcd : simpl never.
+Global Arguments N.lcm : simpl never.
+Global Arguments N.min : simpl never.
+Global Arguments N.max : simpl never.
+Global Arguments N.lor : simpl never.
+Global Arguments N.land : simpl never.
+Global Arguments N.lxor : simpl never.
+Global Arguments N.lnot : simpl never.
+Global Arguments N.square : simpl never.
+
+Global Hint Extern 0 (_ ≤ _)%N => reflexivity : core.
+
+Module N.
+  Export BinNat.N.
+
+  Global Instance add_assoc' : Assoc (=) N.add := N.add_assoc.
+  Global Instance add_comm' : Comm (=) N.add := N.add_comm.
+  Global Instance add_left_id : LeftId (=) 0 N.add := N.add_0_l.
+  Global Instance add_right_id : RightId (=) 0 N.add := N.add_0_r.
+
+  Global Instance sub_right_id : RightId (=) 0 N.sub := N.sub_0_r.
+
+  Global Instance mul_assoc' : Assoc (=) N.mul := N.mul_assoc.
+  Global Instance mul_comm' : Comm (=) N.mul := N.mul_comm.
+  Global Instance mul_left_id : LeftId (=) 1 N.mul := N.mul_1_l.
+  Global Instance mul_right_id : RightId (=) 1 N.mul := N.mul_1_r.
+  Global Instance mul_left_absorb : LeftAbsorb (=) 0 N.mul := N.mul_0_l.
+  Global Instance mul_right_absorb : RightAbsorb (=) 0 N.mul := N.mul_0_r.
+
+  Global Instance div_right_id : RightId (=) 1 N.div := N.div_1_r.
+
+  Global Instance pos_inj : Inj (=) (=) N.pos.
+  Proof. by injection 1. Qed.
+
+  Global Instance eq_dec : EqDecision N := N.eq_dec.
+  Global Program Instance le_dec : RelDecision N.le := λ x y,
+    match N.compare x y with Gt => right _ | _ => left _ end.
+  Solve Obligations with naive_solver.
+  Global Program Instance lt_dec : RelDecision N.lt := λ x y,
+    match N.compare x y with Lt => left _ | _ => right _ end.
+  Solve Obligations with naive_solver.
+  Global Instance inhabited : Inhabited N := populate 1%N.
+  Global Instance lt_pi x y : ProofIrrel (x < y)%N.
+  Proof. unfold N.lt. apply _. Qed.
+
+  Global Instance le_po : PartialOrder (≤)%N.
+  Proof.
+    repeat split; red; [apply N.le_refl | apply N.le_trans | apply N.le_antisymm].
+  Qed.
+  Global Instance le_total : Total (≤)%N.
+  Proof. repeat intro; lia. Qed.
+
+  Lemma lt_wf_0_projected {B} (f : B → N) : well_founded (λ x y, f x < f y).
+  Proof. by apply (wf_projected (<) f), lt_wf_0. Qed.
+
+  (** FIXME: Coq 8.17 deprecated some lemmas in https://github.com/coq/coq/pull/16203.
+  We cannot use the intended replacements since we support Coq 8.16. We also do
+  not want to disable [deprecated-syntactic-definition] everywhere, so instead
+  we provide non-deprecated duplicates of those deprecated lemmas that we need
+  in std++ and Iris. *)
+  Local Set Warnings "-deprecated-syntactic-definition".
+  Lemma add_mod_idemp_l a b n : n ≠ 0 → (a mod n + b) mod n = (a + b) mod n.
+  Proof. auto using add_mod_idemp_l. Qed.
+  Lemma div_lt_upper_bound a b q : b ≠ 0 → a < b * q → a / b < q.
+  Proof. auto using div_lt_upper_bound. Qed.
+End N.
+
+Local Close Scope N_scope.
+
+(** * Notations and properties of [Z] *)
+Local Open Scope Z_scope.
+
+Global Typeclasses Opaque Z.le.
+Global Typeclasses Opaque Z.lt.
+
+Infix "≤" := Z.le : Z_scope.
+Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : Z_scope.
+Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : Z_scope.
+Notation "x < y < z" := (x < y ∧ y < z) : Z_scope.
+Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : Z_scope.
+Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : Z_scope.
+Notation "(≤)" := Z.le (only parsing) : Z_scope.
+Notation "(<)" := Z.lt (only parsing) : Z_scope.
+
+Infix "`div`" := Z.div (at level 35) : Z_scope.
+Infix "`mod`" := Z.modulo (at level 35) : Z_scope.
+Infix "`quot`" := Z.quot (at level 35) : Z_scope.
+Infix "`rem`" := Z.rem (at level 35) : Z_scope.
+Infix "≪" := Z.shiftl (at level 35) : Z_scope.
+Infix "≫" := Z.shiftr (at level 35) : Z_scope.
+Infix "`max`" := Z.max (at level 35) : Z_scope.
+Infix "`min`" := Z.min (at level 35) : Z_scope.
+
+Global Arguments Z.pred : simpl never.
+Global Arguments Z.succ : simpl never.
+Global Arguments Z.of_nat : simpl never.
+Global Arguments Z.to_nat : simpl never.
+Global Arguments Z.mul : simpl never.
+Global Arguments Z.add : simpl never.
+Global Arguments Z.sub : simpl never.
+Global Arguments Z.opp : simpl never.
+Global Arguments Z.pow : simpl never.
+Global Arguments Z.div : simpl never.
+Global Arguments Z.modulo : simpl never.
+Global Arguments Z.quot : simpl never.
+Global Arguments Z.rem : simpl never.
+Global Arguments Z.shiftl : simpl never.
+Global Arguments Z.shiftr : simpl never.
+Global Arguments Z.gcd : simpl never.
+Global Arguments Z.lcm : simpl never.
+Global Arguments Z.min : simpl never.
+Global Arguments Z.max : simpl never.
+Global Arguments Z.lor : simpl never.
+Global Arguments Z.land : simpl never.
+Global Arguments Z.lxor : simpl never.
+Global Arguments Z.lnot : simpl never.
+Global Arguments Z.square : simpl never.
+Global Arguments Z.abs : simpl never.
+
+Module Z.
+  Export BinInt.Z.
+
+  Global Instance add_assoc' : Assoc (=) Z.add := Z.add_assoc.
+  Global Instance add_comm' : Comm (=) Z.add := Z.add_comm.
+  Global Instance add_left_id : LeftId (=) 0 Z.add := Z.add_0_l.
+  Global Instance add_right_id : RightId (=) 0 Z.add := Z.add_0_r.
+
+  Global Instance sub_right_id : RightId (=) 0 Z.sub := Z.sub_0_r.
+
+  Global Instance mul_assoc' : Assoc (=) Z.mul := Z.mul_assoc.
+  Global Instance mul_comm' : Comm (=) Z.mul := Z.mul_comm.
+  Global Instance mul_left_id : LeftId (=) 1 Z.mul := Z.mul_1_l.
+  Global Instance mul_right_id : RightId (=) 1 Z.mul := Z.mul_1_r.
+  Global Instance mul_left_absorb : LeftAbsorb (=) 0 Z.mul := Z.mul_0_l.
+  Global Instance mul_right_absorb : RightAbsorb (=) 0 Z.mul := Z.mul_0_r.
+
+  Global Instance div_right_id : RightId (=) 1 Z.div := Z.div_1_r.
+
+  Global Instance pos_inj : Inj (=) (=) Z.pos.
+  Proof. by injection 1. Qed.
+  Global Instance neg_inj : Inj (=) (=) Z.neg.
+  Proof. by injection 1. Qed.
+
+  Global Instance eq_dec: EqDecision Z := Z.eq_dec.
+  Global Instance le_dec: RelDecision Z.le := Z_le_dec.
+  Global Instance lt_dec: RelDecision Z.lt := Z_lt_dec.
+  Global Instance ge_dec: RelDecision Z.ge := Z_ge_dec.
+  Global Instance gt_dec: RelDecision Z.gt := Z_gt_dec.
+  Global Instance inhabited: Inhabited Z := populate 1.
+  Global Instance lt_pi x y : ProofIrrel (x < y).
+  Proof. unfold Z.lt. apply _. Qed.
+
+  Global Instance le_po : PartialOrder (≤).
+  Proof.
+    repeat split; red; [apply Z.le_refl | apply Z.le_trans | apply Z.le_antisymm].
+  Qed.
+  Global Instance le_total: Total Z.le.
+  Proof. repeat intro; lia. Qed.
+
+  Lemma lt_wf_projected {B} (f : B → Z) z : well_founded (λ x y, z ≤ f x < f y).
+  Proof. by apply (wf_projected (λ x y, z ≤ x < y) f), lt_wf. Qed.
+
+  Lemma pow_pred_r n m : 0 < m → n * n ^ (Z.pred m) = n ^ m.
+  Proof.
+    intros. rewrite <-Z.pow_succ_r, Z.succ_pred; [done|]. by apply Z.lt_le_pred.
+  Qed.
+  Lemma quot_range_nonneg k x y : 0 ≤ x < k → 0 < y → 0 ≤ x `quot` y < k.
+  Proof.
+    intros [??] ?.
+    destruct (decide (y = 1)); subst; [rewrite Z.quot_1_r; auto |].
+    destruct (decide (x = 0)); subst; [rewrite Z.quot_0_l; auto with lia |].
+    split; [apply Z.quot_pos; lia|].
+    trans x; auto. apply Z.quot_lt; lia.
+  Qed.
+
+  Lemma mod_pos x y : 0 < y → 0 ≤ x `mod` y.
+  Proof. apply Z.mod_pos_bound. Qed.
+
+  Global Hint Resolve Z.lt_le_incl : zpos.
+  Global Hint Resolve Z.add_nonneg_pos Z.add_pos_nonneg Z.add_nonneg_nonneg : zpos.
+  Global Hint Resolve Z.mul_nonneg_nonneg Z.mul_pos_pos : zpos.
+  Global Hint Resolve Z.pow_pos_nonneg Z.pow_nonneg: zpos.
+  Global Hint Resolve Z.mod_pos Z.div_pos : zpos.
+  Global Hint Extern 1000 => lia : zpos.
+
+  Lemma succ_pred_induction y (P : Z → Prop) :
+    P y →
+    (∀ x, y ≤ x → P x → P (Z.succ x)) →
+    (∀ x, x ≤ y → P x → P (Z.pred x)) →
+    (∀ x, P x).
+  Proof. intros H0 HS HP. by apply (Z.order_induction' _ _ y). Qed.
+  Lemma mod_in_range q a c :
+    q * c ≤ a < (q + 1) * c →
+    a `mod` c = a - q * c.
+  Proof. intros ?. symmetry. apply Z.mod_unique_pos with q; lia. Qed.
+
+  Lemma ones_spec n m:
+    0 ≤ m → 0 ≤ n →
+    Z.testbit (Z.ones n) m = bool_decide (m < n).
+  Proof.
+    intros. case_bool_decide.
+    - by rewrite Z.ones_spec_low by lia.
+    - by rewrite Z.ones_spec_high by lia.
+  Qed.
+
+  Lemma bounded_iff_bits_nonneg k n :
+    0 ≤ k → 0 ≤ n →
+    n < 2^k ↔ ∀ l, k ≤ l → Z.testbit n l = false.
+  Proof.
+    intros. destruct (decide (n = 0)) as [->|].
+    { naive_solver eauto using Z.bits_0, Z.pow_pos_nonneg with lia. }
+    split.
+    { intros Hb%Z.log2_lt_pow2 l Hl; [|lia]. apply Z.bits_above_log2; lia. }
+    intros Hl. apply Z.nle_gt; intros ?.
+    assert (Z.testbit n (Z.log2 n) = false) as Hbit.
+    { apply Hl, Z.log2_le_pow2; lia. }
+    by rewrite Z.bit_log2 in Hbit by lia.
+  Qed.
+
+  (* Goals of the form [0 ≤ n ≤ 2^k] appear often. So we also define the
+  derived version [Z_bounded_iff_bits_nonneg'] that does not require
+  proving [0 ≤ n] twice in that case. *)
+  Lemma bounded_iff_bits_nonneg' k n :
+    0 ≤ k → 0 ≤ n →
+    0 ≤ n < 2^k ↔ ∀ l, k ≤ l → Z.testbit n l = false.
+  Proof. intros ??. rewrite <-bounded_iff_bits_nonneg; lia. Qed.
+
+  Lemma bounded_iff_bits k n :
+    0 ≤ k →
+    -2^k ≤ n < 2^k ↔ ∀ l, k ≤ l → Z.testbit n l = bool_decide (n < 0).
+  Proof.
+    intros Hk.
+    case_bool_decide; [ | rewrite <-bounded_iff_bits_nonneg; lia].
+    assert(n = - Z.abs n)%Z as -> by lia.
+    split.
+    { intros [? _] l Hl.
+      rewrite Z.bits_opp, negb_true_iff by lia.
+      apply bounded_iff_bits_nonneg with k; lia. }
+    intros Hbit. split.
+    - rewrite <-Z.opp_le_mono, <-Z.lt_pred_le.
+      apply bounded_iff_bits_nonneg; [lia..|]. intros l Hl.
+      rewrite <-negb_true_iff, <-Z.bits_opp by lia.
+      by apply Hbit.
+    - etrans; [|apply Z.pow_pos_nonneg]; lia.
+  Qed.
+
+  Lemma add_nocarry_lor a b :
+    Z.land a b = 0 →
+    a + b = Z.lor a b.
+  Proof. intros ?. rewrite <-Z.lxor_lor by done. by rewrite Z.add_nocarry_lxor. Qed.
+
+  Lemma opp_lnot a : -a - 1 = Z.lnot a.
+  Proof. pose proof (Z.add_lnot_diag a). lia. Qed.
+End Z.
+
+Module Nat2Z.
+  Export Znat.Nat2Z.
+
+  Global Instance inj' : Inj (=) (=) Z.of_nat.
+  Proof. intros n1 n2. apply Nat2Z.inj. Qed.
+
+  Lemma divide n m : (Z.of_nat n | Z.of_nat m) ↔ (n | m)%nat.
+  Proof.
+    split.
+    - rewrite <-(Nat2Z.id m) at 2; intros [i ->]; exists (Z.to_nat i). lia.
+    - intros [i ->]. exists (Z.of_nat i). by rewrite Nat2Z.inj_mul.
+  Qed.
+  Lemma inj_div x y : Z.of_nat (x `div` y) = (Z.of_nat x) `div` (Z.of_nat y).
+  Proof.
+    destruct (decide (y = 0%nat)); [by subst; destruct x |].
+    apply Z.div_unique with (Z.of_nat $ x `mod` y)%nat.
+    { left. rewrite <-(Nat2Z.inj_le 0), <-Nat2Z.inj_lt.
+      apply Nat.mod_bound_pos; lia. }
+    by rewrite <-Nat2Z.inj_mul, <-Nat2Z.inj_add, <-Nat.div_mod.
+  Qed.
+  Lemma inj_mod x y : Z.of_nat (x `mod` y) = (Z.of_nat x) `mod` (Z.of_nat y).
+  Proof.
+    destruct (decide (y = 0%nat)); [by subst; destruct x |].
+    apply Z.mod_unique with (Z.of_nat $ x `div` y)%nat.
+    { left. rewrite <-(Nat2Z.inj_le 0), <-Nat2Z.inj_lt.
+      apply Nat.mod_bound_pos; lia. }
+    by rewrite <-Nat2Z.inj_mul, <-Nat2Z.inj_add, <-Nat.div_mod.
+  Qed.
+End Nat2Z.
+
+Module Z2Nat.
+  Export Znat.Z2Nat.
+
+  Lemma neq_0_pos x : Z.to_nat x ≠ 0%nat → 0 < x.
+  Proof. by destruct x. Qed.
+  Lemma neq_0_nonneg x : Z.to_nat x ≠ 0%nat → 0 ≤ x.
+  Proof. by destruct x. Qed.
+  Lemma nonpos x : x ≤ 0 → Z.to_nat x = 0%nat.
+  Proof. destruct x; simpl; auto using Z2Nat.inj_neg. by intros []. Qed.
+
+  Lemma inj_pow (x y : nat) : Z.of_nat (x ^ y) = (Z.of_nat x) ^ (Z.of_nat y).
+  Proof.
+    induction y as [|y IH]; [by rewrite Z.pow_0_r, Nat.pow_0_r|].
+    by rewrite Nat.pow_succ_r, Nat2Z.inj_succ, Z.pow_succ_r,
+      Nat2Z.inj_mul, IH by auto with zpos.
+  Qed.
+
+  Lemma divide n m :
+    0 ≤ n → 0 ≤ m → (Z.to_nat n | Z.to_nat m)%nat ↔ (n | m).
+  Proof. intros. by rewrite <-Nat2Z.divide, !Z2Nat.id by done. Qed.
+
+  Lemma inj_div x y :
+    0 ≤ x → 0 ≤ y →
+    Z.to_nat (x `div` y) = (Z.to_nat x `div` Z.to_nat y)%nat.
+  Proof.
+    intros. destruct (decide (y = Z.of_nat 0%nat)); [by subst; destruct x|].
+    pose proof (Z.div_pos x y).
+    apply (base.inj Z.of_nat). by rewrite Nat2Z.inj_div, !Z2Nat.id by lia.
+  Qed.
+  Lemma inj_mod x y :
+    0 ≤ x → 0 ≤ y →
+    Z.to_nat (x `mod` y) = (Z.to_nat x `mod` Z.to_nat y)%nat.
+  Proof.
+    intros. destruct (decide (y = Z.of_nat 0%nat)); [by subst; destruct x|].
+    pose proof (Z.mod_pos x y).
+    apply (base.inj Z.of_nat). by rewrite Nat2Z.inj_mod, !Z2Nat.id by lia.
+  Qed.
+End Z2Nat.
+
+(** ** [bool_to_Z] *)
+Definition bool_to_Z (b : bool) : Z :=
+  if b then 1 else 0.
+
+Lemma bool_to_Z_bound b : 0 ≤ bool_to_Z b < 2.
+Proof. destruct b; simpl; lia. Qed.
+Lemma bool_to_Z_eq_0 b : bool_to_Z b = 0 ↔ b = false.
+Proof. destruct b; naive_solver. Qed.
+Lemma bool_to_Z_neq_0 b : bool_to_Z b ≠ 0 ↔ b = true.
+Proof. destruct b; naive_solver. Qed.
+Lemma bool_to_Z_spec b n : Z.testbit (bool_to_Z b) n = bool_decide (n = 0) && b.
+Proof. by destruct b, n. Qed.
+
+Local Close Scope Z_scope.
+
+
+(** * Injectivity of casts *)
+Module Nat2N.
+  Export Nnat.Nat2N.
+  Global Instance inj' : Inj (=) (=) N.of_nat := Nat2N.inj.
+End Nat2N.
+
+Module N2Nat.
+  Export Nnat.N2Nat.
+  Global Instance inj' : Inj (=) (=) N.to_nat := N2Nat.inj.
+End N2Nat.
+
+Module Pos2Nat.
+  Export Pnat.Pos2Nat.
+  Global Instance inj' : Inj (=) (=) Pos.to_nat := Pos2Nat.inj.
+End Pos2Nat.
+
+Module SuccNat2Pos.
+  Export Pnat.SuccNat2Pos.
+  Global Instance inj' : Inj (=) (=) Pos.of_succ_nat := SuccNat2Pos.inj.
+End SuccNat2Pos.
+
+Module N2Z.
+  Export Znat.N2Z.
+  Global Instance inj' : Inj (=) (=) Z.of_N := N2Z.inj.
+End N2Z.
+
+(* Add others here. *)
+
+(** * Notations and properties of [Qc] *)
+Global Typeclasses Opaque Qcle.
+Global Typeclasses Opaque Qclt.
+
+Local Open Scope Qc_scope.
+Delimit Scope Qc_scope with Qc.
+Notation "1" := (Q2Qc 1) : Qc_scope.
+Notation "2" := (1+1) : Qc_scope.
+Notation "- 1" := (Qcopp 1) : Qc_scope.
+Notation "- 2" := (Qcopp 2) : Qc_scope.
+Infix "≤" := Qcle : Qc_scope.
+Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z) : Qc_scope.
+Notation "x ≤ y < z" := (x ≤ y ∧ y < z) : Qc_scope.
+Notation "x < y < z" := (x < y ∧ y < z) : Qc_scope.
+Notation "x < y ≤ z" := (x < y ∧ y ≤ z) : Qc_scope.
+Notation "x ≤ y ≤ z ≤ z'" := (x ≤ y ∧ y ≤ z ∧ z ≤ z') : Qc_scope.
+Notation "(≤)" := Qcle (only parsing) : Qc_scope.
+Notation "(<)" := Qclt (only parsing) : Qc_scope.
+
+Global Hint Extern 1 (_ ≤ _) => reflexivity || discriminate : core.
+Global Arguments Qred : simpl never.
+
+Global Instance Qcplus_assoc' : Assoc (=) Qcplus := Qcplus_assoc.
+Global Instance Qcplus_comm' : Comm (=) Qcplus := Qcplus_comm.
+Global Instance Qcplus_left_id : LeftId (=) 0 Qcplus := Qcplus_0_l.
+Global Instance Qcplus_right_id : RightId (=) 0 Qcplus := Qcplus_0_r.
+
+Global Instance Qcminus_right_id : RightId (=) 0 Qcminus.
+Proof. unfold RightId. intros. ring. Qed.
+
+Global Instance Qcmult_assoc' : Assoc (=) Qcmult := Qcmult_assoc.
+Global Instance Qcmult_comm' : Comm (=) Qcmult := Qcmult_comm.
+Global Instance Qcmult_left_id : LeftId (=) 1 Qcmult := Qcmult_1_l.
+Global Instance Qcmult_right_id : RightId (=) 1 Qcmult := Qcmult_1_r.
+Global Instance Qcmult_left_absorb : LeftAbsorb (=) 0 Qcmult := Qcmult_0_l.
+Global Instance Qcmult_right_absorb : RightAbsorb (=) 0 Qcmult := Qcmult_0_r.
+
+Global Instance Qcdiv_right_id : RightId (=) 1 Qcdiv.
+Proof. intros x. rewrite <-(Qcmult_1_l (x / 1)), Qcmult_div_r; done. Qed.
+
+Lemma inject_Z_Qred n : Qred (inject_Z n) = inject_Z n.
+Proof. apply Qred_identity; auto using Z.gcd_1_r. Qed.
+Definition Qc_of_Z (n : Z) : Qc := Qcmake _ (inject_Z_Qred n).
+
+Global Instance Qc_eq_dec: EqDecision Qc := Qc_eq_dec.
+Global Program Instance Qc_le_dec: RelDecision Qcle := λ x y,
+  if Qclt_le_dec y x then right _ else left _.
+Next Obligation. intros x y; apply Qclt_not_le. Qed.
+Next Obligation. done. Qed.
+Global Program Instance Qc_lt_dec: RelDecision Qclt := λ x y,
+  if Qclt_le_dec x y then left _ else right _.
+Next Obligation. done. Qed.
+Next Obligation. intros x y; apply Qcle_not_lt. Qed.
+Global Instance Qc_lt_pi x y : ProofIrrel (x < y).
+Proof. unfold Qclt. apply _. Qed.
+
+Global Instance Qc_le_po: PartialOrder (≤).
+Proof.
+  repeat split; red; [apply Qcle_refl | apply Qcle_trans | apply Qcle_antisym].
+Qed.
+Global Instance Qc_lt_strict: StrictOrder (<).
+Proof.
+  split; red; [|apply Qclt_trans].
+  intros x Hx. by destruct (Qclt_not_eq x x).
+Qed.
+Global Instance Qc_le_total: Total Qcle.
+Proof. intros x y. destruct (Qclt_le_dec x y); auto using Qclt_le_weak. Qed.
+
+Lemma Qcplus_diag x : (x + x)%Qc = (2 * x)%Qc.
+Proof. ring. Qed.
+Lemma Qcle_ngt (x y : Qc) : x ≤ y ↔ ¬y < x.
+Proof. split; auto using Qcle_not_lt, Qcnot_lt_le. Qed.
+Lemma Qclt_nge (x y : Qc) : x < y ↔ ¬y ≤ x.
+Proof. split; auto using Qclt_not_le, Qcnot_le_lt. Qed.
+Lemma Qcplus_le_mono_l (x y z : Qc) : x ≤ y ↔ z + x ≤ z + y.
+Proof.
+  split; intros.
+  - by apply Qcplus_le_compat.
+  - replace x with ((0 - z) + (z + x)) by ring.
+    replace y with ((0 - z) + (z + y)) by ring.
+    by apply Qcplus_le_compat.
+Qed.
+Lemma Qcplus_le_mono_r (x y z : Qc) : x ≤ y ↔ x + z ≤ y + z.
+Proof. rewrite !(Qcplus_comm _ z). apply Qcplus_le_mono_l. Qed.
+Lemma Qcplus_lt_mono_l (x y z : Qc) : x < y ↔ z + x < z + y.
+Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_l. Qed.
+Lemma Qcplus_lt_mono_r (x y z : Qc) : x < y ↔ x + z < y + z.
+Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_r. Qed.
+Global Instance Qcopp_inj : Inj (=) (=) Qcopp.
+Proof.
+  intros x y H. by rewrite <-(Qcopp_involutive x), H, Qcopp_involutive.
+Qed.
+Global Instance Qcplus_inj_r z : Inj (=) (=) (Qcplus z).
+Proof.
+  intros x y H. by apply (anti_symm (≤));rewrite (Qcplus_le_mono_l _ _ z), H.
+Qed.
+Global Instance Qcplus_inj_l z : Inj (=) (=) (λ x, x + z).
+Proof.
+  intros x y H. by apply (anti_symm (≤)); rewrite (Qcplus_le_mono_r _ _ z), H.
+Qed.
+Lemma Qcplus_pos_nonneg (x y : Qc) : 0 < x → 0 ≤ y → 0 < x + y.
+Proof.
+  intros. apply Qclt_le_trans with (x + 0); [by rewrite Qcplus_0_r|].
+  by apply Qcplus_le_mono_l.
+Qed.
+Lemma Qcplus_nonneg_pos (x y : Qc) : 0 ≤ x → 0 < y → 0 < x + y.
+Proof. rewrite (Qcplus_comm x). auto using Qcplus_pos_nonneg. Qed.
+Lemma Qcplus_pos_pos (x y : Qc) : 0 < x → 0 < y → 0 < x + y.
+Proof. auto using Qcplus_pos_nonneg, Qclt_le_weak. Qed.
+Lemma Qcplus_nonneg_nonneg (x y : Qc) : 0 ≤ x → 0 ≤ y → 0 ≤ x + y.
+Proof.
+  intros. trans (x + 0); [by rewrite Qcplus_0_r|].
+  by apply Qcplus_le_mono_l.
+Qed.
+Lemma Qcplus_neg_nonpos (x y : Qc) : x < 0 → y ≤ 0 → x + y < 0.
+Proof.
+  intros. apply Qcle_lt_trans with (x + 0); [|by rewrite Qcplus_0_r].
+  by apply Qcplus_le_mono_l.
+Qed.
+Lemma Qcplus_nonpos_neg (x y : Qc) : x ≤ 0 → y < 0 → x + y < 0.
+Proof. rewrite (Qcplus_comm x). auto using Qcplus_neg_nonpos. Qed.
+Lemma Qcplus_neg_neg (x y : Qc) : x < 0 → y < 0 → x + y < 0.
+Proof. auto using Qcplus_nonpos_neg, Qclt_le_weak. Qed.
+Lemma Qcplus_nonpos_nonpos (x y : Qc) : x ≤ 0 → y ≤ 0 → x + y ≤ 0.
+Proof.
+  intros. trans (x + 0); [|by rewrite Qcplus_0_r].
+  by apply Qcplus_le_mono_l.
+Qed.
+Lemma Qcmult_le_mono_nonneg_l x y z : 0 ≤ z → x ≤ y → z * x ≤ z * y.
+Proof. intros. rewrite !(Qcmult_comm z). by apply Qcmult_le_compat_r. Qed.
+Lemma Qcmult_le_mono_nonneg_r x y z : 0 ≤ z → x ≤ y → x * z ≤ y * z.
+Proof. intros. by apply Qcmult_le_compat_r. Qed.
+Lemma Qcmult_le_mono_pos_l x y z : 0 < z → x ≤ y ↔ z * x ≤ z * y.
+Proof.
+  split; auto using Qcmult_le_mono_nonneg_l, Qclt_le_weak.
+  rewrite !Qcle_ngt, !(Qcmult_comm z).
+  intuition auto using Qcmult_lt_compat_r.
+Qed.
+Lemma Qcmult_le_mono_pos_r x y z : 0 < z → x ≤ y ↔ x * z ≤ y * z.
+Proof. rewrite !(Qcmult_comm _ z). by apply Qcmult_le_mono_pos_l. Qed.
+Lemma Qcmult_lt_mono_pos_l x y z : 0 < z → x < y ↔ z * x < z * y.
+Proof. intros. by rewrite !Qclt_nge, <-Qcmult_le_mono_pos_l. Qed.
+Lemma Qcmult_lt_mono_pos_r x y z : 0 < z → x < y ↔ x * z < y * z.
+Proof. intros. by rewrite !Qclt_nge, <-Qcmult_le_mono_pos_r. Qed.
+Lemma Qcmult_pos_pos x y : 0 < x → 0 < y → 0 < x * y.
+Proof.
+  intros. apply Qcle_lt_trans with (0 * y); [by rewrite Qcmult_0_l|].
+  by apply Qcmult_lt_mono_pos_r.
+Qed.
+Lemma Qcmult_nonneg_nonneg x y : 0 ≤ x → 0 ≤ y → 0 ≤ x * y.
+Proof.
+  intros. trans (0 * y); [by rewrite Qcmult_0_l|].
+  by apply Qcmult_le_mono_nonneg_r.
+Qed.
+
+Lemma Qcinv_pos x : 0 < x → 0 < /x.
+Proof.
+  intros. assert (0 ≠ x) by (by apply Qclt_not_eq).
+  by rewrite (Qcmult_lt_mono_pos_r _ _ x), Qcmult_0_l, Qcmult_inv_l by done.
+Qed.
+
+Lemma Z2Qc_inj_0 : Qc_of_Z 0 = 0.
+Proof. by apply Qc_is_canon. Qed.
+Lemma Z2Qc_inj_1 : Qc_of_Z 1 = 1.
+Proof. by apply Qc_is_canon. Qed.
+Lemma Z2Qc_inj_2 : Qc_of_Z 2 = 2.
+Proof. by apply Qc_is_canon. Qed.
+Lemma Z2Qc_inj n m : Qc_of_Z n = Qc_of_Z m → n = m.
+Proof. by injection 1. Qed.
+Lemma Z2Qc_inj_iff n m : Qc_of_Z n = Qc_of_Z m ↔ n = m.
+Proof. split; [ auto using Z2Qc_inj | by intros -> ]. Qed.
+Lemma Z2Qc_inj_le n m : (n ≤ m)%Z ↔ Qc_of_Z n ≤ Qc_of_Z m.
+Proof. by rewrite Zle_Qle. Qed.
+Lemma Z2Qc_inj_lt n m : (n < m)%Z ↔ Qc_of_Z n < Qc_of_Z m.
+Proof. by rewrite Zlt_Qlt. Qed.
+Lemma Z2Qc_inj_add n m : Qc_of_Z (n + m) = Qc_of_Z n + Qc_of_Z m.
+Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_plus. Qed.
+Lemma Z2Qc_inj_mul n m : Qc_of_Z (n * m) = Qc_of_Z n * Qc_of_Z m.
+Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_mult. Qed.
+Lemma Z2Qc_inj_opp n : Qc_of_Z (-n) = -Qc_of_Z n.
+Proof. apply Qc_is_canon; simpl. by rewrite Qred_correct, inject_Z_opp. Qed.
+Lemma Z2Qc_inj_sub n m : Qc_of_Z (n - m) = Qc_of_Z n - Qc_of_Z m.
+Proof.
+  apply Qc_is_canon; simpl.
+  by rewrite !Qred_correct, <-inject_Z_opp, <-inject_Z_plus.
+Qed.
+Local Close Scope Qc_scope.
+
+(** * Positive rationals *)
+Declare Scope Qp_scope.
+Delimit Scope Qp_scope with Qp.
+
+Record Qp := mk_Qp { Qp_to_Qc : Qc ; Qp_prf : (0 < Qp_to_Qc)%Qc }.
+Add Printing Constructor Qp.
+Bind Scope Qp_scope with Qp.
+Global Arguments Qp_to_Qc _%Qp : assert.
+
+Program Definition pos_to_Qp (n : positive) : Qp := mk_Qp (Qc_of_Z $ Z.pos n) _.
+Next Obligation. intros n. by rewrite <-Z2Qc_inj_0, <-Z2Qc_inj_lt. Qed.
+Global Arguments pos_to_Qp : simpl never.
+
+Local Open Scope Qp_scope.
+
+Module Qp.
+  Lemma to_Qc_inj_iff p q : Qp_to_Qc p = Qp_to_Qc q ↔ p = q.
+  Proof.
+    split; [|by intros ->].
+    destruct p, q; intros; simplify_eq/=; f_equal; apply (proof_irrel _).
+  Qed.
+  Global Instance eq_dec : EqDecision Qp.
+  Proof.
+    refine (λ p q, cast_if (decide (Qp_to_Qc p = Qp_to_Qc q)));
+      abstract (by rewrite <-to_Qc_inj_iff).
+  Defined.
+
+  Definition add (p q : Qp) : Qp :=
+    let 'mk_Qp p Hp := p in let 'mk_Qp q Hq := q in
+    mk_Qp (p + q) (Qcplus_pos_pos _ _ Hp Hq).
+  Global Arguments add : simpl never.
+
+  Definition sub (p q : Qp) : option Qp :=
+    let 'mk_Qp p Hp := p in let 'mk_Qp q Hq := q in
+    let pq := (p - q)%Qc in
+    Hpq ← guard (0 < pq)%Qc; Some (mk_Qp pq Hpq).
+  Global Arguments sub : simpl never.
+
+  Definition mul (p q : Qp) : Qp :=
+    let 'mk_Qp p Hp := p in let 'mk_Qp q Hq := q in
+    mk_Qp (p * q) (Qcmult_pos_pos _ _ Hp Hq).
+  Global Arguments mul : simpl never.
+
+  Definition inv (q : Qp) : Qp :=
+    let 'mk_Qp q Hq := q return _ in
+    mk_Qp (/ q)%Qc (Qcinv_pos _ Hq).
+  Global Arguments inv : simpl never.
+
+  Definition div (p q : Qp) : Qp := mul p (inv q).
+  Global Typeclasses Opaque div.
+  Global Arguments div : simpl never.
+
+  Definition le (p q : Qp) : Prop :=
+    let 'mk_Qp p _ := p in let 'mk_Qp q _ := q in (p ≤ q)%Qc.
+  Definition lt (p q : Qp) : Prop :=
+    let 'mk_Qp p _ := p in let 'mk_Qp q _ := q in (p < q)%Qc.
+
+  Lemma to_Qc_inj_add p q : Qp_to_Qc (add p q) = (Qp_to_Qc p + Qp_to_Qc q)%Qc.
+  Proof. by destruct p, q. Qed.
+  Lemma to_Qc_inj_mul p q : Qp_to_Qc (mul p q) = (Qp_to_Qc p * Qp_to_Qc q)%Qc.
+  Proof. by destruct p, q. Qed.
+  Lemma to_Qc_inj_le p q : le p q ↔ (Qp_to_Qc p ≤ Qp_to_Qc q)%Qc.
+  Proof. by destruct p, q. Qed.
+  Lemma to_Qc_inj_lt p q : lt p q ↔ (Qp_to_Qc p < Qp_to_Qc q)%Qc.
+  Proof. by destruct p, q. Qed.
+
+  Global Instance le_dec : RelDecision le.
+  Proof.
+    refine (λ p q, cast_if (decide (Qp_to_Qc p ≤ Qp_to_Qc q)%Qc));
+      abstract (by rewrite to_Qc_inj_le).
+  Defined.
+  Global Instance lt_dec : RelDecision lt.
+  Proof.
+    refine (λ p q, cast_if (decide (Qp_to_Qc p < Qp_to_Qc q)%Qc));
+      abstract (by rewrite to_Qc_inj_lt).
+  Defined.
+  Global Instance lt_pi p q : ProofIrrel (lt p q).
+  Proof. destruct p, q; apply _. Qed.
+
+  Definition max (q p : Qp) : Qp := if decide (le q p) then p else q.
+  Definition min (q p : Qp) : Qp := if decide (le q p) then q else p.
+
+  Module Import notations.
+    Infix "+" := add : Qp_scope.
+    Infix "-" := sub : Qp_scope.
+    Infix "*" := mul : Qp_scope.
+    Notation "/ q" := (inv q) : Qp_scope.
+    Infix "/" := div : Qp_scope.
+
+    Notation "1" := (pos_to_Qp 1) : Qp_scope.
+    Notation "2" := (pos_to_Qp 2) : Qp_scope.
+    Notation "3" := (pos_to_Qp 3) : Qp_scope.
+    Notation "4" := (pos_to_Qp 4) : Qp_scope.
+
+    Infix "≤" := le : Qp_scope.
+    Infix "<" := lt : Qp_scope.
+    Notation "p ≤ q ≤ r" := (p ≤ q ∧ q ≤ r) : Qp_scope.
+    Notation "p ≤ q < r" := (p ≤ q ∧ q < r) : Qp_scope.
+    Notation "p < q < r" := (p < q ∧ q < r) : Qp_scope.
+    Notation "p < q ≤ r" := (p < q ∧ q ≤ r) : Qp_scope.
+    Notation "p ≤ q ≤ r ≤ r'" := (p ≤ q ∧ q ≤ r ∧ r ≤ r') : Qp_scope.
+    Notation "(≤)" := le (only parsing) : Qp_scope.
+    Notation "(<)" := lt (only parsing) : Qp_scope.
+
+    Infix "`max`" := max : Qp_scope.
+    Infix "`min`" := min : Qp_scope.
+  End notations.
+
+  Global Hint Extern 0 (_ ≤ _)%Qp => reflexivity : core.
+
+  Global Instance inhabited : Inhabited Qp := populate 1.
+
+  Global Instance add_assoc : Assoc (=) add.
+  Proof. intros [p ?] [q ?] [r ?]; apply to_Qc_inj_iff, Qcplus_assoc. Qed.
+  Global Instance add_comm : Comm (=) add.
+  Proof. intros [p ?] [q ?]; apply to_Qc_inj_iff, Qcplus_comm. Qed.
+  Global Instance add_inj_r p : Inj (=) (=) (add p).
+  Proof.
+    destruct p as [p ?].
+    intros [q1 ?] [q2 ?]. rewrite <-!to_Qc_inj_iff; simpl. apply (inj (Qcplus p)).
+  Qed.
+  Global Instance add_inj_l p : Inj (=) (=) (λ q, q + p).
+  Proof.
+    destruct p as [p ?].
+    intros [q1 ?] [q2 ?]. rewrite <-!to_Qc_inj_iff; simpl. apply (inj (λ q, q + p)%Qc).
+  Qed.
+
+  Global Instance mul_assoc : Assoc (=) mul.
+  Proof. intros [p ?] [q ?] [r ?]. apply Qp.to_Qc_inj_iff, Qcmult_assoc. Qed.
+  Global Instance mul_comm : Comm (=) mul.
+  Proof. intros [p ?] [q ?]; apply Qp.to_Qc_inj_iff, Qcmult_comm. Qed.
+  Global Instance mul_inj_r p : Inj (=) (=) (mul p).
+  Proof.
+    destruct p as [p ?]. intros [q1 ?] [q2 ?]. rewrite <-!Qp.to_Qc_inj_iff; simpl.
+    intros Hpq.
+    apply (anti_symm Qcle); apply (Qcmult_le_mono_pos_l _ _ p); by rewrite ?Hpq.
+  Qed.
+  Global Instance mul_inj_l p : Inj (=) (=) (λ q, q * p).
+  Proof.
+    intros q1 q2 Hpq. apply (inj (mul p)). by rewrite !(comm_L mul p).
+  Qed.
+
+  Lemma mul_add_distr_l p q r : p * (q + r) = p * q + p * r.
+  Proof. destruct p, q, r; by apply Qp.to_Qc_inj_iff, Qcmult_plus_distr_r. Qed.
+  Lemma mul_add_distr_r p q r : (p + q) * r = p * r + q * r.
+  Proof. destruct p, q, r; by apply Qp.to_Qc_inj_iff, Qcmult_plus_distr_l. Qed.
+  Lemma mul_1_l p : 1 * p = p.
+  Proof. destruct p; apply Qp.to_Qc_inj_iff, Qcmult_1_l. Qed.
+  Lemma mul_1_r p : p * 1 = p.
+  Proof. destruct p; apply Qp.to_Qc_inj_iff, Qcmult_1_r. Qed.
+  Global Instance mul_left_id : LeftId (=) 1 mul := mul_1_l.
+  Global Instance mul_right_id : RightId (=) 1 mul := mul_1_r.
+
+  Lemma add_1_1 : 1 + 1 = 2.
+  Proof. compute_done. Qed.
+  Lemma add_diag p : p + p = 2 * p.
+  Proof. by rewrite <-add_1_1, mul_add_distr_r, !mul_1_l. Qed.
+
+  Lemma mul_inv_l p : /p * p = 1.
+  Proof.
+    destruct p as [p ?]; apply Qp.to_Qc_inj_iff; simpl.
+    by rewrite Qcmult_inv_l, Z2Qc_inj_1 by (by apply not_symmetry, Qclt_not_eq).
+  Qed.
+  Lemma mul_inv_r p : p * /p = 1.
+  Proof. by rewrite (comm_L mul), mul_inv_l. Qed.
+  Lemma inv_mul_distr p q : /(p * q) = /p * /q.
+  Proof.
+    apply (inj (mul (p * q))).
+    rewrite mul_inv_r, (comm_L mul p), <-(assoc_L _), (assoc_L mul p).
+    by rewrite mul_inv_r, mul_1_l, mul_inv_r.
+  Qed.
+  Lemma inv_involutive p : / /p = p.
+  Proof.
+    rewrite <-(mul_1_l (/ /p)), <-(mul_inv_r p), <-(assoc_L _).
+    by rewrite mul_inv_r, mul_1_r.
+  Qed.
+  Global Instance inv_inj : Inj (=) (=) inv.
+  Proof.
+    intros p1 p2 Hp. apply (inj (mul (/p1))).
+    by rewrite mul_inv_l, Hp, mul_inv_l.
+  Qed.
+  Lemma inv_1 : /1 = 1.
+  Proof. compute_done. Qed.
+  Lemma inv_half_half : /2 + /2 = 1.
+  Proof. compute_done. Qed.
+  Lemma inv_quarter_quarter : /4 + /4 = /2.
+  Proof. compute_done. Qed.
+
+  Lemma div_diag p : p / p = 1.
+  Proof. apply mul_inv_r. Qed.
+  Lemma mul_div_l p q : (p / q) * q = p.
+  Proof. unfold div. by rewrite <-(assoc_L _), mul_inv_l, mul_1_r. Qed.
+  Lemma mul_div_r p q : q * (p / q) = p.
+  Proof. by rewrite (comm_L mul q), mul_div_l. Qed.
+  Lemma div_add_distr p q r : (p + q) / r = p / r + q / r.
+  Proof. apply mul_add_distr_r. Qed.
+  Lemma div_div p q r : (p / q) / r = p / (q * r).
+  Proof. unfold div. by rewrite inv_mul_distr, (assoc_L _). Qed.
+  Lemma div_mul_cancel_l p q r : (r * p) / (r * q) = p / q.
+  Proof.
+    rewrite <-div_div. f_equiv. unfold div.
+    by rewrite (comm_L mul r), <-(assoc_L _), mul_inv_r, mul_1_r.
+  Qed.
+  Lemma div_mul_cancel_r p q r : (p * r) / (q * r) = p / q.
+  Proof. by rewrite <-!(comm_L mul r), div_mul_cancel_l. Qed.
+  Lemma div_1 p : p / 1 = p.
+  Proof. by rewrite <-(mul_1_r (p / 1)), mul_div_l. Qed.
+  Lemma div_2 p : p / 2 + p / 2 = p.
+  Proof.
+    rewrite <-div_add_distr, add_diag.
+    rewrite <-(mul_1_r 2) at 2. by rewrite div_mul_cancel_l, div_1.
+  Qed.
+  Lemma div_2_mul p q : p / (2 * q) + p / (2 * q) = p / q.
+  Proof. by rewrite <-div_add_distr, add_diag, div_mul_cancel_l. Qed.
+  Global Instance div_right_id : RightId (=) 1 div := div_1.
+
+  Lemma half_half : 1 / 2 + 1 / 2 = 1.
+  Proof. compute_done. Qed.
+  Lemma quarter_quarter : 1 / 4 + 1 / 4 = 1 / 2.
+  Proof. compute_done. Qed.
+  Lemma quarter_three_quarter : 1 / 4 + 3 / 4 = 1.
+  Proof. compute_done. Qed.
+  Lemma three_quarter_quarter : 3 / 4 + 1 / 4 = 1.
+  Proof. compute_done. Qed.
+
+  Global Instance div_inj_r p : Inj (=) (=) (div p).
+  Proof. unfold div; apply _. Qed.
+  Global Instance div_inj_l p : Inj (=) (=) (λ q, q / p)%Qp.
+  Proof. unfold div; apply _. Qed.
+
+  Global Instance le_po : PartialOrder (≤).
+  Proof.
+    split; [split|].
+    - intros p. by apply to_Qc_inj_le.
+    - intros p q r. rewrite !to_Qc_inj_le. by etrans.
+    - intros p q. rewrite !to_Qc_inj_le, <-to_Qc_inj_iff. apply Qcle_antisym.
+  Qed.
+  Global Instance lt_strict : StrictOrder (<).
+  Proof.
+    split.
+    - intros p ?%to_Qc_inj_lt. by apply (irreflexivity (<)%Qc (Qp_to_Qc p)).
+    - intros p q r. rewrite !to_Qc_inj_lt. by etrans.
+  Qed.
+  Global Instance le_total: Total (≤).
+  Proof. intros p q. rewrite !to_Qc_inj_le. apply (total Qcle). Qed.
+
+  Lemma lt_le_incl p q : p < q → p ≤ q.
+  Proof. rewrite to_Qc_inj_lt, to_Qc_inj_le. apply Qclt_le_weak. Qed.
+  Lemma le_lteq p q : p ≤ q ↔ p < q ∨ p = q.
+  Proof.
+    rewrite to_Qc_inj_lt, to_Qc_inj_le, <-Qp.to_Qc_inj_iff. split.
+    - intros [?| ->]%Qcle_lt_or_eq; auto.
+    - intros [?| ->]; auto using Qclt_le_weak.
+  Qed.
+  Lemma lt_ge_cases p q : {p < q} + {q ≤ p}.
+  Proof.
+    refine (cast_if (Qclt_le_dec (Qp_to_Qc p) (Qp_to_Qc q)%Qc));
+      [by apply to_Qc_inj_lt|by apply to_Qc_inj_le].
+  Defined.
+  Lemma le_lt_trans p q r : p ≤ q → q < r → p < r.
+  Proof. rewrite !to_Qc_inj_lt, to_Qc_inj_le. apply Qcle_lt_trans. Qed.
+  Lemma lt_le_trans p q r : p < q → q ≤ r → p < r.
+  Proof. rewrite !to_Qc_inj_lt, to_Qc_inj_le. apply Qclt_le_trans. Qed.
+
+  Lemma le_ngt p q : p ≤ q ↔ ¬q < p.
+  Proof.
+    rewrite !to_Qc_inj_lt, to_Qc_inj_le.
+    split; auto using Qcle_not_lt, Qcnot_lt_le.
+  Qed.
+  Lemma lt_nge p q : p < q ↔ ¬q ≤ p.
+  Proof.
+    rewrite !to_Qc_inj_lt, to_Qc_inj_le.
+    split; auto using Qclt_not_le, Qcnot_le_lt.
+  Qed.
+
+  Lemma add_le_mono_l p q r : p ≤ q ↔ r + p ≤ r + q.
+  Proof. rewrite !to_Qc_inj_le. destruct p, q, r; apply Qcplus_le_mono_l. Qed.
+  Lemma add_le_mono_r p q r : p ≤ q ↔ p + r ≤ q + r.
+  Proof. rewrite !(comm_L add _ r). apply add_le_mono_l. Qed.
+  Lemma add_le_mono q p n m : q ≤ n → p ≤ m → q + p ≤ n + m.
+  Proof. intros. etrans; [by apply add_le_mono_l|by apply add_le_mono_r]. Qed.
+
+  Lemma add_lt_mono_l p q r : p < q ↔ r + p < r + q.
+  Proof. by rewrite !lt_nge, <-add_le_mono_l. Qed.
+  Lemma add_lt_mono_r p q r : p < q ↔ p + r < q + r.
+  Proof. by rewrite !lt_nge, <-add_le_mono_r. Qed.
+  Lemma add_lt_mono q p n m : q < n → p < m → q + p < n + m.
+  Proof. intros. etrans; [by apply add_lt_mono_l|by apply add_lt_mono_r]. Qed.
+
+  Lemma mul_le_mono_l p q r : p ≤ q ↔ r * p ≤ r * q.
+  Proof.
+    rewrite !to_Qc_inj_le. destruct p, q, r; by apply Qcmult_le_mono_pos_l.
+  Qed.
+  Lemma mul_le_mono_r p q r : p ≤ q ↔ p * r ≤ q * r.
+  Proof. rewrite !(comm_L mul _ r). apply mul_le_mono_l. Qed.
+  Lemma mul_le_mono q p n m : q ≤ n → p ≤ m → q * p ≤ n * m.
+  Proof. intros. etrans; [by apply mul_le_mono_l|by apply mul_le_mono_r]. Qed.
+
+  Lemma mul_lt_mono_l p q r : p < q ↔ r * p < r * q.
+  Proof.
+    rewrite !to_Qc_inj_lt. destruct p, q, r; by apply Qcmult_lt_mono_pos_l.
+  Qed.
+  Lemma mul_lt_mono_r p q r : p < q ↔ p * r < q * r.
+  Proof. rewrite !(comm_L mul _ r). apply mul_lt_mono_l. Qed.
+  Lemma mul_lt_mono q p n m : q < n → p < m → q * p < n * m.
+  Proof. intros. etrans; [by apply mul_lt_mono_l|by apply mul_lt_mono_r]. Qed.
+
+  Lemma lt_add_l p q : p < p + q.
+  Proof.
+    destruct p as [p ?], q as [q ?]. apply to_Qc_inj_lt; simpl.
+    rewrite <- (Qcplus_0_r p) at 1. by rewrite <-Qcplus_lt_mono_l.
+  Qed.
+  Lemma lt_add_r p q : q < p + q.
+  Proof. rewrite (comm_L add). apply lt_add_l. Qed.
+
+  Lemma not_add_le_l p q : ¬(p + q ≤ p).
+  Proof. apply lt_nge, lt_add_l. Qed.
+  Lemma not_add_le_r p q : ¬(p + q ≤ q).
+  Proof. apply lt_nge, lt_add_r. Qed.
+
+  Lemma add_id_free q p : q + p ≠ q.
+  Proof. intro Heq. apply (not_add_le_l q p). by rewrite Heq. Qed.
+
+  Lemma le_add_l p q : p ≤ p + q.
+  Proof. apply lt_le_incl, lt_add_l. Qed.
+  Lemma le_add_r p q : q ≤ p + q.
+  Proof. apply lt_le_incl, lt_add_r. Qed.
+
+  Lemma sub_Some p q r : p - q = Some r ↔ p = q + r.
+  Proof.
+    destruct p as [p Hp], q as [q Hq], r as [r Hr].
+    unfold sub, add; simpl; rewrite <-Qp.to_Qc_inj_iff; simpl. split.
+    - intros; simplify_option_eq. unfold Qcminus.
+      by rewrite (Qcplus_comm p), Qcplus_assoc, Qcplus_opp_r, Qcplus_0_l.
+    - intros ->. unfold Qcminus.
+      rewrite <-Qcplus_assoc, (Qcplus_comm r), Qcplus_assoc.
+      rewrite Qcplus_opp_r, Qcplus_0_l. simplify_option_eq; [|done].
+      f_equal. by apply Qp.to_Qc_inj_iff.
+  Qed.
+  Lemma lt_sum p q : p < q ↔ ∃ r, q = p + r.
+  Proof.
+    destruct p as [p Hp], q as [q Hq]. rewrite to_Qc_inj_lt; simpl.
+    split.
+    - intros Hlt%Qclt_minus_iff. exists (mk_Qp (q - p) Hlt).
+      apply Qp.to_Qc_inj_iff; simpl. unfold Qcminus.
+      by rewrite (Qcplus_comm q), Qcplus_assoc, Qcplus_opp_r, Qcplus_0_l.
+    - intros [[r ?] ?%Qp.to_Qc_inj_iff]; simplify_eq/=.
+      rewrite <-(Qcplus_0_r p) at 1. by apply Qcplus_lt_mono_l.
+  Qed.
+
+  Lemma sub_None p q : p - q = None ↔ p ≤ q.
+  Proof.
+    rewrite le_ngt, lt_sum, eq_None_not_Some.
+    by setoid_rewrite <-sub_Some.
+  Qed.
+  Lemma sub_diag p : p - p = None.
+  Proof. by apply sub_None. Qed.
+  Lemma add_sub p q : (p + q) - q = Some p.
+  Proof. apply sub_Some. by rewrite (comm_L add). Qed.
+
+  Lemma inv_lt_mono p q : p < q ↔ /q < /p.
+  Proof.
+    revert p q. cut (∀ p q, p < q → / q < / p).
+    { intros help p q. split; [apply help|]. intros.
+      rewrite <-(inv_involutive p), <-(inv_involutive q). by apply help. }
+    intros p q Hpq. apply (mul_lt_mono_l _ _ q). rewrite mul_inv_r.
+    apply (mul_lt_mono_r _ _ p). rewrite <-(assoc_L _), mul_inv_l.
+    by rewrite mul_1_l, mul_1_r.
+  Qed.
+  Lemma inv_le_mono p q : p ≤ q ↔ /q ≤ /p.
+  Proof. by rewrite !le_ngt, inv_lt_mono. Qed.
+
+  Lemma div_le_mono_l p q r : q ≤ p ↔ r / p ≤ r / q.
+  Proof. unfold div. by rewrite <-mul_le_mono_l, inv_le_mono. Qed.
+  Lemma div_le_mono_r p q r : p ≤ q ↔ p / r ≤ q / r.
+  Proof. apply mul_le_mono_r. Qed.
+  Lemma div_lt_mono_l p q r : q < p ↔ r / p < r / q.
+  Proof. unfold div. by rewrite <-mul_lt_mono_l, inv_lt_mono. Qed.
+  Lemma div_lt_mono_r p q r : p < q ↔ p / r < q / r.
+  Proof. apply mul_lt_mono_r. Qed.
+
+  Lemma div_lt p q : 1 < q → p / q < p.
+  Proof. by rewrite (div_lt_mono_l _ _ p), div_1. Qed.
+  Lemma div_le p q : 1 ≤ q → p / q ≤ p.
+  Proof. by rewrite (div_le_mono_l _ _ p), div_1. Qed.
+
+  Lemma lower_bound q1 q2 : ∃ q q1' q2', q1 = q + q1' ∧ q2 = q + q2'.
+  Proof.
+    revert q1 q2. cut (∀ q1 q2 : Qp, q1 ≤ q2 →
+      ∃ q q1' q2', q1 = q + q1' ∧ q2 = q + q2').
+    { intros help q1 q2.
+      destruct (lt_ge_cases q2 q1) as [Hlt|Hle]; eauto.
+      destruct (help q2 q1) as (q&q1'&q2'&?&?); eauto using lt_le_incl. }
+    intros q1 q2 Hq. exists (q1 / 2)%Qp, (q1 / 2)%Qp.
+    assert (q1 / 2 < q2) as [q2' ->]%lt_sum.
+    { eapply lt_le_trans, Hq. by apply div_lt. }
+    eexists; split; [|done]. by rewrite div_2.
+  Qed.
+
+  Lemma lower_bound_lt q1 q2 : ∃ q : Qp, q < q1 ∧ q < q2.
+  Proof.
+    destruct (lower_bound q1 q2) as (qmin & q1' & q2' & [-> ->]).
+    exists qmin. split; eapply lt_sum; eauto.
+  Qed.
+
+  Lemma cross_split a b c d :
+    a + b = c + d →
+    ∃ ac ad bc bd, ac + ad = a ∧ bc + bd = b ∧ ac + bc = c ∧ ad + bd = d.
+  Proof.
+    intros H. revert a b c d H. cut (∀ a b c d : Qp,
+      a < c → a + b = c + d →
+      ∃ ac ad bc bd, ac + ad = a ∧ bc + bd = b ∧ ac + bc = c ∧ ad + bd = d)%Qp.
+    { intros help a b c d Habcd.
+      destruct (lt_ge_cases a c) as [?|[?| ->]%le_lteq].
+      - auto.
+      - destruct (help c d a b); [done..|]. naive_solver.
+      - apply (inj (add a)) in Habcd as ->.
+        destruct (lower_bound a d) as (q&a'&d'&->&->).
+        exists a', q, q, d'. repeat split; done || by rewrite (comm_L add). }
+    intros a b c d [e ->]%lt_sum. rewrite <-(assoc_L _). intros ->%(inj (add a)).
+    destruct (lower_bound a d) as (q&a'&d'&->&->).
+    eexists a', q, (q + e)%Qp, d'; split_and?; [by rewrite (comm_L add)|..|done].
+    - by rewrite (assoc_L _), (comm_L add e).
+    - by rewrite (assoc_L _), (comm_L add a').
+  Qed.
+
+  Lemma bounded_split p r : ∃ q1 q2 : Qp, q1 ≤ r ∧ p = q1 + q2.
+  Proof.
+    destruct (lt_ge_cases r p) as [[q ->]%lt_sum|?].
+    { by exists r, q. }
+    exists (p / 2)%Qp, (p / 2)%Qp; split.
+    + trans p; [|done]. by apply div_le.
+    + by rewrite div_2.
+  Qed.
+
+  Lemma max_spec q p : (q < p ∧ q `max` p = p) ∨ (p ≤ q ∧ q `max` p = q).
+  Proof.
+    unfold max.
+    destruct (decide (q ≤ p)) as [[?| ->]%le_lteq|?]; [by auto..|].
+    right. split; [|done]. by apply lt_le_incl, lt_nge.
+  Qed.
+
+  Lemma max_spec_le q p : (q ≤ p ∧ q `max` p = p) ∨ (p ≤ q ∧ q `max` p = q).
+  Proof. destruct (max_spec q p) as [[?%lt_le_incl?]|]; [left|right]; done. Qed.
+
+  Global Instance max_assoc : Assoc (=) max.
+  Proof.
+    intros q p o. unfold max. destruct (decide (q ≤ p)), (decide (p ≤ o));
+      try by rewrite ?decide_True by (by etrans).
+    rewrite decide_False by done.
+    by rewrite decide_False by (apply lt_nge; etrans; by apply lt_nge).
+  Qed.
+  Global Instance max_comm : Comm (=) max.
+  Proof.
+    intros q p.
+    destruct (max_spec_le q p) as [[?->]|[?->]],
+      (max_spec_le p q) as [[?->]|[?->]]; done || by apply (anti_symm (≤)).
+  Qed.
+
+  Lemma max_id q : q `max` q = q.
+  Proof. by destruct (max_spec q q) as [[_->]|[_->]]. Qed.
+
+  Lemma le_max_l q p : q ≤ q `max` p.
+  Proof. unfold max. by destruct (decide (q ≤ p)). Qed.
+  Lemma le_max_r q p : p ≤ q `max` p.
+  Proof. rewrite (comm_L max q). apply le_max_l. Qed.
+
+  Lemma max_add q p : q `max` p ≤ q + p.
+  Proof.
+    unfold max.
+    destruct (decide (q ≤ p)); [apply le_add_r|apply le_add_l].
+  Qed.
+
+  Lemma max_lub_l q p o : q `max` p ≤ o → q ≤ o.
+  Proof. unfold max. destruct (decide (q ≤ p)); [by etrans|done]. Qed.
+  Lemma max_lub_r q p o : q `max` p ≤ o → p ≤ o.
+  Proof. rewrite (comm _ q). apply max_lub_l. Qed.
+
+  Lemma min_spec q p : (q < p ∧ q `min` p = q) ∨ (p ≤ q ∧ q `min` p = p).
+  Proof.
+    unfold min.
+    destruct (decide (q ≤ p)) as [[?| ->]%le_lteq|?]; [by auto..|].
+    right. split; [|done]. by apply lt_le_incl, lt_nge.
+  Qed.
+
+  Lemma min_spec_le q p : (q ≤ p ∧ q `min` p = q) ∨ (p ≤ q ∧ q `min` p = p).
+  Proof. destruct (min_spec q p) as [[?%lt_le_incl ?]|]; [left|right]; done. Qed.
+
+  Global Instance min_assoc : Assoc (=) min.
+  Proof.
+    intros q p o. unfold min.
+    destruct (decide (q ≤ p)), (decide (p ≤ o)); eauto using decide_False.
+    - by rewrite !decide_True by (by etrans).
+    - by rewrite decide_False by (apply lt_nge; etrans; by apply lt_nge).
+  Qed.
+  Global Instance min_comm : Comm (=) min.
+  Proof.
+    intros q p.
+    destruct (min_spec_le q p) as [[?->]|[?->]],
+      (min_spec_le p q) as [[? ->]|[? ->]]; done || by apply (anti_symm (≤)).
+  Qed.
+
+  Lemma min_id q : q `min` q = q.
+  Proof. by destruct (min_spec q q) as [[_->]|[_->]]. Qed.
+  Lemma le_min_r q p : q `min` p ≤ p.
+  Proof. by destruct (min_spec_le q p) as [[?->]|[?->]]. Qed.
+
+  Lemma le_min_l p q : p `min` q ≤ p.
+  Proof. rewrite (comm_L min p). apply le_min_r. Qed.
+
+  Lemma min_l_iff q p : q `min` p = q ↔ q ≤ p.
+  Proof.
+    destruct (min_spec_le q p) as [[?->]|[?->]]; [done|].
+    split; [by intros ->|]. intros. by apply (anti_symm (≤)).
+  Qed.
+  Lemma min_r_iff q p : q `min` p = p ↔ p ≤ q.
+  Proof. rewrite (comm_L min q). apply min_l_iff. Qed.
+End Qp.
+
+Export Qp.notations.
+
+Lemma pos_to_Qp_1 : pos_to_Qp 1 = 1.
+Proof. compute_done. Qed.
+Lemma pos_to_Qp_inj n m : pos_to_Qp n = pos_to_Qp m → n = m.
+Proof. by injection 1. Qed.
+Lemma pos_to_Qp_inj_iff n m : pos_to_Qp n = pos_to_Qp m ↔ n = m.
+Proof. split; [apply pos_to_Qp_inj|by intros ->]. Qed.
+Lemma pos_to_Qp_inj_le n m : (n ≤ m)%positive ↔ pos_to_Qp n ≤ pos_to_Qp m.
+Proof. rewrite Qp.to_Qc_inj_le; simpl. by rewrite <-Z2Qc_inj_le. Qed.
+Lemma pos_to_Qp_inj_lt n m : (n < m)%positive ↔ pos_to_Qp n < pos_to_Qp m.
+Proof. by rewrite Pos.lt_nle, Qp.lt_nge, <-pos_to_Qp_inj_le. Qed.
+Lemma pos_to_Qp_add x y : pos_to_Qp x + pos_to_Qp y = pos_to_Qp (x + y).
+Proof. apply Qp.to_Qc_inj_iff; simpl. by rewrite Pos2Z.inj_add, Z2Qc_inj_add. Qed.
+Lemma pos_to_Qp_mul x y : pos_to_Qp x * pos_to_Qp y = pos_to_Qp (x * y).
+Proof. apply Qp.to_Qc_inj_iff; simpl. by rewrite Pos2Z.inj_mul, Z2Qc_inj_mul. Qed.
+
+Local Close Scope Qp_scope.
+
+(** * Helper for working with accessing lists with wrap-around
+    See also [rotate] and [rotate_take] in [list.v] *)
+(** [rotate_nat_add base offset len] computes [(base + offset) `mod`
+len]. This is useful in combination with the [rotate] function on
+lists, since the index [i] of [rotate n l] corresponds to the index
+[rotate_nat_add n i (length i)] of the original list. The definition
+uses [Z] for consistency with [rotate_nat_sub]. **)
+Definition rotate_nat_add (base offset len : nat) : nat :=
+  Z.to_nat ((Z.of_nat base + Z.of_nat offset) `mod` Z.of_nat len)%Z.
+(** [rotate_nat_sub base offset len] is the inverse of [rotate_nat_add
+base offset len]. The definition needs to use modulo on [Z] instead of
+on nat since otherwise we need the sidecondition [base < len] on
+[rotate_nat_sub_add]. **)
+Definition rotate_nat_sub (base offset len : nat) : nat :=
+  Z.to_nat ((Z.of_nat len + Z.of_nat offset - Z.of_nat base) `mod` Z.of_nat len)%Z.
+
+Lemma rotate_nat_add_add_mod base offset len:
+  rotate_nat_add base offset len =
+  rotate_nat_add (base `mod` len) offset len.
+Proof. unfold rotate_nat_add. by rewrite Nat2Z.inj_mod, Zplus_mod_idemp_l. Qed.
+
+Lemma rotate_nat_add_alt base offset len:
+  base < len → offset < len →
+  rotate_nat_add base offset len =
+  if decide (base + offset < len) then base + offset else base + offset - len.
+Proof.
+  unfold rotate_nat_add. intros ??. case_decide.
+  - rewrite Z.mod_small by lia. by rewrite <-Nat2Z.inj_add, Nat2Z.id.
+  - rewrite (Z.mod_in_range 1) by lia.
+    by rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-Nat2Z.inj_sub,Nat2Z.id by lia.
+Qed.
+Lemma rotate_nat_sub_alt base offset len:
+  base < len → offset < len →
+  rotate_nat_sub base offset len =
+  if decide (offset < base) then len + offset - base else offset - base.
+Proof.
+  unfold rotate_nat_sub. intros ??. case_decide.
+  - rewrite Z.mod_small by lia.
+    by rewrite <-Nat2Z.inj_add, <-Nat2Z.inj_sub, Nat2Z.id by lia.
+  - rewrite (Z.mod_in_range 1) by lia.
+    rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-!Nat2Z.inj_sub,Nat2Z.id; lia.
+Qed.
+
+Lemma rotate_nat_add_0 base len :
+  base < len → rotate_nat_add base 0 len = base.
+Proof.
+  intros ?. unfold rotate_nat_add.
+  rewrite Z.mod_small by lia. by rewrite Z.add_0_r, Nat2Z.id.
+Qed.
+Lemma rotate_nat_sub_0 base len :
+  base < len → rotate_nat_sub base base len = 0.
+Proof. intros ?. rewrite rotate_nat_sub_alt by done. case_decide; lia. Qed.
+
+Lemma rotate_nat_add_lt base offset len :
+  0 < len → rotate_nat_add base offset len < len.
+Proof.
+  unfold rotate_nat_add. intros ?.
+  pose proof (Nat.mod_upper_bound (base + offset) len).
+  rewrite Z2Nat.inj_mod, Z2Nat.inj_add, !Nat2Z.id; lia.
+Qed.
+Lemma rotate_nat_sub_lt base offset len :
+  0 < len → rotate_nat_sub base offset len < len.
+Proof.
+  unfold rotate_nat_sub. intros ?.
+  pose proof (Z_mod_lt (Z.of_nat len + Z.of_nat offset - Z.of_nat base) (Z.of_nat len)).
+  apply Nat2Z.inj_lt. rewrite Z2Nat.id; lia.
+Qed.
+
+Lemma rotate_nat_add_sub base len offset:
+  offset < len →
+  rotate_nat_add base (rotate_nat_sub base offset len) len = offset.
+Proof.
+  intros ?. unfold rotate_nat_add, rotate_nat_sub.
+  rewrite Z2Nat.id by (apply Z.mod_pos; lia). rewrite Zplus_mod_idemp_r.
+  replace (Z.of_nat base + (Z.of_nat len + Z.of_nat offset - Z.of_nat base))%Z
+    with (Z.of_nat len + Z.of_nat offset)%Z by lia.
+  rewrite (Z.mod_in_range 1) by lia.
+  rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-!Nat2Z.inj_sub,Nat2Z.id; lia.
+Qed.
+
+Lemma rotate_nat_sub_add base len offset:
+  offset < len →
+  rotate_nat_sub base (rotate_nat_add base offset len) len = offset.
+Proof.
+  intros ?. unfold rotate_nat_add, rotate_nat_sub.
+  rewrite Z2Nat.id by (apply Z.mod_pos; lia).
+  assert (∀ n, (Z.of_nat len + n - Z.of_nat base) = ((Z.of_nat len - Z.of_nat base) + n))%Z
+    as -> by naive_solver lia.
+  rewrite Zplus_mod_idemp_r.
+  replace (Z.of_nat len - Z.of_nat base + (Z.of_nat base + Z.of_nat offset))%Z with
+    (Z.of_nat len + Z.of_nat offset)%Z by lia.
+  rewrite (Z.mod_in_range 1) by lia.
+  rewrite Z.mul_1_l, <-Nat2Z.inj_add, <-!Nat2Z.inj_sub,Nat2Z.id; lia.
+Qed.
+
+Lemma rotate_nat_add_add base offset len n:
+  0 < len →
+  rotate_nat_add base (offset + n) len =
+  (rotate_nat_add base offset len + n) `mod` len.
+Proof.
+  intros ?. unfold rotate_nat_add.
+  rewrite !Z2Nat.inj_mod, !Z2Nat.inj_add, !Nat2Z.id by lia.
+  by rewrite Nat.add_assoc, Nat.add_mod_idemp_l by lia.
+Qed.
+
+Lemma rotate_nat_add_S base offset len:
+  0 < len →
+  rotate_nat_add base (S offset) len =
+  S (rotate_nat_add base offset len) `mod` len.
+Proof. intros ?. by rewrite <-Nat.add_1_r, rotate_nat_add_add, Nat.add_1_r. Qed.

theories/option.v → stdpp/option.v

@@ -13,16 +13,20 @@ Lemma None_ne_Some {A} (x : A) : None ≠ Some x.
 Proof. congruence. Qed.
 Lemma Some_ne_None {A} (x : A) : Some x ≠ None.
 Proof. congruence. Qed.
-Lemma eq_None_ne_Some {A} (mx : option A) x : mx = None → mx ≠ Some x.
-Proof. congruence. Qed.
-Instance Some_inj {A} : Inj (=) (=) (@Some A).
+Lemma eq_None_ne_Some {A} (mx : option A) : (∀ x, mx ≠ Some x) ↔ mx = None.
+Proof. destruct mx; split; congruence. Qed.
+Lemma eq_None_ne_Some_1 {A} (mx : option A) x : mx = None → mx ≠ Some x.
+Proof. intros ?. by apply eq_None_ne_Some. Qed.
+Lemma eq_None_ne_Some_2 {A} (mx : option A) : (∀ x, mx ≠ Some x) → mx = None.
+Proof. intros ?. by apply eq_None_ne_Some. Qed.
+Global Instance Some_inj {A} : Inj (=) (=) (@Some A).
 Proof. congruence. Qed.
 
 (** The [from_option] is the eliminator for option. *)
 Definition from_option {A B} (f : A → B) (y : B) (mx : option A) : B :=
   match mx with None => y | Some x => f x end.
-Instance: Params (@from_option) 3 := {}.
-Arguments from_option {_ _} _ _ !_ / : assert.
+Global Instance: Params (@from_option) 2 := {}.
+Global Arguments from_option {_ _} _ _ !_ / : assert.
 
 (** The eliminator with the identity function. *)
 Notation default := (from_option id).
@@ -38,25 +42,28 @@ Lemma option_eq_1_alt {A} (mx my : option A) x :
 Proof. congruence. Qed.
 
 Definition is_Some {A} (mx : option A) := ∃ x, mx = Some x.
-Instance: Params (@is_Some) 1 := {}.
+Global Instance: Params (@is_Some) 1 := {}.
+
+(** We avoid calling [done] recursively as that can lead to an unresolved evar. *)
+Global Hint Extern 0 (is_Some _) => eexists; fast_done : core.
 
 Lemma is_Some_alt {A} (mx : option A) :
   is_Some mx ↔ match mx with Some _ => True | None => False end.
 Proof. unfold is_Some. destruct mx; naive_solver. Qed.
 
 Lemma mk_is_Some {A} (mx : option A) x : mx = Some x → is_Some mx.
-Proof. intros; red; subst; eauto. Qed.
-Hint Resolve mk_is_Some : core.
+Proof. by intros ->. Qed.
+Global Hint Resolve mk_is_Some : core.
 Lemma is_Some_None {A} : ¬is_Some (@None A).
 Proof. by destruct 1. Qed.
-Hint Resolve is_Some_None : core.
+Global Hint Resolve is_Some_None : core.
 
 Lemma eq_None_not_Some {A} (mx : option A) : mx = None ↔ ¬is_Some mx.
 Proof. rewrite is_Some_alt; destruct mx; naive_solver. Qed.
 Lemma not_eq_None_Some {A} (mx : option A) : mx ≠ None ↔ is_Some mx.
 Proof. rewrite is_Some_alt; destruct mx; naive_solver. Qed.
 
-Instance is_Some_pi {A} (mx : option A) : ProofIrrel (is_Some mx).
+Global Instance is_Some_pi {A} (mx : option A) : ProofIrrel (is_Some mx).
 Proof.
   set (P (mx : option A) := match mx with Some _ => True | _ => False end).
   set (f mx := match mx return P mx → is_Some mx with
@@ -67,7 +74,7 @@ Proof.
   intros p1 p2. rewrite <-(f_g _ p1), <-(f_g _ p2). by destruct mx, p1.
 Qed.
 
-Instance is_Some_dec {A} (mx : option A) : Decision (is_Some mx) :=
+Global Instance is_Some_dec {A} (mx : option A) : Decision (is_Some mx) :=
   match mx with
   | Some x => left (ex_intro _ x eq_refl)
   | None => right is_Some_None
@@ -103,60 +110,60 @@ Section Forall2.
   Global Instance option_Forall2_sym : Symmetric R → Symmetric (option_Forall2 R).
   Proof. destruct 2; by constructor. Qed.
   Global Instance option_Forall2_trans : Transitive R → Transitive (option_Forall2 R).
-  Proof. destruct 2; inversion_clear 1; constructor; etrans; eauto. Qed.
+  Proof. destruct 2; inv 1; constructor; etrans; eauto. Qed.
   Global Instance option_Forall2_equiv : Equivalence R → Equivalence (option_Forall2 R).
   Proof. destruct 1; split; apply _. Qed.
+
+  Lemma option_eq_Forall2 (mx my : option A) :
+    mx = my ↔ option_Forall2 eq mx my.
+  Proof.
+    split.
+    - intros ->. destruct my; constructor; done.
+    - intros [|]; naive_solver.
+  Qed.
 End Forall2.
 
 (** Setoids *)
-Instance option_equiv `{Equiv A} : Equiv (option A) := option_Forall2 (≡).
+Global Instance option_equiv `{Equiv A} : Equiv (option A) := option_Forall2 (≡).
 
 Section setoids.
   Context `{Equiv A}.
   Implicit Types mx my : option A.
 
-  Lemma equiv_option_Forall2 mx my : mx ≡ my ↔ option_Forall2 (≡) mx my.
+  Lemma option_equiv_Forall2 mx my : mx ≡ my ↔ option_Forall2 (≡) mx my.
   Proof. done. Qed.
 
   Global Instance option_equivalence :
     Equivalence (≡@{A}) → Equivalence (≡@{option A}).
   Proof. apply _. Qed.
+  Global Instance option_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (option A).
+  Proof. intros x y; destruct 1; f_equal; by apply leibniz_equiv. Qed.
+
   Global Instance Some_proper : Proper ((≡) ==> (≡@{option A})) Some.
   Proof. by constructor. Qed.
   Global Instance Some_equiv_inj : Inj (≡) (≡@{option A}) Some.
-  Proof. by inversion_clear 1. Qed.
-  Global Instance option_leibniz `{!LeibnizEquiv A} : LeibnizEquiv (option A).
-  Proof. intros x y; destruct 1; f_equal; by apply leibniz_equiv. Qed.
+  Proof. by inv 1. Qed.
 
-  Lemma equiv_None mx : mx ≡ None ↔ mx = None.
-  Proof. split; [by inversion_clear 1|intros ->; constructor]. Qed.
-  Lemma equiv_Some_inv_l mx my x :
-    mx ≡ my → mx = Some x → ∃ y, my = Some y ∧ x ≡ y.
-  Proof. destruct 1; naive_solver. Qed.
-  Lemma equiv_Some_inv_r mx my y :
-    mx ≡ my → my = Some y → ∃ x, mx = Some x ∧ x ≡ y.
-  Proof. destruct 1; naive_solver. Qed.
-  Lemma equiv_Some_inv_l' my x : Some x ≡ my → ∃ x', Some x' = my ∧ x ≡ x'.
-  Proof. intros ?%(equiv_Some_inv_l _ _ x); naive_solver. Qed.
-  Lemma equiv_Some_inv_r' `{!Equivalence (≡@{A})} mx y :
-    mx ≡ Some y → ∃ y', mx = Some y' ∧ y ≡ y'.
-  Proof. intros ?%(equiv_Some_inv_r _ _ y); naive_solver. Qed.
+  Lemma None_equiv_eq mx : mx ≡ None ↔ mx = None.
+  Proof. split; [by inv 1|intros ->; constructor]. Qed.
+  Lemma Some_equiv_eq mx y : mx ≡ Some y ↔ ∃ y', mx = Some y' ∧ y' ≡ y.
+  Proof. split; [inv 1; naive_solver|naive_solver (by constructor)]. Qed.
 
   Global Instance is_Some_proper : Proper ((≡@{option A}) ==> iff) is_Some.
-  Proof. inversion_clear 1; split; eauto. Qed.
-  Global Instance from_option_proper {B} (R : relation B) (f : A → B) :
-    Proper ((≡) ==> R) f → Proper (R ==> (≡) ==> R) (from_option f).
+  Proof. by inv 1. Qed.
+  Global Instance from_option_proper {B} (R : relation B) :
+    Proper (((≡@{A}) ==> R) ==> R ==> (≡) ==> R) from_option.
   Proof. destruct 3; simpl; auto. Qed.
 End setoids.
 
-Typeclasses Opaque option_equiv.
+Global Typeclasses Opaque option_equiv.
 
 (** Equality on [option] is decidable. *)
-Instance option_eq_None_dec {A} (mx : option A) : Decision (mx = None) :=
+Global Instance option_eq_None_dec {A} (mx : option A) : Decision (mx = None) :=
   match mx with Some _ => right (Some_ne_None _) | None => left eq_refl end.
-Instance option_None_eq_dec {A} (mx : option A) : Decision (None = mx) :=
+Global Instance option_None_eq_dec {A} (mx : option A) : Decision (None = mx) :=
   match mx with Some _ => right (None_ne_Some _) | None => left eq_refl end.
-Instance option_eq_dec `{dec : EqDecision A} : EqDecision (option A).
+Global Instance option_eq_dec `{dec : EqDecision A} : EqDecision (option A).
 Proof.
  refine (λ mx my,
   match mx, my with
@@ -166,14 +173,26 @@ Proof.
 Defined.
 
 (** * Monadic operations *)
-Instance option_ret: MRet option := @Some.
-Instance option_bind: MBind option := λ A B f mx,
+Global Instance option_ret: MRet option := @Some.
+Global Instance option_bind: MBind option := λ A B f mx,
   match mx with Some x => f x | None => None end.
-Instance option_join: MJoin option := λ A mmx,
+Global Instance option_join: MJoin option := λ A mmx,
   match mmx with Some mx => mx | None => None end.
-Instance option_fmap: FMap option := @option_map.
-Instance option_guard: MGuard option := λ P dec A f,
-  match dec with left H => f H | _ => None end.
+Global Instance option_fmap: FMap option := @option_map.
+Global Instance option_mfail: MFail option := λ _ _, None.
+
+Lemma option_fmap_inj {A B} (R1 : A → A → Prop) (R2 : B → B → Prop) (f : A → B) :
+  Inj R1 R2 f → Inj (option_Forall2 R1) (option_Forall2 R2) (fmap f).
+Proof. intros ? [?|] [?|]; inv 1; constructor; auto. Qed.
+Global Instance option_fmap_eq_inj {A B} (f : A → B) :
+  Inj (=) (=) f → Inj (=@{option A}) (=@{option B}) (fmap f).
+Proof.
+  intros ?%option_fmap_inj ?? ?%option_eq_Forall2%(inj _).
+  by apply option_eq_Forall2.
+Qed.
+Global Instance option_fmap_equiv_inj `{Equiv A, Equiv B} (f : A → B) :
+  Inj (≡) (≡) f → Inj (≡@{option A}) (≡@{option B}) (fmap f).
+Proof. apply option_fmap_inj. Qed.
 
 Lemma fmap_is_Some {A B} (f : A → B) mx : is_Some (f <$> mx) ↔ is_Some mx.
 Proof. unfold is_Some; destruct mx; naive_solver. Qed.
@@ -191,8 +210,8 @@ Proof.
   destruct mx; simpl; split.
   - intros ?%(inj Some). eauto.
   - intros (? & ->%(inj Some) & ?). constructor. done.
-  - intros ?%symmetry%equiv_None. done.
-  - intros (? & ? & ?). done.
+  - intros [=]%symmetry%None_equiv_eq.
+  - intros (? & [=] & ?).
 Qed.
 Lemma fmap_Some_equiv_1 {A B} `{Equiv B} `{!Equivalence (≡@{B})} (f : A → B) mx y :
   f <$> mx ≡ Some y → ∃ x, mx = Some x ∧ y ≡ f x.
@@ -201,15 +220,16 @@ Lemma fmap_None {A B} (f : A → B) mx : f <$> mx = None ↔ mx = None.
 Proof. by destruct mx. Qed.
 Lemma option_fmap_id {A} (mx : option A) : id <$> mx = mx.
 Proof. by destruct mx. Qed.
-Lemma option_fmap_compose {A B} (f : A → B) {C} (g : B → C) mx :
+Lemma option_fmap_compose {A B} (f : A → B) {C} (g : B → C) (mx : option A) :
   g ∘ f <$> mx = g <$> (f <$> mx).
 Proof. by destruct mx. Qed.
-Lemma option_fmap_ext {A B} (f g : A → B) mx :
+Lemma option_fmap_ext {A B} (f g : A → B) (mx : option A) :
   (∀ x, f x = g x) → f <$> mx = g <$> mx.
 Proof. intros; destruct mx; f_equal/=; auto. Qed.
 Lemma option_fmap_equiv_ext {A} `{Equiv B} (f g : A → B) (mx : option A) :
   (∀ x, f x ≡ g x) → f <$> mx ≡ g <$> mx.
 Proof. destruct mx; constructor; auto. Qed.
+
 Lemma option_fmap_bind {A B C} (f : A → B) (g : B → option C) mx :
   (f <$> mx) ≫= g = mx ≫= g ∘ f.
 Proof. by destruct mx. Qed.
@@ -225,19 +245,22 @@ Proof. intros. by apply option_bind_ext. Qed.
 Lemma bind_Some {A B} (f : A → option B) (mx : option A) y :
   mx ≫= f = Some y ↔ ∃ x, mx = Some x ∧ f x = Some y.
 Proof. destruct mx; naive_solver. Qed.
+Lemma bind_Some_equiv {A} `{Equiv B} (f : A → option B) (mx : option A) y :
+  mx ≫= f ≡ Some y ↔ ∃ x, mx = Some x ∧ f x ≡ Some y.
+Proof. destruct mx; split; first [by inv 1|naive_solver]. Qed.
 Lemma bind_None {A B} (f : A → option B) (mx : option A) :
   mx ≫= f = None ↔ mx = None ∨ ∃ x, mx = Some x ∧ f x = None.
 Proof. destruct mx; naive_solver. Qed.
 Lemma bind_with_Some {A} (mx : option A) : mx ≫= Some = mx.
 Proof. by destruct mx. Qed.
 
-Instance option_fmap_proper `{Equiv A, Equiv B} :
+Global Instance option_fmap_proper `{Equiv A, Equiv B} :
   Proper (((≡) ==> (≡)) ==> (≡@{option A}) ==> (≡@{option B})) fmap.
 Proof. destruct 2; constructor; auto. Qed.
-Instance option_mbind_proper `{Equiv A, Equiv B} :
+Global Instance option_bind_proper `{Equiv A, Equiv B} :
   Proper (((≡) ==> (≡)) ==> (≡@{option A}) ==> (≡@{option B})) mbind.
 Proof. destruct 2; simpl; try constructor; auto. Qed.
-Instance option_mjoin_proper `{Equiv A} :
+Global Instance option_join_proper `{Equiv A} :
   Proper ((≡) ==> (≡@{option (option A)})) mjoin.
 Proof. destruct 1 as [?? []|]; simpl; by constructor. Qed.
 
@@ -246,62 +269,100 @@ Proof. destruct 1 as [?? []|]; simpl; by constructor. Qed.
 not particularly like type level reductions. *)
 Class Maybe {A B : Type} (c : A → B) :=
   maybe : B → option A.
-Arguments maybe {_ _} _ {_} !_ / : assert.
+Global Arguments maybe {_ _} _ {_} !_ / : assert.
 Class Maybe2 {A1 A2 B : Type} (c : A1 → A2 → B) :=
   maybe2 : B → option (A1 * A2).
-Arguments maybe2 {_ _ _} _ {_} !_ / : assert.
+Global Arguments maybe2 {_ _ _} _ {_} !_ / : assert.
 Class Maybe3 {A1 A2 A3 B : Type} (c : A1 → A2 → A3 → B) :=
   maybe3 : B → option (A1 * A2 * A3).
-Arguments maybe3 {_ _ _ _} _ {_} !_ / : assert.
+Global Arguments maybe3 {_ _ _ _} _ {_} !_ / : assert.
 Class Maybe4 {A1 A2 A3 A4 B : Type} (c : A1 → A2 → A3 → A4 → B) :=
   maybe4 : B → option (A1 * A2 * A3 * A4).
-Arguments maybe4 {_ _ _ _ _} _ {_} !_ / : assert.
+Global Arguments maybe4 {_ _ _ _ _} _ {_} !_ / : assert.
 
-Instance maybe_comp `{Maybe B C c1, Maybe A B c2} : Maybe (c1 ∘ c2) := λ x,
+Global Instance maybe_comp `{Maybe B C c1, Maybe A B c2} : Maybe (c1 ∘ c2) := λ x,
   maybe c1 x ≫= maybe c2.
-Arguments maybe_comp _ _ _ _ _ _ _ !_ / : assert.
+Global Arguments maybe_comp _ _ _ _ _ _ _ !_ / : assert.
 
-Instance maybe_inl {A B} : Maybe (@inl A B) := λ xy,
+Global Instance maybe_inl {A B} : Maybe (@inl A B) := λ xy,
   match xy with inl x => Some x | _ => None end.
-Instance maybe_inr {A B} : Maybe (@inr A B) := λ xy,
+Global Instance maybe_inr {A B} : Maybe (@inr A B) := λ xy,
   match xy with inr y => Some y | _ => None end.
-Instance maybe_Some {A} : Maybe (@Some A) := id.
-Arguments maybe_Some _ !_ / : assert.
+Global Instance maybe_Some {A} : Maybe (@Some A) := id.
+Global Arguments maybe_Some _ !_ / : assert.
 
 (** * Union, intersection and difference *)
-Instance option_union_with {A} : UnionWith A (option A) := λ f mx my,
+Global Instance option_union_with {A} : UnionWith A (option A) := λ f mx my,
   match mx, my with
   | Some x, Some y => f x y
   | Some x, None => Some x
   | None, Some y => Some y
   | None, None => None
   end.
-Instance option_intersection_with {A} : IntersectionWith A (option A) :=
+Global Instance option_intersection_with {A} : IntersectionWith A (option A) :=
   λ f mx my, match mx, my with Some x, Some y => f x y | _, _ => None end.
-Instance option_difference_with {A} : DifferenceWith A (option A) := λ f mx my,
+Global Instance option_difference_with {A} : DifferenceWith A (option A) := λ f mx my,
   match mx, my with
   | Some x, Some y => f x y
   | Some x, None => Some x
   | None, _ => None
   end.
-Instance option_union {A} : Union (option A) := union_with (λ x _, Some x).
+Global Instance option_union {A} : Union (option A) := union_with (λ x _, Some x).
+
+Lemma union_Some {A} (mx my : option A) z :
+  mx ∪ my = Some z ↔ mx = Some z ∨ (mx = None ∧ my = Some z).
+Proof. destruct mx, my; naive_solver. Qed.
+Lemma union_Some_l {A} x (my : option A) :
+  Some x ∪ my = Some x.
+Proof. destruct my; done. Qed.
+Lemma union_Some_r {A} (mx : option A) y :
+  mx ∪ Some y = Some (default y mx).
+Proof. destruct mx; done. Qed.
+Lemma union_None {A} (mx my : option A) :
+  mx ∪ my = None ↔ mx = None ∧ my = None.
+Proof. destruct mx, my; naive_solver. Qed.
+Lemma union_is_Some {A} (mx my : option A) :
+  is_Some (mx ∪ my) ↔ is_Some mx ∨ is_Some my.
+Proof. destruct mx, my; naive_solver. Qed.
 
-Lemma option_union_Some {A} (mx my : option A) z :
-  mx ∪ my = Some z → mx = Some z ∨ my = Some z.
+Global Instance option_union_left_id {A} : LeftId (=@{option A}) None union.
+Proof. by intros [?|]. Qed.
+Global Instance option_union_right_id {A} : RightId (=@{option A}) None union.
+Proof. by intros [?|]. Qed.
+
+Global Instance option_intersection {A} : Intersection (option A) :=
+  intersection_with (λ x _, Some x).
+
+Lemma intersection_Some {A} (mx my : option A) x :
+  mx ∩ my = Some x ↔ mx = Some x ∧ is_Some my.
+Proof. destruct mx, my; unfold is_Some; naive_solver. Qed.
+Lemma intersection_is_Some {A} (mx my : option A) :
+  is_Some (mx ∩ my) ↔ is_Some mx ∧ is_Some my.
+Proof. destruct mx, my; unfold is_Some; naive_solver. Qed.
+Lemma intersection_Some_r {A} (mx : option A) (y : A) :
+  mx ∩ Some y = mx.
+Proof. by destruct mx. Qed.
+Lemma intersection_None {A} (mx my : option A) :
+  mx ∩ my = None ↔ mx = None ∨ my = None.
 Proof. destruct mx, my; naive_solver. Qed.
+Lemma intersection_None_l {A} (my : option A) :
+  None ∩ my = None.
+Proof. destruct my; done. Qed.
+Lemma intersection_None_r {A} (mx : option A) :
+  mx ∩ None = None.
+Proof. destruct mx; done. Qed.
+
+Global Instance option_intersection_right_absorb {A} :
+  RightAbsorb (=@{option A}) None intersection.
+Proof. by intros [?|]. Qed.
 
-Class DiagNone {A B C} (f : option A → option B → option C) :=
-  diag_none : f None None = None.
+Global Instance option_intersection_left_absorb {A} :
+  LeftAbsorb (=@{option A}) None intersection.
+Proof. by intros [?|]. Qed.
 
 Section union_intersection_difference.
   Context {A} (f : A → A → option A).
 
-  Global Instance union_with_diag_none : DiagNone (union_with f).
-  Proof. reflexivity. Qed.
-  Global Instance intersection_with_diag_none : DiagNone (intersection_with f).
-  Proof. reflexivity. Qed.
-  Global Instance difference_with_diag_none : DiagNone (difference_with f).
-  Proof. reflexivity. Qed.
   Global Instance union_with_left_id : LeftId (=) None (union_with f).
   Proof. by intros [?|]. Qed.
   Global Instance union_with_right_id : RightId (=) None (union_with f).
@@ -309,46 +370,73 @@ Section union_intersection_difference.
   Global Instance union_with_comm :
     Comm (=) f → Comm (=@{option A}) (union_with f).
   Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed.
+  (** These are duplicates of the above [LeftId]/[RightId] instances, but easier to
+  find with [SearchAbout]. *)
+  Lemma union_with_None_l my : union_with f None my = my.
+  Proof. destruct my; done. Qed.
+  Lemma union_with_None_r mx : union_with f mx None = mx.
+  Proof. destruct mx; done. Qed.
+
   Global Instance intersection_with_left_ab : LeftAbsorb (=) None (intersection_with f).
   Proof. by intros [?|]. Qed.
   Global Instance intersection_with_right_ab : RightAbsorb (=) None (intersection_with f).
   Proof. by intros [?|]. Qed.
+  Global Instance intersection_with_comm :
+    Comm (=) f → Comm (=@{option A}) (intersection_with f).
+  Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed.
+  (** These are duplicates of the above [LeftAbsorb]/[RightAbsorb] instances, but
+  easier to find with [SearchAbout]. *)
+  Lemma intersection_with_None_l my : intersection_with f None my = None.
+  Proof. destruct my; done. Qed.
+  Lemma intersection_with_None_r mx : intersection_with f mx None = None.
+  Proof. destruct mx; done. Qed.
+
   Global Instance difference_with_comm :
     Comm (=) f → Comm (=@{option A}) (intersection_with f).
   Proof. by intros ? [?|] [?|]; compute; rewrite 1?(comm f). Qed.
   Global Instance difference_with_right_id : RightId (=) None (difference_with f).
   Proof. by intros [?|]. Qed.
-End union_intersection_difference.
 
-(** * Tactics *)
-Tactic Notation "case_option_guard" "as" ident(Hx) :=
-  match goal with
-  | H : context C [@mguard option _ ?P ?dec] |- _ =>
-    change (@mguard option _ P dec) with (λ A (f : P → option A),
-      match @decide P dec with left H' => f H' | _ => None end) in *;
-    destruct_decide (@decide P dec) as Hx
-  | |- context C [@mguard option _ ?P ?dec] =>
-    change (@mguard option _ P dec) with (λ A (f : P → option A),
-      match @decide P dec with left H' => f H' | _ => None end) in *;
-    destruct_decide (@decide P dec) as Hx
-  end.
-Tactic Notation "case_option_guard" :=
-  let H := fresh in case_option_guard as H.
+  Global Instance union_with_proper `{Equiv A} :
+    Proper (((≡) ==> (≡) ==> (≡)) ==> (≡@{option A}) ==> (≡) ==> (≡)) union_with.
+  Proof. intros ?? Hf; do 2 destruct 1; try constructor; by try apply Hf. Qed.
+  Global Instance intersection_with_proper `{Equiv A} :
+    Proper (((≡) ==> (≡) ==> (≡)) ==> (≡@{option A}) ==> (≡) ==> (≡)) intersection_with.
+  Proof. intros ?? Hf; do 2 destruct 1; try constructor; by try apply Hf. Qed.
+  Global Instance difference_with_proper `{Equiv A} :
+    Proper (((≡) ==> (≡) ==> (≡)) ==> (≡@{option A}) ==> (≡) ==> (≡)) difference_with.
+  Proof. intros ?? Hf; do 2 destruct 1; try constructor; by try apply Hf. Qed.
+  Global Instance union_proper `{Equiv A} :
+    Proper ((≡@{option A}) ==> (≡) ==> (≡)) union.
+  Proof. apply union_with_proper. by constructor. Qed.
+End union_intersection_difference.
 
+(** This lemma includes a bind, to avoid equalities of proofs. We cannot have
+[guard P = Some p ↔ P] unless [P] is proof irrelant. The best (but less usable)
+self-contained alternative would be [guard P = Some p ↔ decide P = left p]. *)
 Lemma option_guard_True {A} P `{Decision P} (mx : option A) :
-  P → (guard P; mx) = mx.
-Proof. intros. by case_option_guard. Qed.
-Lemma option_guard_False {A} P `{Decision P} (mx : option A) :
-  ¬P → (guard P; mx) = None.
-Proof. intros. by case_option_guard. Qed.
+  P → (guard P;; mx) = mx.
+Proof. intros. by case_guard. Qed.
+Lemma option_guard_True_pi P `{Decision P, ProofIrrel P} (HP : P) :
+  guard P = Some HP.
+Proof. case_guard; [|done]. f_equal; apply proof_irrel. Qed.
+Lemma option_guard_False P `{Decision P} :
+  ¬P → guard P = None.
+Proof. intros. by case_guard. Qed.
 Lemma option_guard_iff {A} P Q `{Decision P, Decision Q} (mx : option A) :
-  (P ↔ Q) → (guard P; mx) = guard Q; mx.
-Proof. intros [??]. repeat case_option_guard; intuition. Qed.
+  (P ↔ Q) → (guard P;; mx) = (guard Q;; mx).
+Proof. intros [??]. repeat case_guard; intuition. Qed.
+Lemma option_guard_decide {A} P `{Decision P} (mx : option A) :
+  (guard P;; mx) = if decide P then mx else None.
+Proof. by case_guard. Qed.
+Lemma option_guard_bool_decide {A} P `{Decision P} (mx : option A) :
+  (guard P;; mx) = if bool_decide P then mx else None.
+Proof. by rewrite option_guard_decide, decide_bool_decide. Qed.
 
 Tactic Notation "simpl_option" "by" tactic3(tac) :=
   let assert_Some_None A mx H := first
-    [ let x := fresh in evar (x:A); let x' := eval unfold x in x in clear x;
-      assert (mx = Some x') as H by tac
+    [ let x := mk_evar A in
+      assert (mx = Some x) as H by tac
     | assert (mx = None) as H by tac ]
   in repeat match goal with
   | H : context [@mret _ _ ?A] |- _ =>
@@ -378,8 +466,8 @@ Tactic Notation "simpl_option" "by" tactic3(tac) :=
     end
   | H : context [decide _] |- _ => rewrite decide_True in H by tac
   | H : context [decide _] |- _ => rewrite decide_False in H by tac
-  | H : context [mguard _ _] |- _ => rewrite option_guard_False in H by tac
-  | H : context [mguard _ _] |- _ => rewrite option_guard_True in H by tac
+  | H : context [guard _] |- _ => rewrite option_guard_False in H by tac
+  | H : context [guard _] |- _ => rewrite option_guard_True in H by tac
   | _ => rewrite decide_True by tac
   | _ => rewrite decide_False by tac
   | _ => rewrite option_guard_True by tac
@@ -397,7 +485,7 @@ Tactic Notation "simplify_option_eq" "by" tactic3(tac) :=
   | _ : maybe2 _ ?x = Some _ |- _ => is_var x; destruct x
   | _ : maybe3 _ ?x = Some _ |- _ => is_var x; destruct x
   | _ : maybe4 _ ?x = Some _ |- _ => is_var x; destruct x
-  | H : _ ∪ _ = Some _ |- _ => apply option_union_Some in H; destruct H
+  | H : _ ∪ _ = Some _ |- _ => apply union_Some in H; destruct H
   | H : mbind (M:=option) ?f ?mx = ?my |- _ =>
     match mx with Some _ => fail 1 | None => fail 1 | _ => idtac end;
     match my with Some _ => idtac | None => idtac | _ => fail 1 end;
@@ -419,6 +507,6 @@ Tactic Notation "simplify_option_eq" "by" tactic3(tac) :=
     let x := fresh in destruct mx as [x|] eqn:?;
       [change (my = Some (f x)) in H|change (my = None) in H]
   | _ => progress case_decide
-  | _ => progress case_option_guard
+  | _ => progress case_guard
   end.
 Tactic Notation "simplify_option_eq" := simplify_option_eq by eauto.

theories/options.v → stdpp/options.v

-(** Coq configuration for std++ (not meant to leak to clients) *)
+(** Coq configuration for std++ (not meant to leak to clients).
+If you are a user of std++, note that importing this file means
+you are implicitly opting-in to every new option we will add here
+in the future. We are *not* guaranteeing any kind of stability here.
+Instead our advice is for you to have your own options file; then
+you can re-export the std++ file there but if we ever add an option
+you disagree with you can easily overwrite it in one central location. *)
 (* Everything here should be [Export Set], which means when this
 file is *imported*, the option will only apply on the import site
 but not transitively. *)
 
-Export Set Default Proof Using "Type".
+(** Allow async proof-checking of sections. *)
+#[export] Set Default Proof Using "Type".
 (* FIXME: cannot enable this yet as some files disable 'Default Proof Using'.
-Export Set Suggest Proof Using. *)
-(* FIXME: cannot enable this on Coq 8.8.
-Export Set Default Goal Selector "!". *)
+#[export] Set Suggest Proof Using. *)
+
+(** Enforces that every tactic is executed with a single focused goal, meaning
+that bullets and curly braces must be used to structure the proof. *)
+#[export] Set Default Goal Selector "!".
 
 (* "Fake" import to whitelist this file for the check that ensures we import
 this file everywhere.

theories/orders.v → stdpp/orders.v

@@ -13,7 +13,7 @@ Section orders.
   Lemma reflexive_eq `{!Reflexive R} X Y : X = Y → X ⊆ Y.
   Proof. by intros <-. Qed.
   Lemma anti_symm_iff `{!PartialOrder R} X Y : X = Y ↔ R X Y ∧ R Y X.
-  Proof. split; [by intros ->|]. by intros [??]; apply (anti_symm _). Qed.
+  Proof. split; [by intros ->|]. by intros [??]; apply (anti_symm R). Qed.
   Lemma strict_spec X Y : X ⊂ Y ↔ X ⊆ Y ∧ Y ⊈ X.
   Proof. done. Qed.
   Lemma strict_include X Y : X ⊂ Y → X ⊆ Y.

stdpp/pmap.v

+(** This files implements an efficient implementation of finite maps whose keys
+range over Coq's data type of positive binary naturals [positive]. The
+data structure is based on the "canonical" binary tries representation by Appel
+and Leroy, https://hal.inria.fr/hal-03372247. It has various 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.e., [(∀ i, m1 !! i = m2 !! i) → m1 = m2].
+- It can be used in nested recursive definitions, e.g.,
+  [Inductive test := Test : Pmap 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). *)
+From stdpp Require Export countable fin_maps fin_map_dom.
+From stdpp Require Import mapset.
+From stdpp Require Import options.
+
+Local Open Scope positive_scope.
+
+(** * The trie data structure *)
+(** To obtain canonical representations, we need to make sure that the "empty"
+trie is represented uniquely. That is, each node should either have a value, a
+non-empty left subtrie, or a non-empty right subtrie. The [Pmap_ne] type
+enumerates all ways of constructing non-empty canonical trie. *)
+Inductive Pmap_ne (A : Type) :=
+  | PNode001 : Pmap_ne A → Pmap_ne A
+  | PNode010 : A → Pmap_ne A
+  | PNode011 : A → Pmap_ne A → Pmap_ne A
+  | PNode100 : Pmap_ne A → Pmap_ne A
+  | PNode101 : Pmap_ne A → Pmap_ne A → Pmap_ne A
+  | PNode110 : Pmap_ne A → A → Pmap_ne A
+  | PNode111 : Pmap_ne A → A → Pmap_ne A → Pmap_ne A.
+Global Arguments PNode001 {A} _ : assert.
+Global Arguments PNode010 {A} _ : assert.
+Global Arguments PNode011 {A} _ _ : assert.
+Global Arguments PNode100 {A} _ : assert.
+Global Arguments PNode101 {A} _ _ : assert.
+Global Arguments PNode110 {A} _ _ : assert.
+Global Arguments PNode111 {A} _ _ _ : assert.
+
+(** Using [Variant] we suppress the generation of the induction scheme. We use
+the induction scheme [Pmap_ind] in terms of the smart constructors to reduce the
+number of cases, similar to Appel and Leroy. *)
+Variant Pmap (A : Type) := PEmpty : Pmap A | PNodes : Pmap_ne A → Pmap A.
+Global Arguments PEmpty {A}.
+Global Arguments PNodes {A} _.
+
+Global Instance Pmap_ne_eq_dec `{EqDecision A} : EqDecision (Pmap_ne A).
+Proof. solve_decision. Defined.
+Global Instance Pmap_eq_dec `{EqDecision A} : EqDecision (Pmap A).
+Proof. solve_decision. Defined.
+
+(** The smart constructor [PNode] and eliminator [Pmap_ne_case] are used to
+reduce the number of cases, similar to Appel and Leroy. *)
+Local Definition PNode {A} (ml : Pmap A) (mx : option A) (mr : Pmap A) : Pmap A :=
+  match ml, mx, mr with
+  | PEmpty, None, PEmpty => PEmpty
+  | PEmpty, None, PNodes r => PNodes (PNode001 r)
+  | PEmpty, Some x, PEmpty => PNodes (PNode010 x)
+  | PEmpty, Some x, PNodes r => PNodes (PNode011 x r)
+  | PNodes l, None, PEmpty => PNodes (PNode100 l)
+  | PNodes l, None, PNodes r => PNodes (PNode101 l r)
+  | PNodes l, Some x, PEmpty => PNodes (PNode110 l x)
+  | PNodes l, Some x, PNodes r => PNodes (PNode111 l x r)
+  end.
+
+Local Definition Pmap_ne_case {A B} (t : Pmap_ne A)
+    (f : Pmap A → option A → Pmap A → B) : B :=
+  match t with
+  | PNode001 r => f PEmpty None (PNodes r)
+  | PNode010 x => f PEmpty (Some x) PEmpty
+  | PNode011 x r => f PEmpty (Some x) (PNodes r)
+  | PNode100 l => f (PNodes l) None PEmpty
+  | PNode101 l r => f (PNodes l) None (PNodes r)
+  | PNode110 l x => f (PNodes l) (Some x) PEmpty
+  | PNode111 l x r => f (PNodes l) (Some x) (PNodes r)
+  end.
+
+(** Operations *)
+Global Instance Pmap_ne_lookup {A} : Lookup positive A (Pmap_ne A) :=
+  fix go i t {struct t} :=
+    let _ : Lookup _ _ _ := @go in
+    match t, i with
+    | (PNode010 x | PNode011 x _ | PNode110 _ x | PNode111 _ x _), 1 => Some x
+    | (PNode100 l | PNode110 l _ | PNode101 l _ | PNode111 l _ _), i~0 => l !! i
+    | (PNode001 r | PNode011 _ r | PNode101 _ r | PNode111 _ _ r), i~1 => r !! i 
+    | _, _ => None
+    end.
+Global Instance Pmap_lookup {A} : Lookup positive A (Pmap A) := λ i mt,
+  match mt with PEmpty => None | PNodes t => t !! i end.
+Local Arguments lookup _ _ _ _ _ !_ / : simpl nomatch, assert.
+
+Global Instance Pmap_empty {A} : Empty (Pmap A) := PEmpty.
+
+(** Block reduction, even on concrete [Pmap]s.
+Marking [Pmap_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 [Pmap] consumers as [simpl never] does not work either, see:
+https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/171#note_53216 *)
+Global Opaque Pmap_empty.
+
+Local Fixpoint Pmap_ne_singleton {A} (i : positive) (x : A) : Pmap_ne A :=
+  match i with
+  | 1 => PNode010 x
+  | i~0 => PNode100 (Pmap_ne_singleton i x)
+  | i~1 => PNode001 (Pmap_ne_singleton i x)
+  end.
+
+Local Definition Pmap_partial_alter_aux {A} (go : positive → Pmap_ne A → Pmap A)
+    (f : option A → option A) (i : positive) (mt : Pmap A) : Pmap A :=
+  match mt with
+  | PEmpty =>
+     match f None with
+     | None => PEmpty | Some x => PNodes (Pmap_ne_singleton i x)
+     end
+  | PNodes t => go i t
+  end.
+Local Definition Pmap_ne_partial_alter {A} (f : option A → option A) :
+    positive → Pmap_ne A → Pmap A :=
+  fix go i t {struct t} :=
+    Pmap_ne_case t $ λ ml mx mr,
+      match i with
+      | 1 => PNode ml (f mx) mr
+      | i~0 => PNode (Pmap_partial_alter_aux go f i ml) mx mr
+      | i~1 => PNode ml mx (Pmap_partial_alter_aux go f i mr)
+      end.
+Global Instance Pmap_partial_alter {A} : PartialAlter positive A (Pmap A) := λ f,
+  Pmap_partial_alter_aux (Pmap_ne_partial_alter f) f.
+
+Local Definition Pmap_ne_fmap {A B} (f : A → B) : Pmap_ne A → Pmap_ne B :=
+  fix go t :=
+    match t with
+    | PNode001 r => PNode001 (go r)
+    | PNode010 x => PNode010 (f x)
+    | PNode011 x r => PNode011 (f x) (go r)
+    | PNode100 l => PNode100 (go l)
+    | PNode101 l r => PNode101 (go l) (go r)
+    | PNode110 l x => PNode110 (go l) (f x)
+    | PNode111 l x r => PNode111 (go l) (f x) (go r)
+    end.
+Global Instance Pmap_fmap : FMap Pmap := λ {A B} f mt,
+  match mt with PEmpty => PEmpty | PNodes t => PNodes (Pmap_ne_fmap f t) end.
+
+Local Definition Pmap_omap_aux {A B} (go : Pmap_ne A → Pmap B) (tm : Pmap A) : Pmap B :=
+  match tm with PEmpty => PEmpty | PNodes t' => go t' end.
+Local Definition Pmap_ne_omap {A B} (f : A → option B) : Pmap_ne A → Pmap B :=
+  fix go t :=
+    Pmap_ne_case t $ λ ml mx mr,
+      PNode (Pmap_omap_aux go ml) (mx ≫= f) (Pmap_omap_aux go mr).
+Global Instance Pmap_omap : OMap Pmap := λ {A B} f,
+  Pmap_omap_aux (Pmap_ne_omap f).
+
+Local Definition Pmap_merge_aux {A B C} (go : Pmap_ne A → Pmap_ne B → Pmap C)
+    (f : option A → option B → option C) (mt1 : Pmap A) (mt2 : Pmap B) : Pmap C :=
+  match mt1, mt2 with
+  | PEmpty, PEmpty => PEmpty
+  | PNodes t1', PEmpty => Pmap_ne_omap (λ x, f (Some x) None) t1'
+  | PEmpty, PNodes t2' => Pmap_ne_omap (λ x, f None (Some x)) t2'
+  | PNodes t1', PNodes t2' => go t1' t2'
+  end.
+Local Definition Pmap_ne_merge {A B C} (f : option A → option B → option C) :
+    Pmap_ne A → Pmap_ne B → Pmap C :=
+  fix go t1 t2 {struct t1} :=
+    Pmap_ne_case t1 $ λ ml1 mx1 mr1,
+      Pmap_ne_case t2 $ λ ml2 mx2 mr2,
+        PNode (Pmap_merge_aux go f ml1 ml2) (diag_None f mx1 mx2)
+              (Pmap_merge_aux go f mr1 mr2).
+Global Instance Pmap_merge : Merge Pmap := λ {A B C} f,
+  Pmap_merge_aux (Pmap_ne_merge f) f.
+
+Local Definition Pmap_fold_aux {A B} (go : positive → B → Pmap_ne A → B)
+    (i : positive) (y : B) (mt : Pmap A) : B :=
+  match mt with PEmpty => y | PNodes t => go i y t end.
+Local Definition Pmap_ne_fold {A B} (f : positive → A → B → B) :
+    positive → B → Pmap_ne A → B :=
+  fix go i y t :=
+    Pmap_ne_case t $ λ ml mx mr,
+      Pmap_fold_aux go i~1
+        (Pmap_fold_aux go i~0
+          match mx with None => y | Some x => f (Pos.reverse i) x y end ml) mr.
+Global Instance Pmap_fold {A} : MapFold positive A (Pmap A) := λ {B} f,
+  Pmap_fold_aux (Pmap_ne_fold f) 1.
+
+(** Proofs *)
+Local Definition PNode_valid {A} (ml : Pmap A) (mx : option A) (mr : Pmap A) :=
+  match ml, mx, mr with PEmpty, None, PEmpty => False | _, _, _ => True end.
+Local Lemma Pmap_ind {A} (P : Pmap A → Prop) :
+  P PEmpty →
+  (∀ ml mx mr, PNode_valid ml mx mr → P ml → P mr → P (PNode ml mx mr)) →
+  ∀ mt, P mt.
+Proof.
+  intros Hemp Hnode [|t]; [done|]. induction t.
+  - by apply (Hnode PEmpty None (PNodes _)).
+  - by apply (Hnode PEmpty (Some _) PEmpty).
+  - by apply (Hnode PEmpty (Some _) (PNodes _)).
+  - by apply (Hnode (PNodes _) None PEmpty).
+  - by apply (Hnode (PNodes _) None (PNodes _)).
+  - by apply (Hnode (PNodes _) (Some _) PEmpty).
+  - by apply (Hnode (PNodes _) (Some _) (PNodes _)).
+Qed.
+
+Local Lemma Pmap_lookup_PNode {A} (ml mr : Pmap A) mx i :
+  PNode ml mx mr !! i = match i with 1 => mx | i~0 => ml !! i | i~1 => mr !! i end.
+Proof. by destruct ml, mx, mr, i. Qed.
+
+Local Lemma Pmap_ne_lookup_not_None {A} (t : Pmap_ne A) : ∃ i, t !! i ≠ None.
+Proof.
+  induction t; repeat select (∃ _, _) (fun H => destruct H);
+    try first [by eexists 1|by eexists _~0|by eexists _~1].
+Qed.
+Local Lemma Pmap_eq_empty {A} (mt : Pmap A) : (∀ i, mt !! i = None) → mt = ∅.
+Proof.
+  intros Hlookup. destruct mt as [|t]; [done|].
+  destruct (Pmap_ne_lookup_not_None t); naive_solver.
+Qed.
+Local Lemma Pmap_eq {A} (mt1 mt2 : Pmap A) : (∀ i, mt1 !! i = mt2 !! i) → mt1 = mt2.
+Proof.
+  revert mt2. induction mt1 as [|ml1 mx1 mr1 _ IHl IHr] using Pmap_ind;
+    intros mt2 Hlookup; destruct mt2 as [|ml2 mx2 mr2 _ _ _] using Pmap_ind.
+  - done.
+  - symmetry. apply Pmap_eq_empty. naive_solver.
+  - apply Pmap_eq_empty. naive_solver.
+  - f_equal.
+    + apply IHl. intros i. generalize (Hlookup (i~0)).
+      by rewrite !Pmap_lookup_PNode.
+    + generalize (Hlookup 1). by rewrite !Pmap_lookup_PNode.
+    + apply IHr. intros i. generalize (Hlookup (i~1)).
+      by rewrite !Pmap_lookup_PNode.
+Qed.
+
+Local Lemma Pmap_ne_lookup_singleton {A} i (x : A) :
+  Pmap_ne_singleton i x !! i = Some x.
+Proof. by induction i. Qed.
+Local Lemma Pmap_ne_lookup_singleton_ne {A} i j (x : A) :
+  i ≠ j → Pmap_ne_singleton i x !! j = None.
+Proof. revert j. induction i; intros [?|?|]; naive_solver. Qed.
+
+Local Lemma Pmap_partial_alter_PNode {A} (f : option A → option A) i ml mx mr :
+  PNode_valid ml mx mr →
+  partial_alter f i (PNode ml mx mr) =
+    match i with
+    | 1 => PNode ml (f mx) mr
+    | i~0 => PNode (partial_alter f i ml) mx mr
+    | i~1 => PNode ml mx (partial_alter f i mr)
+    end.
+Proof. by destruct ml, mx, mr. Qed.
+Local Lemma Pmap_lookup_partial_alter {A} (f : option A → option A)
+    (mt : Pmap A) i :
+  partial_alter f i mt !! i = f (mt !! i).
+Proof.
+  revert i. induction mt using Pmap_ind.
+  { intros i. unfold partial_alter; simpl. destruct (f None); simpl; [|done].
+    by rewrite Pmap_ne_lookup_singleton. }
+  intros []; by rewrite Pmap_partial_alter_PNode, !Pmap_lookup_PNode by done.
+Qed.
+Local Lemma Pmap_lookup_partial_alter_ne {A} (f : option A → option A)
+    (mt : Pmap A) i j :
+  i ≠ j → partial_alter f i mt !! j = mt !! j.
+Proof.
+  revert i j; induction mt using Pmap_ind.
+  { intros i j ?; unfold partial_alter; simpl. destruct (f None); simpl; [|done].
+    by rewrite Pmap_ne_lookup_singleton_ne. }
+  intros [] [] ?;
+    rewrite Pmap_partial_alter_PNode, !Pmap_lookup_PNode by done; auto with lia.
+Qed.
+
+Local Lemma Pmap_lookup_fmap {A B} (f : A → B) (mt : Pmap A) i :
+  (f <$> mt) !! i = f <$> mt !! i.
+Proof.
+  destruct mt as [|t]; simpl; [done|].
+  revert i. induction t; intros []; by simpl.
+Qed.
+
+Local Lemma Pmap_omap_PNode {A B} (f : A → option B) ml mx mr :
+  PNode_valid ml mx mr →
+  omap f (PNode ml mx mr) = PNode (omap f ml) (mx ≫= f) (omap f mr).
+Proof. by destruct ml, mx, mr. Qed.
+Local Lemma Pmap_lookup_omap {A B} (f : A → option B) (mt : Pmap A) i :
+  omap f mt !! i = mt !! i ≫= f.
+Proof.
+  revert i. induction mt using Pmap_ind; [done|].
+  intros []; by rewrite Pmap_omap_PNode, !Pmap_lookup_PNode by done.
+Qed.
+
+Section Pmap_merge.
+  Context {A B C} (f : option A → option B → option C).
+
+  Local Lemma Pmap_merge_PNode_PEmpty ml mx mr :
+    PNode_valid ml mx mr →
+    merge f (PNode ml mx mr) ∅ =
+      PNode (omap (λ x, f (Some x) None) ml) (diag_None f mx None)
+            (omap (λ x, f (Some x) None) mr).
+  Proof. by destruct ml, mx, mr. Qed.
+  Local Lemma Pmap_merge_PEmpty_PNode ml mx mr :
+    PNode_valid ml mx mr →
+    merge f ∅ (PNode ml mx mr) =
+      PNode (omap (λ x, f None (Some x)) ml) (diag_None f None mx)
+            (omap (λ x, f None (Some x)) mr).
+  Proof. by destruct ml, mx, mr. Qed.
+  Local Lemma Pmap_merge_PNode_PNode ml1 ml2 mx1 mx2 mr1 mr2 :
+    PNode_valid ml1 mx1 mr1 → PNode_valid ml2 mx2 mr2 →
+    merge f (PNode ml1 mx1 mr1) (PNode ml2 mx2 mr2) =
+      PNode (merge f ml1 ml2) (diag_None f mx1 mx2) (merge f mr1 mr2).
+  Proof. by destruct ml1, mx1, mr1, ml2, mx2, mr2. Qed.
+
+  Local Lemma Pmap_lookup_merge (mt1 : Pmap A) (mt2 : Pmap B) i :
+    merge f mt1 mt2 !! i = diag_None f (mt1 !! i) (mt2 !! i).
+  Proof.
+    revert mt2 i; induction mt1 using Pmap_ind; intros mt2 i.
+    { induction mt2 using Pmap_ind; [done|].
+      rewrite Pmap_merge_PEmpty_PNode, Pmap_lookup_PNode by done.
+      destruct i; rewrite ?Pmap_lookup_omap, Pmap_lookup_PNode; simpl;
+        by repeat destruct (_ !! _). }
+    destruct mt2 using Pmap_ind.
+    { rewrite Pmap_merge_PNode_PEmpty, Pmap_lookup_PNode by done.
+      destruct i; rewrite ?Pmap_lookup_omap, Pmap_lookup_PNode; simpl;
+        by repeat destruct (_ !! _). }
+    rewrite Pmap_merge_PNode_PNode by done.
+    destruct i; by rewrite ?Pmap_lookup_PNode.
+  Qed.
+End Pmap_merge.
+
+Section Pmap_fold.
+  Local Notation Pmap_fold f := (Pmap_fold_aux (Pmap_ne_fold f)).
+
+  Local Lemma Pmap_fold_PNode {A B} (f : positive → A → B → B) i y ml mx mr :
+    Pmap_fold f i y (PNode ml mx mr) = Pmap_fold f i~1
+      (Pmap_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, mr. Qed.
+
+  Local Lemma Pmap_fold_ind {A} (P : Pmap A → Prop) :
+    P PEmpty →
+    (∀ i x mt,
+      mt !! i = None →
+      (∀ j A' B (f : positive → A' → B → B) (g : A → A') b x',
+        Pmap_fold f j b (<[i:=x']> (g <$> mt))
+        = f (Pos.reverse_go i j) x' (Pmap_fold f j b (g <$> mt))) →
+      P mt → P (<[i:=x]> mt)) →
+    ∀ mt, P mt.
+  Proof.
+    intros Hemp Hinsert mt. revert P Hemp Hinsert.
+    induction mt as [|ml mx mr ? IHl IHr] using Pmap_ind;
+      intros P Hemp Hinsert; [done|].
+    apply (IHr (λ mt, P (PNode ml mx mt))).
+    { apply (IHl (λ mt, P (PNode mt mx PEmpty))).
+      { destruct mx as [x|]; [|done].
+        replace (PNode PEmpty (Some x) PEmpty)
+          with (<[1:=x]> PEmpty : Pmap A) by done.
+        by apply Hinsert. }
+      intros i x mt ? Hfold ?.
+      replace (PNode (<[i:=x]> mt) mx PEmpty)
+        with (<[i~0:=x]> (PNode mt mx PEmpty)) by (by destruct mt, mx).
+      apply Hinsert.
+      - by rewrite Pmap_lookup_PNode.
+      - intros j A' B f g b x'.
+        replace (<[i~0:=x']> (g <$> PNode mt mx PEmpty))
+          with (PNode (<[i:=x']> (g <$> mt)) (g <$> mx) PEmpty)
+          by (by destruct mt, mx).
+        replace (g <$> PNode mt mx PEmpty)
+          with (PNode (g <$> mt) (g <$> mx) PEmpty) by (by destruct mt, mx).
+        rewrite !Pmap_fold_PNode; simpl; auto.
+      - done. }
+    intros i x mt r ? Hfold.
+    replace (PNode ml mx (<[i:=x]> mt))
+      with (<[i~1:=x]> (PNode ml mx mt)) by (by destruct ml, mx, mt).
+    apply Hinsert.
+    - by rewrite Pmap_lookup_PNode.
+    - intros j A' B f g b x'.
+      replace (<[i~1:=x']> (g <$> PNode ml mx mt))
+        with (PNode (g <$> ml) (g <$> mx) (<[i:=x']> (g <$> mt)))
+        by (by destruct ml, mx, mt).
+      replace (g <$> PNode ml mx mt)
+        with (PNode (g <$> ml) (g <$> mx) (g <$> mt)) by (by destruct ml, mx, mt).
+      rewrite !Pmap_fold_PNode; simpl; auto.
+    - done.
+  Qed.
+End Pmap_fold.
+
+(** Instance of the finite map type class *)
+Global Instance Pmap_finmap : FinMap positive Pmap.
+Proof.
+  split.
+  - intros. by apply Pmap_eq.
+  - done.
+  - intros. apply Pmap_lookup_partial_alter.
+  - intros. by apply Pmap_lookup_partial_alter_ne.
+  - intros. apply Pmap_lookup_fmap.
+  - intros. apply Pmap_lookup_omap.
+  - intros. apply Pmap_lookup_merge.
+  - done.
+  - intros A P Hemp Hinsert. apply Pmap_fold_ind; [done|].
+    intros i x mt ? Hfold. apply Hinsert; [done|]. apply (Hfold 1).
+Qed.
+
+(** Type annotation [list (positive * A)] seems needed in Coq 8.14, not in more
+recent versions. *)
+Global Program Instance Pmap_countable `{Countable A} : Countable (Pmap A) := {
+  encode m := encode (map_to_list m : list (positive * A));
+  decode p := list_to_map <$> decode p
+}.
+Next Obligation.
+  intros A ?? m; simpl. rewrite decode_encode; simpl. by rewrite list_to_map_to_list.
+Qed.
+
+(** * Finite sets *)
+(** We construct sets of [positives]s satisfying extensional equality. *)
+Notation Pset := (mapset Pmap).
+Global Instance Pmap_dom {A} : Dom (Pmap A) Pset := mapset_dom.
+Global Instance Pmap_dom_spec : FinMapDom positive Pmap Pset := mapset_dom_spec.

theories/pretty.v → stdpp/pretty.v

@@ -4,11 +4,17 @@ From Coq Require Import Ascii.
 From stdpp Require Import options.
 
 Class Pretty A := pretty : A → string.
+Global Hint Mode Pretty ! : typeclass_instances.
+
 Definition pretty_N_char (x : N) : ascii :=
   match x with
   | 0 => "0" | 1 => "1" | 2 => "2" | 3 => "3" | 4 => "4"
   | 5 => "5" | 6 => "6" | 7 => "7" | 8 => "8" | _ => "9"
   end%char%N.
+Lemma pretty_N_char_inj x y :
+  (x < 10)%N → (y < 10)%N → pretty_N_char x = pretty_N_char y → x = y.
+Proof. compute; intros. by repeat (discriminate || case_match). Qed.
+
 Fixpoint pretty_N_go_help (x : N) (acc : Acc (<)%N x) (s : string) : string :=
   match decide (0 < x)%N with
   | left H => pretty_N_go_help (x `div` 10)%N
@@ -16,8 +22,14 @@ Fixpoint pretty_N_go_help (x : N) (acc : Acc (<)%N x) (s : string) : string :=
      (String (pretty_N_char (x `mod` 10)) s)
   | right _ => s
   end.
+(** The argument [S (N.size_nat x)] of [wf_guard] makes sure that computation
+works if [x] is a closed term, but that it blocks if [x] is an open term. The
+latter prevents unexpected stack overflows, see [tests/pretty.v]. *)
 Definition pretty_N_go (x : N) : string → string :=
-  pretty_N_go_help x (wf_guard 32 N.lt_wf_0 x).
+  pretty_N_go_help x (wf_guard (S (N.size_nat x)) N.lt_wf_0 x).
+Global Instance pretty_N : Pretty N := λ x,
+  if decide (x = 0)%N then "0" else pretty_N_go x "".
+
 Lemma pretty_N_go_0 s : pretty_N_go 0 s = s.
 Proof. done. Qed.
 Lemma pretty_N_go_help_irrel x acc1 acc2 s :
@@ -31,22 +43,45 @@ Lemma pretty_N_go_step x s :
   = pretty_N_go (x `div` 10) (String (pretty_N_char (x `mod` 10)) s).
 Proof.
   unfold pretty_N_go; intros; destruct (wf_guard 32 N.lt_wf_0 x).
-  destruct wf_guard. (* this makes coqchk happy. *)
+  destruct (wf_guard _ _). (* this makes coqchk happy. *)
   unfold pretty_N_go_help at 1; fold pretty_N_go_help.
   by destruct (decide (0 < x)%N); auto using pretty_N_go_help_irrel.
 Qed.
-Instance pretty_N : Pretty N := λ x, pretty_N_go x ""%string.
-Lemma pretty_N_unfold x : pretty x = pretty_N_go x "".
-Proof. done. Qed.
-Instance pretty_N_inj : Inj (=@{N}) (=) pretty.
+
+(** Helper lemma to prove [pretty_N_inj] and [pretty_Z_inj]. *)
+Lemma pretty_N_go_ne_0 x s : s ≠ "0" → pretty_N_go x s ≠ "0".
+Proof.
+  revert s. induction (N.lt_wf_0 x) as [x _ IH]; intros s ?.
+  assert (x = 0 ∨ 0 < x < 10 ∨ 10 ≤ x)%N as [->|[[??]|?]] by lia.
+  - by rewrite pretty_N_go_0.
+  - rewrite pretty_N_go_step by done. apply IH.
+    { by apply N.div_lt. }
+    assert (x = 1 ∨ x = 2 ∨ x = 3 ∨ x = 4 ∨ x = 5 ∨ x = 6
+          ∨ x = 7 ∨ x = 8 ∨ x = 9)%N by lia; naive_solver.
+  - rewrite 2!pretty_N_go_step by (try apply N.div_str_pos_iff; lia).
+    apply IH; [|done].
+    trans (x `div` 10)%N; apply N.div_lt; auto using N.div_str_pos with lia.
+Qed.
+(** Helper lemma to prove [pretty_Z_inj]. *)
+Lemma pretty_N_go_ne_dash x s s' : s ≠ "-" +:+ s' → pretty_N_go x s ≠ "-" +:+ s'.
+Proof.
+  revert s. induction (N.lt_wf_0 x) as [x _ IH]; intros s ?.
+  assert (x = 0 ∨ 0 < x)%N as [->|?] by lia.
+  - by rewrite pretty_N_go_0.
+  - rewrite pretty_N_go_step by done. apply IH.
+    { by apply N.div_lt. }
+    unfold pretty_N_char. by repeat case_match.
+Qed.
+
+Global Instance pretty_N_inj : Inj (=@{N}) (=) pretty.
 Proof.
-  assert (∀ x y, x < 10 → y < 10 →
-    pretty_N_char x =  pretty_N_char y → x = y)%N.
-  { compute; intros. by repeat (discriminate || case_match). }
   cut (∀ x y s s', pretty_N_go x s = pretty_N_go y s' →
     String.length s = String.length s' → x = y ∧ s = s').
-  { intros help x y Hp.
-    eapply (help x y "" ""); [by rewrite <-!pretty_N_unfold|done]. }
+  { intros help x y. unfold pretty, pretty_N. intros.
+    repeat case_decide; simplify_eq/=; [done|..].
+    - by destruct (pretty_N_go_ne_0 y "").
+    - by destruct (pretty_N_go_ne_0 x "").
+    - by apply (help x y "" ""). }
   assert (∀ x s, ¬String.length (pretty_N_go x s) < String.length s) as help.
   { setoid_rewrite <-Nat.le_ngt.
     intros x; induction (N.lt_wf_0 x) as [x _ IH]; intros s.
@@ -57,18 +92,34 @@ Proof.
   assert ((x = 0 ∨ 0 < x) ∧ (y = 0 ∨ 0 < y))%N as [[->|?] [->|?]] by lia;
     rewrite ?pretty_N_go_0, ?pretty_N_go_step, ?(pretty_N_go_step y) by done.
   { done. }
-  { intros -> Hlen; edestruct help; rewrite Hlen; simpl; lia. }
-  { intros <- Hlen; edestruct help; rewrite <-Hlen; simpl; lia. }
-  intros Hs Hlen; apply IH in Hs; destruct Hs;
-    simplify_eq/=; split_and?; auto using N.div_lt_upper_bound with lia.
-  rewrite (N.div_mod x 10), (N.div_mod y 10) by done.
-  auto using N.mod_lt with f_equal.
+  { intros -> Hlen. edestruct help; rewrite Hlen; simpl; lia. }
+  { intros <- Hlen. edestruct help; rewrite <-Hlen; simpl; lia. }
+  intros Hs Hlen.
+  apply IH in Hs as [? [= Hchar]];
+    [|auto using N.div_lt_upper_bound with lia|simpl; lia].
+  split; [|done].
+  apply pretty_N_char_inj in Hchar; [|by auto using N.mod_lt..].
+  rewrite (N.div_mod x 10), (N.div_mod y 10) by done. lia.
 Qed.
-Instance pretty_Z : Pretty Z := λ x,
-  match x with
-  | Z0 => "" | Zpos x => pretty (Npos x) | Zneg x => "-" +:+ pretty (Npos x)
-  end%string.
-Instance pretty_nat : Pretty nat := λ x, pretty (N.of_nat x).
-Instance pretty_nat_inj : Inj (=@{nat}) (=) pretty.
+
+Global Instance pretty_nat : Pretty nat := λ x, pretty (N.of_nat x).
+Global Instance pretty_nat_inj : Inj (=@{nat}) (=) pretty.
+Proof. apply _. Qed.
+
+Global Instance pretty_positive : Pretty positive := λ x, pretty (Npos x).
+Global Instance pretty_positive_inj : Inj (=@{positive}) (=) pretty.
 Proof. apply _. Qed.
 
+Global Instance pretty_Z : Pretty Z := λ x,
+  match x with
+  | Z0 => "0" | Zpos x => pretty x | Zneg x => "-" +:+ pretty x
+  end.
+Global Instance pretty_Z_inj : Inj (=@{Z}) (=) pretty.
+Proof.
+  unfold pretty, pretty_Z.
+  intros [|x|x] [|y|y] Hpretty; simplify_eq/=; try done.
+  - by destruct (pretty_N_go_ne_0 (N.pos y) "").
+  - by destruct (pretty_N_go_ne_0 (N.pos x) "").
+  - by edestruct (pretty_N_go_ne_dash (N.pos x) "").
+  - by edestruct (pretty_N_go_ne_dash (N.pos y) "").
+Qed.

theories/proof_irrel.v → stdpp/proof_irrel.v

@@ -2,21 +2,21 @@
 From stdpp Require Export base.
 From stdpp Require Import options.
 
-Hint Extern 200 (ProofIrrel _) => progress (lazy beta) : typeclass_instances.
+Global Hint Extern 200 (ProofIrrel _) => progress (lazy beta) : typeclass_instances.
 
-Instance True_pi: ProofIrrel True.
+Global Instance True_pi: ProofIrrel True.
 Proof. intros [] []; reflexivity. Qed.
-Instance False_pi: ProofIrrel False.
+Global Instance False_pi: ProofIrrel False.
 Proof. intros []. Qed.
-Instance unit_pi: ProofIrrel ().
+Global Instance unit_pi: ProofIrrel ().
 Proof. intros [] []; reflexivity. Qed.
-Instance and_pi (A B : Prop) :
+Global Instance and_pi (A B : Prop) :
   ProofIrrel A → ProofIrrel B → ProofIrrel (A ∧ B).
 Proof. intros ?? [??] [??]. f_equal; trivial. Qed.
-Instance prod_pi (A B : Type) :
+Global Instance prod_pi (A B : Type) :
   ProofIrrel A → ProofIrrel B → ProofIrrel (A * B).
 Proof. intros ?? [??] [??]. f_equal; trivial. Qed.
-Instance eq_pi {A} (x : A) `{∀ z, Decision (x = z)} (y : A) :
+Global Instance eq_pi {A} (x : A) `{∀ z, Decision (x = z)} (y : A) :
   ProofIrrel (x = y).
 Proof.
   set (f z (H : x = z) :=
@@ -29,7 +29,7 @@ Proof.
   intros p q. rewrite <-(help _ p), <-(help _ q).
   unfold f at 2 4. destruct (decide _); [reflexivity|]. exfalso; tauto.
 Qed.
-Instance Is_true_pi (b : bool) : ProofIrrel (Is_true b).
+Global Instance Is_true_pi (b : bool) : ProofIrrel (Is_true b).
 Proof. destruct b; simpl; apply _. Qed.
 Lemma sig_eq_pi `(P : A → Prop) `{∀ x, ProofIrrel (P x)}
   (x y : sig P) : x = y ↔ `x = `y.
@@ -38,7 +38,7 @@ Proof.
   destruct x as [x Hx], y as [y Hy]; simpl; intros; subst.
   f_equal. apply proof_irrel.
 Qed.
-Instance proj1_sig_inj `(P : A → Prop) `{∀ x, ProofIrrel (P x)} :
+Global Instance proj1_sig_inj `(P : A → Prop) `{∀ x, ProofIrrel (P x)} :
   Inj (=) (=) (proj1_sig (P:=P)).
 Proof. intros ??. apply (sig_eq_pi P). Qed.
 Lemma exists_proj1_pi `(P : A → Prop) `{∀ x, ProofIrrel (P x)}

theories/propset.v → stdpp/propset.v

@@ -4,22 +4,28 @@ From stdpp Require Import options.
 
 Record propset (A : Type) : Type := PropSet { propset_car : A → Prop }.
 Add Printing Constructor propset.
-Arguments PropSet {_} _ : assert.
-Arguments propset_car {_} _ _ : assert.
+Global Arguments PropSet {_} _ : assert.
+Global Arguments propset_car {_} _ _ : assert.
+(** Here we are using the notation "as pattern" because we want to
+    be compatible with all the rules that start with [ {[ TERM ] such as
+    records, singletons, and map singletons. See
+    https://coq.inria.fr/refman/user-extensions/syntax-extensions.html#binders-bound-in-the-notation-and-parsed-as-terms
+    and https://gitlab.mpi-sws.org/iris/stdpp/-/merge_requests/533#note_98003.
+    We don't set a level to be consistent with the notation for singleton sets. *)
 Notation "{[ x | P ]}" := (PropSet (λ x, P))
-  (at level 1, format "{[  x  |  P  ]}") : stdpp_scope.
+  (at level 1, x as pattern, format "{[  x  |  P  ]}") : stdpp_scope.
 
-Instance propset_elem_of {A} : ElemOf A (propset A) := λ x X, propset_car X x.
+Global Instance propset_elem_of {A} : ElemOf A (propset A) := λ x X, propset_car X x.
 
-Instance propset_top {A} : Top (propset A) := {[ _ | True ]}.
-Instance propset_empty {A} : Empty (propset A) := {[ _ | False ]}.
-Instance propset_singleton {A} : Singleton A (propset A) := λ y, {[ x | y = x ]}.
-Instance propset_union {A} : Union (propset A) := λ X1 X2, {[ x | x ∈ X1 ∨ x ∈ X2 ]}.
-Instance propset_intersection {A} : Intersection (propset A) := λ X1 X2,
+Global Instance propset_top {A} : Top (propset A) := {[ _ | True ]}.
+Global Instance propset_empty {A} : Empty (propset A) := {[ _ | False ]}.
+Global Instance propset_singleton {A} : Singleton A (propset A) := λ y, {[ x | y = x ]}.
+Global Instance propset_union {A} : Union (propset A) := λ X1 X2, {[ x | x ∈ X1 ∨ x ∈ X2 ]}.
+Global Instance propset_intersection {A} : Intersection (propset A) := λ X1 X2,
   {[ x | x ∈ X1 ∧ x ∈ X2 ]}.
-Instance propset_difference {A} : Difference (propset A) := λ X1 X2,
+Global Instance propset_difference {A} : Difference (propset A) := λ X1 X2,
   {[ x | x ∈ X1 ∧ x ∉ X2 ]}.
-Instance propset_top_set {A} : TopSet A (propset A).
+Global Instance propset_top_set {A} : TopSet A (propset A).
 Proof. split; [split; [split| |]|]; by repeat intro. Qed.
 
 Lemma elem_of_PropSet {A} (P : A → Prop) x : x ∈ {[ x | P x ]} ↔ P x.
@@ -33,17 +39,17 @@ Lemma elem_of_set_to_propset `{SemiSet A C} x (X : C) :
   x ∈ set_to_propset X ↔ x ∈ X.
 Proof. done. Qed.
 
-Instance propset_ret : MRet propset := λ A (x : A), {[ x ]}.
-Instance propset_bind : MBind propset := λ A B (f : A → propset B) (X : propset A),
+Global Instance propset_ret : MRet propset := λ A (x : A), {[ x ]}.
+Global Instance propset_bind : MBind propset := λ A B (f : A → propset B) (X : propset A),
   PropSet (λ b, ∃ a, b ∈ f a ∧ a ∈ X).
-Instance propset_fmap : FMap propset := λ A B (f : A → B) (X : propset A),
+Global Instance propset_fmap : FMap propset := λ A B (f : A → B) (X : propset A),
   {[ b | ∃ a, b = f a ∧ a ∈ X ]}.
-Instance propset_join : MJoin propset := λ A (XX : propset (propset A)),
+Global Instance propset_join : MJoin propset := λ A (XX : propset (propset A)),
   {[ a | ∃ X : propset A, a ∈ X ∧ X ∈ XX ]}.
-Instance propset_monad_set : MonadSet propset.
+Global Instance propset_monad_set : MonadSet propset.
 Proof. by split; try apply _. Qed.
 
-Instance set_unfold_PropSet {A} (P : A → Prop) x Q :
+Global Instance set_unfold_PropSet {A} (P : A → Prop) x Q :
   SetUnfoldSimpl (P x) Q → SetUnfoldElemOf x (PropSet P) Q.
 Proof. intros HPQ. constructor. apply HPQ. Qed.