Misc updates to the prelude.

theories/ars.v

@@ -170,8 +170,7 @@ Hint Extern 5 (subrelation _ (tc _)) =>
   eapply @tc_once_subrel : typeclass_instances.
 
 Hint Resolve
-  rtc_once rtc_r
-  tc_r
+  rtc_once rtc_r tc_r
   bsteps_once bsteps_r bsteps_refl bsteps_trans : ars.
 
 (** * Theorems on sub relations *)

theories/base.v

@@ -6,7 +6,7 @@ abstract interfaces for ordered structures, collections, and various other data
 structures. *)
 Global Generalizable All Variables.
 Global Set Automatic Coercions Import.
-Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid NArith.
+Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid.
 
 (** * General *)
 (** The following coercion allows us to use Booleans as propositions. *)
@@ -17,6 +17,7 @@ applied. *)
 Arguments id _ _/.
 Arguments compose _ _ _ _ _ _ /.
 Arguments flip _ _ _ _ _ _/.
+Typeclasses Transparent id compose flip.
 
 (** Change [True] and [False] into notations in order to enable overloading.
 We will use this in the file [assertions] to give [True] and [False] a
@@ -415,10 +416,6 @@ Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
   fold_right delete m l.
 Instance: Params (@delete_list) 3.
 
-Definition insert_consecutive `{Insert nat A M} (i : nat) (l : list A)
-  (m : M) : M := fold_right (λ x f i, <[i:=x]>(f (S i))) (λ _, m) l i.
-Instance: Params (@insert_consecutive) 3.
-
 (** The function [union_with f m1 m2] is supposed to yield the union of [m1]
 and [m2] using the function [f] to combine values of members that are in
 both [m1] and [m2]. *)
@@ -451,6 +448,10 @@ Class Injective {A B} (R : relation A) (S : relation B) (f : A → B) : Prop :=
 Class Injective2 {A B C} (R1 : relation A) (R2 : relation B)
     (S : relation C) (f : A → B → C) : Prop :=
   injective2: ∀ x1 x2  y1 y2, S (f x1 x2) (f y1 y2) → R1 x1 y1 ∧ R2 x2 y2.
+Class Cancel {A B} (S : relation B) (f : A → B) (g : B → A) : Prop :=
+  cancel: ∀ x, S (f (g x)) x.
+Class Surjective {A B} (R : relation B) (f : A → B) :=
+  surjective : ∀ y, ∃ x, R (f x) y.
 Class Idempotent {A} (R : relation A) (f : A → A → A) : Prop :=
   idempotent: ∀ x, R (f x x) x.
 Class Commutative {A B} (R : relation A) (f : B → B → A) : Prop :=
@@ -475,6 +476,8 @@ Class AntiSymmetric {A} (R S : relation A) : Prop :=
 Arguments irreflexivity {_} _ {_} _ _.
 Arguments injective {_ _ _ _} _ {_} _ _ _.
 Arguments injective2 {_ _ _ _ _ _} _ {_} _ _ _ _ _.
+Arguments cancel {_ _ _} _ _ {_} _.
+Arguments surjective {_ _ _} _ {_} _.
 Arguments idempotent {_ _} _ {_} _.
 Arguments commutative {_ _ _} _ {_} _ _.
 Arguments left_id {_ _} _ _ {_} _.
@@ -486,55 +489,6 @@ Arguments left_distr {_ _} _ _ {_} _ _ _.
 Arguments right_distr {_ _} _ _ {_} _ _ _.
 Arguments anti_symmetric {_ _} _ {_} _ _ _ _.
 
-Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R).
-Proof. tauto. Qed.
-Instance: Commutative (↔) (@eq A).
-Proof. red. intuition. Qed.
-Instance: Commutative (↔) (λ x y, @eq A y x).
-Proof. red. intuition. Qed.
-Instance: Commutative (↔) (↔).
-Proof. red. intuition. Qed.
-Instance: Commutative (↔) (∧).
-Proof. red. intuition. Qed.
-Instance: Associative (↔) (∧).
-Proof. red. intuition. Qed.
-Instance: Idempotent (↔) (∧).
-Proof. red. intuition. Qed.
-Instance: Commutative (↔) (∨).
-Proof. red. intuition. Qed.
-Instance: Associative (↔) (∨).
-Proof. red. intuition. Qed.
-Instance: Idempotent (↔) (∨).
-Proof. red. intuition. Qed.
-Instance: LeftId (↔) True (∧).
-Proof. red. intuition. Qed.
-Instance: RightId (↔) True (∧).
-Proof. red. intuition. Qed.
-Instance: LeftAbsorb (↔) False (∧).
-Proof. red. intuition. Qed.
-Instance: RightAbsorb (↔) False (∧).
-Proof. red. intuition. Qed.
-Instance: LeftId (↔) False (∨).
-Proof. red. intuition. Qed.
-Instance: RightId (↔) False (∨).
-Proof. red. intuition. Qed.
-Instance: LeftAbsorb (↔) True (∨).
-Proof. red. intuition. Qed.
-Instance: RightAbsorb (↔) True (∨).
-Proof. red. intuition. Qed.
-Instance: LeftId (↔) True impl.
-Proof. unfold impl. red. intuition. Qed.
-Instance: RightAbsorb (↔) True impl.
-Proof. unfold impl. red. intuition. Qed.
-Instance: LeftDistr (↔) (∧) (∨).
-Proof. red. intuition. Qed.
-Instance: RightDistr (↔) (∧) (∨).
-Proof. red. intuition. Qed.
-Instance: LeftDistr (↔) (∨) (∧).
-Proof. red. intuition. Qed.
-Instance: RightDistr (↔) (∨) (∧).
-Proof. red. intuition. Qed.
-
 (** The following lemmas are specific versions of the projections of the above
 type classes for Leibniz equality. These lemmas allow us to enforce Coq not to
 use the setoid rewriting mechanism. *)
@@ -696,11 +650,9 @@ Notation "x .½" := (half x) (at level 20, format "x .½") : C_scope.
 Lemma proj1_sig_inj {A} (P : A → Prop) x (Px : P x) y (Py : P y) :
   x↾Px = y↾Py → x = y.
 Proof. injection 1; trivial. Qed.
-Lemma not_symmetry `{R : relation A} `{!Symmetric R} (x y : A) :
-  ¬R x y → ¬R y x.
+Lemma not_symmetry `{R : relation A} `{!Symmetric R} x y : ¬R x y → ¬R y x.
 Proof. intuition. Qed.
-Lemma symmetry_iff `(R : relation A) `{!Symmetric R} (x y : A) :
-  R x y ↔ R y x.
+Lemma symmetry_iff `(R : relation A) `{!Symmetric R} x y : R x y ↔ R y x.
 Proof. intuition. Qed.
 
 (** ** Pointwise relations *)
@@ -765,11 +717,15 @@ Section prod_relation.
 End prod_relation.
 
 (** ** Other *)
-Definition proj_relation {A B} (R : relation A)
-  (f : B → A) : relation B := λ x y, R (f x) (f y).
-Definition proj_relation_equivalence {A B} (R : relation A) (f : B → A) :
-  Equivalence R → Equivalence (proj_relation R f).
-Proof. unfold proj_relation. firstorder auto. Qed.
+Definition proj_eq {A B} (f : B → A) : relation B := λ x y, f x = f y.
+Global Instance proj_eq_equivalence `(f : B → A) : Equivalence (proj_eq f).
+Proof. unfold proj_eq. repeat split; red; intuition congruence. Qed.
+Notation "x ~{ f } y" := (proj_eq f x y)
+  (at level 70, format "x  ~{ f }  y") : C_scope.
+Notation "(~{ f } )" := (proj_eq f) (f at level 10, only parsing) : C_scope.
+
+Hint Extern 0 (_ ~{_} _) => reflexivity.
+Hint Extern 0 (_ ~{_} _) => symmetry; assumption.
 
 Instance: ∀ A B (x : B), Commutative (=) (λ _ _ : A, x).
 Proof. red. trivial. Qed.
@@ -799,3 +755,96 @@ Proof. red. trivial. Qed.
 Instance idem_propholds {A} (R : relation A) f :
   Idempotent R f → ∀ x, PropHolds (R (f x x) x).
 Proof. red. trivial. Qed.
+
+Lemma injective_iff {A B} {R : relation A} {S : relation B} (f : A → B)
+  `{!Injective R S f} `{!Proper (R ==> S) f} x y : S (f x) (f y) ↔ R x y.
+Proof. firstorder. Qed.
+Instance: Injective (=) (=) (@inl A B).
+Proof. injection 1; auto. Qed.
+Instance: Injective (=) (=) (@inr A B).
+Proof. injection 1; auto. Qed.
+Instance: Injective2 (=) (=) (=) (@pair A B).
+Proof. injection 1; auto. Qed.
+Instance: ∀ `{Injective2 A B C R1 R2 R3 f} y, Injective R1 R3 (λ x, f x y).
+Proof. repeat intro; edestruct (injective2 f); eauto. Qed.
+Instance: ∀ `{Injective2 A B C R1 R2 R3 f} x, Injective R2 R3 (f x).
+Proof. repeat intro; edestruct (injective2 f); eauto. Qed.
+
+Lemma cancel_injective `{Cancel A B R1 f g}
+  `{!Equivalence R1} `{!Proper (R2 ==> R1) f} : Injective R1 R2 g.
+Proof.
+  intros x y E. rewrite <-(cancel f g x), <-(cancel f g y), E. reflexivity.
+Qed.
+Lemma cancel_surjective `{Cancel A B R1 f g} : Surjective R1 f.
+Proof. intros y. exists (g y). auto. Qed.
+
+Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R).
+Proof. tauto. Qed.
+Instance: Commutative (↔) (@eq A).
+Proof. red. intuition. Qed.
+Instance: Commutative (↔) (λ x y, @eq A y x).
+Proof. red. intuition. Qed.
+Instance: Commutative (↔) (↔).
+Proof. red. intuition. Qed.
+Instance: Commutative (↔) (∧).
+Proof. red. intuition. Qed.
+Instance: Associative (↔) (∧).
+Proof. red. intuition. Qed.
+Instance: Idempotent (↔) (∧).
+Proof. red. intuition. Qed.
+Instance: Commutative (↔) (∨).
+Proof. red. intuition. Qed.
+Instance: Associative (↔) (∨).
+Proof. red. intuition. Qed.
+Instance: Idempotent (↔) (∨).
+Proof. red. intuition. Qed.
+Instance: LeftId (↔) True (∧).
+Proof. red. intuition. Qed.
+Instance: RightId (↔) True (∧).
+Proof. red. intuition. Qed.
+Instance: LeftAbsorb (↔) False (∧).
+Proof. red. intuition. Qed.
+Instance: RightAbsorb (↔) False (∧).
+Proof. red. intuition. Qed.
+Instance: LeftId (↔) False (∨).
+Proof. red. intuition. Qed.
+Instance: RightId (↔) False (∨).
+Proof. red. intuition. Qed.
+Instance: LeftAbsorb (↔) True (∨).
+Proof. red. intuition. Qed.
+Instance: RightAbsorb (↔) True (∨).
+Proof. red. intuition. Qed.
+Instance: LeftId (↔) True impl.
+Proof. unfold impl. red. intuition. Qed.
+Instance: RightAbsorb (↔) True impl.
+Proof. unfold impl. red. intuition. Qed.
+Instance: LeftDistr (↔) (∧) (∨).
+Proof. red. intuition. Qed.
+Instance: RightDistr (↔) (∧) (∨).
+Proof. red. intuition. Qed.
+Instance: LeftDistr (↔) (∨) (∧).
+Proof. red. intuition. Qed.
+Instance: RightDistr (↔) (∨) (∧).
+Proof. red. intuition. Qed.
+Lemma not_injective `{Injective A B R R' f} x y : ¬R x y → ¬R' (f x) (f y).
+Proof. intuition. Qed.
+Instance injective_compose {A B C} R1 R2 R3 (f : A → B) (g : B → C) :
+  Injective R1 R2 f → Injective R2 R3 g → Injective R1 R3 (g ∘ f).
+Proof. red; intuition. Qed.
+Instance surjective_compose {A B C} R (f : A → B) (g : B → C) :
+  Surjective (=) f → Surjective R g → Surjective R (g ∘ f).
+Proof.
+  intros ?? x. unfold compose. destruct (surjective g x) as [y ?].
+  destruct (surjective f y) as [z ?]. exists z. congruence.
+Qed.
+
+Section sig_map.
+  Context `{P : A → Prop} `{Q : B → Prop} (f : A → B) (Hf : ∀ x, P x → Q (f x)).
+  Definition sig_map (x : sig P) : sig Q := f (`x) ↾ Hf _ (proj2_sig x).
+  Global Instance sig_map_injective:
+    (∀ x, ProofIrrel (P x)) → Injective (=) (=) f → Injective (=) (=) sig_map.
+  Proof.
+    intros ?? [x Hx] [y Hy]. injection 1. intros Hxy.
+    apply (injective f) in Hxy; subst. rewrite (proof_irrel _ Hy). auto.
+  Qed.
+End sig_map.

