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 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 (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 :=
+  match l with
+  | [] => 0
+  | x :: l => f x + go l
+  end.
+Notation sum_list := (sum_list_with id).
+
+Definition max_list_with {A} (f : A → nat) : list A → nat :=
+  fix go l :=
+  match l with
+  | [] => 0
+  | x :: l => f x `max` go l
+  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|].
+    by rewrite IH, Nat.add_succ_r.
+  Qed.
+  Lemma fmap_S_seq j n : S <$> seq j n = seq (S j) n.
+  Proof. apply (fmap_add_seq 1). Qed.
+  Lemma imap_seq {A B} (l : list A) (g : nat → B) i :
+    imap (λ j _, g (i + j)) l = g <$> seq i (length l).
+  Proof.
+    revert i. induction l as [|x l IH]; [done|].
+    csimpl. intros n. rewrite <-IH, <-plus_n_O. f_equal.
+    apply imap_ext; simpl; auto with lia.
+  Qed.
+  Lemma imap_seq_0 {A B} (l : list A) (g : nat → B) :
+    imap (λ j _, g j) l = g <$> seq 0 (length l).
+  Proof. rewrite (imap_ext _ (λ i o, g (0 + i))); [|done]. apply imap_seq. Qed.
+  Lemma lookup_seq_lt j n i : i < n → seq j n !! i = Some (j + i).
+  Proof.
+    revert j i. induction n as [|n IH]; intros j [|i] ?; simpl; auto with lia.
+    rewrite IH; auto with lia.
+  Qed.
+  Lemma lookup_total_seq_lt j n i : i < n → seq j n !!! i = j + i.
+  Proof. intros. by rewrite !list_lookup_total_alt, lookup_seq_lt. Qed.
+  Lemma lookup_seq_ge j n i : n ≤ i → seq j n !! i = None.
+  Proof. revert j i. induction n; intros j [|i] ?; simpl; auto with lia. Qed.
+  Lemma lookup_total_seq_ge j n i : n ≤ i → seq j n !!! i = inhabitant.
+  Proof. intros. by rewrite !list_lookup_total_alt, lookup_seq_ge. Qed.
+  Lemma lookup_seq j n i j' : seq j n !! i = Some j' ↔ j' = j + i ∧ i < n.
+  Proof.
+    destruct (le_lt_dec n i).
+    - rewrite lookup_seq_ge by done. naive_solver lia.
+    - rewrite lookup_seq_lt by done. naive_solver lia.
+  Qed.
+  Lemma NoDup_seq j n : NoDup (seq j n).
+  Proof. apply NoDup_ListNoDup, seq_NoDup. Qed.
+
+  Lemma elem_of_seq j n k :
+    k ∈ seq j n ↔ j ≤ k < j + n.
+  Proof. rewrite elem_of_list_In, in_seq. done. Qed.
+
+  Lemma seq_nil n m : seq n m = [] ↔ m = 0.
+  Proof. by destruct m. Qed.
+
+  Lemma seq_subseteq_mono m n1 n2 : n1 ≤ n2 → seq m n1 ⊆ seq m n2.
+  Proof. by intros Hle i Hi%elem_of_seq; apply elem_of_seq; lia. Qed.
+
+  Lemma Forall_seq (P : nat → Prop) i n :
+    Forall P (seq i n) ↔ ∀ j, i ≤ j < i + n → P j.
+  Proof. rewrite Forall_forall. setoid_rewrite elem_of_seq. auto with lia. Qed.
+
+  Lemma drop_seq j n m :
+    drop m (seq j n) = seq (j + m) (n - m).
+  Proof.
+    revert j m. induction n as [|n IH]; simpl; intros j m.
+    - rewrite drop_nil. done.
+    - destruct m; simpl.
+      + rewrite Nat.add_0_r. done.
+      + rewrite IH. f_equal; lia.
+  Qed.
+  Lemma take_seq j n m :
+    take m (seq j n) = seq j (m `min` n).
+  Proof.
+    revert j m. induction n as [|n IH]; simpl; intros j m.
+    - rewrite take_nil. replace (m `min` 0) with 0 by lia. done.
+    - destruct m; simpl; auto with f_equal.
+  Qed.
+
+End seq.
+
+(** ** Properties of the [seqZ] function *)
+Section seqZ.
+  Implicit Types (m n : Z) (i j : nat).
+  Local Open Scope Z_scope.
+
+  Lemma seqZ_nil m n : n ≤ 0 → seqZ m n = [].
+  Proof. by destruct n. Qed.
+  Lemma seqZ_cons m n : 0 < n → seqZ m n = m :: seqZ (Z.succ m) (Z.pred n).
+  Proof.
+    intros H. unfold seqZ. replace n with (Z.succ (Z.pred n)) at 1 by lia.
+    rewrite Z2Nat.inj_succ by lia. f_equal/=.
+    rewrite <-fmap_S_seq, <-list_fmap_compose.
+    apply map_ext; naive_solver lia.
+  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'.
+    - 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 : 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);
+      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 : 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 ≤ 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.
+    - 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 ≤ 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 + Z.of_nat i ∧ Z.of_nat i < n.
+  Proof.
+    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 seqZ_app m n1 n2 :
+    0 ≤ n1 →
+    0 ≤ n2 →
+    seqZ m (n1 + n2) = seqZ m n1 ++ seqZ (m + n1) n2.
+  Proof.
+    intros. unfold seqZ. rewrite Z2Nat.inj_add, seq_app, fmap_app by done.
+    f_equal. rewrite Nat.add_comm, <-!fmap_add_seq, <-list_fmap_compose.
+    apply list_fmap_ext; 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] function *)
+Section sum_list.
+  Context {A : Type}.
+  Implicit Types x y z : A.
+  Implicit Types l k : list A.
+  Lemma sum_list_with_app (f : A → nat) l k :
+    sum_list_with f (l ++ k) = sum_list_with f l + sum_list_with f k.
+  Proof. induction l; simpl; lia. Qed.
+  Lemma sum_list_with_reverse (f : A → nat) l :
+    sum_list_with f (reverse l) = sum_list_with f l.
+  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 length_drop; lia).
+  Qed.
+  Lemma sum_list_replicate n m : sum_list (replicate m n) = m * n.
+  Proof. induction m; simpl; auto. Qed.
+  Lemma sum_list_fmap_same n l f :
+    Forall (λ x, f x = n) l →
+    sum_list (f <$> l) = length l * n.
+  Proof. induction 1; csimpl; lia. Qed.
+  Lemma sum_list_fmap_const l n :
+    sum_list ((λ _, n) <$> l) = length l * n.
+  Proof. by apply sum_list_fmap_same, Forall_true. Qed.
+End sum_list.
+
+(** ** Properties of the [mjoin] function that rely on [sum_list] *)
+Section mjoin.
+  Context {A : Type}.
+  Implicit Types x y z : A.
+  Implicit Types l k : list A.
+  Implicit Types ls : list (list A).
+
+  Lemma length_join ls:
+    length (mjoin ls) = sum_list (length <$> ls).
+  Proof. induction ls; [done|]; csimpl. rewrite length_app. lia. Qed.
+
+  Lemma join_lookup_Some ls i x :
+    mjoin ls !! i = Some x ↔ ∃ j l i', ls !! j = Some l ∧ l !! i' = Some x
+                                     ∧ i = sum_list (length <$> take j ls) + i'.
+  Proof.
+    revert i. induction ls as [|l ls IH]; csimpl; intros i.
+    { setoid_rewrite lookup_nil. naive_solver. }
+    rewrite lookup_app_Some, IH. split.
+    - destruct 1 as [?|(?&?&?&?&?&?&?)].
+      + eexists 0. naive_solver.
+      + eexists (S _); naive_solver lia.
+    - destruct 1 as [[|?] ?]; naive_solver lia.
+  Qed.
+
+  Lemma join_lookup_Some_same_length n ls i x :
+    Forall (λ l, length l = n) ls →
+    mjoin ls !! i = Some x ↔ ∃ j l i', ls !! j = Some l ∧ l !! i' = Some x
+                                     ∧ i = j * n + i'.
+  Proof.
+    intros Hl. rewrite join_lookup_Some.
+    f_equiv; intros j. f_equiv; intros l. f_equiv; intros i'.
+    assert (ls !! j = Some l → j < length ls) by eauto using lookup_lt_Some.
+    rewrite (sum_list_fmap_same n), length_take by auto using Forall_take.
+    naive_solver lia.
+  Qed.
+
+  Lemma join_lookup_Some_same_length' n ls j i x :
+    Forall (λ l, length l = n) ls →
+    i < n →
+    mjoin ls !! (j * n + i) = Some x ↔ ∃ l, ls !! j = Some l ∧ l !! i = Some x.
+  Proof.
+    intros. rewrite join_lookup_Some_same_length by done.
+    split; [|naive_solver].
+    destruct 1 as (j'&l'&i'&?&?&Hj); decompose_Forall.
+    assert (i' < length l') by eauto using lookup_lt_Some.
+    apply Nat.mul_split_l in Hj; naive_solver.
+  Qed.
+End mjoin.
+
+(** ** Properties of the [max_list] function *)
+Section max_list.
+  Context {A : Type}.
+
+  Lemma max_list_elem_of_le n ns :
+    n ∈ ns → n ≤ max_list ns.
+  Proof. induction 1; simpl; lia. Qed.
+
+  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.

theories/listset.v → stdpp/listset.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file implements finite set as unordered lists without duplicates
 removed. This implementation forms a monad. *)
 From stdpp Require Export sets list.
-Set Default Proof Using "Type".
+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}.
@@ -30,8 +28,8 @@ 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.
-Qed. 
+  destruct l as [|x l]; [done|]. oinversion Hl. left.
+Qed.
 Global Instance listset_empty_dec (X : listset A) : Decision (X ≡ ∅).
 Proof.
  refine (cast_if (decide (listset_car X = [])));
@@ -50,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 _.
@@ -68,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

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file implements finite as unordered lists without duplicates.
 Although this implementation is slow, it is very useful as decidable equality
 is the only constraint on the carrier set. *)
 From stdpp Require Export sets list.
-Set Default Proof Using "Type".
+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}.
 Notation C := (listset_nodup A).
 
-Instance listset_nodup_elem_of: ElemOf A C := λ x l, x ∈ listset_nodup_car l.
-Instance listset_nodup_empty: Empty C := ListsetNoDup [] (@NoDup_nil_2 _).
-Instance listset_nodup_singleton: Singleton A C := λ x,
+Global Instance listset_nodup_elem_of: ElemOf A C := λ x l, x ∈ listset_nodup_car l.
+Global Instance listset_nodup_empty: Empty C := ListsetNoDup [] (@NoDup_nil_2 _).
+Global Instance listset_nodup_singleton: Singleton A C := λ x,
   ListsetNoDup [x] (NoDup_singleton x).
-Instance listset_nodup_union: Union C :=
+Global Instance listset_nodup_union: Union C :=
   λ '(ListsetNoDup l Hl) '(ListsetNoDup k Hk),
     ListsetNoDup _ (NoDup_list_union _ _ Hl Hk).
-Instance listset_nodup_intersection: Intersection C :=
+Global Instance listset_nodup_intersection: Intersection C :=
   λ '(ListsetNoDup l Hl) '(ListsetNoDup k Hk),
     ListsetNoDup _ (NoDup_list_intersection _ k Hl).
-Instance listset_nodup_difference: Difference C :=
+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.
@@ -43,20 +41,5 @@ Qed.
 
 Global Instance listset_nodup_elems: Elements A C := listset_nodup_car.
 Global Instance listset_nodup_fin_set: FinSet A C.
-Proof. split. apply _. done. by intros [??]. Qed.
+Proof. split; [apply _|done|]. by intros [??]. Qed.
 End list_set.
-
-Hint Extern 1 (ElemOf _ (listset_nodup _)) =>
-  eapply @listset_nodup_elem_of : typeclass_instances.
-Hint Extern 1 (Empty (listset_nodup _)) =>
-  eapply @listset_nodup_empty : typeclass_instances.
-Hint Extern 1 (Singleton _ (listset_nodup _)) =>
-  eapply @listset_nodup_singleton : typeclass_instances.
-Hint Extern 1 (Union (listset_nodup _)) =>
-  eapply @listset_nodup_union : typeclass_instances.
-Hint Extern 1 (Intersection (listset_nodup _)) =>
-  eapply @listset_nodup_intersection : typeclass_instances.
-Hint Extern 1 (Difference (listset_nodup _)) =>
-  eapply @listset_nodup_difference : typeclass_instances.
-Hint Extern 1 (Elements _ (listset_nodup _)) =>
-  eapply @listset_nodup_elems : typeclass_instances.

theories/mapset.v → stdpp/mapset.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This files gives an implementation of finite sets using finite maps with
 elements of the unit type. Since maps enjoy extensional equality, the
 constructed finite sets do so as well. *)
 From stdpp Require Export countable fin_map_dom.
-(* FIXME: This file needs a 'Proof Using' hint. *)
+From stdpp Require Import options.
 
-Record mapset (M : Type → Type) : Type :=
-  Mapset { mapset_car: M (unit : Type) }.
-Arguments Mapset {_} _ : assert.
-Arguments mapset_car {_} _ : assert.
+(* FIXME: This file needs a 'Proof Using' hint, but they need to be set
+locally (or things moved out of sections) as no default works well enough. *)
+Unset Default Proof Using.
+
+(** 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}.
@@ -35,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.
@@ -43,15 +51,15 @@ Proof.
   - unfold singleton, elem_of, mapset_singleton, mapset_elem_of.
     simpl. by split; intros; simplify_map_eq.
   - unfold union, elem_of, mapset_union, mapset_elem_of.
-    intros [m1] [m2] ?. simpl. rewrite lookup_union_Some_raw.
+    intros [m1] [m2] x. simpl. rewrite lookup_union_Some_raw.
     destruct (m1 !! x) as [[]|]; tauto.
   - unfold intersection, elem_of, mapset_intersection, mapset_elem_of.
-    intros [m1] [m2] ?. simpl. rewrite lookup_intersection_Some.
+    intros [m1] [m2] x. simpl. rewrite lookup_intersection_Some.
     assert (is_Some (m2 !! x) ↔ m2 !! x = Some ()).
     { split; eauto. by intros [[] ?]. }
     naive_solver.
   - unfold difference, elem_of, mapset_difference, mapset_elem_of.
-    intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some.
+    intros [m1] [m2] x. simpl. rewrite lookup_difference_Some.
     destruct (m2 !! x) as [[]|]; intuition congruence.
 Qed.
 Global Instance mapset_leibniz : LeibnizEquiv (mapset M).
@@ -101,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)).
@@ -118,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

 From stdpp Require Export countable coPset.
-Set Default Proof Using "Type".
+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,14 +51,14 @@ 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 [= ?%encode_inj]%positives_flatten_suffix_eq.
+    revert Hqy. by intros [= ?%(inj encode)]%positives_flatten_suffix_eq.
   Qed.
 
   Lemma ndot_preserve_disjoint_l N E x : ↑N ## E → ↑N.@x ## E.
@@ -73,30 +73,67 @@ of the forms:
 - [N1 ## N2]
 - [↑N1 ⊆ E ∖ ↑N2 ∖ .. ∖ ↑Nn]
 - [E1 ∖ ↑N1 ⊆ E2 ∖ ↑N2 ∖ .. ∖ ↑Nn] *)
-Create HintDb ndisj.
+Create HintDb ndisj discriminated.
 
 (** Rules for goals of the form [_ ⊆ _] *)
 (** If-and-only-if rules. Well, not quite, but for the fragment we are
 considering they are. *)
-Hint Resolve (subseteq_difference_r (A:=positive) (C:=coPset)) : ndisj.
-Hint Resolve (empty_subseteq (A:=positive) (C:=coPset)) : ndisj.
-Hint Resolve (union_least (A:=positive) (C:=coPset)) : ndisj.
+Local Definition coPset_subseteq_difference_r := subseteq_difference_r (C:=coPset).
+Global Hint Resolve coPset_subseteq_difference_r : ndisj.
+Local Definition coPset_empty_subseteq := empty_subseteq (C:=coPset).
+Global Hint Resolve coPset_empty_subseteq : ndisj.
+Local Definition coPset_union_least := union_least (C:=coPset).
+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. *)
-Hint Resolve (subseteq_difference_l (A:=positive) (C:=coPset)) | 100 : ndisj.
-Hint Resolve nclose_subseteq' | 100 : ndisj.
+Local Definition coPset_subseteq_difference_l := subseteq_difference_l (C:=coPset).
+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. *)
-Hint Resolve (disjoint_difference_l1 (A:=positive) (C:=coPset)) | 50 : ndisj.
-Hint Resolve (disjoint_difference_l2 (A:=positive) (C:=coPset)) | 100 : ndisj.
-Hint Resolve ndot_preserve_disjoint_l ndot_preserve_disjoint_r | 100 : ndisj.
+Local Definition coPset_disjoint_difference_l1 := disjoint_difference_l1 (C:=coPset).
+Global Hint Resolve coPset_disjoint_difference_l1 | 50 : ndisj.
+Local Definition coPset_disjoint_difference_l2 := disjoint_difference_l2 (C:=coPset).
+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

 From stdpp Require Import numbers.
+From stdpp Require Import options.
 
 (** The class [NatCancel m n m' n'] is a simple canceler for natural numbers
 implemented using type classes.
@@ -37,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
@@ -53,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

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This files implements a type [natmap A] of finite maps whose keys range
 over Coq's data type of unary natural numbers [nat]. The implementation equips
 a list with a proof of canonicity. *)
 From stdpp Require Import fin_maps mapset.
-Set Default Proof Using "Type".
+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) :
@@ -28,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.
@@ -43,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 :=
@@ -58,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.
@@ -71,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
@@ -86,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 :=
@@ -120,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).
 
@@ -130,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).
@@ -138,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). by apply fmap_is_Some. done.
-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.
@@ -217,20 +232,29 @@ Proof.
     + by specialize (E 0).
     + destruct (natmap_wf_lookup (None :: l2)) as (i&?&?); auto with congruence.
     + by specialize (E 0).
-    + f_equal. apply (E 0). apply IH; eauto using natmap_wf_inv.
-      intros i. apply (E (S i)).
+    + f_equal.
+      * apply (E 0).
+      * apply IH; eauto using natmap_wf_inv.
+        intros i. apply (E (S i)).
     + by specialize (E 0).
     + destruct (natmap_wf_lookup (None :: l1)) as (i&?&?); auto with congruence.
     + 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,11 +280,11 @@ 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 *)
-Fixpoint bools_to_natset (βs : list bool) : natset :=
+Definition bools_to_natset (βs : list bool) : natset :=
   let f (β : bool) := if β then Some () else None in
   Mapset $ list_to_natmap $ f <$> βs.
 Definition natset_to_bools (sz : nat) (X : natset) : list bool :=
@@ -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

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This files extends the implementation of finite over [positive] to finite
 maps whose keys range over Coq's data type of binary naturals [N]. *)
 From stdpp Require Import pmap mapset.
 From stdpp Require Export prelude fin_maps.
-Set Default Proof Using "Type".
+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 ??? [??] []; simpl; [done|]. apply lookup_fmap.
   - 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

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file collects general purpose definitions and theorems on the option
 data type that are not in the Coq standard library. *)
 From stdpp Require Export tactics.
-Set Default Proof Using "Type".
+From stdpp Require Import options.
 
 Inductive option_reflect {A} (P : A → Prop) (Q : Prop) : option A → Type :=
   | ReflectSome x : P x → option_reflect P Q (Some x)
@@ -15,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).
@@ -40,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
@@ -69,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
@@ -105,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
@@ -168,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,10 +208,10 @@ Lemma fmap_Some_equiv {A B} `{Equiv B} `{!Equivalence (≡@{B})} (f : A → B) m
   f <$> mx ≡ Some y ↔ ∃ x, mx = Some x ∧ y ≡ f x.
 Proof.
   destruct mx; simpl; split.
-  - intros ?%Some_equiv_inj. eauto.
-  - intros (? & ->%Some_inj & ?). constructor. done.
-  - intros ?%symmetry%equiv_None. done.
-  - intros (? & ? & ?). done.
+  - intros ?%(inj Some). eauto.
+  - intros (? & ->%(inj Some) & ?). constructor. 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.
@@ -203,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 `{Equiv A, Equiv B} (f g : A → B) (mx : option A) :
+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.
@@ -227,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.
 
@@ -248,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).
@@ -311,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] |- _ =>
@@ -380,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
@@ -399,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;
@@ -421,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.

stdpp/options.v

+(** 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. *)
+
+(** 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. *)
+
+(** 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.
+From stdpp Require Import options.
+*)

theories/orders.v → stdpp/orders.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** Properties about arbitrary pre-, partial, and total orders. We do not use
 the relation [⊆] because we often have multiple orders on the same structure *)
 From stdpp Require Export tactics.
-Set Default Proof Using "Type".
+From stdpp Require Import options.
 
 Section orders.
   Context {A} {R : relation A}.
@@ -15,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.
@@ -47,8 +45,8 @@ Section orders.
   Lemma strict_spec_alt `{!AntiSymm (=) R} X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠ Y.
   Proof.
     split.
-    - intros [? HYX]. split. done. by intros <-.
-    - intros [? HXY]. split. done. by contradict HXY; apply (anti_symm R).
+    - intros [? HYX]. split; [ done | by intros <- ].
+    - intros [? HXY]. split; [ done | by contradict HXY; apply (anti_symm R) ].
   Qed.
   Lemma po_eq_dec `{!PartialOrder R, !RelDecision R} : EqDecision A.
   Proof.

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/prelude.v → stdpp/prelude.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 From stdpp Require Export
   base
   tactics
@@ -12,4 +10,6 @@ From stdpp Require Export
   fin_sets
   listset
   list
+  list_numbers
   lexico.
+From stdpp Require Import options.

theories/pretty.v → stdpp/pretty.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 From stdpp Require Export strings.
 From stdpp Require Import relations numbers.
 From Coq Require Import Ascii.
-Set Default Proof Using "Type".
+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
@@ -18,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 :
@@ -33,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.
@@ -59,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

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file collects facts on proof irrelevant types/propositions. *)
 From stdpp Require Export base.
-Set Default Proof Using "Type".
+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 and_pi (A B : Prop) :
+Global Instance unit_pi: ProofIrrel ().
+Proof. intros [] []; reflexivity. Qed.
+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) :=
@@ -27,9 +27,9 @@ Proof.
     eq_trans (eq_sym (f x (eq_refl x))) (f z H) = H) as help.
   { intros ? []. destruct (f x eq_refl); tauto. }
   intros p q. rewrite <-(help _ p), <-(help _ q).
-  unfold f at 2 4. destruct (decide _). reflexivity. exfalso; tauto.
+  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,6 +38,9 @@ Proof.
   destruct x as [x Hx], y as [y Hy]; simpl; intros; subst.
   f_equal. apply proof_irrel.
 Qed.
+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)}
   (x : sig P) p : `x ↾ p = x.
 Proof. apply (sig_eq_pi _); reflexivity. Qed.

theories/propset.v → stdpp/propset.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file implements sets as functions into Prop. *)
 From stdpp Require Export sets.
-Set Default Proof Using "Type".
+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_set : Set_ A (propset A).
-Proof. split; [split | |]; by repeat intro. Qed.
+Global Instance propset_top_set {A} : TopSet A (propset A).
+Proof. split; [split; [split| |]|]; by repeat intro. Qed.
 
-Lemma elem_of_top {A} (x : A) : x ∈ (⊤ : propset A) ↔ True.
-Proof. done. Qed.
 Lemma elem_of_PropSet {A} (P : A → Prop) x : x ∈ {[ x | P x ]} ↔ P x.
 Proof. done. Qed.
 Lemma not_elem_of_PropSet {A} (P : A → Prop) x : x ∉ {[ x | P x ]} ↔ ¬P x.
 Proof. done. Qed.
-Lemma top_subseteq {A} (X : propset A) : X ⊆ ⊤.
-Proof. done. Qed.
-Hint Resolve top_subseteq : core.
 
 Definition set_to_propset `{ElemOf A C} (X : C) : propset A :=
   {[ x | x ∈ X ]}.
@@ -40,19 +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_top {A} (x : A) : SetUnfoldElemOf x (⊤ : propset A) True.
-Proof. by constructor. 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.
 

theories/relations.v → stdpp/relations.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file collects definitions and theorems on abstract rewriting systems.
 These are particularly useful as we define the operational semantics as a
 small step semantics. *)
-From Coq Require Import Wf_nat.
-From stdpp Require Export tactics base.
-Set Default Proof Using "Type".
+From stdpp Require Export sets well_founded.
+From stdpp Require Import options.
 
 (** * Definitions *)
 Section definitions.
@@ -59,7 +56,9 @@ End definitions.
 (** The reflexive transitive symmetric closure. *)
 Definition rtsc {A} (R : relation A) := rtc (sc R).
 
-(** Strongly normalizing elements. *)
+(** Weakly and strongly normalizing elements. *)
+Definition wn {A} (R : relation A) (x : A) := ∃ y, rtc R x y ∧ nf R y.
+
 Notation sn R := (Acc (flip R)).
 
 (** The various kinds of "confluence" properties. Any relation that has the
@@ -75,14 +74,15 @@ Definition confluent {A} (R : relation A) :=
 Definition locally_confluent {A} (R : relation A) :=
   ∀ x y1 y2, R x y1 → R x y2 → ∃ z, rtc R y1 z ∧ rtc R y2 z.
 
-Hint Unfold nf red : core.
+Global Hint Unfold nf red : core.
 
 (** * General theorems *)
-Section closure.
+Section general.
   Context `{R : relation A}.
 
-  Hint Constructors rtc nsteps bsteps tc : core.
+  Local Hint Constructors rtc nsteps bsteps tc : core.
 
+  (** ** Results about the reflexive-transitive closure [rtc] *)
   Lemma rtc_transitive x y z : rtc R x y → rtc R y z → rtc R x z.
   Proof. induction 1; eauto. Qed.
 
@@ -95,7 +95,7 @@ Section closure.
      See Coq bug https://github.com/coq/coq/issues/7916 and the test
      [tests.typeclasses.test_setoid_rewrite]. *)
   Global Instance rtc_po : PreOrder (rtc R) | 10.
-  Proof. split. exact (@rtc_refl A R). exact rtc_transitive. Qed.
+  Proof. split; [exact (@rtc_refl A R) | exact rtc_transitive]. Qed.
 
   (* Not an instance, related to the issue described above, this sometimes makes
   [setoid_rewrite] queries loop. *)
@@ -110,7 +110,7 @@ Section closure.
   Lemma rtc_r x y z : rtc R x y → R y z → rtc R x z.
   Proof. intros. etrans; eauto. Qed.
   Lemma rtc_inv x z : rtc R x z → x = z ∨ ∃ y, R x y ∧ rtc R y z.
-  Proof. inversion_clear 1; eauto. Qed.
+  Proof. inv 1; eauto. Qed.
   Lemma rtc_ind_l (P : A → Prop) (z : A)
     (Prefl : P z) (Pstep : ∀ x y, R x y → rtc R y z → P y → P x) :
     ∀ x, rtc R x z → P x.
@@ -133,68 +133,62 @@ Section closure.
   Proof. revert z. apply rtc_ind_r; eauto. Qed.
 
   Lemma rtc_nf x y : rtc R x y → nf R x → x = y.