theories/collections.v

@@ -489,7 +489,7 @@ Section collection_monad.
     * revert l. induction k; esolve_elem_of.
     * induction 1; esolve_elem_of.
   Qed.
-  Lemma mapM_length {A B} (f : A → M B) l k :
+  Lemma collection_mapM_length {A B} (f : A → M B) l k :
     l ∈ mapM f k → length l = length k.
   Proof. revert l; induction k; esolve_elem_of. Qed.
 

theories/fin_collections.v

@@ -3,10 +3,11 @@
 (** This file collects definitions and theorems on finite collections. Most
 importantly, it implements a fold and size function and some useful induction
 principles on finite collections . *)
-Require Import Permutation ars.
-Require Export collections numbers listset.
+Require Import Permutation ars listset.
+Require Export numbers collections.
 
-Definition choose `{Elements A C} (X : C) : option A := head (elements X).
+Definition collection_choose `{Elements A C} (X : C) : option A :=
+  head (elements X).
 Instance collection_size `{Elements A C} : Size C := length ∘ elements.
 Definition collection_fold `{Elements A C} {B}
   (f : A → B → B) (b : B) : C → B := foldr f b ∘ elements.
@@ -56,23 +57,27 @@ Proof.
   rewrite (nil_length l), !elem_of_list_singleton by done. congruence.
 Qed.
 
-Lemma choose_Some X x : choose X = Some x → x ∈ X.
+Lemma collection_choose_Some X x : collection_choose X = Some x → x ∈ X.
 Proof.
-  unfold choose. destruct (elements X) eqn:E; intros; simplify_equality.
-  rewrite elements_spec, E. by left.
+  unfold collection_choose. destruct (elements X) eqn:E; intros;
+    simplify_equality. rewrite elements_spec, E. by left.
 Qed.
-Lemma choose_None X : choose X = None → X ≡ ∅.
+Lemma collection_choose_None X : collection_choose X = None → X ≡ ∅.
 Proof.
-  unfold choose. destruct (elements X) eqn:E; intros; simplify_equality.
+  unfold collection_choose.
+  destruct (elements X) eqn:E; intros; simplify_equality.
   apply equiv_empty. intros x. by rewrite elements_spec, E, elem_of_nil.
 Qed.
 Lemma elem_of_or_empty X : (∃ x, x ∈ X) ∨ X ≡ ∅.
-Proof. destruct (choose X) eqn:?; eauto using choose_Some, choose_None. Qed.
-Lemma choose_is_Some X : X ≢ ∅ ↔ is_Some (choose X).
 Proof.
-  destruct (choose X) eqn:?.
-  * rewrite elem_of_equiv_empty. split; eauto using choose_Some.
-  * split. intros []; eauto using choose_None. by intros [??].
+  destruct (collection_choose X) eqn:?;
+    eauto using collection_choose_Some, collection_choose_None.
+Qed.
+Lemma collection_choose_is_Some X : X ≢ ∅ ↔ is_Some (collection_choose X).
+Proof.
+  destruct (collection_choose X) eqn:?.
+  * rewrite elem_of_equiv_empty. split; eauto using collection_choose_Some.
+  * split. intros []; eauto using collection_choose_None. by intros [??].
 Qed.
 Lemma not_elem_of_equiv_empty X : X ≢ ∅ ↔ (∃ x, x ∈ X).
 Proof.