-  Proof. destruct 1 as [x|x y1 y2]. done. intros []; eauto. Qed.
+  Proof. destruct 1 as [x|x y1 y2]; [done|]. intros []; eauto. Qed.
 
   Lemma rtc_congruence {B} (f : A → B) (R' : relation B) x y :
     (∀ x y, R x y → R' (f x) (f y)) → rtc R x y → rtc R' (f x) (f y).
   Proof. induction 2; econstructor; eauto. Qed.
 
+  (** ** Results about [nsteps] *)
   Lemma nsteps_once x y : R x y → nsteps R 1 x y.
   Proof. eauto. Qed.
   Lemma nsteps_once_inv x y : nsteps R 1 x y → R x y.
-  Proof. inversion 1 as [|???? Hhead Htail]; inversion Htail; by subst. Qed.
+  Proof. inv 1 as [|???? Hhead Htail]; by inv Htail. Qed.
   Lemma nsteps_trans n m x y z :
     nsteps R n x y → nsteps R m y z → nsteps R (n + m) x z.
   Proof. induction 1; simpl; eauto. Qed.
   Lemma nsteps_r n x y z : nsteps R n x y → R y z → nsteps R (S n) x z.
   Proof. induction 1; eauto. Qed.
-  Lemma nsteps_rtc n x y : nsteps R n x y → rtc R x y.
-  Proof. induction 1; eauto. Qed.
-  Lemma rtc_nsteps x y : rtc R x y → ∃ n, nsteps R n x y.
-  Proof. induction 1; firstorder eauto. Qed.
 
-  Lemma nsteps_plus_inv n m x z :
+  Lemma nsteps_add_inv n m x z :
     nsteps R (n + m) x z → ∃ y, nsteps R n x y ∧ nsteps R m y z.
   Proof.
     revert x.
     induction n as [|n IH]; intros x Hx; simpl; [by eauto|].
-    inversion Hx; naive_solver.
+    inv Hx; naive_solver.
   Qed.
 
   Lemma nsteps_inv_r n x z : nsteps R (S n) x z → ∃ y, nsteps R n x y ∧ R y z.
   Proof.
     rewrite <- PeanoNat.Nat.add_1_r.
-    intros (?&?&?%nsteps_once_inv)%nsteps_plus_inv; eauto.
+    intros (?&?&?%nsteps_once_inv)%nsteps_add_inv; eauto.
   Qed.
 
   Lemma nsteps_congruence {B} (f : A → B) (R' : relation B) n x y :
     (∀ x y, R x y → R' (f x) (f y)) → nsteps R n x y → nsteps R' n (f x) (f y).
   Proof. induction 2; econstructor; eauto. Qed.
 
+  (** ** Results about [bsteps] *)
   Lemma bsteps_once n x y : R x y → bsteps R (S n) x y.
   Proof. eauto. Qed.
-  Lemma bsteps_plus_r n m x y :
+  Lemma bsteps_add_r n m x y :
     bsteps R n x y → bsteps R (n + m) x y.
   Proof. induction 1; simpl; eauto. Qed.
   Lemma bsteps_weaken n m x y :
     n ≤ m → bsteps R n x y → bsteps R m x y.
   Proof.
-    intros. rewrite (Minus.le_plus_minus n m); auto using bsteps_plus_r.
+    intros. rewrite (Nat.le_add_sub n m); auto using bsteps_add_r.
   Qed.
-  Lemma bsteps_plus_l n m x y :
+  Lemma bsteps_add_l n m x y :
     bsteps R n x y → bsteps R (m + n) x y.
   Proof. apply bsteps_weaken. auto with arith. Qed.
   Lemma bsteps_S n x y :  bsteps R n x y → bsteps R (S n) x y.
   Proof. apply bsteps_weaken. lia. Qed.
   Lemma bsteps_trans n m x y z :
     bsteps R n x y → bsteps R m y z → bsteps R (n + m) x z.
-  Proof. induction 1; simpl; eauto using bsteps_plus_l. Qed.
+  Proof. induction 1; simpl; eauto using bsteps_add_l. Qed.
   Lemma bsteps_r n x y z : bsteps R n x y → R y z → bsteps R (S n) x z.
   Proof. induction 1; eauto. Qed.
-  Lemma bsteps_rtc n x y : bsteps R n x y → rtc R x y.
-  Proof. induction 1; eauto. Qed.
-  Lemma rtc_bsteps x y : rtc R x y → ∃ n, bsteps R n x y.
-  Proof. induction 1; [exists 0; constructor|]. naive_solver eauto. Qed.
   Lemma bsteps_ind_r (P : nat → A → Prop) (x : A)
     (Prefl : ∀ n, P n x)
     (Pstep : ∀ n y z, bsteps R n x y → R y z → P n y → P (S n) z) :
@@ -202,7 +196,7 @@ Section closure.
   Proof.
     cut (∀ m y z, bsteps R m y z → ∀ n,
       bsteps R n x y → (∀ m', n ≤ m' ∧ m' ≤ n + m → P m' y) → P (n + m) z).
-    { intros help ?. change n with (0 + n). eauto. }
+    { intros help n. change n with (0 + n). eauto. }
     induction 1 as [|m x' y z p2 p3 IH]; [by eauto with arith|].
     intros n p1 H. rewrite <-plus_n_Sm.
     apply (IH (S n)); [by eauto using bsteps_r |].
@@ -216,6 +210,7 @@ Section closure.
     (∀ x y, R x y → R' (f x) (f y)) → bsteps R n x y → bsteps R' n (f x) (f y).
   Proof. induction 2; econstructor; eauto. Qed.
 
+  (** ** Results about the transitive closure [tc] *)
   Lemma tc_transitive x y z : tc R x y → tc R y z → tc R x z.
   Proof. induction 1; eauto. Qed.
   Global Instance tc_transitive' : Transitive (tc R).
@@ -229,10 +224,18 @@ Section closure.
   Lemma tc_rtc x y : tc R x y → rtc R x y.
   Proof. induction 1; eauto. Qed.
 
+  Lemma red_tc x : red (tc R) x ↔ red R x.
+  Proof.
+    split.
+    - intros [y []]; eexists; eauto.
+    - intros [y HR]. exists y. by apply tc_once.
+  Qed.
+
   Lemma tc_congruence {B} (f : A → B) (R' : relation B) x y :
     (∀ x y, R x y → R' (f x) (f y)) → tc R x y → tc R' (f x) (f y).
   Proof. induction 2; econstructor; by eauto. Qed.
 
+  (** ** Results about the symmetric closure [sc] *)
   Global Instance sc_symmetric : Symmetric (sc R).
   Proof. unfold Symmetric, sc. naive_solver. Qed.
 
@@ -245,11 +248,120 @@ Section closure.
     (∀ x y, R x y → R' (f x) (f y)) → sc R x y → sc R' (f x) (f y).
   Proof. induction 2; econstructor; by eauto. Qed.
 
-End closure.
+  (** ** Equivalences between closure operators *)
+  Lemma bsteps_nsteps n x y : bsteps R n x y ↔ ∃ n', n' ≤ n ∧ nsteps R n' x y.
+  Proof.
+    split.
+    - induction 1 as [|n x1 x2 y ?? (n'&?&?)].
+      + exists 0; naive_solver eauto with lia.
+      + exists (S n'); naive_solver eauto with lia.
+    - intros (n'&Hn'&Hsteps). apply bsteps_weaken with n'; [done|].
+      clear Hn'. induction Hsteps; eauto.
+  Qed.
+
+  Lemma tc_nsteps x y : tc R x y ↔ ∃ n, 0 < n ∧ nsteps R n x y.
+  Proof.
+    split.
+    - induction 1 as [|x1 x2 y ?? (n&?&?)].
+      { exists 1. eauto using nsteps_once with lia. }
+      exists (S n); eauto using nsteps_l.
+    - intros (n & ? & Hstep). induction Hstep as [|n x1 x2 y ? Hstep]; [lia|].
+      destruct Hstep; eauto with lia.
+  Qed.
+
+  Lemma rtc_tc x y : rtc R x y ↔ x = y ∨ tc R x y.
+  Proof.
+    split; [|naive_solver eauto using tc_rtc].
+    induction 1; naive_solver.
+  Qed.
+
+  Lemma rtc_nsteps x y : rtc R x y ↔ ∃ n, nsteps R n x y.
+  Proof.
+    split.
+    - induction 1; naive_solver.
+    - intros [n Hsteps]. induction Hsteps; naive_solver.
+  Qed.
+  Lemma rtc_nsteps_1 x y : rtc R x y → ∃ n, nsteps R n x y.
+  Proof. rewrite rtc_nsteps. naive_solver. Qed.
+  Lemma rtc_nsteps_2 n x y : nsteps R n x y → rtc R x y.
+  Proof. rewrite rtc_nsteps. naive_solver. Qed.
+
+  Lemma rtc_bsteps x y : rtc R x y ↔ ∃ n, bsteps R n x y.
+  Proof. rewrite rtc_nsteps. setoid_rewrite bsteps_nsteps. naive_solver. Qed.
+  Lemma rtc_bsteps_1 x y : rtc R x y → ∃ n, bsteps R n x y.
+  Proof. rewrite rtc_bsteps. naive_solver. Qed.
+  Lemma rtc_bsteps_2 n x y : bsteps R n x y → rtc R x y.
+  Proof. rewrite rtc_bsteps. naive_solver. Qed.
+
+  Lemma nsteps_list n x y :
+    nsteps R n x y ↔ ∃ l,
+      length l = S n ∧
+      head l = Some x ∧
+      last l = Some y ∧
+      ∀ i a b, l !! i = Some a → l !! S i = Some b → R a b.
+  Proof.
+    setoid_rewrite head_lookup. split.
+    - induction 1 as [x|n' x x' y ?? IH].
+      { exists [x]; naive_solver. }
+      destruct IH as (l & Hlen & Hfirst & Hlast & Hcons).
+      exists (x :: l). simpl. rewrite Hlen, last_cons, Hlast.
+      split_and!; [done..|]. intros [|i]; naive_solver.
+    - intros ([|x' l]&?&Hfirst&Hlast&Hcons); simplify_eq/=.
+      revert x Hlast Hcons.
+      induction l as [|x1 l IH]; intros x2 Hlast Hcons; simplify_eq/=; [constructor|].
+      econstructor; [by apply (Hcons 0)|].
+      apply IH; [done|]. intros i. apply (Hcons (S i)).
+  Qed.
+
+  Lemma bsteps_list n x y :
+    bsteps R n x y ↔ ∃ l,
+      length l ≤ S n ∧
+      head l = Some x ∧
+      last l = Some y ∧
+      ∀ i a b, l !! i = Some a → l !! S i = Some b → R a b.
+  Proof.
+    rewrite bsteps_nsteps. split.
+    - intros (n'&?&(l&?&?&?&?)%nsteps_list). exists l; eauto with lia.
+    - intros (l&?&?&?&?). exists (pred (length l)). split; [lia|].
+      apply nsteps_list. exists l. split; [|by eauto]. by destruct l.
+  Qed.
+
+  Lemma rtc_list x y :
+    rtc R x y ↔ ∃ l,
+      head l = Some x ∧
+      last l = Some y ∧
+      ∀ i a b, l !! i = Some a → l !! S i = Some b → R a b.
+  Proof.
+    rewrite rtc_bsteps. split.
+    - intros (n'&(l&?&?&?&?)%bsteps_list). exists l; eauto with lia.
+    - intros (l&?&?&?). exists (pred (length l)).
+      apply bsteps_list. exists l. eauto with lia.
+  Qed.
+
+  Lemma tc_list x y :
+    tc R x y ↔ ∃ l,
+      1 < length l ∧
+      head l = Some x ∧
+      last l = Some y ∧
+      ∀ i a b, l !! i = Some a → l !! S i = Some b → R a b.
+  Proof.
+    rewrite tc_nsteps. split.
+    - intros (n'&?&(l&?&?&?&?)%nsteps_list). exists l; eauto with lia.
+    - intros (l&?&?&?&?). exists (pred (length l)).
+      split; [lia|]. apply nsteps_list. exists l. eauto with lia.
+  Qed.
 
-Section more_closure.
+  Lemma ex_loop_inv x :
+    ex_loop R x →
+    ∃ x', R x x' ∧ ex_loop R x'.
+  Proof. inv 1; eauto. Qed.
+
+End general.
+
+Section more_general.
   Context `{R : relation A}.
 
+  (** ** Results about the reflexive-transitive-symmetric closure [rtsc] *)
   Global Instance rtsc_equivalence : Equivalence (rtsc R) | 10.
   Proof. apply rtc_equivalence, _. Qed.
 
@@ -266,15 +378,68 @@ Section more_closure.
     (∀ x y, R x y → R' (f x) (f y)) → rtsc R x y → rtsc R' (f x) (f y).
   Proof. unfold rtsc; eauto using rtc_congruence, sc_congruence. Qed.
 
-End more_closure.
+  Lemma ex_loop_tc x :
+    ex_loop (tc R) x ↔ ex_loop R x.
+  Proof.
+    split.
+    - revert x; cofix IH.
+      intros x (y & Hstep & Hloop')%ex_loop_inv.
+      destruct Hstep as [x y Hstep|x y z Hstep Hsteps].
+      + econstructor; eauto.
+      + econstructor; [by eauto|].
+        eapply IH. econstructor; eauto.
+    - revert x; cofix IH.
+      intros x (y & Hstep & Hloop')%ex_loop_inv.
+      econstructor; eauto using tc_once.
+  Qed.
+
+End more_general.
 
 Section properties.
   Context `{R : relation A}.
 
-  Hint Constructors rtc nsteps bsteps tc : core.
+  Local Hint Constructors rtc nsteps bsteps tc : core.
 
-  Lemma acc_not_ex_loop x : Acc (flip R) x → ¬ex_loop R x.
-  Proof. unfold not. induction 1; destruct 1; eauto. Qed.
+  Lemma nf_wn x : nf R x → wn R x.
+  Proof. intros. exists x; eauto. Qed.
+  Lemma wn_step x y : wn R y → R x y → wn R x.
+  Proof. intros (z & ? & ?) ?. exists z; eauto. Qed.
+  Lemma wn_step_rtc x y : wn R y → rtc R x y → wn R x.
+  Proof. induction 2; eauto using wn_step. Qed.
+
+  Lemma nf_sn x : nf R x → sn R x.
+  Proof. intros Hnf. constructor; intros y Hxy. destruct Hnf; eauto. Qed.
+  Lemma sn_step x y : sn R x → R x y → sn R y.
+  Proof. induction 1; eauto. Qed.
+  Lemma sn_step_rtc x y : sn R x → rtc R x y → sn R y.
+  Proof. induction 2; eauto using sn_step. Qed.
+
+  (** An acyclic relation that can only take finitely many steps (sometimes
+  called "globally finite") is strongly normalizing *)
+  Lemma tc_finite_sn x : Irreflexive (tc R) → pred_finite (tc R x) → sn R x.
+  Proof.
+    intros Hirr [xs Hfin]. remember (length xs) as n eqn:Hn.
+    revert x xs Hn Hfin.
+    induction (lt_wf n) as [n _ IH]; intros x xs -> Hfin.
+    constructor; simpl; intros x' Hxx'.
+    assert (x' ∈ xs) as (xs1&xs2&->)%elem_of_list_split by eauto using tc_once.
+    refine (IH (length xs1 + length xs2) _ _ (xs1 ++ xs2) _ _);
+      [rewrite length_app; simpl; lia..|].
+    intros x'' Hx'x''. opose proof* (Hfin x'') as Hx''; [by econstructor|].
+    cut (x' ≠ x''); [set_solver|].
+    intros ->. by apply (Hirr x'').
+  Qed.
+
+  (** The following theorem requires that [red R] is decidable. The intuition
+  for this requirement is that [wn R] is a very "positive" statement as it
+  points out a particular trace. In contrast, [sn R] just says "this also holds
+  for all successors", there is no "data"/"trace" there. *)
+  Lemma sn_wn `{!∀ y, Decision (red R y)} x : sn R x → wn R x.
+  Proof.
+    induction 1 as [x _ IH]. destruct (decide (red R x)) as [[x' ?]|?].
+    - destruct (IH x') as (y&?&?); eauto using wn_step.
+    - by apply nf_wn.
+  Qed.
 
   Lemma all_loop_red x : all_loop R x → red R x.
   Proof. destruct 1; auto. Qed.
@@ -290,6 +455,11 @@ Section properties.
     cofix FIX. constructor; eauto using rtc_r.
   Qed.
 
+  Lemma wn_not_all_loop x : wn R x → ¬all_loop R x.
+  Proof. intros (z&?&?). rewrite all_loop_alt. eauto. Qed.
+  Lemma sn_not_ex_loop x : sn R x → ¬ex_loop R x.
+  Proof. unfold not. induction 1; destruct 1; eauto. Qed.
+
   (** An alternative definition of confluence; also known as the Church-Rosser
   property. *)
   Lemma confluent_alt :
@@ -355,50 +525,3 @@ Section subrel.
   Lemma rtc_subrel x y : subrel → rtc R1 x y → rtc R2 x y.
   Proof. induction 2; [by apply rtc_refl|]. eapply rtc_l; eauto. Qed.
 End subrel.
-
-(** * Theorems on well founded relations *)
-Lemma Acc_impl {A} (R1 R2 : relation A) x :
-  Acc R1 x → (∀ y1 y2, R2 y1 y2 → R1 y1 y2) → Acc R2 x.
-Proof. induction 1; constructor; naive_solver. Qed.
-
-Notation wf := well_founded.
-Definition wf_guard `{R : relation A} (n : nat) (wfR : wf R) : wf R :=
-  Acc_intro_generator n wfR.
-
-(* Generally we do not want [wf_guard] to be expanded (neither by tactics,
-nor by conversion tests in the kernel), but in some cases we do need it for
-computation (that is, we cannot make it opaque). We use the [Strategy]
-command to make its expanding behavior less eager. *)
-Strategy 100 [wf_guard].
-
-Lemma wf_projected `{R1 : relation A} `(R2 : relation B) (f : A → B) :
-  (∀ x y, R1 x y → R2 (f x) (f y)) →
-  wf R2 → wf R1.
-Proof.
-  intros Hf Hwf.
-  cut (∀ y, Acc R2 y → ∀ x, y = f x → Acc R1 x).
-  { intros aux x. apply (aux (f x)); auto. }
-  induction 1 as [y _ IH]. intros x ?. subst.
-  constructor. intros. apply (IH (f y)); auto.
-Qed.
-
-Lemma Fix_F_proper `{R : relation A} (B : A → Type) (E : ∀ x, relation (B x))
-    (F : ∀ x, (∀ y, R y x → B y) → B x)
-    (HF : ∀ (x : A) (f g : ∀ y, R y x → B y),
-      (∀ y Hy Hy', E _ (f y Hy) (g y Hy')) → E _ (F x f) (F x g))
-    (x : A) (acc1 acc2 : Acc R x) :
-  E _ (Fix_F B F acc1) (Fix_F B F acc2).
-Proof. revert x acc1 acc2. fix FIX 2. intros x [acc1] [acc2]; simpl; auto. Qed.
-
-Lemma Fix_unfold_rel `{R : relation A} (wfR : wf R) (B : A → Type) (E : ∀ x, relation (B x))
-    (F: ∀ x, (∀ y, R y x → B y) → B x)
-    (HF: ∀ (x: A) (f g: ∀ y, R y x → B y),
-           (∀ y Hy Hy', E _ (f y Hy) (g y Hy')) → E _ (F x f) (F x g))
-    (x: A) :
-  E _ (Fix wfR B F x) (F x (λ y _, Fix wfR B F y)).
-Proof.
-  unfold Fix.
-  destruct (wfR x); simpl.
-  apply HF; intros.
-  apply Fix_F_proper; auto.
-Qed.

theories/sets.v → stdpp/sets.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** This file collects definitions and theorems on sets. Most
 importantly, it implements some tactics to automatically solve goals involving
 sets. *)
-From stdpp Require Export orders list.
-(* FIXME: This file needs a 'Proof Using' hint, but the default we use
-   everywhere makes for lots of extra ssumptions. *)
+From stdpp Require Export orders list list_numbers.
+From stdpp Require Import finite.
+From stdpp Require Import options.
+
+(* FIXME: This file needs a 'Proof Using' hint, but they need to be set
+locally (or things moved out of sections) as no default works well enough. *)
+Unset Default Proof Using.
 
 (* Higher precedence to make sure these instances are not used for other types
 with an [ElemOf] instance, such as lists. *)
-Instance set_equiv `{ElemOf A C} : Equiv C | 20 := λ X Y,
+Global Instance set_equiv_instance `{ElemOf A C} : Equiv C | 20 := λ X Y,
   ∀ x, x ∈ X ↔ x ∈ Y.
-Instance set_subseteq `{ElemOf A C} : SubsetEq C | 20 := λ X Y,
+Global Instance set_subseteq_instance `{ElemOf A C} : SubsetEq C | 20 := λ X Y,
   ∀ x, x ∈ X → x ∈ Y.
-Instance set_disjoint `{ElemOf A C} : Disjoint C | 20 := λ X Y,
+Global Instance set_disjoint_instance `{ElemOf A C} : Disjoint C | 20 := λ X Y,
   ∀ x, x ∈ X → x ∈ Y → False.
-Typeclasses Opaque set_equiv set_subseteq set_disjoint.
+Global Typeclasses Opaque set_equiv_instance set_subseteq_instance set_disjoint_instance.
 
 (** * Setoids *)
 Section setoids_simple.
@@ -44,6 +46,8 @@ Section setoids_simple.
   Proof.
     intros X1 X2 HX Y1 Y2 HY. apply forall_proper; intros x. by rewrite HX, HY.
   Qed.
+  Global Instance subset_proper : Proper ((≡@{C}) ==> (≡@{C}) ==> iff) (⊂).
+  Proof. solve_proper. Qed.
 End setoids_simple.
 
 Section setoids.
@@ -91,29 +95,29 @@ involving just [∈]. For example, [A → x ∈ X ∪ ∅] becomes [A → x ∈
 
 This transformation is implemented using type classes instead of setoid
 rewriting to ensure that we traverse each term at most once and to be able to
-deal with occurences of the set operations under binders. *)
+deal with occurrences of the set operations under binders. *)
 Class SetUnfold (P Q : Prop) := { set_unfold : P ↔ Q }.
-Arguments set_unfold _ _ {_} : assert.
-Hint Mode SetUnfold + - : typeclass_instances.
+Global Arguments set_unfold _ _ {_} : assert.
+Global Hint Mode SetUnfold + - : typeclass_instances.
 
 (** The class [SetUnfoldElemOf] is a more specialized version of [SetUnfold]
 for propositions of the shape [x ∈ X] to improve performance. *)
 Class SetUnfoldElemOf `{ElemOf A C} (x : A) (X : C) (Q : Prop) :=
   { set_unfold_elem_of : x ∈ X ↔ Q }.
-Arguments set_unfold_elem_of {_ _ _} _ _ _ {_} : assert.
-Hint Mode SetUnfoldElemOf + + + - + - : typeclass_instances.
+Global Arguments set_unfold_elem_of {_ _ _} _ _ _ {_} : assert.
+Global Hint Mode SetUnfoldElemOf + + + - + - : typeclass_instances.
 
-Instance set_unfold_elem_of_default `{ElemOf A C} (x : A) (X : C) :
+Global Instance set_unfold_elem_of_default `{ElemOf A C} (x : A) (X : C) :
   SetUnfoldElemOf x X (x ∈ X) | 1000.
 Proof. done. Qed.
-Instance set_unfold_elem_of_set_unfold `{ElemOf A C} (x : A) (X : C) Q :
+Global Instance set_unfold_elem_of_set_unfold `{ElemOf A C} (x : A) (X : C) Q :
   SetUnfoldElemOf x X Q → SetUnfold (x ∈ X) Q.
 Proof. by destruct 1; constructor. Qed.
 
 Class SetUnfoldSimpl (P Q : Prop) := { set_unfold_simpl : SetUnfold P Q }.
-Hint Extern 0 (SetUnfoldSimpl _ _) => csimpl; constructor : typeclass_instances.
+Global Hint Extern 0 (SetUnfoldSimpl _ _) => csimpl; constructor : typeclass_instances.
 
-Instance set_unfold_default P : SetUnfold P P | 1000. done. Qed.
+Global Instance set_unfold_default P : SetUnfold P P | 1000. done. Qed.
 Definition set_unfold_1 `{SetUnfold P Q} : P → Q := proj1 (set_unfold P Q).
 Definition set_unfold_2 `{SetUnfold P Q} : Q → P := proj2 (set_unfold P Q).
 
@@ -140,19 +144,19 @@ Proof. constructor. naive_solver. Qed.
 
 (* Avoid too eager application of the above instances (and thus too eager
 unfolding of type class transparent definitions). *)
-Hint Extern 0 (SetUnfold (_ → _) _) =>
+Global Hint Extern 0 (SetUnfold (_ → _) _) =>
   class_apply set_unfold_impl : typeclass_instances.
-Hint Extern 0 (SetUnfold (_ ∧ _) _) =>
+Global Hint Extern 0 (SetUnfold (_ ∧ _) _) =>
   class_apply set_unfold_and : typeclass_instances.
-Hint Extern 0 (SetUnfold (_ ∨ _) _) =>
+Global Hint Extern 0 (SetUnfold (_ ∨ _) _) =>
   class_apply set_unfold_or : typeclass_instances.
-Hint Extern 0 (SetUnfold (_ ↔ _) _) =>
+Global Hint Extern 0 (SetUnfold (_ ↔ _) _) =>
   class_apply set_unfold_iff : typeclass_instances.
-Hint Extern 0 (SetUnfold (¬ _) _) =>
+Global Hint Extern 0 (SetUnfold (¬ _) _) =>
   class_apply set_unfold_not : typeclass_instances.
-Hint Extern 1 (SetUnfold (∀ _, _) _) =>
+Global Hint Extern 1 (SetUnfold (∀ _, _) _) =>
   class_apply set_unfold_forall : typeclass_instances.
-Hint Extern 0 (SetUnfold (∃ _, _) _) =>
+Global Hint Extern 0 (SetUnfold (∃ _, _) _) =>
   class_apply set_unfold_exist : typeclass_instances.
 
 Section set_unfold_simple.
@@ -161,7 +165,7 @@ Section set_unfold_simple.
   Implicit Types X Y : C.
 
   Global Instance set_unfold_empty x : SetUnfoldElemOf x (∅ : C) False.
-  Proof. constructor. split. apply not_elem_of_empty. done. Qed.
+  Proof. constructor. split; [|done]. apply not_elem_of_empty. Qed.
   Global Instance set_unfold_singleton x y : SetUnfoldElemOf x ({[ y ]} : C) (x = y).
   Proof. constructor; apply elem_of_singleton. Qed.
   Global Instance set_unfold_union x X Y P Q :
@@ -177,16 +181,16 @@ Section set_unfold_simple.
   Global Instance set_unfold_equiv_empty_l X (P : A → Prop) :
     (∀ x, SetUnfoldElemOf x X (P x)) → SetUnfold (∅ ≡ X) (∀ x, ¬P x) | 5.
   Proof.
-    intros ?; constructor. unfold equiv, set_equiv.
+    intros ?; constructor. unfold equiv, set_equiv_instance.
     pose proof (not_elem_of_empty (C:=C)); naive_solver.
   Qed.
   Global Instance set_unfold_equiv_empty_r (P : A → Prop) X :
     (∀ x, SetUnfoldElemOf x X (P x)) → SetUnfold (X ≡ ∅) (∀ x, ¬P x) | 5.
   Proof.
-    intros ?; constructor. unfold equiv, set_equiv.
+    intros ?; constructor. unfold equiv, set_equiv_instance.
     pose proof (not_elem_of_empty (C:=C)); naive_solver.
   Qed.
-  Global Instance set_unfold_equiv (P Q : A → Prop) X :
+  Global Instance set_unfold_equiv (P Q : A → Prop) X Y :
     (∀ x, SetUnfoldElemOf x X (P x)) → (∀ x, SetUnfoldElemOf x Y (Q x)) →
     SetUnfold (X ≡ Y) (∀ x, P x ↔ Q x) | 10.
   Proof. constructor. apply forall_proper; naive_solver. Qed.
@@ -194,7 +198,7 @@ Section set_unfold_simple.
     (∀ x, SetUnfoldElemOf x X (P x)) → (∀ x, SetUnfoldElemOf x Y (Q x)) →
     SetUnfold (X ⊆ Y) (∀ x, P x → Q x).
   Proof. constructor. apply forall_proper; naive_solver. Qed.
-  Global Instance set_unfold_subset (P Q : A → Prop) X :
+  Global Instance set_unfold_subset (P Q : A → Prop) X Y :
     (∀ x, SetUnfoldElemOf x X (P x)) → (∀ x, SetUnfoldElemOf x Y (Q x)) →
     SetUnfold (X ⊂ Y) ((∀ x, P x → Q x) ∧ ¬∀ x, Q x → P x).
   Proof.
@@ -204,7 +208,7 @@ Section set_unfold_simple.
   Global Instance set_unfold_disjoint (P Q : A → Prop) X Y :
     (∀ x, SetUnfoldElemOf x X (P x)) → (∀ x, SetUnfoldElemOf x Y (Q x)) →
     SetUnfold (X ## Y) (∀ x, P x → Q x → False).
-  Proof. constructor. unfold disjoint, set_disjoint. naive_solver. Qed.
+  Proof. constructor. unfold disjoint, set_disjoint_instance. naive_solver. Qed.
 
   Context `{!LeibnizEquiv C}.
   Global Instance set_unfold_equiv_same_L X : SetUnfold (X = X) True | 1.
@@ -242,21 +246,25 @@ Section set_unfold.
   Qed.
 End set_unfold.
 
+Global Instance set_unfold_top `{TopSet A C} (x : A) :
+  SetUnfoldElemOf x (⊤ : C) True.
+Proof. constructor. split; [done|intros; apply elem_of_top']. Qed.
+
 Section set_unfold_monad.
   Context `{MonadSet M}.
 
   Global Instance set_unfold_ret {A} (x y : A) :
     SetUnfoldElemOf x (mret (M:=M) y) (x = y).
   Proof. constructor; apply elem_of_ret. Qed.
-  Global Instance set_unfold_bind {A B} (f : A → M B) X (P Q : A → Prop) :
+  Global Instance set_unfold_bind {A B} (f : A → M B) X (P Q : A → Prop) x :
     (∀ y, SetUnfoldElemOf y X (P y)) → (∀ y, SetUnfoldElemOf x (f y) (Q y)) →
     SetUnfoldElemOf x (X ≫= f) (∃ y, Q y ∧ P y).
   Proof. constructor. rewrite elem_of_bind; naive_solver. Qed.
-  Global Instance set_unfold_fmap {A B} (f : A → B) (X : M A) (P : A → Prop) :
+  Global Instance set_unfold_fmap {A B} (f : A → B) (X : M A) (P : A → Prop) x :
     (∀ y, SetUnfoldElemOf y X (P y)) →
     SetUnfoldElemOf x (f <$> X) (∃ y, x = f y ∧ P y).
   Proof. constructor. rewrite elem_of_fmap; naive_solver. Qed.
-  Global Instance set_unfold_join {A} (X : M (M A)) (P : M A → Prop) :
+  Global Instance set_unfold_join {A} (X : M (M A)) (P : M A → Prop) x :
     (∀ Y, SetUnfoldElemOf Y X (P Y)) →
     SetUnfoldElemOf x (mjoin X) (∃ Y, x ∈ Y ∧ P Y).
   Proof. constructor. rewrite elem_of_join; naive_solver. Qed.
@@ -279,6 +287,15 @@ Section set_unfold_list.
     intros ??; constructor.
     by rewrite elem_of_app, (set_unfold_elem_of x l P), (set_unfold_elem_of x k Q).
   Qed.
+  Global Instance set_unfold_list_cprod {B} (x : A * B) l (k : list B) P Q :
+    SetUnfoldElemOf x.1 l P → SetUnfoldElemOf x.2 k Q →
+    SetUnfoldElemOf x (cprod l k) (P ∧ Q).
+  Proof.
+    intros ??; constructor.
+    by rewrite elem_of_list_cprod, (set_unfold_elem_of x.1 l P),
+      (set_unfold_elem_of x.2 k Q).
+  Qed.
+
   Global Instance set_unfold_included l k (P Q : A → Prop) :
     (∀ x, SetUnfoldElemOf x l (P x)) → (∀ x, SetUnfoldElemOf x k (Q x)) →
     SetUnfold (l ⊆ k) (∀ x, P x → Q x).
@@ -291,16 +308,24 @@ Section set_unfold_list.
     SetUnfoldElemOf x l P → SetUnfoldElemOf x (reverse l) P.
   Proof. constructor. by rewrite elem_of_reverse, (set_unfold_elem_of x l P). Qed.
 
-  Global Instance set_unfold_list_fmap {B} (f : A → B) l P :
-    (∀ y, SetUnfoldElemOf y l (P y)) →
-    SetUnfoldElemOf x (f <$> l) (∃ y, x = f y ∧ P y).
+  Global Instance set_unfold_list_fmap {B} (f : A → B) l P y :
+    (∀ x, SetUnfoldElemOf x l (P x)) →
+    SetUnfoldElemOf y (f <$> l) (∃ x, y = f x ∧ P x).
   Proof.
-    constructor. rewrite elem_of_list_fmap. f_equiv; intros y.
-    by rewrite (set_unfold_elem_of y l (P y)).
+    constructor. rewrite elem_of_list_fmap. f_equiv; intros x.
+    by rewrite (set_unfold_elem_of x l (P x)).
   Qed.
+  Global Instance set_unfold_rotate x l P n:
+    SetUnfoldElemOf x l P → SetUnfoldElemOf x (rotate n l) P.
+  Proof. constructor. by rewrite elem_of_rotate, (set_unfold_elem_of x l P). Qed.
+
+  Global Instance set_unfold_list_bind {B} (f : A → list B) l P Q y :
+    (∀ x, SetUnfoldElemOf x l (P x)) → (∀ x, SetUnfoldElemOf y (f x) (Q x)) →
+    SetUnfoldElemOf y (l ≫= f) (∃ x, Q x ∧ P x).
+  Proof. constructor. rewrite elem_of_list_bind. naive_solver. Qed.
 End set_unfold_list.
 
-Ltac set_unfold :=
+Tactic Notation "set_unfold" :=
   let rec unfold_hyps :=
     try match goal with
     | H : ?P |- _ =>
@@ -313,6 +338,13 @@ Ltac set_unfold :=
     end in
   apply set_unfold_2; unfold_hyps; csimpl in *.
 
+Tactic Notation "set_unfold" "in" ident(H) :=
+  let P := type of H in
+  lazymatch type of P with
+  | Prop => apply set_unfold_1 in H
+  | _ => fail "hypothesis" H "is not a proposition"
+  end.
+
 (** Since [firstorder] already fails or loops on very small goals generated by
 [set_solver], we use the [naive_solver] tactic as a substitute. *)
 Tactic Notation "set_solver" "by" tactic3(tac) :=
@@ -326,13 +358,13 @@ Tactic Notation "set_solver" "-" hyp_list(Hs) "by" tactic3(tac) :=
   clear Hs; set_solver by tac.
 Tactic Notation "set_solver" "+" hyp_list(Hs) "by" tactic3(tac) :=
   clear -Hs; set_solver by tac.
-Tactic Notation "set_solver" := set_solver by idtac.
+Tactic Notation "set_solver" := set_solver by eauto.
 Tactic Notation "set_solver" "-" hyp_list(Hs) := clear Hs; set_solver.
 Tactic Notation "set_solver" "+" hyp_list(Hs) := clear -Hs; set_solver.
 
-Hint Extern 1000 (_ ∉ _) => set_solver : set_solver.
-Hint Extern 1000 (_ ∈ _) => set_solver : set_solver.
-Hint Extern 1000 (_ ⊆ _) => set_solver : set_solver.
+Global Hint Extern 1000 (_ ∉ _) => set_solver : set_solver.
+Global Hint Extern 1000 (_ ∈ _) => set_solver : set_solver.
+Global Hint Extern 1000 (_ ⊆ _) => set_solver : set_solver.
 
 
 (** * Sets with [∪], [∅] and [{[_]}] *)
@@ -343,17 +375,21 @@ Section semi_set.
   Implicit Types Xs Ys : list C.
 
   (** Equality *)
-  Lemma elem_of_equiv X Y : X ≡ Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
+  Lemma set_equiv X Y : X ≡ Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
   Proof. set_solver. Qed.
-  Lemma set_equiv_spec X Y : X ≡ Y ↔ X ⊆ Y ∧ Y ⊆ X.
+  Lemma set_equiv_subseteq X Y : X ≡ Y ↔ X ⊆ Y ∧ Y ⊆ X.
   Proof. set_solver. Qed.
+  Global Instance singleton_equiv_inj : Inj (=) (≡@{C}) singleton.
+  Proof. unfold Inj. set_solver. Qed.
+  Global Instance singleton_inj `{!LeibnizEquiv C} : Inj (=) (=@{C}) singleton.
+  Proof. unfold Inj. set_solver. Qed.
 
   (** Subset relation *)
   Global Instance set_subseteq_antisymm: AntiSymm (≡) (⊆@{C}).
   Proof. intros ??. set_solver. Qed.
 
   Global Instance set_subseteq_preorder: PreOrder (⊆@{C}).
-  Proof. split. by intros ??. intros ???; set_solver. Qed.
+  Proof. split; [by intros ??|]. intros ???; set_solver. Qed.
 
   Lemma subseteq_union X Y : X ⊆ Y ↔ X ∪ Y ≡ Y.
   Proof. set_solver. Qed.
@@ -364,8 +400,12 @@ Section semi_set.
 
   Lemma union_subseteq_l X Y : X ⊆ X ∪ Y.
   Proof. set_solver. Qed.
+  Lemma union_subseteq_l' X X' Y : X ⊆ X' → X ⊆ X' ∪ Y.
+  Proof. set_solver. Qed.
   Lemma union_subseteq_r X Y : Y ⊆ X ∪ Y.
   Proof. set_solver. Qed.
+  Lemma union_subseteq_r' X Y Y' : Y ⊆ Y' → Y ⊆ X ∪ Y'.
+  Proof. set_solver. Qed.
   Lemma union_least X Y Z : X ⊆ Z → Y ⊆ Z → X ∪ Y ⊆ Z.
   Proof. set_solver. Qed.
 
@@ -373,6 +413,11 @@ Section semi_set.
   Proof. done. Qed.
   Lemma elem_of_subset X Y : X ⊂ Y ↔ (∀ x, x ∈ X → x ∈ Y) ∧ ¬(∀ x, x ∈ Y → x ∈ X).
   Proof. set_solver. Qed.
+  Lemma elem_of_weaken x X Y : x ∈ X → X ⊆ Y → x ∈ Y.
+  Proof. set_solver. Qed.
+
+  Lemma not_elem_of_weaken x X Y : x ∉ Y → X ⊆ Y → x ∉ X.
+  Proof. set_solver. Qed.
 
   (** Union *)
   Lemma union_subseteq X Y Z : X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z.
@@ -414,7 +459,7 @@ Section semi_set.
   Proof. set_solver. Qed.
   Lemma elem_of_equiv_empty X : X ≡ ∅ ↔ ∀ x, x ∉ X.
   Proof. set_solver. Qed.
-  Lemma elem_of_empty x : x ∈ (∅ : C) ↔ False.
+  Lemma elem_of_empty x : x ∈@{C} ∅ ↔ False.
   Proof. set_solver. Qed.
   Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅.
   Proof. set_solver. Qed.
@@ -426,16 +471,25 @@ Section semi_set.
   Proof. set_solver. Qed.
 
   (** Singleton *)
-  Lemma elem_of_singleton_1 x y : x ∈ ({[y]} : C) → x = y.
+  Lemma elem_of_singleton_1 x y : x ∈@{C} {[y]} → x = y.
   Proof. by rewrite elem_of_singleton. Qed.
-  Lemma elem_of_singleton_2 x y : x = y → x ∈ ({[y]} : C).
+  Lemma elem_of_singleton_2 x y : x = y → x ∈@{C} {[y]}.
   Proof. by rewrite elem_of_singleton. Qed.
   Lemma elem_of_subseteq_singleton x X : x ∈ X ↔ {[ x ]} ⊆ X.
   Proof. set_solver. Qed.
-  Lemma non_empty_singleton x : ({[ x ]} : C) ≢ ∅.
+  Lemma non_empty_singleton x : {[ x ]} ≢@{C} ∅.
   Proof. set_solver. Qed.
-  Lemma not_elem_of_singleton x y : x ∉ ({[ y ]} : C) ↔ x ≠ y.
+  Lemma not_elem_of_singleton x y : x ∉@{C} {[ y ]} ↔ x ≠ y.
   Proof. by rewrite elem_of_singleton. Qed.
+  Lemma not_elem_of_singleton_1 x y : x ∉@{C} {[ y ]} → x ≠ y.
+  Proof. apply not_elem_of_singleton. Qed.
+  Lemma not_elem_of_singleton_2 x y : x ≠ y → x ∉@{C} {[ y ]}.
+  Proof. apply not_elem_of_singleton. Qed.
+
+  Lemma singleton_subseteq_l x X : {[ x ]} ⊆ X ↔ x ∈ X.
+  Proof. set_solver. Qed.
+  Lemma singleton_subseteq x y : {[ x ]} ⊆@{C} {[ y ]} ↔ x = y.
+  Proof. set_solver. Qed.
 
   (** Disjointness *)
   Lemma elem_of_disjoint X Y : X ## Y ↔ ∀ x, x ∈ X → x ∈ Y → False.
@@ -485,24 +539,25 @@ Section semi_set.
   Qed.
   Lemma union_list_mono Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
   Proof. induction 1; simpl; auto using union_mono. Qed.
+
   Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (.≡ ∅) Xs.
   Proof.
     split.
     - induction Xs; simpl; rewrite ?empty_union; intuition.
-    - induction 1 as [|?? E1 ? E2]; simpl. done. by apply empty_union.
+    - induction 1 as [|?? E1 ? E2]; simpl; [done|]. by apply empty_union.
   Qed.
 
   Section leibniz.
     Context `{!LeibnizEquiv C}.
 
-    Lemma elem_of_equiv_L X Y : X = Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
-    Proof. unfold_leibniz. apply elem_of_equiv. Qed.
-    Lemma set_equiv_spec_L X Y : X = Y ↔ X ⊆ Y ∧ Y ⊆ X.
-    Proof. unfold_leibniz. apply set_equiv_spec. Qed.
+    Lemma set_eq X Y : X = Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
+    Proof. unfold_leibniz. apply set_equiv. Qed.
+    Lemma set_eq_subseteq X Y : X = Y ↔ X ⊆ Y ∧ Y ⊆ X.
+    Proof. unfold_leibniz. apply set_equiv_subseteq. Qed.
 
     (** Subset relation *)
     Global Instance set_subseteq_partialorder : PartialOrder (⊆@{C}).
-    Proof. split. apply _. intros ??. unfold_leibniz. apply (anti_symm _). Qed.
+    Proof. split; [apply _|]. intros ??. unfold_leibniz. apply (anti_symm _). Qed.
 
     Lemma subseteq_union_L X Y : X ⊆ Y ↔ X ∪ Y = Y.
     Proof. unfold_leibniz. apply subseteq_union. Qed.
@@ -544,7 +599,7 @@ Section semi_set.
     Proof. unfold_leibniz. apply non_empty_inhabited. Qed.
 
     (** Singleton *)
-    Lemma non_empty_singleton_L x : {[ x ]} ≠ (∅ : C).
+    Lemma non_empty_singleton_L x : {[ x ]} ≠@{C} ∅.
     Proof. unfold_leibniz. apply non_empty_singleton. Qed.
 
     (** Big unions *)
@@ -554,32 +609,42 @@ Section semi_set.
     Proof. unfold_leibniz. apply union_list_app. Qed.
     Lemma union_list_reverse_L Xs : ⋃ (reverse Xs) = ⋃ Xs.
     Proof. unfold_leibniz. apply union_list_reverse. Qed.
+
     Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (.= ∅) Xs.
-    Proof. unfold_leibniz. by rewrite empty_union_list. Qed. 
+    Proof. unfold_leibniz. apply empty_union_list. Qed.
   End leibniz.
 
+  Lemma not_elem_of_iff `{!RelDecision (∈@{C})} X Y x :
+    (x ∈ X ↔ x ∈ Y) ↔ (x ∉ X ↔ x ∉ Y).
+  Proof. destruct (decide (x ∈ X)), (decide (x ∈ Y)); tauto. Qed.
+
   Section dec.
     Context `{!RelDecision (≡@{C})}.
+
     Lemma set_subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y.
     Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed.
     Lemma set_not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y.
     Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed.
 
     Lemma non_empty_union X Y : X ∪ Y ≢ ∅ ↔ X ≢ ∅ ∨ Y ≢ ∅.
-    Proof. rewrite empty_union. destruct (decide (X ≡ ∅)); intuition. Qed.
+    Proof. destruct (decide (X ≡ ∅)); set_solver. Qed.
     Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (.≢ ∅) Xs.
     Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed.
+  End dec.
+
+  Section dec_leibniz.
+    Context `{!RelDecision (≡@{C}), !LeibnizEquiv C}.
 
-    Context `{!LeibnizEquiv C}.
     Lemma set_subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y.
     Proof. unfold_leibniz. apply set_subseteq_inv. Qed.
     Lemma set_not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y.
     Proof. unfold_leibniz. apply set_not_subset_inv. Qed.
+
     Lemma non_empty_union_L X Y : X ∪ Y ≠ ∅ ↔ X ≠ ∅ ∨ Y ≠ ∅.
     Proof. unfold_leibniz. apply non_empty_union. Qed.
     Lemma non_empty_union_list_L Xs : ⋃ Xs ≠ ∅ → Exists (.≠ ∅) Xs.
     Proof. unfold_leibniz. apply non_empty_union_list. Qed.
-  End dec.
+  End dec_leibniz.
 End semi_set.
 
 
@@ -591,7 +656,7 @@ Section set.
 
   (** Intersection *)
   Lemma subseteq_intersection X Y : X ⊆ Y ↔ X ∩ Y ≡ X.
-  Proof. set_solver. Qed. 
+  Proof. set_solver. Qed.
   Lemma subseteq_intersection_1 X Y : X ⊆ Y → X ∩ Y ≡ X.
   Proof. apply subseteq_intersection. Qed.
   Lemma subseteq_intersection_2 X Y : X ∩ Y ≡ X → X ⊆ Y.
@@ -623,7 +688,7 @@ Section set.
   Global Instance intersection_empty_r: RightAbsorb (≡@{C}) ∅ (∩).
   Proof. intros X; set_solver. Qed.
 
-  Lemma intersection_singletons x : ({[x]} : C) ∩ {[x]} ≡ {[x]}.
+  Lemma intersection_singletons x : {[x]} ∩ {[x]} ≡@{C} {[x]}.
   Proof. set_solver. Qed.
 
   Lemma union_intersection_l X Y Z : X ∪ (Y ∩ Z) ≡ (X ∪ Y) ∩ (X ∪ Z).
@@ -652,9 +717,9 @@ Section set.
   Proof. set_solver. Qed.
   Lemma difference_disjoint X Y : X ## Y → X ∖ Y ≡ X.
   Proof. set_solver. Qed.
-  Lemma subset_difference_elem_of {x: A} {s: C} (inx: x ∈ s): s ∖ {[ x ]} ⊂ s.
+  Lemma subset_difference_elem_of x X : x ∈ X → X ∖ {[ x ]} ⊂ X.
   Proof. set_solver. Qed.
-  Lemma difference_difference X Y Z : (X ∖ Y) ∖ Z ≡ X ∖ (Y ∪ Z).
+  Lemma difference_difference_l X Y Z : (X ∖ Y) ∖ Z ≡ X ∖ (Y ∪ Z).
   Proof. set_solver. Qed.
 
   Lemma difference_mono X1 X2 Y1 Y2 :
@@ -705,7 +770,7 @@ Section set.
     Global Instance intersection_empty_r_L: RightAbsorb (=@{C}) ∅ (∩).
     Proof. intros ?. unfold_leibniz. apply (right_absorb _ _). Qed.
 
-    Lemma intersection_singletons_L x : {[x]} ∩ {[x]} = ({[x]} : C).
+    Lemma intersection_singletons_L x : {[x]} ∩ {[x]} =@{C} {[x]}.
     Proof. unfold_leibniz. apply intersection_singletons. Qed.
 
     Lemma union_intersection_l_L X Y Z : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z).
@@ -735,8 +800,8 @@ Section set.
     Proof. unfold_leibniz. apply difference_intersection_distr_l. Qed.
     Lemma difference_disjoint_L X Y : X ## Y → X ∖ Y = X.
     Proof. unfold_leibniz. apply difference_disjoint. Qed.
-    Lemma difference_difference_L X Y Z : (X ∖ Y) ∖ Z = X ∖ (Y ∪ Z).
-    Proof. unfold_leibniz. apply difference_difference. Qed.
+    Lemma difference_difference_l_L X Y Z : (X ∖ Y) ∖ Z = X ∖ (Y ∪ Z).
+    Proof. unfold_leibniz. apply difference_difference_l. Qed.
 
     (** Disjointness *)
     Lemma disjoint_intersection_L X Y : X ## Y ↔ X ∩ Y = ∅.
@@ -745,6 +810,7 @@ Section set.
 
   Section dec.
     Context `{!RelDecision (∈@{C})}.
+
     Lemma not_elem_of_intersection x X Y : x ∉ X ∩ Y ↔ x ∉ X ∨ x ∉ Y.
     Proof. rewrite elem_of_intersection. destruct (decide (x ∈ X)); tauto. Qed.
     Lemma not_elem_of_difference x X Y : x ∉ X ∖ Y ↔ x ∉ X ∨ x ∈ Y.
@@ -754,11 +820,18 @@ Section set.
       intros ? x; split; rewrite !elem_of_union, elem_of_difference; [|intuition].
       destruct (decide (x ∈ X)); intuition.
     Qed.
+    Lemma union_difference_singleton x Y : x ∈ Y → Y ≡ {[x]} ∪ Y ∖ {[x]}.
+    Proof. intros ?. apply union_difference. set_solver. Qed.
     Lemma difference_union X Y : X ∖ Y ∪ Y ≡ X ∪ Y.
     Proof.
       intros x. rewrite !elem_of_union; rewrite elem_of_difference.
       split; [ | destruct (decide (x ∈ Y)) ]; intuition.
     Qed.
+    Lemma difference_difference_r X Y Z : X ∖ (Y ∖ Z) ≡ (X ∖ Y) ∪ (X ∩ Z).
+    Proof. intros x. destruct (decide (x ∈ Z)); set_solver. Qed.
+    Lemma difference_union_intersection X Y : (X ∖ Y) ∪ (X ∩ Y) ≡ X.
+    Proof. rewrite union_intersection_l, difference_union. set_solver. Qed.
+
     Lemma subseteq_disjoint_union X Y : X ⊆ Y ↔ ∃ Z, Y ≡ X ∪ Z ∧ X ## Z.
     Proof.
       split; [|set_solver].
@@ -770,14 +843,16 @@ Section set.
     Proof. set_solver. Qed.
     Lemma singleton_union_difference X Y x :
       {[x]} ∪ (X ∖ Y) ≡ ({[x]} ∪ X) ∖ (Y ∖ {[x]}).
-    Proof.
-      intro y; split; intros Hy; [ set_solver | ].
-      destruct (decide (y ∈ ({[x]} : C))); set_solver.
-    Qed.
+    Proof. intro y; destruct (decide (y ∈@{C} {[x]})); set_solver. Qed.
+  End dec.
+
+  Section dec_leibniz.
+    Context `{!RelDecision (∈@{C}), !LeibnizEquiv C}.
 
-    Context `{!LeibnizEquiv C}.
     Lemma union_difference_L X Y : X ⊆ Y → Y = X ∪ Y ∖ X.
     Proof. unfold_leibniz. apply union_difference. Qed.
+    Lemma union_difference_singleton_L x Y : x ∈ Y → Y = {[x]} ∪ Y ∖ {[x]}.
+    Proof. unfold_leibniz. apply union_difference_singleton. Qed.
     Lemma difference_union_L X Y : X ∖ Y ∪ Y = X ∪ Y.
     Proof. unfold_leibniz. apply difference_union. Qed.
     Lemma non_empty_difference_L X Y : X ⊂ Y → Y ∖ X ≠ ∅.
@@ -789,10 +864,28 @@ Section set.
     Lemma singleton_union_difference_L X Y x :
       {[x]} ∪ (X ∖ Y) = ({[x]} ∪ X) ∖ (Y ∖ {[x]}).
     Proof. unfold_leibniz. apply singleton_union_difference. Qed.
-  End dec.
+    Lemma difference_difference_r_L X Y Z : X ∖ (Y ∖ Z) = (X ∖ Y) ∪ (X ∩ Z).
+    Proof. unfold_leibniz. apply difference_difference_r. Qed.
+    Lemma difference_union_intersection_L X Y : (X ∖ Y) ∪ (X ∩ Y) = X.
+    Proof. unfold_leibniz. apply difference_union_intersection. Qed.
+
+  End dec_leibniz.
 End set.
 
 
+(** * Sets with [∪], [∩], [∖], [∅], [{[_]}], and [⊤] *)
+Section top_set.
+  Context `{TopSet A C}.
+  Implicit Types x y : A.
+  Implicit Types X Y : C.
+
+  Lemma elem_of_top x : x ∈@{C} ⊤ ↔ True.
+  Proof. split; [done|intros; apply elem_of_top']. Qed.
+  Lemma top_subseteq X : X ⊆ ⊤.
+  Proof. intros x. by rewrite elem_of_top. Qed.
+End top_set.
+
+
 (** * Conversion of option and list *)
 Section option_and_list_to_set.
   Context `{SemiSet A C}.
@@ -826,39 +919,74 @@ Section option_and_list_to_set.
   Proof. done. Qed.
   Lemma list_to_set_app l1 l2 : list_to_set (l1 ++ l2) ≡@{C} list_to_set l1 ∪ list_to_set l2.
   Proof. set_solver. Qed.
+  Lemma list_to_set_singleton x : list_to_set [x] ≡@{C} {[ x ]}.
+  Proof. set_solver. Qed.
+  Lemma list_to_set_snoc l x : list_to_set (l ++ [x]) ≡@{C} list_to_set l ∪ {[ x ]}.
+  Proof. set_solver. Qed.
   Global Instance list_to_set_perm : Proper ((≡ₚ) ==> (≡)) (list_to_set (C:=C)).
   Proof. induction 1; set_solver. Qed.
 
-  Context `{!LeibnizEquiv C}.
-  Lemma list_to_set_app_L l1 l2 : list_to_set (l1 ++ l2) =@{C} list_to_set l1 ∪ list_to_set l2.
-  Proof. set_solver. Qed.
-  Global Instance list_to_set_perm_L : Proper ((≡ₚ) ==> (=)) (list_to_set (C:=C)).
-  Proof. induction 1; set_solver. Qed.
+  Section leibniz.
+    Context `{!LeibnizEquiv C}.
+
+    Lemma list_to_set_app_L l1 l2 :
+      list_to_set (l1 ++ l2) =@{C} list_to_set l1 ∪ list_to_set l2.
+    Proof. set_solver. Qed.
+    Global Instance list_to_set_perm_L : Proper ((≡ₚ) ==> (=)) (list_to_set (C:=C)).
+    Proof. induction 1; set_solver. Qed.
+  End leibniz.
 End option_and_list_to_set.
 
+(** * Finite types to sets. *)
+Definition fin_to_set (A : Type) `{Singleton A C, Empty C, Union C, Finite A} : C :=
+  list_to_set (enum A).
+
+Section fin_to_set.
+  Context `{SemiSet A C, Finite A}.
+  Implicit Types a : A.
+
+  Lemma elem_of_fin_to_set a : a ∈@{C} fin_to_set A.
+  Proof. apply elem_of_list_to_set, elem_of_enum. Qed.
+
+  Global Instance set_unfold_fin_to_set a :
+    SetUnfoldElemOf (C:=C) a (fin_to_set A) True.
+  Proof. constructor. split; auto using elem_of_fin_to_set. Qed.
+End fin_to_set.
 
 (** * Guard *)
-Global Instance set_guard `{MonadSet M} : MGuard M :=
-  λ P dec A x, match dec with left H => x H | _ => ∅ end.
+Global Instance set_mfail `{MonadSet M} : MFail M := λ _ _, ∅.
+Global Typeclasses Opaque set_mfail.
 
 Section set_monad_base.
   Context `{MonadSet M}.
+
+  Lemma elem_of_mfail {A} x : x ∈@{M A} mfail ↔ False.
+  Proof. unfold mfail, set_mfail. by rewrite elem_of_empty. Qed.
+
+  Global Instance set_unfold_elem_of_mfail {A} (x : A) :
+    SetUnfoldElemOf x (mfail : M A) False.
+  Proof. constructor. by apply elem_of_mfail. Qed.
+
+  (** This lemma includes a bind, to avoid equalities of proofs. We cannot have
+  [p ∈ guard P ↔ P] unless [P] is proof irrelant. The best (but less usable)
+  self-contained alternative would be [p ∈ guard P ↔ decide P = left p]. *)
   Lemma elem_of_guard `{Decision P} {A} (x : A) (X : M A) :
-    (x ∈ guard P; X) ↔ P ∧ x ∈ X.
+    x ∈ (guard P;; X) ↔ P ∧ x ∈ X.
   Proof.
-    unfold mguard, set_guard; simpl; case_match;
-      rewrite ?elem_of_empty; naive_solver.
+    case_guard; rewrite elem_of_bind;
+      [setoid_rewrite elem_of_ret | setoid_rewrite elem_of_mfail];
+      naive_solver.
   Qed.
   Lemma elem_of_guard_2 `{Decision P} {A} (x : A) (X : M A) :
-    P → x ∈ X → x ∈ guard P; X.
+    P → x ∈ X → x ∈ (guard P;; X).
   Proof. by rewrite elem_of_guard. Qed.
-  Lemma guard_empty `{Decision P} {A} (X : M A) : (guard P; X) ≡ ∅ ↔ ¬P ∨ X ≡ ∅.
+  Lemma guard_empty `{Decision P} {A} (X : M A) : (guard P;; X) ≡ ∅ ↔ ¬P ∨ X ≡ ∅.
   Proof.
     rewrite !elem_of_equiv_empty; setoid_rewrite elem_of_guard.
     destruct (decide P); naive_solver.
   Qed.
   Global Instance set_unfold_guard `{Decision P} {A} (x : A) (X : M A) Q :
-    SetUnfoldElemOf x X Q → SetUnfoldElemOf x (guard P; X) (P ∧ Q).
+    SetUnfoldElemOf x X Q → SetUnfoldElemOf x (guard P;; X) (P ∧ Q).
   Proof. constructor. by rewrite elem_of_guard, (set_unfold (x ∈ X) Q). Qed.
   Lemma bind_empty {A B} (f : A → M B) X :
     X ≫= f ≡ ∅ ↔ X ≡ ∅ ∨ ∀ x, x ∈ X → f x ≡ ∅.
@@ -874,33 +1002,50 @@ Section quantifiers.
   Context `{SemiSet A C} (P : A → Prop).
   Implicit Types X Y : C.
 
+  Global Instance set_unfold_set_Forall X (QX QP : A → Prop) :
+    (∀ x, SetUnfoldElemOf x X (QX x)) →
+    (∀ x, SetUnfold (P x) (QP x)) →
+    SetUnfold (set_Forall P X) (∀ x, QX x → QP x).
+  Proof.
+    intros HX HP; constructor. unfold set_Forall. apply forall_proper; intros x.
+    by rewrite (set_unfold (x ∈ X) _), (set_unfold (P x) _).
+  Qed.
+  Global Instance set_unfold_set_Exists X (QX QP : A → Prop) :
+    (∀ x, SetUnfoldElemOf x X (QX x)) →
+    (∀ x, SetUnfold (P x) (QP x)) →
+    SetUnfold (set_Exists P X) (∃ x, QX x ∧ QP x).
+  Proof.
+    intros HX HP; constructor. unfold set_Exists. f_equiv; intros x.
+    by rewrite (set_unfold (x ∈ X) _), (set_unfold (P x) _).
+  Qed.
+
   Lemma set_Forall_empty : set_Forall P (∅ : C).
-  Proof. unfold set_Forall. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Forall_singleton x : set_Forall P ({[ x ]} : C) ↔ P x.
-  Proof. unfold set_Forall. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Forall_union X Y :
     set_Forall P X → set_Forall P Y → set_Forall P (X ∪ Y).
-  Proof. unfold set_Forall. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Forall_union_inv_1 X Y : set_Forall P (X ∪ Y) → set_Forall P X.
-  Proof. unfold set_Forall. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Forall_union_inv_2 X Y : set_Forall P (X ∪ Y) → set_Forall P Y.
-  Proof. unfold set_Forall. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Forall_list_to_set l : set_Forall P (list_to_set (C:=C) l) ↔ Forall P l.
-  Proof. rewrite Forall_forall. unfold set_Forall. set_solver. Qed.
+  Proof. rewrite Forall_forall. set_solver. Qed.
 
   Lemma set_Exists_empty : ¬set_Exists P (∅ : C).
-  Proof. unfold set_Exists. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Exists_singleton x : set_Exists P ({[ x ]} : C) ↔ P x.
-  Proof. unfold set_Exists. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Exists_union_1 X Y : set_Exists P X → set_Exists P (X ∪ Y).
-  Proof. unfold set_Exists. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Exists_union_2 X Y : set_Exists P Y → set_Exists P (X ∪ Y).
-  Proof. unfold set_Exists. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Exists_union_inv X Y :
     set_Exists P (X ∪ Y) → set_Exists P X ∨ set_Exists P Y.
-  Proof. unfold set_Exists. set_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Exists_list_to_set l : set_Exists P (list_to_set (C:=C) l) ↔ Exists P l.
-  Proof. rewrite Exists_exists. unfold set_Exists. set_solver. Qed.
+  Proof. rewrite Exists_exists. set_solver. Qed.
 End quantifiers.
 
 Section more_quantifiers.
@@ -909,10 +1054,10 @@ Section more_quantifiers.
 
   Lemma set_Forall_impl (P Q : A → Prop) X :
     set_Forall P X → (∀ x, P x → Q x) → set_Forall Q X.
-  Proof. unfold set_Forall. naive_solver. Qed.
+  Proof. set_solver. Qed.
   Lemma set_Exists_impl (P Q : A → Prop) X :
     set_Exists P X → (∀ x, P x → Q x) → set_Exists Q X.
-  Proof. unfold set_Exists. naive_solver. Qed.
+  Proof. set_solver. Qed.
 End more_quantifiers.
 
 (** * Properties of implementations of sets that form a monad *)
@@ -931,7 +1076,7 @@ Section set_monad.
 
   Lemma set_bind_singleton {A B} (f : A → M B) x : {[ x ]} ≫= f ≡ f x.
   Proof. set_solver. Qed.
-  Lemma set_guard_True {A} `{Decision P} (X : M A) : P → (guard P; X) ≡ X.
+  Lemma set_guard_True {A} `{Decision P} (X : M A) : P → (guard P;; X) ≡ X.
   Proof. set_solver. Qed.
   Lemma set_fmap_compose {A B C} (f : A → B) (g : B → C) (X : M A) :
     g ∘ f <$> X ≡ g <$> (f <$> X).
@@ -953,7 +1098,7 @@ Section set_monad.
     - revert l. induction k; set_solver by eauto.
     - induction 1; set_solver.
   Qed.
-  Lemma set_mapM_length {A B} (f : A → M B) l k :
+  Lemma length_set_mapM {A B} (f : A → M B) l k :
     l ∈ mapM f k → length l = length k.
   Proof. revert l; induction k; set_solver by eauto. Qed.
   Lemma elem_of_mapM_fmap {A B} (f : A → B) (g : B → M A) l k :
@@ -967,8 +1112,26 @@ Section set_monad.
     Forall2 P l1 l2.
   Proof.
     rewrite elem_of_mapM. intros Hl1. revert l2.
-    induction Hl1; inversion_clear 1; constructor; auto.
+    induction Hl1; inv 1; constructor; auto.
+  Qed.
+
+  Global Instance monadset_cprod {A B} : CProd (M A) (M B) (M (A * B)) := λ X Y,
+    x ← X; fmap (x,.) Y.
+
+  Lemma elem_of_monadset_cprod {A B} (X : M A) (Y : M B) (x : A * B) :
+    x ∈ cprod X Y ↔ x.1 ∈ X ∧ x.2 ∈ Y.
+  Proof. unfold cprod, monadset_cprod. destruct x; set_solver. Qed.
+
+  Global Instance set_unfold_monadset_cprod {A B} (X : M A) (Y : M B) P Q x :
+    SetUnfoldElemOf x.1 X P →
+    SetUnfoldElemOf x.2 Y Q →
+    SetUnfoldElemOf x (cprod X Y) (P ∧ Q).
+  Proof.
+    constructor.
+    by rewrite elem_of_monadset_cprod, (set_unfold_elem_of x.1 X P),
+      (set_unfold_elem_of x.2 Y Q).
   Qed.
+
 End set_monad.
 
 (** Finite sets *)
@@ -987,6 +1150,18 @@ Section pred_finite_infinite.
     pred_infinite P → (∀ x, P x → Q x) → pred_infinite Q.
   Proof. unfold pred_infinite. set_solver. Qed.
 
+  (** If [f] is surjective onto [P], then pre-composing with [f] preserves
+  infinity. *)
+  Lemma pred_infinite_surj {A B} (P : B → Prop) (f : A → B) :
+    (∀ x, P x → ∃ y, f y = x) →
+    pred_infinite P → pred_infinite (P ∘ f).
+  Proof.
+    intros Hf HP xs. destruct (HP (f <$> xs)) as [x [HPx Hx]].
+    destruct (Hf _ HPx) as [y Hf']. exists y. split.
+    - simpl. rewrite Hf'. done.
+    - intros Hy. apply Hx. apply elem_of_list_fmap. eauto.
+  Qed.
+
   Lemma pred_not_infinite_finite {A} (P : A → Prop) :
     pred_infinite P → pred_finite P → False.
   Proof. intros Hinf [xs ?]. destruct (Hinf xs). set_solver. Qed.
@@ -995,6 +1170,22 @@ Section pred_finite_infinite.
   Proof.
     intros xs. exists (fresh xs). split; [done|]. apply infinite_is_fresh.
   Qed.
+
+  Lemma pred_finite_lt n : pred_finite (flip lt n).
+  Proof.
+    exists (seq 0 n); intros i Hi. apply (elem_of_list_lookup_2 _ i).
+    by rewrite lookup_seq.
+  Qed.
+  Lemma pred_infinite_lt n : pred_infinite (lt n).
+  Proof.
+    intros l. exists (S (n `max` max_list l)). split; [lia| ].
+    intros H%max_list_elem_of_le; lia.
+  Qed.
+
+  Lemma pred_finite_le n : pred_finite (flip le n).
+  Proof. eapply pred_finite_impl; [apply (pred_finite_lt (S n))|]; naive_solver lia. Qed.
+  Lemma pred_infinite_le n : pred_infinite (le n).
+  Proof. eapply pred_infinite_impl; [apply (pred_infinite_lt (S n))|]; naive_solver lia. Qed.
 End pred_finite_infinite.
 
 Section set_finite_infinite.
@@ -1023,6 +1214,8 @@ Section set_finite_infinite.
   Proof. intros [l ?]; exists l; set_solver. Qed.
   Lemma union_finite_inv_r X Y : set_finite (X ∪ Y) → set_finite Y.
   Proof. intros [l ?]; exists l; set_solver. Qed.
+  Lemma list_to_set_finite l : set_finite (list_to_set (C:=C) l).
+  Proof. exists l. intros x. by rewrite elem_of_list_to_set. Qed.
 
   Global Instance set_infinite_subseteq :
     Proper ((⊆) ==> impl) (@set_infinite A C _).
@@ -1058,6 +1251,42 @@ Section more_finite.
   Proof. intros Hinf [xs ?] xs'. destruct (Hinf (xs ++ xs')). set_solver. Qed.
 End more_finite.
 
+Lemma top_infinite `{TopSet A C, Infinite A} : set_infinite (⊤ : C).
+Proof.
+  intros xs. exists (fresh xs). split; [set_solver|]. apply infinite_is_fresh.
+Qed.
+
+(** This formulation of finiteness is stronger than [pred_finite]: when equality
+    is decidable, it is equivalent to the predicate being finite AND decidable. *)
+Lemma dec_pred_finite_alt {A} (P : A → Prop) `{!∀ x, Decision (P x)} :
+  pred_finite P ↔ ∃ xs : list A, ∀ x, P x ↔ x ∈ xs.
+Proof.
+  split; intros [xs ?].
+  - exists (filter P xs). intros x. rewrite elem_of_list_filter. naive_solver.
+  - exists xs. naive_solver.
+Qed.
+
+Lemma finite_sig_pred_finite {A} (P : A → Prop) `{Finite (sig P)} :
+  pred_finite P.
+Proof.
+  exists (proj1_sig <$> enum _). intros x px.
+  apply elem_of_list_fmap_1_alt with (x ↾ px); [apply elem_of_enum|]; done.
+Qed.
+
+Lemma pred_finite_arg2 {A B} (P : A → B → Prop) x :
+  pred_finite (uncurry P) → pred_finite (P x).
+Proof.
+  intros [xys ?]. exists (xys.*2). intros y ?.
+  apply elem_of_list_fmap_1_alt with (x, y); by auto.
+Qed.
+
+Lemma pred_finite_arg1 {A B} (P : A → B → Prop) y :
+  pred_finite (uncurry P) → pred_finite (flip P y).
+Proof.
+  intros [xys ?]. exists (xys.*1). intros x ?.
+  apply elem_of_list_fmap_1_alt with (x, y); by auto.
+Qed.
+
 (** Sets of sequences of natural numbers *)
 (* The set [seq_seq start len] of natural numbers contains the sequence
 [start, start + 1, ..., start + (len-1)]. *)
@@ -1078,21 +1307,42 @@ Section set_seq.
     - rewrite elem_of_empty. lia.
     - rewrite elem_of_union, elem_of_singleton, IH. lia.
   Qed.
-  Global Instance set_unfold_seq start len :
+  Global Instance set_unfold_seq start len x :
     SetUnfoldElemOf x (set_seq (C:=C) start len) (start ≤ x < start + len).
   Proof. constructor; apply elem_of_set_seq. Qed.
 
-  Lemma set_seq_plus_disjoint start len1 len2 :
+  Lemma set_seq_len_pos n start len : n ∈ set_seq (C:=C) start len → 0 < len.
+  Proof. rewrite elem_of_set_seq. lia. Qed.
+
+  Lemma set_seq_subseteq start1 len1 start2 len2 :
+    0 < len1 →
+    set_seq (C:=C) start1 len1 ⊆ set_seq (C:=C) start2 len2 ↔
+      start2 ≤ start1 ∧ start1 + len1 ≤ start2 + len2.
+  Proof.
+    intros Hlen. set_unfold. split.
+    - intros Hx. pose proof (Hx start1). pose proof (Hx (start1 + len1 - 1)). lia.
+    - intros Heq x. lia.
+  Qed.
+
+  Lemma set_seq_subseteq_len_gt start1 len1 start2 len2 :
+    set_seq (C:=C) start1 len1 ⊆ set_seq (C:=C) start2 len2 → len1 ≤ len2.
+  Proof.
+    destruct len1 as [|len1].
+    - set_unfold. lia.
+    - rewrite set_seq_subseteq; lia.
+  Qed.
+
+  Lemma set_seq_add_disjoint start len1 len2 :
     set_seq (C:=C) start len1 ## set_seq (start + len1) len2.
   Proof. set_solver by lia. Qed.
-  Lemma set_seq_plus start len1 len2 :
+  Lemma set_seq_add start len1 len2 :
     set_seq (C:=C) start (len1 + len2)
     ≡ set_seq start len1 ∪ set_seq (start + len1) len2.
   Proof. set_solver by lia. Qed.
-  Lemma set_seq_plus_L `{!LeibnizEquiv C} start len1 len2 :
+  Lemma set_seq_add_L `{!LeibnizEquiv C} start len1 len2 :
     set_seq (C:=C) start (len1 + len2)
     = set_seq start len1 ∪ set_seq (start + len1) len2.
-  Proof. unfold_leibniz. apply set_seq_plus. Qed.
+  Proof. unfold_leibniz. apply set_seq_add. Qed.
 
   Lemma set_seq_S_start_disjoint start len :
     {[ start ]} ## set_seq (C:=C) (S start) len.
@@ -1124,8 +1374,8 @@ End set_seq.
 (** Mimimal elements *)
 Definition minimal `{ElemOf A C} (R : relation A) (x : A) (X : C) : Prop :=
   ∀ y, y ∈ X → R y x → R x y.
-Instance: Params (@minimal) 5 := {}.
-Typeclasses Opaque minimal.
+Global Instance: Params (@minimal) 5 := {}.
+Global Typeclasses Opaque minimal.
 
 Section minimal.
   Context `{SemiSet A C} {R : relation A}.

theories/sorting.v → stdpp/sorting.v

-(* Copyright (c) 2012-2019, Coq-std++ developers. *)
-(* This file is distributed under the terms of the BSD license. *)
 (** Merge sort. Adapted from the implementation of Hugo Herbelin in the Coq
 standard library, but without using the module system. *)
 From Coq Require Export Sorted.
 From stdpp Require Export orders list.
-Set Default Proof Using "Type".
+From stdpp Require Import sets.
+From stdpp Require Import options.
 
 Section merge_sort.
   Context {A} (R : relation A) `{∀ x y, Decision (R x y)}.
@@ -50,43 +49,67 @@ Inductive TlRel {A} (R : relation A) (a : A) : list A → Prop :=
 Section sorted.
   Context {A} (R : relation A).
 
-  Lemma elem_of_StronglySorted_app l1 l2 x1 x2 :
-    StronglySorted R (l1 ++ l2) → x1 ∈ l1 → x2 ∈ l2 → R x1 x2.
+  Lemma StronglySorted_cons l x :
+    StronglySorted R (x :: l) ↔
+      Forall (R x) l ∧ StronglySorted R l.
+  Proof. split; [inv 1|constructor]; naive_solver. Qed.
+
+  Lemma StronglySorted_app l1 l2 :
+    StronglySorted R (l1 ++ l2) ↔
+      (∀ x1 x2, x1 ∈ l1 → x2 ∈ l2 → R x1 x2) ∧
+      StronglySorted R l1 ∧
+      StronglySorted R l2.
   Proof.
-    induction l1 as [|x1' l1 IH]; simpl; [by rewrite elem_of_nil|].
-    intros [? Hall]%StronglySorted_inv [->|?]%elem_of_cons ?; [|by auto].
-    rewrite Forall_app, !Forall_forall in Hall. naive_solver.
+    induction l1 as [|x1' l1 IH]; simpl.
+    - set_solver by eauto using SSorted_nil.
+    - rewrite !StronglySorted_cons, IH, !Forall_forall. set_solver.
   Qed.
-  Lemma StronglySorted_app_inv_l l1 l2 :
+  Lemma StronglySorted_app_2 l1 l2 :
+    (∀ x1 x2, x1 ∈ l1 → x2 ∈ l2 → R x1 x2) →
+    StronglySorted R l1 →
+    StronglySorted R l2 →
+    StronglySorted R (l1 ++ l2).
+  Proof. by rewrite StronglySorted_app. Qed.
+  Lemma StronglySorted_app_1_elem_of l1 l2 x1 x2 :
+    StronglySorted R (l1 ++ l2) → x1 ∈ l1 → x2 ∈ l2 → R x1 x2.
+  Proof. rewrite StronglySorted_app. naive_solver. Qed.
+  Lemma StronglySorted_app_1_l l1 l2 :
     StronglySorted R (l1 ++ l2) → StronglySorted R l1.
-  Proof.
-    induction l1 as [|x1' l1 IH]; simpl;
-      [|inversion_clear 1]; decompose_Forall; constructor; auto.
-  Qed.
-  Lemma StronglySorted_app_inv_r l1 l2 :
+  Proof. rewrite StronglySorted_app. naive_solver. Qed.
+  Lemma StronglySorted_app_1_r l1 l2 :
     StronglySorted R (l1 ++ l2) → StronglySorted R l2.
-  Proof.
-    induction l1 as [|x1' l1 IH]; simpl;
-      [|inversion_clear 1]; decompose_Forall; auto.
-  Qed.
+  Proof. rewrite StronglySorted_app. naive_solver. Qed.
 
   Lemma Sorted_StronglySorted `{!Transitive R} l :
     Sorted R l → StronglySorted R l.
   Proof. by apply Sorted.Sorted_StronglySorted. Qed.
-  Lemma StronglySorted_unique `{!AntiSymm (=) R} l1 l2 :
+
+  Lemma StronglySorted_unique_strong l1 l2 :
+    (∀ x1 x2, x1 ∈ l1 → x2 ∈ l2 → R x1 x2 → R x2 x1 → x1 = x2) →
     StronglySorted R l1 → StronglySorted R l2 → l1 ≡ₚ l2 → l1 = l2.
   Proof.
-    intros Hl1; revert l2. induction Hl1 as [|x1 l1 ? IH Hx1]; intros l2 Hl2 E.
+    intros Hasym Hl1. revert l2 Hasym.
+    induction Hl1 as [|x1 l1 ? IH Hx1]; intros l2 Hasym Hl2 E.
     { symmetry. by apply Permutation_nil. }
     destruct Hl2 as [|x2 l2 ? Hx2].
-    { by apply Permutation_nil in E. }
+    { by apply Permutation_nil_r in E. }
     assert (x1 = x2); subst.
     { rewrite Forall_forall in Hx1, Hx2.
       assert (x2 ∈ x1 :: l1) as Hx2' by (by rewrite E; left).
       assert (x1 ∈ x2 :: l2) as Hx1' by (by rewrite <-E; left).
-      inversion Hx1'; inversion Hx2'; simplify_eq; auto. }
-    f_equal. by apply IH, (inj (x2 ::.)).
+      inv Hx1'; inv Hx2'; simplify_eq; [eauto..|].
+      apply Hasym; [by constructor..| |]; by eauto. }
+    f_equal. apply IH, (inj (x2 ::.)); [|done..].
+    intros ????. apply Hasym; by constructor.
   Qed.
+  Lemma StronglySorted_unique `{!AntiSymm (=) R} l1 l2 :
+    StronglySorted R l1 → StronglySorted R l2 → l1 ≡ₚ l2 → l1 = l2.
+  Proof. apply StronglySorted_unique_strong; eauto. Qed.
+
+  Lemma Sorted_unique_strong `{!Transitive R} l1 l2 :
+    (∀ x1 x2, x1 ∈ l1 → x2 ∈ l2 → R x1 x2 → R x2 x1 → x1 = x2) →
+    Sorted R l1 → Sorted R l2 → l1 ≡ₚ l2 → l1 = l2.
+  Proof. auto using StronglySorted_unique_strong, Sorted_StronglySorted. Qed.
   Lemma Sorted_unique `{!Transitive R, !AntiSymm (=) R} l1 l2 :
     Sorted R l1 → Sorted R l2 → l1 ≡ₚ l2 → l1 = l2.
   Proof. auto using StronglySorted_unique, Sorted_StronglySorted. Qed.
@@ -98,7 +121,7 @@ Section sorted.
     match l with
     | [] => left _
     | y :: l => cast_if (decide (R x y))
-    end; abstract first [by constructor | by inversion 1].
+    end; abstract first [by constructor | by inv 1].
   Defined.
   Global Instance Sorted_dec `{∀ x y, Decision (R x y)} : ∀ l,
     Decision (Sorted R l).
@@ -108,7 +131,7 @@ Section sorted.
     match l return Decision (Sorted R l) with
     | [] => left _
     | x :: l => cast_if_and (decide (HdRel R x l)) (go l)
-    end); clear go; abstract first [by constructor | by inversion 1].
+    end); clear go; abstract first [by constructor | by inv 1].
   Defined.
   Global Instance StronglySorted_dec `{∀ x y, Decision (R x y)} : ∀ l,
     Decision (StronglySorted R l).
@@ -118,7 +141,7 @@ Section sorted.
     match l return Decision (StronglySorted R l) with
     | [] => left _
     | x :: l => cast_if_and (decide (Forall (R x) l)) (go l)
-    end); clear go; abstract first [by constructor | by inversion 1].
+    end); clear go; abstract first [by constructor | by inv 1].
   Defined.
 
   Section fmap.
@@ -145,10 +168,10 @@ Section sorted.
   Proof.
     induction 1 as [|y l Hsort IH Hhd]; intros Htl; simpl.
     { repeat constructor. }
-    constructor. apply IH.
-    - inversion Htl as [|? [|??]]; simplify_list_eq; by constructor.
+    constructor.
+    - apply IH. inv Htl as [|? [|??]]; simplify_list_eq; by constructor.
     - destruct Hhd; constructor; [|done].
-      inversion Htl as [|? [|??]]; by try discriminate_list.
+      inv Htl as [|? [|??]]; by try discriminate_list.
   Qed.
 End sorted.
 
@@ -184,7 +207,8 @@ Section merge_sort_correct.
     intros Hl1. revert l2. induction Hl1 as [|x1 l1 IH1];
       induction 1 as [|x2 l2 IH2]; rewrite ?list_merge_cons; simpl;
       repeat case_decide;
-      constructor; eauto using HdRel_list_merge, HdRel_cons, total_not.
+      repeat match goal with H : ¬R _ _ |- _ => apply total_not in H end;
+      constructor; eauto using HdRel_list_merge, HdRel_cons.
   Qed.
   Lemma merge_Permutation l1 l2 : list_merge R l1 l2 ≡ₚ l1 ++ l2.
   Proof.