@@ -156,8 +161,7 @@ Qed.
 
 Lemma collection_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B) :
   Proper ((=) ==> (≡) ==> iff) P →
-  P b ∅ →
-  (∀ x X r, x ∉ X → P r X → P (f x r) ({[ x ]} ∪ X)) →
+  P b ∅ → (∀ x X r, x ∉ X → P r X → P (f x r) ({[ x ]} ∪ X)) →
   ∀ X, P (collection_fold f b X) X.
 Proof.
   intros ? Hemp Hadd.
@@ -184,7 +188,6 @@ Proof.
     abstract (unfold set_Forall; setoid_rewrite elements_spec;
       by rewrite <-Forall_forall).
 Defined.
-
 Global Instance set_Exists_dec `(P : A → Prop) `{∀ x, Decision (P x)} X :
   Decision (set_Exists P X) | 100.
 Proof.
@@ -192,7 +195,6 @@ Proof.
     abstract (unfold set_Exists; setoid_rewrite elements_spec;
       by rewrite <-Exists_exists).
 Defined.
-
 Global Instance rel_elem_of_dec `{∀ x y, Decision (R x y)} x X :
   Decision (elem_of_upto R x X) | 100 := decide (set_Exists (R x) X).
 End fin_collection.

theories/fin_maps.v

@@ -135,14 +135,21 @@ Lemma map_subset_empty {A} (m : M A) : m ⊄ ∅.
 Proof. intros [? []]. intros i x. by rewrite lookup_empty. Qed.
 
 (** ** Properties of the [partial_alter] operation *)
-Lemma partial_alter_compose {A} (m : M A) i f g :
+Lemma partial_alter_ext {A} (f g : option A → option A) (m : M A) i :
+  (∀ x, m !! i = x → f x = g x) → partial_alter f i m = partial_alter g i m.
+Proof.
+  intros Hfg. apply map_eq. intros j. destruct (decide (i = j)); subst.
+  * rewrite !lookup_partial_alter. by apply Hfg.
+  * by rewrite !lookup_partial_alter_ne.
+Qed.
+Lemma partial_alter_compose {A} f g (m : M A) i:
   partial_alter (f ∘ g) i m = partial_alter f i (partial_alter g i m).
 Proof.
   intros. apply map_eq. intros ii. case (decide (i = ii)).
   * intros. subst. by rewrite !lookup_partial_alter.
   * intros. by rewrite !lookup_partial_alter_ne.
 Qed.
-Lemma partial_alter_commute {A} (m : M A) i j f g :
+Lemma partial_alter_commute {A} f g (m : M A) i j :
   i ≠ j → partial_alter f i (partial_alter g j m) =
     partial_alter g j (partial_alter f i m).
 Proof.
@@ -164,10 +171,10 @@ Qed.
 Lemma partial_alter_self {A} (m : M A) i : partial_alter (λ _, m !! i) i m = m.
 Proof. by apply partial_alter_self_alt. Qed.
 
-Lemma partial_alter_subseteq {A} (m : M A) i f :
+Lemma partial_alter_subseteq {A} f (m : M A) i :
   m !! i = None → m ⊆ partial_alter f i m.
 Proof. intros Hi j x Hj. rewrite lookup_partial_alter_ne; congruence. Qed.
-Lemma partial_alter_subset {A} (m : M A) i f :
+Lemma partial_alter_subset {A} f (m : M A) i :
   m !! i = None → is_Some (f (m !! i)) → m ⊂ partial_alter f i m.
 Proof.
   intros Hi Hfi. split.
@@ -178,11 +185,26 @@ Proof.
 Qed.
 
 (** ** Properties of the [alter] operation *)
+Lemma alter_ext {A} (f g : A → A) (m : M A) i :
+  (∀ x, m !! i = Some x → f x = g x) → alter f i m = alter g i m.
+Proof. intro. apply partial_alter_ext. intros [x|] ?; simpl; f_equal; auto. Qed.
+
 Lemma lookup_alter {A} (f : A → A) m i : alter f i m !! i = f <$> m !! i.
 Proof. apply lookup_partial_alter. Qed.
 Lemma lookup_alter_ne {A} (f : A → A) m i j : i ≠ j → alter f i m !! j = m !! j.
 Proof. apply lookup_partial_alter_ne. Qed.
 
+Lemma alter_compose {A} (f g : A → A) (m : M A) i:
+  alter (f ∘ g) i m = alter f i (alter g i m).
+Proof.
+  unfold alter, map_alter. rewrite <-partial_alter_compose.
+  apply partial_alter_ext. by intros [?|].
+Qed.
+
+Lemma alter_commute {A} (f g : A → A) (m : M A) i j :
+  i ≠ j → alter f i (alter g j m) = alter g j (alter f i m).
+Proof. apply partial_alter_commute. Qed.
+
 Lemma lookup_alter_Some {A} (f : A → A) m i j y :
   alter f i m !! j = Some y ↔
     (i = j ∧ ∃ x, m !! j = Some x ∧ y = f x) ∨ (i ≠ j ∧ m !! j = Some y).
@@ -456,7 +478,7 @@ Lemma map_of_list_inj {A} (l1 l2 : list (K * A)) :
   NoDup (fst <$> l1) → NoDup (fst <$> l2) →
   map_of_list l1 = map_of_list l2 → l1 ≡ₚ l2.
 Proof.
-  intros ?? Hl1l2. apply NoDup_Permutation; auto using (NoDup_fmap_1 fst).
+  intros ?? Hl1l2. apply NoDup_Permutation; auto using (fmap_nodup_1 fst).
   intros [i x]. by rewrite !elem_of_map_of_list, Hl1l2.
 Qed.
 Lemma map_of_to_list {A} (m : M A) : map_of_list (map_to_list m) = m.

theories/list.v

@@ -53,6 +53,10 @@ Instance list_alter {A} (f : A → A) : AlterD nat A (list A) f :=
   | x :: l => match i with 0 => f x :: l | S i => x :: @alter _ _ _ f go i l end
   end.
 
+(** The operation [<[i:=x]> l] overwrites the element at position [i] with the
+value [x]. In case [i] is out of bounds, the list is returned unchanged. *)
+Instance list_insert {A} : Insert nat A (list A) := λ i x, alter (λ _, x) i.
+
 (** The operation [delete i l] removes the [i]th element of [l] and moves
 all consecutive elements one position ahead. In case [i] is out of bounds,
 the list is returned unchanged. *)
@@ -63,10 +67,6 @@ Instance list_delete {A} : Delete nat (list A) :=
   | x :: l => match i with 0 => l | S i => x :: @delete _ _ go i l end
   end.
 
-(** The operation [<[i:=x]> l] overwrites the element at position [i] with the
-value [x]. In case [i] is out of bounds, the list is returned unchanged. *)
-Instance list_insert {A} : Insert nat A (list A) := λ i x, alter (λ _, x) i.
-
 (** The function [option_list o] converts an element [Some x] into the
 singleton list [[x]], and [None] into the empty list [[]]. *)
 Definition option_list {A} : option A → list A := option_rect _ (λ x, [x]) [].
@@ -82,6 +82,21 @@ Instance list_filter {A} : Filter A (list A) :=
     then x :: @filter _ _ (@go) _ _ l
     else @filter _ _ (@go) _ _ l