From 716f554d652e6865a5dd013a636e8472da630ad3 Mon Sep 17 00:00:00 2001
From: Robbert Krebbers <mail@robbertkrebbers.nl>
Date: Fri, 2 May 2014 22:32:11 +0200
Subject: [PATCH] Start integrating memory model with sequence point semantics.
---
theories/assoc.v | 75 +-
theories/base.v | 297 ++++--
theories/collections.v | 91 +-
theories/decidable.v | 22 +-
theories/fin_collections.v | 4 +-
theories/fin_map_dom.v | 44 +-
theories/fin_maps.v | 643 +++++-------
theories/lexico.v | 34 +-
theories/list.v | 1961 +++++++++++++++++-------------------
theories/listset.v | 23 +-
theories/listset_nodup.v | 39 +-
theories/map.v | 144 +++
theories/natmap.v | 77 +-
theories/nmap.v | 20 +-
theories/numbers.v | 119 ++-
theories/option.v | 131 +--
theories/orders.v | 212 ++--
theories/pmap.v | 123 +--
theories/tactics.v | 9 +-
theories/vector.v | 97 +-
20 files changed, 2032 insertions(+), 2133 deletions(-)
create mode 100644 theories/map.v
diff --git a/theories/assoc.v b/theories/assoc.v
index a197271e..60c4e8c8 100644
--- a/theories/assoc.v
+++ b/theories/assoc.v
@@ -11,13 +11,13 @@ Require Export fin_maps.
(** Because the association list is sorted using [strict lexico] instead of
[lexico], it automatically guarantees that no duplicates exist. *)
-Definition assoc (K : Type) `{Lexico K} `{!TrichotomyT lexico}
- `{!StrictOrder lexico} (A : Type) : Type :=
+Definition assoc (K : Type) `{Lexico K, !TrichotomyT lexico,
+ !StrictOrder lexico} (A : Type) : Type :=
dsig (λ l : list (K * A), StronglySorted lexico (fst <$> l)).
Section assoc.
-Context `{Lexico K} `{!StrictOrder lexico}.
-Context `{∀ x y : K, Decision (x = y)} `{!TrichotomyT lexico}.
+Context `{Lexico K, !StrictOrder lexico,
+ ∀ x y : K, Decision (x = y), !TrichotomyT lexico}.
Infix "⊂" := lexico.
Notation assoc_before j l :=
@@ -44,6 +44,7 @@ Ltac simplify_assoc := intros;
| H : StronglySorted _ (_ :: _) |- _ => inversion_clear H
| _ => progress decompose_elem_of_list
| _ => progress simplify_equality'
+ | _ => match goal with |- context [?o ≫= _] => by destruct o end
end;
repeat first
[ progress simplify_order
@@ -139,30 +140,45 @@ Proof.
destruct (f _); simplify_assoc.
Qed.
Lemma assoc_fmap_wf {A B} (f : A → B) (l : list (K * A)) :
- assoc_wf l → assoc_wf (snd_map f <$> l).
+ assoc_wf l → assoc_wf (prod_map id f <$> l).
Proof.
intros. by rewrite <-list_fmap_compose,
(list_fmap_ext _ fst l l) by (done; by intros []).
Qed.
Global Program Instance assoc_fmap: FMap (assoc K) := λ A B f m,
dexist _ (assoc_fmap_wf f _ (proj2_dsig m)).
-
Lemma assoc_lookup_fmap {A B} (f : A → B) (l : list (K * A)) i :
- assoc_lookup_raw i (snd_map f <$> l) = fmap f (assoc_lookup_raw i l).
+ assoc_lookup_raw i (prod_map id f <$> l) = fmap f (assoc_lookup_raw i l).
Proof. induction l as [|[??]]; simplify_assoc. Qed.
-Fixpoint assoc_merge_aux {A B} (f : option A → option B)
+Fixpoint assoc_omap_raw {A B} (f : A → option B)
(l : list (K * A)) : list (K * B) :=
match l with
| [] => []
- | (i,x) :: l => assoc_cons i (f (Some x)) (assoc_merge_aux f l)
+ | (i,x) :: l => assoc_cons i (f x) (assoc_omap_raw f l)
end.
+Lemma assoc_omap_raw_before {A B} (f : A → option B) l j :
+ assoc_before j l → assoc_before j (assoc_omap_raw f l).
+Proof. induction l as [|[??]]; simplify_assoc. Qed.
+Hint Resolve assoc_omap_raw_before.
+Lemma assoc_omap_wf {A B} (f : A → option B) l :
+ assoc_wf l → assoc_wf (assoc_omap_raw f l).
+Proof. induction l as [|[??]]; simplify_assoc. Qed.
+Hint Resolve assoc_omap_wf.
+Global Instance assoc_omap: OMap (assoc K) := λ A B f m,
+ dexist _ (assoc_omap_wf f _ (proj2_dsig m)).
+Lemma assoc_omap_spec {A B} (f : A → option B) l i :
+ assoc_wf l →
+ assoc_lookup_raw i (assoc_omap_raw f l) = assoc_lookup_raw i l ≫= f.
+Proof. intros. induction l as [|[??]]; simplify_assoc. Qed.
+Hint Rewrite @assoc_omap_spec using (by eauto) : assoc.
+
Fixpoint assoc_merge_raw {A B C} (f : option A → option B → option C)
(l : list (K * A)) : list (K * B) → list (K * C) :=
fix go (k : list (K * B)) :=
match l, k with
- | [], _ => assoc_merge_aux (f None) k
- | _, [] => assoc_merge_aux (flip f None) l
+ | [], _ => assoc_omap_raw (f None ∘ Some) k
+ | _, [] => assoc_omap_raw (flip f None ∘ Some) l
| (i,x) :: l, (j,y) :: k =>
match trichotomyT lexico i j with
| (**i i ⊂ j *) inleft (left _) =>
@@ -173,15 +189,13 @@ Fixpoint assoc_merge_raw {A B C} (f : option A → option B → option C)
assoc_cons j (f None (Some y)) (go k)
end
end.
-
Section assoc_merge_raw.
- Context {A B C} (f : option A → option B → option C).
-
+ Context {A B C} (f : option A → option B → option C).
Lemma assoc_merge_nil_l k :
- assoc_merge_raw f [] k = assoc_merge_aux (f None) k.
+ assoc_merge_raw f [] k = assoc_omap_raw (f None ∘ Some) k.
Proof. by destruct k. Qed.
Lemma assoc_merge_nil_r l :
- assoc_merge_raw f l [] = assoc_merge_aux (flip f None) l.
+ assoc_merge_raw f l [] = assoc_omap_raw (flip f None ∘ Some) l.
Proof. by destruct l as [|[??]]. Qed.
Lemma assoc_merge_cons i x j y l k :
assoc_merge_raw f ((i,x) :: l) ((j,y) :: k) =
@@ -195,14 +209,8 @@ Section assoc_merge_raw.
end.
Proof. done. Qed.
End assoc_merge_raw.
-
Arguments assoc_merge_raw _ _ _ _ _ _ : simpl never.
Hint Rewrite @assoc_merge_nil_l @assoc_merge_nil_r @assoc_merge_cons : assoc.
-
-Lemma assoc_merge_aux_before {A B} (f : option A → option B) l j :
- assoc_before j l → assoc_before j (assoc_merge_aux f l).
-Proof. induction l as [|[??]]; simplify_assoc. Qed.
-Hint Resolve assoc_merge_aux_before.
Lemma assoc_merge_before {A B C} (f : option A → option B → option C) l1 l2 j :
assoc_before j l1 → assoc_before j l2 →
assoc_before j (assoc_merge_raw f l1 l2).
@@ -211,26 +219,14 @@ Proof.
intros l2; induction l2 as [|[??] l2 IH2]; simplify_assoc.
Qed.
Hint Resolve assoc_merge_before.
-
Lemma assoc_merge_wf {A B C} (f : option A → option B → option C) l1 l2 :
assoc_wf l1 → assoc_wf l2 → assoc_wf (assoc_merge_raw f l1 l2).
Proof.
- revert A B C f l1 l2. assert (∀ A B (f : option A → option B) l,
- assoc_wf l → assoc_wf (assoc_merge_aux f l)).
- { intros ?? j l. induction l as [|[??]]; simplify_assoc. }
- intros A B C f l1. induction l1 as [|[i x] l1 IH];
+ revert l2. induction l1 as [|[i x] l1 IH];
intros l2; induction l2 as [|[j y] l2 IH2]; simplify_assoc.
Qed.
Global Instance assoc_merge: Merge (assoc K) := λ A B C f m1 m2,
- dexist (merge f (`m1) (`m2))
- (assoc_merge_wf _ _ _ (proj2_dsig m1) (proj2_dsig m2)).
-
-Lemma assoc_merge_aux_spec {A B} (f : option A → option B) l i :
- f None = None → assoc_wf l →
- assoc_lookup_raw i (assoc_merge_aux f l) = f (assoc_lookup_raw i l).
-Proof. intros. induction l as [|[??]]; simplify_assoc. Qed.
-Hint Rewrite @assoc_merge_aux_spec using (by eauto) : assoc.
-
+ dexist _ (assoc_merge_wf f _ _ (proj2_dsig m1) (proj2_dsig m2)).
Lemma assoc_merge_spec {A B C} (f : option A → option B → option C) l1 l2 i :
f None None = None → assoc_wf l1 → assoc_wf l2 →
assoc_lookup_raw i (assoc_merge_raw f l1 l2) =
@@ -268,6 +264,7 @@ Proof.
* intros ??? [??] ?. apply assoc_lookup_fmap.
* intros ? [??]. apply assoc_to_list_nodup; auto.
* intros ? [??] ??. apply assoc_to_list_elem_of; auto.
+ * intros ??? [??] ?. apply assoc_omap_spec; auto.
* intros ????? [??] [??] ?. apply assoc_merge_spec; auto.
Qed.
End assoc.
@@ -275,8 +272,8 @@ End assoc.
(** * Finite sets *)
(** We construct finite sets using the above implementation of maps. *)
Notation assoc_set K := (mapset (assoc K)).
-Instance assoc_map_dom `{Lexico K} `{!TrichotomyT (@lexico K _)}
- `{!StrictOrder lexico} {A} : Dom (assoc K A) (assoc_set K) := mapset_dom.
+Instance assoc_map_dom `{Lexico K, !TrichotomyT (@lexico K _),
+ !StrictOrder lexico} {A} : Dom (assoc K A) (assoc_set K) := mapset_dom.
Instance assoc_map_dom_spec `{Lexico K} `{!TrichotomyT (@lexico K _)}
- `{!StrictOrder lexico} `{∀ x y : K, Decision (x = y)} :
+ `{!StrictOrder lexico, ∀ x y : K, Decision (x = y)} :
FinMapDom K (assoc K) (assoc_set K) := mapset_dom_spec.
diff --git a/theories/base.v b/theories/base.v
index 6669e27a..d6b470dc 100644
--- a/theories/base.v
+++ b/theories/base.v
@@ -11,13 +11,22 @@ Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid.
(** * General *)
(** The following coercion allows us to use Booleans as propositions. *)
Coercion Is_true : bool >-> Sortclass.
+Notation "(&&)" := andb (only parsing).
+Notation "(||)" := orb (only parsing).
+
+(** Zipping lists. *)
+Definition zip_with {A B C} (f : A → B → C) : list A → list B → list C :=
+ fix go l1 l2 :=
+ match l1, l2 with x1 :: l1, x2 :: l2 => f x1 x2 :: go l1 l2 | _ , _ => [] end.
+Notation zip := (zip_with pair).
(** Ensure that [simpl] unfolds [id], [compose], and [flip] when fully
applied. *)
Arguments id _ _ /.
Arguments compose _ _ _ _ _ _ /.
Arguments flip _ _ _ _ _ _ /.
-Typeclasses Transparent id compose flip.
+Arguments const _ _ _ _ /.
+Typeclasses Transparent id compose flip const.
(** 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
@@ -43,6 +52,7 @@ Notation "( x ≠)" := (λ y, x ≠y) (only parsing) : C_scope.
Notation "(≠x )" := (λ y, y ≠x) (only parsing) : C_scope.
Hint Extern 0 (?x = ?x) => reflexivity.
+Hint Extern 100 (_ ≠_) => discriminate.
Notation "(→)" := (λ A B, A → B) (only parsing) : C_scope.
Notation "( A →)" := (λ B, A → B) (only parsing) : C_scope.
@@ -70,6 +80,22 @@ Notation "(↔)" := iff (only parsing) : C_scope.
Notation "( A ↔)" := (iff A) (only parsing) : C_scope.
Notation "(↔ B )" := (λ A, A ↔ B) (only parsing) : C_scope.
+Hint Extern 0 (_ ↔ _) => reflexivity.
+Hint Extern 0 (_ ↔ _) => symmetry; assumption.
+
+Notation "( x ,)" := (pair x) (only parsing) : C_scope.
+Notation "(, y )" := (λ x, (x,y)) (only parsing) : C_scope.
+
+Notation "p .1" := (fst p) (at level 10, format "p .1").
+Notation "p .2" := (snd p) (at level 10, format "p .2").
+
+Definition prod_map {A A' B B'} (f : A → A') (g : B → B')
+ (p : A * B) : A' * B' := (f (p.1), g (p.2)).
+Arguments prod_map {_ _ _ _} _ _ !_ /.
+Definition prod_zip {A A' A'' B B' B''} (f : A → A' → A'') (g : B → B' → B'')
+ (p : A * B) (q : A' * B') : A'' * B'' := (f (p.1) (q.1), g (p.2) (q.2)).
+Arguments prod_zip {_ _ _ _ _ _} _ _ !_ !_ /.
+
(** Set convenient implicit arguments for [existT] and introduce notations. *)
Arguments existT {_ _} _ _.
Arguments proj1_sig {_ _} _.
@@ -128,12 +154,12 @@ Class ProofIrrel (A : Type) : Prop := proof_irrel (x y : A) : x = y.
Class Equiv A := equiv: relation A.
Infix "≡" := equiv (at level 70, no associativity) : C_scope.
Notation "(≡)" := equiv (only parsing) : C_scope.
-Notation "( x ≡)" := (equiv x) (only parsing) : C_scope.
-Notation "(≡ x )" := (λ y, y ≡ x) (only parsing) : C_scope.
-Notation "(≢)" := (λ x y, ¬x ≡ y) (only parsing) : C_scope.
-Notation "x ≢ y":= (¬x ≡ y) (at level 70, no associativity) : C_scope.
-Notation "( x ≢)" := (λ y, x ≢ y) (only parsing) : C_scope.
-Notation "(≢ x )" := (λ y, y ≢ x) (only parsing) : C_scope.
+Notation "( X ≡)" := (equiv X) (only parsing) : C_scope.
+Notation "(≡ X )" := (λ Y, Y ≡ X) (only parsing) : C_scope.
+Notation "(≢)" := (λ X Y, ¬X ≡ Y) (only parsing) : C_scope.
+Notation "X ≢ Y":= (¬X ≡ Y) (at level 70, no associativity) : C_scope.
+Notation "( X ≢)" := (λ Y, X ≢ Y) (only parsing) : C_scope.
+Notation "(≢ X )" := (λ Y, Y ≢ X) (only parsing) : C_scope.
(** The type class [LeibnizEquiv] collects setoid equalities that coincide
with Leibniz equality. We provide the tactic [fold_leibniz] to transform such
@@ -182,6 +208,12 @@ Infix "∪" := union (at level 50, left associativity) : C_scope.
Notation "(∪)" := union (only parsing) : C_scope.
Notation "( x ∪)" := (union x) (only parsing) : C_scope.
Notation "(∪ x )" := (λ y, union y x) (only parsing) : C_scope.
+Infix "∪*" := (zip_with (∪)) (at level 50, left associativity) : C_scope.
+Notation "(∪*)" := (zip_with (∪)) (only parsing) : C_scope.
+Infix "∪**" := (zip_with (zip_with (∪)))
+ (at level 50, left associativity) : C_scope.
+Infix "∪*∪**" := (zip_with (prod_zip (∪) (∪*)))
+ (at level 50, left associativity) : C_scope.
Definition union_list `{Empty A} `{Union A} : list A → A := fold_right (∪) ∅.
Arguments union_list _ _ _ !_ /.
@@ -200,6 +232,12 @@ Infix "∖" := difference (at level 40) : C_scope.
Notation "(∖)" := difference (only parsing) : C_scope.
Notation "( x ∖)" := (difference x) (only parsing) : C_scope.
Notation "(∖ x )" := (λ y, difference y x) (only parsing) : C_scope.
+Infix "∖*" := (zip_with (∖)) (at level 40, left associativity) : C_scope.
+Notation "(∖*)" := (zip_with (∖)) (only parsing) : C_scope.
+Infix "∖**" := (zip_with (zip_with (∖)))
+ (at level 40, left associativity) : C_scope.
+Infix "∖*∖**" := (zip_with (prod_zip (∖) (∖*)))
+ (at level 50, left associativity) : C_scope.
Class Singleton A B := singleton: A → B.
Instance: Params (@singleton) 3.
@@ -217,22 +255,58 @@ Instance: Params (@subseteq) 2.
Infix "⊆" := subseteq (at level 70) : C_scope.
Notation "(⊆)" := subseteq (only parsing) : C_scope.
Notation "( X ⊆ )" := (subseteq X) (only parsing) : C_scope.
-Notation "( ⊆ X )" := (λ Y, subseteq Y X) (only parsing) : C_scope.
+Notation "( ⊆ X )" := (λ Y, Y ⊆ X) (only parsing) : C_scope.
Notation "X ⊈ Y" := (¬X ⊆ Y) (at level 70) : C_scope.
Notation "(⊈)" := (λ X Y, X ⊈ Y) (only parsing) : C_scope.
Notation "( X ⊈ )" := (λ Y, X ⊈ Y) (only parsing) : C_scope.
Notation "( ⊈ X )" := (λ Y, Y ⊈ X) (only parsing) : C_scope.
-Infix "⊆*" := (Forall2 subseteq) (at level 70) : C_scope.
-Notation "(⊆*)" := (Forall2 subseteq) (only parsing) : C_scope.
+Infix "⊆*" := (Forall2 (⊆)) (at level 70) : C_scope.
+Notation "(⊆*)" := (Forall2 (⊆)) (only parsing) : C_scope.
+Infix "⊆**" := (Forall2 (⊆*)) (at level 70) : C_scope.
+Infix "⊆1*" := (Forall2 (λ p q, p.1 ⊆ q.1)) (at level 70) : C_scope.
+Infix "⊆2*" := (Forall2 (λ p q, p.2 ⊆ q.2)) (at level 70) : C_scope.
+Infix "⊆1**" := (Forall2 (λ p q, p.1 ⊆* q.1)) (at level 70) : C_scope.
+Infix "⊆2**" := (Forall2 (λ p q, p.2 ⊆* q.2)) (at level 70) : C_scope.
Hint Extern 0 (_ ⊆ _) => reflexivity.
+Hint Extern 0 (_ ⊆* _) => reflexivity.
+Hint Extern 0 (_ ⊆** _) => reflexivity.
+
+Class SubsetEqE E A := subseteqE: E → relation A.
+Instance: Params (@subseteqE) 4.
+Notation "X ⊆{ Γ } Y" := (subseteqE Γ X Y)
+ (at level 70, format "X ⊆{ Γ } Y") : C_scope.
+Notation "(⊆{ Γ } )" := (subseteqE Γ) (only parsing, Γ at level 1) : C_scope.
+Notation "X ⊈{ Γ } Y" := (¬X ⊆{Γ} Y)
+ (at level 70, format "X ⊈{ Γ } Y") : C_scope.
+Notation "(⊈{ Γ } )" := (λ X Y, X ⊈{Γ} Y)
+ (only parsing, Γ at level 1) : C_scope.
+Notation "Xs ⊆{ Γ }* Ys" := (Forall2 (⊆{Γ}) Xs Ys)
+ (at level 70, format "Xs ⊆{ Γ }* Ys") : C_scope.
+Notation "(⊆{ Γ }* )" := (Forall2 (⊆{Γ}))
+ (only parsing, Γ at level 1) : C_scope.
+Notation "X ⊆{ Γ1 , Γ2 , .. , Γ3 } Y" :=
+ (subseteqE (pair .. (Γ1, Γ2) .. Γ3) X Y)
+ (at level 70, format "'[' X ⊆{ Γ1 , Γ2 , .. , Γ3 } '/' Y ']'") : C_scope.
+Notation "(⊆{ Γ1 , Γ2 , .. , Γ3 } )" := (subseteqE (pair .. (Γ1, Γ2) .. Γ3))
+ (only parsing, Γ1 at level 1) : C_scope.
+Notation "X ⊈{ Γ1 , Γ2 , .. , Γ3 } Y" := (¬X ⊆{pair .. (Γ1, Γ2) .. Γ3} Y)
+ (at level 70, format "X ⊈{ Γ1 , Γ2 , .. , Γ3 } Y") : C_scope.
+Notation "(⊈{ Γ1 , Γ2 , .. , Γ3 } )" := (λ X Y, X ⊈{pair .. (Γ1, Γ2) .. Γ3} Y)
+ (only parsing) : C_scope.
+Notation "Xs ⊆{ Γ1 , Γ2 , .. , Γ3 }* Ys" :=
+ (Forall2 (⊆{pair .. (Γ1, Γ2) .. Γ3}) Xs Ys)
+ (at level 70, format "Xs ⊆{ Γ1 , Γ2 , .. , Γ3 }* Ys") : C_scope.
+Notation "(⊆{ Γ1 , Γ2 , .. , Γ3 }* )" := (Forall2 (⊆{pair .. (Γ1, Γ2) .. Γ3}))
+ (only parsing, Γ1 at level 1) : C_scope.
+Hint Extern 0 (_ ⊆{_} _) => reflexivity.
Definition strict {A} (R : relation A) : relation A := λ X Y, R X Y ∧ ¬R Y X.
Instance: Params (@strict) 2.
-Infix "⊂" := (strict subseteq) (at level 70) : C_scope.
-Notation "(⊂)" := (strict subseteq) (only parsing) : C_scope.
-Notation "( X ⊂ )" := (strict subseteq X) (only parsing) : C_scope.
-Notation "( ⊂ X )" := (λ Y, strict subseteq Y X) (only parsing) : C_scope.
+Infix "⊂" := (strict (⊆)) (at level 70) : C_scope.
+Notation "(⊂)" := (strict (⊆)) (only parsing) : C_scope.
+Notation "( X ⊂ )" := (strict (⊆) X) (only parsing) : C_scope.
+Notation "( ⊂ X )" := (λ Y, Y ⊂ X) (only parsing) : C_scope.
Notation "X ⊄ Y" := (¬X ⊂ Y) (at level 70) : C_scope.
Notation "(⊄)" := (λ X Y, X ⊄ Y) (only parsing) : C_scope.
Notation "( X ⊄ )" := (λ Y, X ⊄ Y) (only parsing) : C_scope.
@@ -259,50 +333,52 @@ Instance: Params (@disjoint) 2.
Infix "⊥" := disjoint (at level 70) : C_scope.
Notation "(⊥)" := disjoint (only parsing) : C_scope.
Notation "( X ⊥.)" := (disjoint X) (only parsing) : C_scope.
-Notation "(.⊥ X )" := (λ Y, disjoint Y X) (only parsing) : C_scope.
+Notation "(.⊥ X )" := (λ Y, Y ⊥ X) (only parsing) : C_scope.
+Infix "⊥*" := (Forall2 (⊥)) (at level 70) : C_scope.
+Notation "(⊥*)" := (Forall2 (⊥)) (only parsing) : C_scope.
+Infix "⊥**" := (Forall2 (⊥*)) (at level 70) : C_scope.
+Infix "⊥1*" := (Forall2 (λ p q, p.1 ⊥ q.1)) (at level 70) : C_scope.
+Infix "⊥2*" := (Forall2 (λ p q, p.2 ⊥ q.2)) (at level 70) : C_scope.
+Infix "⊥1**" := (Forall2 (λ p q, p.1 ⊥* q.1)) (at level 70) : C_scope.
+Infix "⊥2**" := (Forall2 (λ p q, p.2 ⊥* q.2)) (at level 70) : C_scope.
+Hint Extern 0 (_ ⊥ _) => symmetry; eassumption.
+Hint Extern 0 (_ ⊥* _) => symmetry; eassumption.
+
+Class DisjointE E A := disjointE : E → A → A → Prop.
+Instance: Params (@disjointE) 4.
+Notation "X ⊥{ Γ } Y" := (disjointE Γ X Y)
+ (at level 70, format "X ⊥{ Γ } Y") : C_scope.
+Notation "(⊥{ Γ } )" := (disjointE Γ) (only parsing, Γ at level 1) : C_scope.
+Notation "Xs ⊥{ Γ }* Ys" := (Forall2 (⊥{Γ}) Xs Ys)
+ (at level 70, format "Xs ⊥{ Γ }* Ys") : C_scope.
+Notation "(⊥{ Γ }* )" := (Forall2 (⊥{Γ}))
+ (only parsing, Γ at level 1) : C_scope.
+Notation "X ⊥{ Γ1 , Γ2 , .. , Γ3 } Y" := (disjoint (pair .. (Γ1, Γ2) .. Γ3) X Y)
+ (at level 70, format "X ⊥{ Γ1 , Γ2 , .. , Γ3 } Y") : C_scope.
+Notation "Xs ⊥{ Γ1 , Γ2 , .. , Γ3 }* Ys" :=
+ (Forall2 (disjoint (pair .. (Γ1, Γ2) .. Γ3)) Xs Ys)
+ (at level 70, format "Xs ⊥{ Γ1 , Γ2 , .. , Γ3 }* Ys") : C_scope.
+Hint Extern 0 (_ ⊥{_} _) => symmetry; eassumption.
Class DisjointList A := disjoint_list : list A → Prop.
Instance: Params (@disjoint_list) 2.
-Notation "⊥ l" := (disjoint_list l) (at level 20, format "⊥ l") : C_scope.
+Notation "⊥ Xs" := (disjoint_list Xs) (at level 20, format "⊥ Xs") : C_scope.
-Section default_disjoint_list.
- Context `{Empty A} `{Union A} `{Disjoint A}.
- Inductive default_disjoint_list : DisjointList A :=
- | disjoint_nil_2 : ⊥ []
- | disjoint_cons_2 X Xs : X ⊥ ⋃ Xs → ⊥ Xs → ⊥ (X :: Xs).
- Global Existing Instance default_disjoint_list.
+Section disjoint_list.
+ Context `{Disjoint A, Union A, Empty A}.
+ Inductive disjoint_list_default : DisjointList A :=
+ | disjoint_nil_2 : ⊥ (@nil A)
+ | disjoint_cons_2 (X : A) (Xs : list A) : X ⊥ ⋃ Xs → ⊥ Xs → ⊥ (X :: Xs).
+ Global Existing Instance disjoint_list_default.
- Lemma disjoint_list_nil : ⊥ @nil A ↔ True.
+ Lemma disjoint_list_nil : ⊥ @nil A ↔ True.
Proof. split; constructor. Qed.
Lemma disjoint_list_cons X Xs : ⊥ (X :: Xs) ↔ X ⊥ ⋃ Xs ∧ ⊥ Xs.
Proof. split. inversion_clear 1; auto. intros [??]. constructor; auto. Qed.
-End default_disjoint_list.
+End disjoint_list.
Class Filter A B := filter: ∀ (P : A → Prop) `{∀ x, Decision (P x)}, B → B.
-(** We define variants of the relations [(≡)] and [(⊆)] that are indexed by
-an environment. *)
-Class EquivEnv A B := equiv_env : A → relation B.
-Notation "X ≡@{ E } Y" := (equiv_env E X Y)
- (at level 70, format "X ≡@{ E } Y") : C_scope.
-Notation "(≡@{ E } )" := (equiv_env E) (E at level 1, only parsing) : C_scope.
-Instance: Params (@equiv_env) 4.
-
-Class SubsetEqEnv A B := subseteq_env : A → relation B.
-Instance: Params (@subseteq_env) 4.
-Notation "X ⊑@{ E } Y" := (subseteq_env E X Y)
- (at level 70, format "X ⊑@{ E } Y") : C_scope.
-Notation "(⊑@{ E } )" := (subseteq_env E)
- (E at level 1, only parsing) : C_scope.
-Notation "X ⊑@{ E }* Y" := (Forall2 (subseteq_env E) X Y)
- (at level 70, format "X ⊑@{ E }* Y") : C_scope.
-Notation "(⊑@{ E }*)" := (Forall2 (subseteq_env E))
- (E at level 1, only parsing) : C_scope.
-Instance: Params (@subseteq_env) 4.
-
-Hint Extern 0 (_ ≡@{_} _) => reflexivity.
-Hint Extern 0 (_ ⊑@{_} _) => reflexivity.
-
(** ** Monadic operations *)
(** We define operational type classes for the monadic operations bind, join
and fmap. These type classes are defined in a non-standard way by taking the
@@ -340,6 +416,11 @@ Notation FMap M := (∀ {A B} (f : A → B), FMapD M f)%type.
Instance: Params (@fmap) 6.
Arguments fmap {_ _ _} _ {_} !_ /.
+Class OMapD (M : Type → Type) {A B} (f : A → option B) := omap: M A → M B.
+Notation OMap M := (∀ {A B} (f : A → option B), OMapD M f)%type.
+Instance: Params (@omap) 6.
+Arguments omap {_ _ _} _ {_} !_ /.
+
Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope.
Notation "( m ≫=)" := (λ f, mbind f m) (only parsing) : C_scope.
Notation "(≫= f )" := (mbind f) (only parsing) : C_scope.
@@ -348,6 +429,12 @@ Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : C_scope.
Notation "x ↠y ; z" := (y ≫= (λ x : _, z))
(at level 65, next at level 35, only parsing, right associativity) : C_scope.
Infix "<$>" := fmap (at level 60, right associativity) : C_scope.
+Notation "'( x1 , x2 ) ↠y ; z" :=
+ (y ≫= (λ x : _, let ' (x1, x2) := x in z))
+ (at level 65, next at level 35, only parsing, right associativity) : C_scope.
+Notation "'( x1 , x2 , x3 ) ↠y ; z" :=
+ (y ≫= (λ x : _, let ' (x1,x2,x3) := x in z))
+ (at level 65, next at level 35, only parsing, right associativity) : C_scope.
Class MGuard (M : Type → Type) :=
mguard: ∀ P {dec : Decision P} {A}, (P → M A) → M A.
@@ -363,10 +450,9 @@ on maps. In the file [fin_maps] we will axiomatize finite maps.
The function look up [m !! k] should yield the element at key [k] in [m]. *)
Class Lookup (K A M : Type) := lookup: K → M → option A.
Instance: Params (@lookup) 4.
-
Notation "m !! i" := (lookup i m) (at level 20) : C_scope.
Notation "(!!)" := lookup (only parsing) : C_scope.
-Notation "( m !!)" := (λ i, lookup i m) (only parsing) : C_scope.
+Notation "( m !!)" := (λ i, m !! i) (only parsing) : C_scope.
Notation "(!! i )" := (lookup i) (only parsing) : C_scope.
Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch.
@@ -416,7 +502,7 @@ Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch.
(** We lift the insert and delete operation to lists of elements. *)
Definition insert_list `{Insert K A M} (l : list (K * A)) (m : M) : M :=
- fold_right (λ p, <[ fst p := snd p ]>) m l.
+ fold_right (λ p, <[p.1:=p.2]>) m l.
Instance: Params (@insert_list) 4.
Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
fold_right delete m l.
@@ -445,6 +531,19 @@ Definition intersection_with_list `{IntersectionWith A M}
(f : A → A → option A) : M → list M → M := fold_right (intersection_with f).
Arguments intersection_with_list _ _ _ _ _ !_ /.
+Class LookupE (E K A M : Type) := lookupE: E → K → M → option A.
+Instance: Params (@lookupE) 6.
+Notation "m !!{ Γ } i" := (lookupE Γ i m)
+ (at level 20, format "m !!{ Γ } i") : C_scope.
+Notation "(!!{ Γ } )" := (lookupE Γ) (only parsing, Γ at level 1) : C_scope.
+Arguments lookupE _ _ _ _ _ _ !_ !_ / : simpl nomatch.
+
+Class InsertE (E K A M : Type) := insertE: E → K → A → M → M.
+Instance: Params (@insert) 6.
+Notation "<[ k := a ]{ Γ }>" := (insertE Γ k a)
+ (at level 5, right associativity, format "<[ k := a ]{ Γ }>") : C_scope.
+Arguments insertE _ _ _ _ _ _ !_ _ !_ / : simpl nomatch.
+
(** ** Common properties *)
(** These operational type classes allow us to refer to common mathematical
properties in a generic way. For example, for injectivity of [(k ++)] it
@@ -503,6 +602,9 @@ Arguments total {_} _ {_} _ _.
Arguments trichotomy {_} _ {_} _ _.
Arguments trichotomyT {_} _ {_} _ _.
+Instance id_injective {A} : Injective (=) (=) (@id A).
+Proof. intros ??; auto. Qed.
+
(** The following lemmas are specific versions of the projections of the above
type classes for Leibniz equality. These lemmas allow us to enforce Coq not to
use the setoid rewriting mechanism. *)
@@ -543,59 +645,56 @@ Class TotalOrder {A} (R : relation A) : Prop := {
to_trichotomy :> Trichotomy R
}.
-(** A pre-order equipped with a smallest element. *)
-Class BoundedPreOrder A `{Empty A} `{SubsetEq A} : Prop := {
- bounded_preorder :>> PreOrder (⊆);
- subseteq_empty x : ∅ ⊆ x
-}.
-
(** We do not include equality in the following interfaces so as to avoid the
need for proofs that the relations and operations respect setoid equality.
Instead, we will define setoid equality in a generic way as
[λ X Y, X ⊆ Y ∧ Y ⊆ X]. *)
-Class BoundedJoinSemiLattice A `{Empty A} `{SubsetEq A} `{Union A} : Prop := {
+Class BoundedPreOrder A `{Empty A, SubsetEq A} : Prop := {
+ bounded_preorder :>> PreOrder (⊆);
+ subseteq_empty X : ∅ ⊆ X
+}.
+Class BoundedJoinSemiLattice A `{Empty A, SubsetEq A, Union A} : Prop := {
bjsl_preorder :>> BoundedPreOrder A;
- union_subseteq_l x y : x ⊆ x ∪ y;
- union_subseteq_r x y : y ⊆ x ∪ y;
- union_least x y z : x ⊆ z → y ⊆ z → x ∪ y ⊆ z
+ union_subseteq_l X Y : X ⊆ X ∪ Y;
+ union_subseteq_r X Y : Y ⊆ X ∪ Y;
+ union_least X Y Z : X ⊆ Z → Y ⊆ Z → X ∪ Y ⊆ Z
}.
-Class MeetSemiLattice A `{Empty A} `{SubsetEq A} `{Intersection A} : Prop := {
+Class MeetSemiLattice A `{Empty A, SubsetEq A, Intersection A} : Prop := {
msl_preorder :>> BoundedPreOrder A;
- intersection_subseteq_l x y : x ∩ y ⊆ x;
- intersection_subseteq_r x y : x ∩ y ⊆ y;
- intersection_greatest x y z : z ⊆ x → z ⊆ y → z ⊆ x ∩ y
+ intersection_subseteq_l X Y : X ∩ Y ⊆ X;
+ intersection_subseteq_r X Y : X ∩ Y ⊆ Y;
+ intersection_greatest X Y Z : Z ⊆ X → Z ⊆ Y → Z ⊆ X ∩ Y
}.
(** A join distributive lattice with distributivity stated in the order
theoretic way. We will prove that distributivity of join, and distributivity
as an equality can be derived. *)
-Class LowerBoundedLattice A `{Empty A} `{SubsetEq A}
- `{Union A} `{Intersection A} : Prop := {
+Class LowerBoundedLattice A
+ `{Empty A, SubsetEq A, Union A, Intersection A} : Prop := {
lbl_bjsl :>> BoundedJoinSemiLattice A;
lbl_msl :>> MeetSemiLattice A;
- lbl_distr x y z : (x ∪ y) ∩ (x ∪ z) ⊆ x ∪ (y ∩ z)
+ lbl_distr X Y Z : (X ∪ Y) ∩ (X ∪ Z) ⊆ X ∪ (Y ∩ Z)
}.
(** ** Axiomatization of collections *)
(** The class [SimpleCollection A C] axiomatizes a collection of type [C] with
elements of type [A]. *)
Instance: Params (@map) 3.
-Class SimpleCollection A C `{ElemOf A C}
- `{Empty C} `{Singleton A C} `{Union C} : Prop := {
+Class SimpleCollection A C `{ElemOf A C,
+ Empty C, Singleton A C, Union C} : Prop := {
not_elem_of_empty (x : A) : x ∉ ∅;
elem_of_singleton (x y : A) : x ∈ {[ y ]} ↔ x = y;
elem_of_union X Y (x : A) : x ∈ X ∪ Y ↔ x ∈ X ∨ x ∈ Y
}.
-Class Collection A C `{ElemOf A C} `{Empty C} `{Singleton A C}
- `{Union C} `{Intersection C} `{Difference C} : Prop := {
+Class Collection A C `{ElemOf A C, Empty C, Singleton A C,
+ Union C, Intersection C, Difference C} : Prop := {
collection_simple :>> SimpleCollection A C;
elem_of_intersection X Y (x : A) : x ∈ X ∩ Y ↔ x ∈ X ∧ x ∈ Y;
elem_of_difference X Y (x : A) : x ∈ X ∖ Y ↔ x ∈ X ∧ x ∉ Y
}.
-Class CollectionOps A C
- `{ElemOf A C} `{Empty C} `{Singleton A C}
- `{Union C} `{Intersection C} `{Difference C}
- `{IntersectionWith A C} `{Filter A C} : Prop := {
+Class CollectionOps A C `{ElemOf A C, Empty C, Singleton A C,
+ Union C, Intersection C, Difference C,
+ IntersectionWith A C, Filter A C} : Prop := {
collection_ops :>> Collection A C;
elem_of_intersection_with (f : A → A → option A) X Y (x : A) :
x ∈ intersection_with f X Y ↔ ∃ x1 x2, x1 ∈ X ∧ x2 ∈ Y ∧ f x1 x2 = Some x;
@@ -621,9 +720,9 @@ Inductive NoDup {A} : list A → Prop :=
(** Decidability of equality of the carrier set is admissible, but we add it
anyway so as to avoid cycles in type class search. *)
-Class FinCollection A C `{ElemOf A C} `{Empty C} `{Singleton A C}
- `{Union C} `{Intersection C} `{Difference C}
- `{Elements A C} `{∀ x y : A, Decision (x = y)} : Prop := {
+Class FinCollection A C `{ElemOf A C, Empty C, Singleton A C,
+ Union C, Intersection C, Difference C,
+ Elements A C, ∀ x y : A, Decision (x = y)} : Prop := {
fin_collection :>> Collection A C;
elements_spec X x : x ∈ X ↔ x ∈ elements X;
elements_nodup X : NoDup (elements X)
@@ -640,9 +739,9 @@ possible (we will only provide an inhabitant using unordered lists without
duplicates removed). More interesting implementations typically need
decidability of equality, or a total order on the elements, which do not fit
in a type constructor of type [Type → Type]. *)
-Class CollectionMonad M `{∀ A, ElemOf A (M A)}
- `{∀ A, Empty (M A)} `{∀ A, Singleton A (M A)} `{∀ A, Union (M A)}
- `{!MBind M} `{!MRet M} `{!FMap M} `{!MJoin M} : Prop := {
+Class CollectionMonad M `{∀ A, ElemOf A (M A),
+ ∀ A, Empty (M A), ∀ A, Singleton A (M A), ∀ A, Union (M A),
+ !MBind M, !MRet M, !FMap M, !MJoin M} : Prop := {
collection_monad_simple A :> SimpleCollection A (M A);
elem_of_bind {A B} (f : A → M B) (X : M A) (x : B) :
x ∈ X ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ X;
@@ -657,8 +756,8 @@ will later prove that [fresh] is [Proper] with respect to the induced setoid
equality on collections. *)
Class Fresh A C := fresh: C → A.
Instance: Params (@fresh) 3.
-Class FreshSpec A C `{ElemOf A C}
- `{Empty C} `{Singleton A C} `{Union C} `{Fresh A C} : Prop := {
+Class FreshSpec A C `{ElemOf A C,
+ Empty C, Singleton A C, Union C, Fresh A C} : Prop := {
fresh_collection_simple :>> SimpleCollection A C;
fresh_proper_alt X Y : (∀ x, x ∈ X ↔ x ∈ Y) → fresh X = fresh Y;
is_fresh (X : C) : fresh X ∉ X
@@ -666,12 +765,13 @@ Class FreshSpec A C `{ElemOf A C}
(** * Miscellaneous *)
Class Half A := half: A → A.
-Notation "x .½" := (half x) (at level 20, format "x .½") : C_scope.
+Notation "½" := half : C_scope.
+Notation "½*" := (fmap (M:=list) half) : 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 : ¬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 : R x y ↔ R y x.
Proof. intuition. Qed.
@@ -690,25 +790,18 @@ Instance pointwise_transitive {A} `{R : relation B} :
Proof. firstorder. Qed.
(** ** Products *)
-Definition fst_map {A A' B} (f : A → A') (p : A * B) : A' * B :=
- (f (fst p), snd p).
-Definition snd_map {A B B'} (f : B → B') (p : A * B) : A * B' :=
- (fst p, f (snd p)).
-Arguments fst_map {_ _ _} _ !_ /.
-Arguments snd_map {_ _ _} _ !_ /.
-
-Instance: ∀ {A A' B} (f : A → A'),
- Injective (=) (=) f → Injective (=) (=) (@fst_map A A' B f).
-Proof. intros ????? [??] [??]; injection 1; firstorder congruence. Qed.
-Instance: ∀ {A B B'} (f : B → B'),
- Injective (=) (=) f → Injective (=) (=) (@snd_map A B B' f).
-Proof. intros ????? [??] [??]; injection 1; firstorder congruence. Qed.
+Instance prod_map_injective {A A' B B'} (f : A → A') (g : B → B') :
+ Injective (=) (=) f → Injective (=) (=) g →
+ Injective (=) (=) (prod_map f g).
+Proof.
+ intros ?? [??] [??] ?; simpl in *; f_equal;
+ [apply (injective f)|apply (injective g)]; congruence.
+Qed.
Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) :
- relation (A * B) := λ x y, R1 (fst x) (fst y) ∧ R2 (snd x) (snd y).
-
+ relation (A * B) := λ x y, R1 (x.1) (y.1) ∧ R2 (x.2) (y.2).
Section prod_relation.
- Context `{R1 : relation A} `{R2 : relation B}.
+ Context `{R1 : relation A, R2 : relation B}.
Global Instance:
Reflexive R1 → Reflexive R2 → Reflexive (prod_relation R1 R2).
Proof. firstorder eauto. Qed.
@@ -735,8 +828,6 @@ 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.
diff --git a/theories/collections.v b/theories/collections.v
index 78f8cd0b..79d39ae3 100644
--- a/theories/collections.v
+++ b/theories/collections.v
@@ -5,6 +5,9 @@ importantly, it implements some tactics to automatically solve goals involving
collections. *)
Require Export base tactics orders.
+Instance collection_subseteq `{ElemOf A C} : SubsetEq C := λ X Y,
+ ∀ x, x ∈ X → x ∈ Y.
+
(** * Basic theorems *)
Section simple_collection.
Context `{SimpleCollection A C}.
@@ -16,8 +19,6 @@ Section simple_collection.
Lemma elem_of_union_r x X Y : x ∈ Y → x ∈ X ∪ Y.
Proof. intros. apply elem_of_union. auto. Qed.
- Global Instance collection_subseteq: SubsetEq C := λ X Y,
- ∀ x, x ∈ X → x ∈ Y.
Global Instance: BoundedJoinSemiLattice C.
Proof. firstorder auto. Qed.
@@ -34,29 +35,25 @@ Section simple_collection.
Lemma elem_of_subseteq_singleton x X : x ∈ X ↔ {[ x ]} ⊆ X.
Proof.
split.
- * intros ??. rewrite elem_of_singleton. intro. by subst.
+ * intros ??. rewrite elem_of_singleton. by intros ->.
* intros Ex. by apply (Ex x), elem_of_singleton.
Qed.
Global Instance singleton_proper : Proper ((=) ==> (≡)) singleton.
- Proof. repeat intro. by subst. Qed.
+ Proof. by repeat intro; subst. Qed.
Global Instance elem_of_proper: Proper ((=) ==> (≡) ==> iff) (∈) | 5.
- Proof. intros ???. subst. firstorder. Qed.
+ Proof. intros ???; subst. firstorder. Qed.
Lemma elem_of_union_list Xs x : x ∈ ⋃ Xs ↔ ∃ X, X ∈ Xs ∧ x ∈ X.
Proof.
split.
- * induction Xs; simpl; intros HXs.
- + by apply elem_of_empty in HXs.
- + setoid_rewrite elem_of_cons.
- apply elem_of_union in HXs. naive_solver.
- * intros [X []]. induction 1; simpl.
- + by apply elem_of_union_l.
- + intros. apply elem_of_union_r; auto.
+ * induction Xs; simpl; intros HXs; [by apply elem_of_empty in HXs|].
+ setoid_rewrite elem_of_cons. apply elem_of_union in HXs. naive_solver.
+ * intros [X []]. induction 1; simpl; [by apply elem_of_union_l |].
+ intros. apply elem_of_union_r; auto.
Qed.
Lemma non_empty_singleton x : {[ x ]} ≢ ∅.
Proof. intros [E _]. by apply (elem_of_empty x), E, elem_of_singleton. Qed.
-
Lemma not_elem_of_singleton x y : x ∉ {[ y ]} ↔ x ≠y.
Proof. by rewrite elem_of_singleton. Qed.
Lemma not_elem_of_union x X Y : x ∉ X ∪ Y ↔ x ∉ X ∧ x ∉ Y.
@@ -64,7 +61,6 @@ Section simple_collection.
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 elem_of_equiv_alt_L X Y :
@@ -78,7 +74,6 @@ Section simple_collection.
Section dec.
Context `{∀ X Y : C, Decision (X ⊆ Y)}.
-
Global Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100.
Proof.
refine (cast_if (decide_rel (⊆) {[ x ]} X));
@@ -203,18 +198,12 @@ Section collection.
Context `{Collection A C}.
Global Instance: LowerBoundedLattice C.
- Proof.
- split.
- * apply _.
- * firstorder auto.
- * solve_elem_of.
- Qed.
+ Proof. split. apply _. firstorder auto. solve_elem_of. Qed.
Lemma intersection_singletons x : {[x]} ∩ {[x]} ≡ {[x]}.
Proof. esolve_elem_of. Qed.
Lemma difference_twice X Y : (X ∖ Y) ∖ Y ≡ X ∖ Y.
Proof. esolve_elem_of. Qed.
-
Lemma empty_difference X Y : X ⊆ Y → X ∖ Y ≡ ∅.
Proof. esolve_elem_of. Qed.
Lemma difference_diag X : X ∖ X ≡ ∅.
@@ -226,12 +215,10 @@ Section collection.
Section leibniz.
Context `{!LeibnizEquiv C}.
-
Lemma intersection_singletons_L x : {[x]} ∩ {[x]} = {[x]}.
Proof. unfold_leibniz. apply intersection_singletons. Qed.
Lemma difference_twice_L X Y : (X ∖ Y) ∖ Y = X ∖ Y.
Proof. unfold_leibniz. apply difference_twice. Qed.
-
Lemma empty_difference_L X Y : X ⊆ Y → X ∖ Y = ∅.
Proof. unfold_leibniz. apply empty_difference. Qed.
Lemma difference_diag_L X : X ∖ X = ∅.
@@ -245,20 +232,14 @@ Section collection.
Section dec.
Context `{∀ X Y : C, Decision (X ⊆ Y)}.
-
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.
+ 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.
- Proof.
- rewrite elem_of_difference. destruct (decide (x ∈ Y)); tauto.
- Qed.
+ Proof. rewrite elem_of_difference. destruct (decide (x ∈ Y)); tauto. Qed.
Lemma union_difference X Y : X ⊆ Y → Y ≡ X ∪ Y ∖ X.
Proof.
- split; intros x; rewrite !elem_of_union, elem_of_difference.
- * destruct (decide (x ∈ X)); intuition.
- * intuition.
+ split; intros x; rewrite !elem_of_union, elem_of_difference; [|intuition].
+ destruct (decide (x ∈ X)); intuition.
Qed.
Lemma non_empty_difference X Y : X ⊂ Y → Y ∖ X ≢ ∅.
Proof.
@@ -267,7 +248,6 @@ Section collection.
Qed.
Context `{!LeibnizEquiv C}.
-
Lemma union_difference_L X Y : X ⊆ Y → Y = X ∪ Y ∖ X.
Proof. unfold_leibniz. apply union_difference. Qed.
Lemma non_empty_difference_L X Y : X ⊂ Y → Y ∖ X ≠∅.
@@ -283,12 +263,10 @@ Section collection_ops.
Forall2 (∈) xs Xs ∧ y ∈ Y ∧ foldr (λ x, (≫= f x)) (Some y) xs = Some x.
Proof.
split.
- * revert x. induction Xs; simpl; intros x HXs.
- + eexists [], x. intuition.
- + rewrite elem_of_intersection_with in HXs.
- destruct HXs as (x1 & x2 & Hx1 & Hx2 & ?).
- destruct (IHXs x2) as (xs & y & hy & ? & ?); trivial.
- eexists (x1 :: xs), y. intuition (simplify_option_equality; auto).
+ * revert x. induction Xs; simpl; intros x HXs; [eexists [], x; intuition|].
+ rewrite elem_of_intersection_with in HXs; destruct HXs as (x1&x2&?&?&?).
+ destruct (IHXs x2) as (xs & y & hy & ? & ?); trivial.
+ eexists (x1 :: xs), y. intuition (simplify_option_equality; auto).
* intros (xs & y & Hxs & ? & Hx). revert x Hx.
induction Hxs; intros; simplify_option_equality; [done |].
rewrite elem_of_intersection_with. naive_solver.
@@ -416,23 +394,17 @@ Section fresh.
Global Instance fresh_list_proper: Proper ((=) ==> (≡) ==> (=)) fresh_list.
Proof.
- intros ? n ?. subst. induction n; simpl; intros ?? E; f_equal.
- * by rewrite E.
- * apply IHn. by rewrite E.
+ intros ? n ->. induction n as [|n IH]; intros ?? E; f_equal'; [by rewrite E|].
+ apply IH. by rewrite E.
Qed.
-
Lemma fresh_list_length n X : length (fresh_list n X) = n.
Proof. revert X. induction n; simpl; auto. Qed.
-
Lemma fresh_list_is_fresh n X x : x ∈ fresh_list n X → x ∉ X.
Proof.
- revert X. induction n; intros X; simpl.
- * by rewrite elem_of_nil.
- * rewrite elem_of_cons. intros [?| Hin]; subst.
- + apply is_fresh.
- + apply IHn in Hin. solve_elem_of.
+ revert X. induction n as [|n IH]; intros X; simpl; [by rewrite elem_of_nil|].
+ rewrite elem_of_cons; intros [->| Hin]; [apply is_fresh|].
+ apply IH in Hin; solve_elem_of.
Qed.
-
Lemma fresh_list_nodup n X : NoDup (fresh_list n X).
Proof.
revert X. induction n; simpl; constructor; auto.
@@ -441,20 +413,14 @@ Section fresh.
End fresh.
Definition option_collection `{Singleton A C} `{Empty C} (x : option A) : C :=
- match x with
- | None => ∅
- | Some a => {[ a ]}
- end.
+ match x with None => ∅ | Some a => {[ a ]} end.
(** * Properties of implementations of collections that form a monad *)
Section collection_monad.
Context `{CollectionMonad M}.
Global Instance collection_guard: MGuard M := λ P dec A x,
- match dec with
- | left H => x H
- | _ => ∅
- end.
+ match dec with left H => x H | _ => ∅ end.
Global Instance collection_fmap_proper {A B} (f : A → B) :
Proper ((≡) ==> (≡)) (fmap f).
@@ -496,9 +462,8 @@ Section collection_monad.
Lemma elem_of_mapM_fmap {A B} (f : A → B) (g : B → M A) l k :
Forall (λ x, ∀ y, y ∈ g x → f y = x) l → k ∈ mapM g l → fmap f k = l.
Proof.
- intros Hl. revert k.
- induction Hl; simpl; intros;
- decompose_elem_of; simpl; f_equal; auto.
+ intros Hl. revert k. induction Hl; simpl; intros;
+ decompose_elem_of; f_equal'; auto.
Qed.
Lemma elem_of_mapM_Forall {A B} (f : A → M B) (P : B → Prop) l k :
diff --git a/theories/decidable.v b/theories/decidable.v
index b61c6e79..778be133 100644
--- a/theories/decidable.v
+++ b/theories/decidable.v
@@ -70,6 +70,7 @@ Ltac solve_decision := intros; first
(** The following combinators are useful to create Decision proofs in
combination with the [refine] tactic. *)
+Notation swap_if S := (match S with left H => right H | right H => left H end).
Notation cast_if S := (if S then left _ else right _).
Notation cast_if_and S1 S2 := (if S1 then cast_if S2 else right _).
Notation cast_if_and3 S1 S2 S3 := (if S1 then cast_if_and S2 S3 else right _).
@@ -77,6 +78,8 @@ Notation cast_if_and4 S1 S2 S3 S4 :=
(if S1 then cast_if_and3 S2 S3 S4 else right _).
Notation cast_if_and5 S1 S2 S3 S4 S5 :=
(if S1 then cast_if_and4 S2 S3 S4 S5 else right _).
+Notation cast_if_and6 S1 S2 S3 S4 S5 S6 :=
+ (if S1 then cast_if_and5 S2 S3 S4 S5 S6 else right _).
Notation cast_if_or S1 S2 := (if S1 then left _ else cast_if S2).
Notation cast_if_or3 S1 S2 S3 := (if S1 then left _ else cast_if_or S2 S3).
Notation cast_if_not_or S1 S2 := (if S1 then cast_if S2 else left _).
@@ -131,6 +134,8 @@ Proof. by apply dsig_eq. Qed.
(** Instances of [Decision] for operators of propositional logic. *)
Instance True_dec: Decision True := left I.
Instance False_dec: Decision False := right (False_rect False).
+Instance Is_true_dec b : Decision (Is_true b).
+Proof. destruct b; apply _. Defined.
Section prop_dec.
Context `(P_dec : Decision P) `(Q_dec : Decision Q).
@@ -144,18 +149,17 @@ Section prop_dec.
Global Instance impl_dec: Decision (P → Q).
Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined.
End prop_dec.
+Instance iff_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
+ Decision (P ↔ Q) := and_dec _ _.
(** Instances of [Decision] for common data types. *)
Instance bool_eq_dec (x y : bool) : Decision (x = y).
Proof. solve_decision. Defined.
Instance unit_eq_dec (x y : unit) : Decision (x = y).
-Proof. refine (left _); by destruct x, y. Defined.
+Proof. solve_decision. Defined.
Instance prod_eq_dec `(A_dec : ∀ x y : A, Decision (x = y))
`(B_dec : ∀ x y : B, Decision (x = y)) (x y : A * B) : Decision (x = y).
-Proof.
- refine (cast_if_and (A_dec (fst x) (fst y)) (B_dec (snd x) (snd y)));
- abstract (destruct x, y; simpl in *; congruence).
-Defined.
+Proof. solve_decision. Defined.
Instance sum_eq_dec `(A_dec : ∀ x y : A, Decision (x = y))
`(B_dec : ∀ x y : B, Decision (x = y)) (x y : A + B) : Decision (x = y).
Proof. solve_decision. Defined.
@@ -173,7 +177,11 @@ Instance sig_eq_dec `(P : A → Prop) `{∀ x, ProofIrrel (P x)}
Proof. refine (cast_if (decide (`x = `y))); by rewrite sig_eq_pi. Defined.
(** Some laws for decidable propositions *)
-Lemma not_and_l {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ (¬Q ∧ P).
+Lemma not_and_l {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q.
+Proof. destruct (decide P); tauto. Qed.
+Lemma not_and_r {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ ¬P ∨ ¬Q.
+Proof. destruct (decide Q); tauto. Qed.
+Lemma not_and_l_alt {P Q : Prop} `{Decision P} : ¬(P ∧ Q) ↔ ¬P ∨ (¬Q ∧ P).
Proof. destruct (decide P); tauto. Qed.
-Lemma not_and_r {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ (¬P ∧ Q) ∨ ¬Q.
+Lemma not_and_r_alt {P Q : Prop} `{Decision Q} : ¬(P ∧ Q) ↔ (¬P ∧ Q) ∨ ¬Q.
Proof. destruct (decide Q); tauto. Qed.
diff --git a/theories/fin_collections.v b/theories/fin_collections.v
index ecccd40b..b6898dd5 100644
--- a/theories/fin_collections.v
+++ b/theories/fin_collections.v
@@ -34,7 +34,7 @@ Qed.
Lemma size_empty_inv (X : C) : size X = 0 → X ≡ ∅.
Proof.
intros. apply equiv_empty. intro. rewrite elements_spec.
- rewrite (nil_length (elements X)). by rewrite elem_of_nil. done.
+ rewrite (nil_length_inv (elements X)). by rewrite elem_of_nil. done.
Qed.
Lemma size_empty_iff (X : C) : size X = 0 ↔ X ≡ ∅.
Proof. split. apply size_empty_inv. intros E. by rewrite E, size_empty. Qed.
@@ -54,7 +54,7 @@ Lemma size_singleton_inv X x y : size X = 1 → x ∈ X → y ∈ X → x = y.
Proof.
unfold size, collection_size. simpl. rewrite !elements_spec.
generalize (elements X). intros [|? l]; intro; simplify_equality.
- rewrite (nil_length l), !elem_of_list_singleton by done. congruence.
+ rewrite (nil_length_inv l), !elem_of_list_singleton by done. congruence.
Qed.
Lemma collection_choose_Some X x : collection_choose X = Some x → x ∈ X.
diff --git a/theories/fin_map_dom.v b/theories/fin_map_dom.v
index 0d81c4e5..431f7604 100644
--- a/theories/fin_map_dom.v
+++ b/theories/fin_map_dom.v
@@ -5,12 +5,11 @@ maps. We provide such an axiomatization, instead of implementing the domain
function in a generic way, to allow more efficient implementations. *)
Require Export collections fin_maps.
-Class FinMapDom K M D `{!FMap M}
- `{∀ A, Lookup K A (M A)} `{∀ A, Empty (M A)} `{∀ A, PartialAlter K A (M A)}
- `{!Merge M} `{∀ A, FinMapToList K A (M A)}
- `{∀ i j : K, Decision (i = j)}
- `{∀ A, Dom (M A) D} `{ElemOf K D} `{Empty D} `{Singleton K D}
- `{Union D}`{Intersection D} `{Difference D} := {
+Class FinMapDom K M D `{FMap M,
+ ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A, PartialAlter K A (M A),
+ OMap M, Merge M, ∀ A, FinMapToList K A (M A), ∀ i j : K, Decision (i = j),
+ ∀ A, Dom (M A) D, ElemOf K D, Empty D, Singleton K D,
+ Union D, Intersection D, Difference D} := {
finmap_dom_map :>> FinMap K M;
finmap_dom_collection :>> Collection K D;
elem_of_dom {A} (m : M A) i : i ∈ dom D m ↔ is_Some (m !! i)
@@ -19,35 +18,32 @@ Class FinMapDom K M D `{!FMap M}
Section fin_map_dom.
Context `{FinMapDom K M D}.
+Lemma elem_of_dom_2 {A} (m : M A) i x : m !! i = Some x → i ∈ dom D m.
+Proof. rewrite elem_of_dom; eauto. Qed.
Lemma not_elem_of_dom {A} (m : M A) i : i ∉ dom D m ↔ m !! i = None.
Proof. by rewrite elem_of_dom, eq_None_not_Some. Qed.
-
Lemma subseteq_dom {A} (m1 m2 : M A) : m1 ⊆ m2 → dom D m1 ⊆ dom D m2.
Proof.
- unfold subseteq, map_subseteq, collection_subseteq.
- intros ??. rewrite !elem_of_dom. inversion 1. eauto.
+ rewrite map_subseteq_spec.
+ intros ??. rewrite !elem_of_dom. inversion 1; eauto.
Qed.
Lemma subset_dom {A} (m1 m2 : M A) : m1 ⊂ m2 → dom D m1 ⊂ dom D m2.
Proof.
- intros [Hss1 Hss2]. split.
- { by apply subseteq_dom. }
- intros Hdom. destruct Hss2. intros i x Hi.
- specialize (Hdom i). rewrite !elem_of_dom in Hdom.
- destruct Hdom; eauto. erewrite (Hss1 i) in Hi by eauto. congruence.
+ intros [Hss1 Hss2]; split; [by apply subseteq_dom |].
+ contradict Hss2. rewrite map_subseteq_spec. intros i x Hi.
+ specialize (Hss2 i). rewrite !elem_of_dom in Hss2.
+ destruct Hss2; eauto. by simplify_map_equality.
Qed.
-
Lemma dom_empty {A} : dom D (@empty (M A) _) ≡ ∅.
Proof.
- split; intro.
- * rewrite elem_of_dom, lookup_empty. by inversion 1.
- * solve_elem_of.
+ split; intro; [|solve_elem_of].
+ rewrite elem_of_dom, lookup_empty. by inversion 1.
Qed.
Lemma dom_empty_inv {A} (m : M A) : dom D m ≡ ∅ → m = ∅.
Proof.
intros E. apply map_empty. intros. apply not_elem_of_dom.
rewrite E. solve_elem_of.
Qed.
-
Lemma dom_insert {A} (m : M A) i x : dom D (<[i:=x]>m) ≡ {[ i ]} ∪ dom D m.
Proof.
apply elem_of_equiv. intros j. rewrite elem_of_union, !elem_of_dom.
@@ -59,13 +55,11 @@ Proof. rewrite (dom_insert _). solve_elem_of. Qed.
Lemma dom_insert_subseteq_compat_l {A} (m : M A) i x X :
X ⊆ dom D m → X ⊆ dom D (<[i:=x]>m).
Proof. intros. transitivity (dom D m); eauto using dom_insert_subseteq. Qed.
-
Lemma dom_singleton {A} (i : K) (x : A) : dom D {[(i, x)]} ≡ {[ i ]}.
Proof.
unfold singleton at 1, map_singleton.
rewrite dom_insert, dom_empty. solve_elem_of.
Qed.
-
Lemma dom_delete {A} (m : M A) i : dom D (delete i m) ≡ dom D m ∖ {[ i ]}.
Proof.
apply elem_of_equiv. intros j. rewrite elem_of_difference, !elem_of_dom.
@@ -77,32 +71,28 @@ Proof. rewrite not_elem_of_dom. apply delete_partial_alter. Qed.
Lemma delete_insert_dom {A} (m : M A) i x :
i ∉ dom D m → delete i (<[i:=x]>m) = m.
Proof. rewrite not_elem_of_dom. apply delete_insert. Qed.
-
Lemma map_disjoint_dom {A} (m1 m2 : M A) : m1 ⊥ m2 ↔ dom D m1 ∩ dom D m2 ≡ ∅.
Proof.
- unfold disjoint, map_disjoint, map_intersection_forall.
- rewrite elem_of_equiv_empty. setoid_rewrite elem_of_intersection.
+ rewrite map_disjoint_spec, elem_of_equiv_empty.
+ setoid_rewrite elem_of_intersection.
setoid_rewrite elem_of_dom. unfold is_Some. naive_solver.
Qed.
Lemma map_disjoint_dom_1 {A} (m1 m2 : M A) : m1 ⊥ m2 → dom D m1 ∩ dom D m2 ≡ ∅.
Proof. apply map_disjoint_dom. Qed.
Lemma map_disjoint_dom_2 {A} (m1 m2 : M A) : dom D m1 ∩ dom D m2 ≡ ∅ → m1 ⊥ m2.
Proof. apply map_disjoint_dom. Qed.
-
Lemma dom_union {A} (m1 m2 : M A) : dom D (m1 ∪ m2) ≡ dom D m1 ∪ dom D m2.
Proof.
apply elem_of_equiv. intros i. rewrite elem_of_union, !elem_of_dom.
unfold is_Some. setoid_rewrite lookup_union_Some_raw.
destruct (m1 !! i); naive_solver.
Qed.
-
Lemma dom_intersection {A} (m1 m2 : M A) :
dom D (m1 ∩ m2) ≡ dom D m1 ∩ dom D m2.
Proof.
apply elem_of_equiv. intros i. rewrite elem_of_intersection, !elem_of_dom.
unfold is_Some. setoid_rewrite lookup_intersection_Some. naive_solver.
Qed.
-
Lemma dom_difference {A} (m1 m2 : M A) : dom D (m1 ∖ m2) ≡ dom D m1 ∖ dom D m2.
Proof.
apply elem_of_equiv. intros i. rewrite elem_of_difference, !elem_of_dom.
diff --git a/theories/fin_maps.v b/theories/fin_maps.v
index eb2e0554..57be9f1f 100644
--- a/theories/fin_maps.v
+++ b/theories/fin_maps.v
@@ -25,10 +25,9 @@ which enables us to give a generic implementation of [union_with],
Class FinMapToList K A M := map_to_list: M → list (K * A).
-Class FinMap K M `{!FMap M}
- `{∀ A, Lookup K A (M A)} `{∀ A, Empty (M A)} `{∀ A, PartialAlter K A (M A)}
- `{!Merge M} `{∀ A, FinMapToList K A (M A)}
- `{∀ i j : K, Decision (i = j)} := {
+Class FinMap K M `{FMap M, ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A,
+ PartialAlter K A (M A), OMap M, Merge M, ∀ A, FinMapToList K A (M A),
+ ∀ i j : K, Decision (i = j)} := {
map_eq {A} (m1 m2 : M A) : (∀ i, m1 !! i = m2 !! i) → m1 = m2;
lookup_empty {A} i : (∅ : M A) !! i = None;
lookup_partial_alter {A} f (m : M A) i :
@@ -39,6 +38,7 @@ Class FinMap K M `{!FMap M}
map_to_list_nodup {A} (m : M A) : NoDup (map_to_list m);
elem_of_map_to_list {A} (m : M A) i x :
(i,x) ∈ map_to_list m ↔ m !! i = Some x;
+ lookup_omap {A B} (f : A → option B) m i : omap f m !! i = m !! i ≫= f;
lookup_merge {A B C} (f : option A → option B → option C)
`{!PropHolds (f None None = None)} m1 m2 i :
merge f m1 m2 !! i = f (m1 !! i) (m2 !! i)
@@ -55,8 +55,8 @@ Instance map_alter `{PartialAlter K A M} : Alter K A M :=
λ f, partial_alter (fmap f).
Instance map_delete `{PartialAlter K A M} : Delete K M :=
partial_alter (λ _, None).
-Instance map_singleton `{PartialAlter K A M}
- `{Empty M} : Singleton (K * A) M := λ p, <[fst p:=snd p]>∅.
+Instance map_singleton `{PartialAlter K A M, Empty M} :
+ Singleton (K * A) M := λ p, <[p.1:=p.2]> ∅.
Definition map_of_list `{Insert K A M} `{Empty M}
(l : list (K * A)) : M := insert_list l ∅.
@@ -70,13 +70,26 @@ Instance map_difference_with `{Merge M} {A} : DifferenceWith A (M A) :=
(** The relation [intersection_forall R] on finite maps describes that the
relation [R] holds for each pair in the intersection. *)
-Definition map_forall `{Lookup K A M} (P : K → A → Prop) : M → Prop :=
+Definition map_Forall `{Lookup K A M} (P : K → A → Prop) : M → Prop :=
λ m, ∀ i x, m !! i = Some x → P i x.
-Definition map_intersection_forall `{Lookup K A M}
+Definition map_Forall2 `{∀ A, Lookup K A (M A)} {A B}
+ (R : A → B → Prop) (P : A → Prop) (Q : B → Prop)
+ (m1 : M A) (m2 : M B) : Prop := ∀ i,
+ match m1 !! i, m2 !! i with
+ | Some x, Some y => R x y
+ | Some x, None => P x
+ | None, Some y => Q y
+ | None, None => True
+ end.
+(*
+Definition map_intersection_Forall `{Lookup K A M}
(R : relation A) : relation M := λ m1 m2,
∀ i x1 x2, m1 !! i = Some x1 → m2 !! i = Some x2 → R x1 x2.
-Instance map_disjoint `{∀ A, Lookup K A (M A)} : Disjoint (M A) :=
- λ A, map_intersection_forall (λ _ _, False).
+*)
+Instance map_disjoint `{∀ A, Lookup K A (M A)} {A} : Disjoint (M A) :=
+ map_Forall2 (λ _ _, False) (λ _, True) (λ _, True).
+Instance map_subseteq `{∀ A, Lookup K A (M A)} {A} : SubsetEq (M A) :=
+ map_Forall2 (=) (λ _, False) (λ _, True).
(** The union of two finite maps only has a meaningful definition for maps
that are disjoint. However, as working with partial functions is inconvenient
@@ -95,33 +108,41 @@ Instance map_difference `{Merge M} {A} : Difference (M A) :=
Section theorems.
Context `{FinMap K M}.
-Global Instance map_subseteq {A} : SubsetEq (M A) := λ m1 m2,
- ∀ i x, m1 !! i = Some x → m2 !! i = Some x.
+Lemma map_eq_iff {A} (m1 m2 : M A) : m1 = m2 ↔ ∀ i, m1 !! i = m2 !! i.
+Proof. split. by intros ->. apply map_eq. Qed.
+Lemma map_subseteq_spec {A} (m1 m2 : M A) :
+ m1 ⊆ m2 ↔ ∀ i x, m1 !! i = Some x → m2 !! i = Some x.
+Proof.
+ unfold subseteq, map_subseteq, map_Forall2. split; intros Hm i;
+ specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver.
+Qed.
Global Instance: BoundedPreOrder (M A).
-Proof. split; [firstorder |]. intros m i x. by rewrite lookup_empty. Qed.
+Proof.
+ repeat split.
+ * intros m. by rewrite map_subseteq_spec.
+ * intros m1 m2 m3. rewrite !map_subseteq_spec. naive_solver.
+ * intros m. rewrite !map_subseteq_spec. intros i x. by rewrite lookup_empty.
+Qed.
Global Instance : PartialOrder (@subseteq (M A) _).
Proof.
- split; [apply _ |].
- intros ????. apply map_eq. intros i. apply option_eq. naive_solver.
+ split; [apply _ |]. intros ??. rewrite !map_subseteq_spec.
+ intros ??. apply map_eq; intros i. apply option_eq. naive_solver.
Qed.
-
Lemma lookup_weaken {A} (m1 m2 : M A) i x :
m1 !! i = Some x → m1 ⊆ m2 → m2 !! i = Some x.
-Proof. auto. Qed.
+Proof. rewrite !map_subseteq_spec. auto. Qed.
Lemma lookup_weaken_is_Some {A} (m1 m2 : M A) i :
is_Some (m1 !! i) → m1 ⊆ m2 → is_Some (m2 !! i).
Proof. inversion 1. eauto using lookup_weaken. Qed.
Lemma lookup_weaken_None {A} (m1 m2 : M A) i :
m2 !! i = None → m1 ⊆ m2 → m1 !! i = None.
Proof.
- rewrite eq_None_not_Some. intros Hm2 Hm1m2.
- specialize (Hm1m2 i). destruct (m1 !! i); naive_solver.
+ rewrite map_subseteq_spec, !eq_None_not_Some.
+ intros Hm2 Hm [??]; destruct Hm2; eauto.
Qed.
-
Lemma lookup_weaken_inv {A} (m1 m2 : M A) i x y :
m1 !! i = Some x → m1 ⊆ m2 → m2 !! i = Some y → x = y.
Proof. intros Hm1 ? Hm2. eapply lookup_weaken in Hm1; eauto. congruence. Qed.
-
Lemma lookup_ne {A} (m : M A) i j : m !! i ≠m !! j → i ≠j.
Proof. congruence. Qed.
Lemma map_empty {A} (m : M A) : (∀ i, m !! i = None) → m = ∅.
@@ -130,102 +151,94 @@ Lemma lookup_empty_is_Some {A} i : ¬is_Some ((∅ : M A) !! i).
Proof. rewrite lookup_empty. by inversion 1. Qed.
Lemma lookup_empty_Some {A} i (x : A) : ¬∅ !! i = Some x.
Proof. by rewrite lookup_empty. Qed.
-
Lemma map_subset_empty {A} (m : M A) : m ⊄ ∅.
-Proof. intros [? []]. intros i x. by rewrite lookup_empty. Qed.
+Proof.
+ intros [_ []]. rewrite map_subseteq_spec. intros ??. by rewrite lookup_empty.
+Qed.
(** ** Properties of the [partial_alter] operation *)
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.
+ intros. apply map_eq; intros j. by destruct (decide (i = j)) as [->|?];
+ rewrite ?lookup_partial_alter, ?lookup_partial_alter_ne; auto.
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.
+ intros. apply map_eq. intros ii. by destruct (decide (i = ii)) as [->|?];
+ rewrite ?lookup_partial_alter, ?lookup_partial_alter_ne.
Qed.
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.
- intros. apply map_eq. intros jj. destruct (decide (jj = j)).
- * subst. by rewrite lookup_partial_alter_ne,
- !lookup_partial_alter, lookup_partial_alter_ne.
- * destruct (decide (jj = i)).
- + subst. by rewrite lookup_partial_alter,
- !lookup_partial_alter_ne, lookup_partial_alter by congruence.
- + by rewrite !lookup_partial_alter_ne by congruence.
+ intros. apply map_eq; intros jj. destruct (decide (jj = j)) as [->|?].
+ { by rewrite lookup_partial_alter_ne,
+ !lookup_partial_alter, lookup_partial_alter_ne. }
+ destruct (decide (jj = i)) as [->|?].
+ * by rewrite lookup_partial_alter,
+ !lookup_partial_alter_ne, lookup_partial_alter by congruence.
+ * by rewrite !lookup_partial_alter_ne by congruence.
Qed.
Lemma partial_alter_self_alt {A} (m : M A) i x :
x = m !! i → partial_alter (λ _, x) i m = m.
Proof.
- intros. apply map_eq. intros ii. destruct (decide (i = ii)).
- * subst. by rewrite lookup_partial_alter.
- * by rewrite lookup_partial_alter_ne.
+ intros. apply map_eq. intros ii. by destruct (decide (i = ii)) as [->|];
+ rewrite ?lookup_partial_alter, ?lookup_partial_alter_ne.
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} 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.
+Proof.
+ rewrite map_subseteq_spec. intros Hi j x Hj.
+ rewrite lookup_partial_alter_ne; congruence.
+Qed.
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.
- * by apply partial_alter_subseteq.
- * inversion Hfi as [x Hx]. intros Hm.
- apply (Some_ne_None x). rewrite <-(Hm i x); [done|].
- by rewrite lookup_partial_alter.
+ intros Hi Hfi. split; [by apply partial_alter_subseteq|].
+ rewrite !map_subseteq_spec. inversion Hfi as [x Hx]. intros Hm.
+ apply (Some_ne_None x). rewrite <-(Hm i x); [done|].
+ by rewrite lookup_partial_alter.
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.
-
+Proof. intro. apply partial_alter_ext. intros [x|] ?; 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).
Proof.
- destruct (decide (i = j)); subst.
+ destruct (decide (i = j)) as [->|?].
* rewrite lookup_alter. naive_solver (simplify_option_equality; eauto).
* rewrite lookup_alter_ne by done. naive_solver.
Qed.
Lemma lookup_alter_None {A} (f : A → A) m i j :
alter f i m !! j = None ↔ m !! j = None.
Proof.
- destruct (decide (i = j)); subst.
- * by rewrite lookup_alter, fmap_None.
- * by rewrite lookup_alter_ne.
+ by destruct (decide (i = j)) as [->|?];
+ rewrite ?lookup_alter, ?fmap_None, ?lookup_alter_ne.
Qed.
-
Lemma alter_None {A} (f : A → A) m i : m !! i = None → alter f i m = m.
Proof.
- intros Hi. apply map_eq. intros j. destruct (decide (i = j)); subst.
- * by rewrite lookup_alter, !Hi.
- * by rewrite lookup_alter_ne.
+ intros Hi. apply map_eq. intros j. by destruct (decide (i = j)) as [->|?];
+ rewrite ?lookup_alter, ?Hi, ?lookup_alter_ne.
Qed.
(** ** Properties of the [delete] operation *)
@@ -233,23 +246,20 @@ Lemma lookup_delete {A} (m : M A) i : delete i m !! i = None.
Proof. apply lookup_partial_alter. Qed.
Lemma lookup_delete_ne {A} (m : M A) i j : i ≠j → delete i m !! j = m !! j.
Proof. apply lookup_partial_alter_ne. Qed.
-
Lemma lookup_delete_Some {A} (m : M A) i j y :
delete i m !! j = Some y ↔ i ≠j ∧ m !! j = Some y.
Proof.
split.
- * destruct (decide (i = j)); subst;
+ * destruct (decide (i = j)) as [->|?];
rewrite ?lookup_delete, ?lookup_delete_ne; intuition congruence.
* intros [??]. by rewrite lookup_delete_ne.
Qed.
Lemma lookup_delete_None {A} (m : M A) i j :
delete i m !! j = None ↔ i = j ∨ m !! j = None.
Proof.
- destruct (decide (i = j)).
- * subst. rewrite lookup_delete. tauto.
- * rewrite lookup_delete_ne; tauto.
+ destruct (decide (i = j)) as [->|?];
+ rewrite ?lookup_delete, ?lookup_delete_ne; tauto.
Qed.
-
Lemma delete_empty {A} i : delete i (∅ : M A) = ∅.
Proof. rewrite <-(partial_alter_self ∅) at 2. by rewrite lookup_empty. Qed.
Lemma delete_singleton {A} i (x : A) : delete i {[i, x]} = ∅.
@@ -260,14 +270,11 @@ Proof. destruct (decide (i = j)). by subst. by apply partial_alter_commute. Qed.
Lemma delete_insert_ne {A} (m : M A) i j x :
i ≠j → delete i (<[j:=x]>m) = <[j:=x]>(delete i m).
Proof. intro. by apply partial_alter_commute. Qed.
-
Lemma delete_notin {A} (m : M A) i : m !! i = None → delete i m = m.
Proof.
- intros. apply map_eq. intros j. destruct (decide (i = j)).
- * subst. by rewrite lookup_delete.
- * by apply lookup_delete_ne.
+ intros. apply map_eq. intros j. by destruct (decide (i = j)) as [->|?];
+ rewrite ?lookup_delete, ?lookup_delete_ne.
Qed.
-
Lemma delete_partial_alter {A} (m : M A) i f :
m !! i = None → delete i (partial_alter f i m) = m.
Proof.
@@ -284,18 +291,21 @@ Proof.
rewrite <-partial_alter_compose. unfold compose. rewrite <-Hmi.
by apply partial_alter_self_alt.
Qed.
-
Lemma delete_subseteq {A} (m : M A) i : delete i m ⊆ m.
-Proof. intros j x. rewrite lookup_delete_Some. tauto. Qed.
+Proof.
+ rewrite !map_subseteq_spec. intros j x. rewrite lookup_delete_Some. tauto.
+Qed.
Lemma delete_subseteq_compat {A} (m1 m2 : M A) i :
m1 ⊆ m2 → delete i m1 ⊆ delete i m2.
-Proof. intros ? j x. rewrite !lookup_delete_Some. intuition eauto. Qed.
+Proof.
+ rewrite !map_subseteq_spec. intros ? j x.
+ rewrite !lookup_delete_Some. intuition eauto.
+Qed.
Lemma delete_subset_alt {A} (m : M A) i x : m !! i = Some x → delete i m ⊂ m.
Proof.
- split.
- * apply delete_subseteq.
- * intros Hi. apply (None_ne_Some x).
- by rewrite <-(lookup_delete m i), (Hi i x).
+ split; [apply delete_subseteq|].
+ rewrite !map_subseteq_spec. intros Hi. apply (None_ne_Some x).
+ by rewrite <-(lookup_delete m i), (Hi i x).
Qed.
Lemma delete_subset {A} (m : M A) i : is_Some (m !! i) → delete i m ⊂ m.
Proof. inversion 1. eauto using delete_subset_alt. Qed.
@@ -310,26 +320,21 @@ Proof. unfold insert. apply lookup_partial_alter_ne. Qed.
Lemma insert_commute {A} (m : M A) i j x y :
i ≠j → <[i:=x]>(<[j:=y]>m) = <[j:=y]>(<[i:=x]>m).
Proof. apply partial_alter_commute. Qed.
-
Lemma lookup_insert_Some {A} (m : M A) i j x y :
<[i:=x]>m !! j = Some y ↔ (i = j ∧ x = y) ∨ (i ≠j ∧ m !! j = Some y).
Proof.
split.
- * destruct (decide (i = j)); subst;
+ * destruct (decide (i = j)) as [->|?];
rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence.
- * intros [[??]|[??]].
- + subst. apply lookup_insert.
- + by rewrite lookup_insert_ne.
+ * intros [[-> ->]|[??]]; [apply lookup_insert|]. by rewrite lookup_insert_ne.
Qed.
Lemma lookup_insert_None {A} (m : M A) i j x :
<[i:=x]>m !! j = None ↔ m !! j = None ∧ i ≠j.
Proof.
- split.
- * destruct (decide (i = j)); subst;
- rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence.
- * intros [??]. by rewrite lookup_insert_ne.
+ split; [|by intros [??]; rewrite lookup_insert_ne].
+ destruct (decide (i = j)) as [->|];
+ rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence.
Qed.
-
Lemma insert_subseteq {A} (m : M A) i x : m !! i = None → m ⊆ <[i:=x]>m.
Proof. apply partial_alter_subseteq. Qed.
Lemma insert_subset {A} (m : M A) i x : m !! i = None → m ⊂ <[i:=x]>m.
@@ -337,36 +342,33 @@ Proof. intro. apply partial_alter_subset; eauto. Qed.
Lemma insert_subseteq_r {A} (m1 m2 : M A) i x :
m1 !! i = None → m1 ⊆ m2 → m1 ⊆ <[i:=x]>m2.
Proof.
- intros ?? j ?. destruct (decide (j = i)); subst.
- * congruence.
- * rewrite lookup_insert_ne; auto.
+ rewrite !map_subseteq_spec. intros ?? j ?.
+ destruct (decide (j = i)) as [->|?]; [congruence|].
+ rewrite lookup_insert_ne; auto.
Qed.
-
Lemma insert_delete_subseteq {A} (m1 m2 : M A) i x :
m1 !! i = None → <[i:=x]> m1 ⊆ m2 → m1 ⊆ delete i m2.
Proof.
- intros Hi Hix j y Hj. destruct (decide (i = j)); subst.
- * congruence.
- * rewrite lookup_delete_ne by done. apply Hix.
- by rewrite lookup_insert_ne by done.
+ rewrite !map_subseteq_spec. intros Hi Hix j y Hj.
+ destruct (decide (i = j)) as [->|]; [congruence|].
+ rewrite lookup_delete_ne by done.
+ apply Hix; by rewrite lookup_insert_ne by done.
Qed.
Lemma delete_insert_subseteq {A} (m1 m2 : M A) i x :
m1 !! i = Some x → delete i m1 ⊆ m2 → m1 ⊆ <[i:=x]> m2.
Proof.
- intros Hix Hi j y Hj. destruct (decide (i = j)); subst.
+ rewrite !map_subseteq_spec.
+ intros Hix Hi j y Hj. destruct (decide (i = j)) as [->|?].
* rewrite lookup_insert. congruence.
* rewrite lookup_insert_ne by done. apply Hi. by rewrite lookup_delete_ne.
Qed.
-
Lemma insert_delete_subset {A} (m1 m2 : M A) i x :
m1 !! i = None → <[i:=x]> m1 ⊂ m2 → m1 ⊂ delete i m2.
Proof.
- intros ? [Hm12 Hm21]. split.
- * eauto using insert_delete_subseteq.
- * contradict Hm21. apply delete_insert_subseteq; auto.
- apply Hm12. by rewrite lookup_insert.
+ intros ? [Hm12 Hm21]; split; [eauto using insert_delete_subseteq|].
+ contradict Hm21. apply delete_insert_subseteq; auto.
+ eapply lookup_weaken, Hm12. by rewrite lookup_insert.
Qed.
-
Lemma insert_subset_inv {A} (m1 m2 : M A) i x :
m1 !! i = None → <[i:=x]> m1 ⊂ m2 →
∃ m2', m2 = <[i:=x]>m2' ∧ m1 ⊂ m2' ∧ m2' !! i = None.
@@ -394,7 +396,11 @@ Lemma lookup_singleton {A} i (x : A) : {[i, x]} !! i = Some x.
Proof. by rewrite lookup_singleton_Some. Qed.
Lemma lookup_singleton_ne {A} i j (x : A) : i ≠j → {[i, x]} !! j = None.
Proof. by rewrite lookup_singleton_None. Qed.
-
+Lemma singleton_ne_empty {A} i (x : A) : {[i,x]} ≠∅.
+Proof.
+ intros Hix. apply (f_equal (!! i)) in Hix.
+ by rewrite lookup_empty, lookup_singleton in Hix.
+Qed.
Lemma insert_singleton {A} i (x y : A) : <[i:=y]>{[i, x]} = {[i, y]}.
Proof.
unfold singleton, map_singleton, insert, map_insert.
@@ -402,72 +408,65 @@ Proof.
Qed.
Lemma alter_singleton {A} (f : A → A) i x : alter f i {[i,x]} = {[i, f x]}.
Proof.
- intros. apply map_eq. intros i'. destruct (decide (i = i')); subst.
+ intros. apply map_eq. intros i'. destruct (decide (i = i')) as [->|?].
* by rewrite lookup_alter, !lookup_singleton.
* by rewrite lookup_alter_ne, !lookup_singleton_ne.
Qed.
Lemma alter_singleton_ne {A} (f : A → A) i j x :
i ≠j → alter f i {[j,x]} = {[j,x]}.
Proof.
- intros. apply map_eq. intros i'. destruct (decide (i = i')); subst.
- * by rewrite lookup_alter, lookup_singleton_ne.
- * by rewrite lookup_alter_ne.
+ intros. apply map_eq; intros i'. by destruct (decide (i = i')) as [->|?];
+ rewrite ?lookup_alter, ?lookup_singleton_ne, ?lookup_alter_ne by done.
Qed.
+(** ** Properties of the map operations *)
+Lemma fmap_empty {A B} (f : A → B) : f <$> ∅ = ∅.
+Proof. apply map_empty; intros i. by rewrite lookup_fmap, lookup_empty. Qed.
+Lemma omap_empty {A B} (f : A → option B) : omap f ∅ = ∅.
+Proof. apply map_empty; intros i. by rewrite lookup_omap, lookup_empty. Qed.
+
(** ** Properties of conversion to lists *)
Lemma map_to_list_unique {A} (m : M A) i x y :
(i,x) ∈ map_to_list m → (i,y) ∈ map_to_list m → x = y.
Proof. rewrite !elem_of_map_to_list. congruence. Qed.
Lemma map_to_list_key_nodup {A} (m : M A) : NoDup (fst <$> map_to_list m).
Proof. eauto using NoDup_fmap_fst, map_to_list_unique, map_to_list_nodup. Qed.
-
Lemma elem_of_map_of_list_1 {A} (l : list (K * A)) i x :
NoDup (fst <$> l) → (i,x) ∈ l → map_of_list l !! i = Some x.
Proof.
- induction l as [|[j y] l IH]; simpl.
- { by rewrite elem_of_nil. }
+ induction l as [|[j y] l IH]; simpl; [by rewrite elem_of_nil|].
rewrite NoDup_cons, elem_of_cons, elem_of_list_fmap.
- intros [Hl ?] [?|?]; simplify_equality.
- { by rewrite lookup_insert. }
- destruct (decide (i = j)); simplify_equality.
- * destruct Hl. by exists (j,x).
- * rewrite lookup_insert_ne; auto.
+ intros [Hl ?] [?|?]; simplify_equality; [by rewrite lookup_insert|].
+ destruct (decide (i = j)) as [->|]; [|rewrite lookup_insert_ne; auto].
+ destruct Hl. by exists (j,x).
Qed.
Lemma elem_of_map_of_list_2 {A} (l : list (K * A)) i x :
map_of_list l !! i = Some x → (i,x) ∈ l.
Proof.
- induction l as [|[j y] l IH]; simpl.
- { by rewrite lookup_empty. }
- rewrite elem_of_cons. destruct (decide (i = j)); simplify_equality.
- * rewrite lookup_insert; intuition congruence.
- * rewrite lookup_insert_ne; intuition congruence.
+ induction l as [|[j y] l IH]; simpl; [by rewrite lookup_empty|].
+ rewrite elem_of_cons. destruct (decide (i = j)) as [->|];
+ rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence.
Qed.
Lemma elem_of_map_of_list {A} (l : list (K * A)) i x :
NoDup (fst <$> l) → (i,x) ∈ l ↔ map_of_list l !! i = Some x.
Proof. split; auto using elem_of_map_of_list_1, elem_of_map_of_list_2. Qed.
-
Lemma not_elem_of_map_of_list_1 {A} (l : list (K * A)) i :
i ∉ fst <$> l → map_of_list l !! i = None.
Proof.
- rewrite elem_of_list_fmap, eq_None_not_Some.
- intros Hi [x ?]. destruct Hi. exists (i,x). simpl.
- auto using elem_of_map_of_list_2.
+ rewrite elem_of_list_fmap, eq_None_not_Some. intros Hi [x ?]; destruct Hi.
+ exists (i,x); simpl; auto using elem_of_map_of_list_2.
Qed.
Lemma not_elem_of_map_of_list_2 {A} (l : list (K * A)) i :
map_of_list l !! i = None → i ∉ fst <$> l.
Proof.
- induction l as [|[j y] l IH]; simpl.
- { rewrite elem_of_nil. tauto. }
+ induction l as [|[j y] l IH]; simpl; [rewrite elem_of_nil; tauto|].
rewrite elem_of_cons. destruct (decide (i = j)); simplify_equality.
* by rewrite lookup_insert.
* by rewrite lookup_insert_ne; intuition.
Qed.
Lemma not_elem_of_map_of_list {A} (l : list (K * A)) i :
i ∉ fst <$> l ↔ map_of_list l !! i = None.
-Proof.
- split; auto using not_elem_of_map_of_list_1, not_elem_of_map_of_list_2.
-Qed.
-
+Proof. red; auto using not_elem_of_map_of_list_1,not_elem_of_map_of_list_2. Qed.
Lemma map_of_list_proper {A} (l1 l2 : list (K * A)) :
NoDup (fst <$> l1) → l1 ≡ₚ l2 → map_of_list l1 = map_of_list l2.
Proof.
@@ -496,7 +495,6 @@ Proof.
intros. rewrite <-(map_of_to_list m1), <-(map_of_to_list m2).
auto using map_of_list_proper, map_to_list_key_nodup.
Qed.
-
Lemma map_to_list_empty {A} : map_to_list ∅ = @nil (K * A).
Proof.
apply elem_of_nil_inv. intros [i x].
@@ -512,18 +510,15 @@ Proof.
rewrite elem_of_map_to_list in Hlookup. congruence.
* by rewrite !map_of_to_list.
Qed.
-
Lemma map_of_list_nil {A} : map_of_list (@nil (K * A)) = ∅.
Proof. done. Qed.
Lemma map_of_list_cons {A} (l : list (K * A)) i x :
map_of_list ((i, x) :: l) = <[i:=x]>(map_of_list l).
Proof. done. Qed.
-
Lemma map_to_list_empty_inv_alt {A} (m : M A) : map_to_list m ≡ₚ [] → m = ∅.
Proof. rewrite <-map_to_list_empty. apply map_to_list_inj. Qed.
Lemma map_to_list_empty_inv {A} (m : M A) : map_to_list m = [] → m = ∅.
Proof. intros Hm. apply map_to_list_empty_inv_alt. by rewrite Hm. Qed.
-
Lemma map_to_list_insert_inv {A} (m : M A) l i x :
map_to_list m ≡ₚ (i,x) :: l → m = <[i:=x]>(map_of_list l).
Proof.
@@ -539,31 +534,28 @@ Qed.
Lemma map_ind {A} (P : M A → Prop) :
P ∅ → (∀ i x m, m !! i = None → P m → P (<[i:=x]>m)) → ∀ m, P m.
Proof.
- intros Hemp Hins.
- cut (∀ l, NoDup (fst <$> l) → ∀ m, map_to_list m ≡ₚ l → P m).
+ intros ? Hins. cut (∀ l, NoDup (fst <$> l) → ∀ m, map_to_list m ≡ₚ l → P m).
{ intros help m.
apply (help (map_to_list m)); auto using map_to_list_key_nodup. }
induction l as [|[i x] l IH]; intros Hnodup m Hml.
{ apply map_to_list_empty_inv_alt in Hml. by subst. }
inversion_clear Hnodup.
- apply map_to_list_insert_inv in Hml. subst. apply Hins.
+ apply map_to_list_insert_inv in Hml; subst m. apply Hins.
* by apply not_elem_of_map_of_list_1.
* apply IH; auto using map_to_of_list.
Qed.
-
Lemma map_to_list_length {A} (m1 m2 : M A) :
m1 ⊂ m2 → length (map_to_list m1) < length (map_to_list m2).
Proof.
revert m2. induction m1 as [|i x m ? IH] using map_ind.
{ intros m2 Hm2. rewrite map_to_list_empty. simpl.
apply neq_0_lt. intros Hlen. symmetry in Hlen.
- apply nil_length, map_to_list_empty_inv in Hlen.
+ apply nil_length_inv, map_to_list_empty_inv in Hlen.
rewrite Hlen in Hm2. destruct (irreflexivity (⊂) ∅ Hm2). }
intros m2 Hm2.
destruct (insert_subset_inv m m2 i x) as (m2'&?&?&?); auto; subst.
rewrite !map_to_list_insert; simpl; auto with arith.
Qed.
-
Lemma map_wf {A} : wf (strict (@subseteq (M A) _)).
Proof.
apply (wf_projected (<) (length ∘ map_to_list)).
@@ -572,10 +564,10 @@ Proof.
Qed.
(** ** Properties of the [map_forall] predicate *)
-Section map_forall.
+Section map_Forall.
Context {A} (P : K → A → Prop).
-Lemma map_forall_to_list m : map_forall P m ↔ Forall (curry P) (map_to_list m).
+Lemma map_Forall_to_list m : map_Forall P m ↔ Forall (curry P) (map_to_list m).
Proof.
rewrite Forall_forall. split.
* intros Hforall [i x]. rewrite elem_of_map_to_list. by apply (Hforall i x).
@@ -583,30 +575,29 @@ Proof.
Qed.
Context `{∀ i x, Decision (P i x)}.
-Global Instance map_forall_dec m : Decision (map_forall P m).
+Global Instance map_Forall_dec m : Decision (map_Forall P m).
Proof.
refine (cast_if (decide (Forall (curry P) (map_to_list m))));
- by rewrite map_forall_to_list.
+ by rewrite map_Forall_to_list.
Defined.
-
-Lemma map_not_forall (m : M A) :
- ¬map_forall P m ↔ ∃ i x, m !! i = Some x ∧ ¬P i x.
+Lemma map_not_Forall (m : M A) :
+ ¬map_Forall P m ↔ ∃ i x, m !! i = Some x ∧ ¬P i x.
Proof.
split.
- * rewrite map_forall_to_list. intros Hm.
+ * rewrite map_Forall_to_list. intros Hm.
apply (not_Forall_Exists _), Exists_exists in Hm.
destruct Hm as ([i x]&?&?). exists i x. by rewrite <-elem_of_map_to_list.
* intros (i&x&?&?) Hm. specialize (Hm i x). tauto.
Qed.
-End map_forall.
+End map_Forall.
(** ** Properties of the [merge] operation *)
Lemma merge_Some {A B C} (f : option A → option B → option C)
`{!PropHolds (f None None = None)} m1 m2 m :
(∀ i, m !! i = f (m1 !! i) (m2 !! i)) ↔ merge f m1 m2 = m.
Proof.
- split; [| intro; subst; apply (lookup_merge _) ].
- intros Hlookup. apply map_eq. intros. rewrite Hlookup. apply (lookup_merge _).
+ split; [|intros <-; apply (lookup_merge _) ].
+ intros Hlookup. apply map_eq; intros. rewrite Hlookup. apply (lookup_merge _).
Qed.
Section merge.
@@ -690,50 +681,59 @@ Proof.
Qed.
End merge.
-(** ** Properties on the [map_intersection_forall] relation *)
-Section intersection_forall.
-Context {A} (R : relation A).
-
-Global Instance map_intersection_forall_sym:
- Symmetric R → Symmetric (map_intersection_forall R).
-Proof. firstorder auto. Qed.
-Lemma map_intersection_forall_empty_l (m : M A) : map_intersection_forall R ∅ m.
-Proof. intros ???. by rewrite lookup_empty. Qed.
-Lemma map_intersection_forall_empty_r (m : M A) : map_intersection_forall R m ∅.
-Proof. intros ???. by rewrite lookup_empty. Qed.
-
-Lemma map_intersection_forall_alt (m1 m2 : M A) :
- map_intersection_forall R m1 m2 ↔
- map_forall (λ _, curry R) (merge (λ x y,
- match x, y with
- | Some x, Some y => Some (x,y)
- | _, _ => None
- end) m1 m2).
+(** ** Properties on the [map_Forall2] relation *)
+Section Forall2.
+Context {A B} (R : A → B → Prop) (P : A → Prop) (Q : B → Prop).
+Context `{∀ x y, Decision (R x y), ∀ x, Decision (P x), ∀ y, Decision (Q y)}.
+
+Let f (mx : option A) (my : option B) : option bool :=
+ match mx, my with
+ | Some x, Some y => Some (bool_decide (R x y))
+ | Some x, None => Some (bool_decide (P x))
+ | None, Some y => Some (bool_decide (Q y))
+ | None, None => None
+ end.
+Lemma map_Forall2_alt (m1 : M A) (m2 : M B) :
+ map_Forall2 R P Q m1 m2 ↔ map_Forall (λ _ P, Is_true P) (merge f m1 m2).
Proof.
split.
- * intros Hm12 i [x y]. rewrite lookup_merge by done. intros.
- destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; simplify_equality.
- eapply Hm12; eauto.
- * intros Hm12 i x y ??. apply (Hm12 i (x,y)).
- rewrite lookup_merge by done. by simplify_option_equality.
-Qed.
-
+ * intros Hm i P'; rewrite lookup_merge by done; intros.
+ specialize (Hm i). destruct (m1 !! i), (m2 !! i);
+ simplify_equality; auto using bool_decide_pack.
+ * intros Hm i. specialize (Hm i). rewrite lookup_merge in Hm by done.
+ destruct (m1 !! i), (m2 !! i); simplify_equality'; auto;
+ by eapply bool_decide_unpack, Hm.
+Qed.
+Global Instance map_Forall2_dec `{∀ x y, Decision (R x y), ∀ x, Decision (P x),
+ ∀ y, Decision (Q y)} m1 m2 : Decision (map_Forall2 R P Q m1 m2).
+Proof.
+ refine (cast_if (decide (map_Forall (λ _ P, Is_true P) (merge f m1 m2))));
+ abstract by rewrite map_Forall2_alt.
+Defined.
(** Due to the finiteness of finite maps, we can extract a witness if the
relation does not hold. *)
-Lemma map_not_intersection_forall `{∀ x y, Decision (R x y)} (m1 m2 : M A) :
- ¬map_intersection_forall R m1 m2
- ↔ ∃ i x1 x2, m1 !! i = Some x1 ∧ m2 !! i = Some x2 ∧ ¬R x1 x2.
+Lemma map_not_Forall2 (m1 : M A) (m2 : M B) :
+ ¬map_Forall2 R P Q m1 m2 ↔ ∃ i,
+ (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ ¬R x y)
+ ∨ (∃ x, m1 !! i = Some x ∧ m2 !! i = None ∧ ¬P x)
+ ∨ (∃ y, m1 !! i = None ∧ m2 !! i = Some y ∧ ¬Q y).
Proof.
split.
- * rewrite map_intersection_forall_alt, (map_not_forall _).
- intros (i & [x y] & Hm12 & ?). rewrite lookup_merge in Hm12 by done.
- exists i x y. by destruct (m1 !! i), (m2 !! i); simplify_equality.
- * intros (i & x1 & x2 & Hx1 & Hx2 & Hx1x2) Hm12.
- by apply Hx1x2, (Hm12 i x1 x2).
+ * rewrite map_Forall2_alt, (map_not_Forall _). intros (i&?&Hm&?); exists i.
+ rewrite lookup_merge in Hm by done.
+ destruct (m1 !! i), (m2 !! i); naive_solver auto 2 using bool_decide_pack.
+ * by intros [i[(x&y&?&?&?)|[(x&?&?&?)|(y&?&?&?)]]] Hm;
+ specialize (Hm i); simplify_option_equality.
Qed.
-End intersection_forall.
+End Forall2.
(** ** Properties on the disjoint maps *)
+Lemma map_disjoint_spec {A} (m1 m2 : M A) :
+ m1 ⊥ m2 ↔ ∀ i x y, m1 !! i = Some x → m2 !! i = Some y → False.
+Proof.
+ split; intros Hm i; specialize (Hm i);
+ destruct (m1 !! i), (m2 !! i); naive_solver.
+Qed.
Lemma map_disjoint_alt {A} (m1 m2 : M A) :
m1 ⊥ m2 ↔ ∀ i, m1 !! i = None ∨ m2 !! i = None.
Proof.
@@ -743,65 +743,52 @@ Qed.
Lemma map_not_disjoint {A} (m1 m2 : M A) :
¬m1 ⊥ m2 ↔ ∃ i x1 x2, m1 !! i = Some x1 ∧ m2 !! i = Some x2.
Proof.
- unfold disjoint, map_disjoint. rewrite map_not_intersection_forall.
- * naive_solver.
- * right. auto.
+ unfold disjoint, map_disjoint. rewrite map_not_Forall2 by solve_decision.
+ split; [|naive_solver].
+ * intros [i[(x&y&?&?&?)|[(x&?&?&[])|(y&?&?&[])]]]; naive_solver.
Qed.
-
Global Instance: Symmetric (@disjoint (M A) _).
-Proof. intro. apply map_intersection_forall_sym. auto. Qed.
+Proof. intros A m1 m2. rewrite !map_disjoint_spec. naive_solver. Qed.
Lemma map_disjoint_empty_l {A} (m : M A) : ∅ ⊥ m.
-Proof. apply map_intersection_forall_empty_l. Qed.
+Proof. rewrite !map_disjoint_spec. intros i x y. by rewrite lookup_empty. Qed.
Lemma map_disjoint_empty_r {A} (m : M A) : m ⊥ ∅.
-Proof. apply map_intersection_forall_empty_r. Qed.
-
+Proof. rewrite !map_disjoint_spec. intros i x y. by rewrite lookup_empty. Qed.
Lemma map_disjoint_weaken {A} (m1 m1' m2 m2' : M A) :
m1' ⊥ m2' → m1 ⊆ m1' → m2 ⊆ m2' → m1 ⊥ m2.
-Proof.
- intros Hdisjoint Hm1 Hm2 i x1 x2 Hx1 Hx2.
- destruct (Hdisjoint i x1 x2); auto.
-Qed.
+Proof. rewrite !map_subseteq_spec, !map_disjoint_spec. eauto. Qed.
Lemma map_disjoint_weaken_l {A} (m1 m1' m2 : M A) :
m1' ⊥ m2 → m1 ⊆ m1' → m1 ⊥ m2.
Proof. eauto using map_disjoint_weaken. Qed.
Lemma map_disjoint_weaken_r {A} (m1 m2 m2' : M A) :
m1 ⊥ m2' → m2 ⊆ m2' → m1 ⊥ m2.
Proof. eauto using map_disjoint_weaken. Qed.
-
Lemma map_disjoint_Some_l {A} (m1 m2 : M A) i x:
m1 ⊥ m2 → m1 !! i = Some x → m2 !! i = None.
-Proof.
- intros Hdisjoint ?. rewrite eq_None_not_Some.
- intros [x2 ?]. by apply (Hdisjoint i x x2).
-Qed.
+Proof. rewrite map_disjoint_spec, eq_None_not_Some. intros ?? [??]; eauto. Qed.
Lemma map_disjoint_Some_r {A} (m1 m2 : M A) i x:
m1 ⊥ m2 → m2 !! i = Some x → m1 !! i = None.
Proof. rewrite (symmetry_iff (⊥)). apply map_disjoint_Some_l. Qed.
-
Lemma map_disjoint_singleton_l {A} (m : M A) i x : {[i, x]} ⊥ m ↔ m !! i = None.
Proof.
- split.
+ split; [|rewrite !map_disjoint_spec].
* intro. apply (map_disjoint_Some_l {[i, x]} _ _ x);
auto using lookup_singleton.
- * intros ? j y1 y2. destruct (decide (i = j)); subst.
+ * intros ? j y1 y2. destruct (decide (i = j)) as [->|].
+ rewrite lookup_singleton. intuition congruence.
+ by rewrite lookup_singleton_ne.
Qed.
Lemma map_disjoint_singleton_r {A} (m : M A) i x :
m ⊥ {[i, x]} ↔ m !! i = None.
Proof. by rewrite (symmetry_iff (⊥)), map_disjoint_singleton_l. Qed.
-
Lemma map_disjoint_singleton_l_2 {A} (m : M A) i x :
m !! i = None → {[i, x]} ⊥ m.
Proof. by rewrite map_disjoint_singleton_l. Qed.
Lemma map_disjoint_singleton_r_2 {A} (m : M A) i x :
m !! i = None → m ⊥ {[i, x]}.
Proof. by rewrite map_disjoint_singleton_r. Qed.
-
Lemma map_disjoint_delete_l {A} (m1 m2 : M A) i : m1 ⊥ m2 → delete i m1 ⊥ m2.
Proof.
- rewrite !map_disjoint_alt.
- intros Hdisjoint j. destruct (Hdisjoint j); auto.
+ rewrite !map_disjoint_alt. intros Hdisjoint j. destruct (Hdisjoint j); auto.
rewrite lookup_delete_None. tauto.
Qed.
Lemma map_disjoint_delete_r {A} (m1 m2 : M A) i : m1 ⊥ m2 → m1 ⊥ delete i m2.
@@ -811,44 +798,13 @@ Proof. symmetry. by apply map_disjoint_delete_l. Qed.
Section union_with.
Context {A} (f : A → A → option A).
-Lemma lookup_union_with m1 m2 i z :
- union_with f m1 m2 !! i = z ↔
- (m1 !! i = None ∧ m2 !! i = None ∧ z = None) ∨
- (∃ x, m1 !! i = Some x ∧ m2 !! i = None ∧ z = Some x) ∨
- (∃ y, m1 !! i = None ∧ m2 !! i = Some y ∧ z = Some y) ∨
- (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ z = f x y).
-Proof.
- unfold union_with, map_union_with. rewrite (lookup_merge _).
- destruct (m1 !! i), (m2 !! i); compute; naive_solver.
-Qed.
-Lemma lookup_union_with_Some m1 m2 i z :
- union_with f m1 m2 !! i = Some z ↔
- (m1 !! i = Some z ∧ m2 !! i = None) ∨
- (m1 !! i = None ∧ m2 !! i = Some z) ∨
- (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ f x y = Some z).
-Proof. rewrite lookup_union_with. naive_solver. Qed.
-Lemma lookup_union_with_None m1 m2 i :
- union_with f m1 m2 !! i = None ↔
- (m1 !! i = None ∧ m2 !! i = None) ∨
- (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ f x y = None).
-Proof. rewrite lookup_union_with. naive_solver. Qed.
-
-Lemma lookup_union_with_Some_lr m1 m2 i x y z :
- m1 !! i = Some x → m2 !! i = Some y → f x y = Some z →
- union_with f m1 m2 !! i = Some z.
-Proof. rewrite lookup_union_with. naive_solver. Qed.
-Lemma lookup_union_with_Some_l m1 m2 i x :
- m1 !! i = Some x → m2 !! i = None → union_with f m1 m2 !! i = Some x.
-Proof. rewrite lookup_union_with. naive_solver. Qed.
-Lemma lookup_union_with_Some_r m1 m2 i y :
- m1 !! i = None → m2 !! i = Some y → union_with f m1 m2 !! i = Some y.
-Proof. rewrite lookup_union_with. naive_solver. Qed.
-
+Lemma lookup_union_with m1 m2 i :
+ union_with f m1 m2 !! i = union_with f (m1 !! i) (m2 !! i).
+Proof. by rewrite <-(lookup_merge _). Qed.
Global Instance: LeftId (@eq (M A)) ∅ (union_with f).
Proof. unfold union_with, map_union_with. apply _. Qed.
Global Instance: RightId (@eq (M A)) ∅ (union_with f).
Proof. unfold union_with, map_union_with. apply _. Qed.
-
Lemma union_with_commutative m1 m2 :
(∀ i x y, m1 !! i = Some x → m2 !! i = Some y → f x y = f y x) →
union_with f m1 m2 = union_with f m2 m1.
@@ -858,14 +814,12 @@ Proof.
Qed.
Global Instance: Commutative (=) f → Commutative (@eq (M A)) (union_with f).
Proof. intros ???. apply union_with_commutative. eauto. Qed.
-
Lemma union_with_idempotent m :
(∀ i x, m !! i = Some x → f x x = Some x) → union_with f m m = m.
Proof.
intros. apply (merge_idempotent _). intros i.
destruct (m !! i) eqn:?; simpl; eauto.
Qed.
-
Lemma alter_union_with (g : A → A) m1 m2 i :
(∀ x y, m1 !! i = Some x → m2 !! i = Some y → g <$> f x y = f (g x) (g y)) →
alter g i (union_with f m1 m2) =
@@ -880,7 +834,7 @@ Lemma alter_union_with_l (g : A → A) m1 m2 i :
alter g i (union_with f m1 m2) = union_with f (alter g i m1) m2.
Proof.
intros. apply (partial_alter_merge_l _).
- destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; simpl; eauto using f_equal.
+ destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; f_equal'; auto.
Qed.
Lemma alter_union_with_r (g : A → A) m1 m2 i :
(∀ x y, m1 !! i = Some x → m2 !! i = Some y → g <$> f x y = f x (g y)) →
@@ -888,18 +842,15 @@ Lemma alter_union_with_r (g : A → A) m1 m2 i :
alter g i (union_with f m1 m2) = union_with f m1 (alter g i m2).
Proof.
intros. apply (partial_alter_merge_r _).
- destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; simpl; eauto using f_equal.
+ destruct (m1 !! i) eqn:?, (m2 !! i) eqn:?; f_equal'; auto.
Qed.
-
Lemma delete_union_with m1 m2 i :
delete i (union_with f m1 m2) = union_with f (delete i m1) (delete i m2).
Proof. by apply (partial_alter_merge _). Qed.
-
Lemma delete_list_union_with (m1 m2 : M A) is :
delete_list is (union_with f m1 m2) =
union_with f (delete_list is m1) (delete_list is m2).
Proof. induction is; simpl. done. by rewrite IHis, delete_union_with. Qed.
-
Lemma insert_union_with m1 m2 i x :
(∀ x, f x x = Some x) →
<[i:=x]>(union_with f m1 m2) = union_with f (<[i:=x]>m1) (<[i:=x]>m2).
@@ -943,51 +894,50 @@ Proof.
unfold union, map_union, union_with, map_union_with. rewrite (lookup_merge _).
destruct (m1 !! i), (m2 !! i); compute; intuition congruence.
Qed.
-
Lemma lookup_union_Some {A} (m1 m2 : M A) i x :
m1 ⊥ m2 → (m1 ∪ m2) !! i = Some x ↔ m1 !! i = Some x ∨ m2 !! i = Some x.
Proof.
intros Hdisjoint. rewrite lookup_union_Some_raw.
intuition eauto using map_disjoint_Some_r.
Qed.
-
Lemma lookup_union_Some_l {A} (m1 m2 : M A) i x :
m1 !! i = Some x → (m1 ∪ m2) !! i = Some x.
Proof. intro. rewrite lookup_union_Some_raw; intuition. Qed.
Lemma lookup_union_Some_r {A} (m1 m2 : M A) i x :
m1 ⊥ m2 → m2 !! i = Some x → (m1 ∪ m2) !! i = Some x.
Proof. intro. rewrite lookup_union_Some; intuition. Qed.
-
Lemma map_union_commutative {A} (m1 m2 : M A) : m1 ⊥ m2 → m1 ∪ m2 = m2 ∪ m1.
Proof.
intros Hdisjoint. apply (merge_commutative (union_with (λ x _, Some x))).
intros i. specialize (Hdisjoint i).
destruct (m1 !! i), (m2 !! i); compute; naive_solver.
Qed.
-
Lemma map_subseteq_union {A} (m1 m2 : M A) : m1 ⊆ m2 → m1 ∪ m2 = m2.
Proof.
+ rewrite map_subseteq_spec.
intros Hm1m2. apply map_eq. intros i. apply option_eq. intros x.
rewrite lookup_union_Some_raw. split; [by intuition |].
intros Hm2. specialize (Hm1m2 i). destruct (m1 !! i) as [y|]; [| by auto].
rewrite (Hm1m2 y eq_refl) in Hm2. intuition congruence.
Qed.
-
Lemma map_union_subseteq_l {A} (m1 m2 : M A) : m1 ⊆ m1 ∪ m2.
-Proof. intros ? i x. rewrite lookup_union_Some_raw. intuition. Qed.
+Proof.
+ rewrite map_subseteq_spec. intros ? i x. rewrite lookup_union_Some_raw. tauto.
+Qed.
Lemma map_union_subseteq_r {A} (m1 m2 : M A) : m1 ⊥ m2 → m2 ⊆ m1 ∪ m2.
Proof.
intros. rewrite map_union_commutative by done. by apply map_union_subseteq_l.
Qed.
-
Lemma map_union_subseteq_l_alt {A} (m1 m2 m3 : M A) : m1 ⊆ m2 → m1 ⊆ m2 ∪ m3.
Proof. intros. transitivity m2; auto using map_union_subseteq_l. Qed.
Lemma map_union_subseteq_r_alt {A} (m1 m2 m3 : M A) :
m2 ⊥ m3 → m1 ⊆ m3 → m1 ⊆ m2 ∪ m3.
Proof. intros. transitivity m3; auto using map_union_subseteq_r. Qed.
-
Lemma map_union_preserving_l {A} (m1 m2 m3 : M A) : m1 ⊆ m2 → m3 ∪ m1 ⊆ m3 ∪ m2.
-Proof. intros ???. rewrite !lookup_union_Some_raw. naive_solver. Qed.
+Proof.
+ rewrite !map_subseteq_spec. intros ???.
+ rewrite !lookup_union_Some_raw. naive_solver.
+Qed.
Lemma map_union_preserving_r {A} (m1 m2 m3 : M A) :
m2 ⊥ m3 → m1 ⊆ m2 → m1 ∪ m3 ⊆ m2 ∪ m3.
Proof.
@@ -995,13 +945,12 @@ Proof.
by eauto using map_disjoint_weaken_l.
by apply map_union_preserving_l.
Qed.
-
Lemma map_union_reflecting_l {A} (m1 m2 m3 : M A) :
m3 ⊥ m1 → m3 ⊥ m2 → m3 ∪ m1 ⊆ m3 ∪ m2 → m1 ⊆ m2.
Proof.
- intros Hm3m1 Hm3m2 E b x ?. specialize (E b x).
- rewrite !lookup_union_Some in E by done.
- destruct E; auto. by destruct (Hm3m1 b x x).
+ rewrite !map_subseteq_spec. intros Hm31 Hm32 Hm i x ?. specialize (Hm i x).
+ rewrite !lookup_union_Some in Hm by done. destruct Hm; auto.
+ by rewrite map_disjoint_spec in Hm31; destruct (Hm31 i x x).
Qed.
Lemma map_union_reflecting_r {A} (m1 m2 m3 : M A) :
m1 ⊥ m3 → m2 ⊥ m3 → m1 ∪ m3 ⊆ m2 ∪ m3 → m1 ⊆ m2.
@@ -1009,20 +958,18 @@ Proof.
intros ??. rewrite !(map_union_commutative _ m3) by done.
by apply map_union_reflecting_l.
Qed.
-
Lemma map_union_cancel_l {A} (m1 m2 m3 : M A) :
m1 ⊥ m3 → m2 ⊥ m3 → m3 ∪ m1 = m3 ∪ m2 → m1 = m2.
Proof.
- intros. by apply (anti_symmetric (⊆));
- apply map_union_reflecting_l with m3; auto with congruence.
+ intros. apply (anti_symmetric (⊆));
+ apply map_union_reflecting_l with m3; auto using (reflexive_eq (R:=(⊆))).
Qed.
Lemma map_union_cancel_r {A} (m1 m2 m3 : M A) :
m1 ⊥ m3 → m2 ⊥ m3 → m1 ∪ m3 = m2 ∪ m3 → m1 = m2.
Proof.
intros. apply (anti_symmetric (⊆));
- apply map_union_reflecting_r with m3; auto with congruence.
+ apply map_union_reflecting_r with m3; auto using (reflexive_eq (R:=(⊆))).
Qed.
-
Lemma map_disjoint_union_l {A} (m1 m2 m3 : M A) :
m1 ∪ m2 ⊥ m3 ↔ m1 ⊥ m3 ∧ m2 ⊥ m3.
Proof.
@@ -1039,7 +986,6 @@ Proof. by rewrite map_disjoint_union_l. Qed.
Lemma map_disjoint_union_r_2 {A} (m1 m2 m3 : M A) :
m1 ⊥ m2 → m1 ⊥ m3 → m1 ⊥ m2 ∪ m3.
Proof. by rewrite map_disjoint_union_r. Qed.
-
Lemma insert_union_singleton_l {A} (m : M A) i x : <[i:=x]>m = {[i,x]} ∪ m.
Proof.
apply map_eq. intros j. apply option_eq. intros y.
@@ -1054,7 +1000,6 @@ Proof.
intro. rewrite insert_union_singleton_l, map_union_commutative; [done |].
by apply map_disjoint_singleton_l.
Qed.
-
Lemma map_disjoint_insert_l {A} (m1 m2 : M A) i x :
<[i:=x]>m1 ⊥ m2 ↔ m2 !! i = None ∧ m1 ⊥ m2.
Proof.
@@ -1067,14 +1012,12 @@ Proof.
rewrite insert_union_singleton_l.
by rewrite map_disjoint_union_r, map_disjoint_singleton_r.
Qed.
-
Lemma map_disjoint_insert_l_2 {A} (m1 m2 : M A) i x :
m2 !! i = None → m1 ⊥ m2 → <[i:=x]>m1 ⊥ m2.
Proof. by rewrite map_disjoint_insert_l. Qed.
Lemma map_disjoint_insert_r_2 {A} (m1 m2 : M A) i x :
m1 !! i = None → m1 ⊥ m2 → m1 ⊥ <[i:=x]>m2.
Proof. by rewrite map_disjoint_insert_r. Qed.
-
Lemma insert_union_l {A} (m1 m2 : M A) i x :
<[i:=x]>(m1 ∪ m2) = <[i:=x]>m1 ∪ m2.
Proof. by rewrite !insert_union_singleton_l, (associative_L (∪)). Qed.
@@ -1085,14 +1028,12 @@ Proof.
rewrite (map_union_commutative m1); [done |].
by apply map_disjoint_singleton_r.
Qed.
-
Lemma insert_list_union {A} (m : M A) l : insert_list l m = map_of_list l ∪ m.
Proof.
induction l; simpl.
* by rewrite (left_id_L _ _).
* by rewrite IHl, insert_union_l.
Qed.
-
Lemma delete_union {A} (m1 m2 : M A) i :
delete i (m1 ∪ m2) = delete i m1 ∪ delete i m2.
Proof. apply delete_union_with. Qed.
@@ -1103,21 +1044,18 @@ Lemma map_disjoint_union_list_l {A} (ms : list (M A)) (m : M A) :
Proof.
split.
* induction ms; simpl; rewrite ?map_disjoint_union_l; intuition.
- * induction 1; simpl.
- + apply map_disjoint_empty_l.
- + by rewrite map_disjoint_union_l.
+ * induction 1; simpl; [apply map_disjoint_empty_l |].
+ by rewrite map_disjoint_union_l.
Qed.
Lemma map_disjoint_union_list_r {A} (ms : list (M A)) (m : M A) :
m ⊥ ⋃ ms ↔ Forall (.⊥ m) ms.
Proof. by rewrite (symmetry_iff (⊥)), map_disjoint_union_list_l. Qed.
-
Lemma map_disjoint_union_list_l_2 {A} (ms : list (M A)) (m : M A) :
Forall (.⊥ m) ms → ⋃ ms ⊥ m.
Proof. by rewrite map_disjoint_union_list_l. Qed.
Lemma map_disjoint_union_list_r_2 {A} (ms : list (M A)) (m : M A) :
Forall (.⊥ m) ms → m ⊥ ⋃ ms.
Proof. by rewrite map_disjoint_union_list_r. Qed.
-
Lemma map_union_sublist {A} (ms1 ms2 : list (M A)) :
⊥ ms2 → ms1 `sublist` ms2 → ⋃ ms1 ⊆ ⋃ ms2.
Proof.
@@ -1141,75 +1079,64 @@ Qed.
Lemma lookup_delete_list {A} (m : M A) is j :
j ∈ is → delete_list is m !! j = None.
Proof.
- induction 1 as [|i j is]; simpl.
- * by rewrite lookup_delete.
- * destruct (decide (i = j)).
- + subst. by rewrite lookup_delete.
- + rewrite lookup_delete_ne; auto.
+ induction 1 as [|i j is]; simpl; [by rewrite lookup_delete|].
+ by destruct (decide (i = j)) as [->|?];
+ rewrite ?lookup_delete, ?lookup_delete_ne by done.
Qed.
Lemma lookup_delete_list_not_elem_of {A} (m : M A) is j :
j ∉ is → delete_list is m !! j = m !! j.
Proof.
- induction is; simpl; [done |]. rewrite elem_of_cons. intros.
- intros. rewrite lookup_delete_ne; intuition.
+ induction is; simpl; [done |]. rewrite elem_of_cons; intros.
+ rewrite lookup_delete_ne; intuition.
Qed.
Lemma delete_list_notin {A} (m : M A) is :
Forall (λ i, m !! i = None) is → delete_list is m = m.
-Proof.
- induction 1; simpl; [done |]. rewrite delete_notin; congruence.
-Qed.
-
+Proof. induction 1; simpl; [done |]. rewrite delete_notin; congruence. Qed.
Lemma delete_list_insert_ne {A} (m : M A) is j x :
j ∉ is → delete_list is (<[j:=x]>m) = <[j:=x]>(delete_list is m).
Proof.
induction is; simpl; [done |]. rewrite elem_of_cons. intros.
rewrite IHis, delete_insert_ne; intuition.
Qed.
-
Lemma map_disjoint_delete_list_l {A} (m1 m2 : M A) is :
m1 ⊥ m2 → delete_list is m1 ⊥ m2.
Proof. induction is; simpl; auto using map_disjoint_delete_l. Qed.
Lemma map_disjoint_delete_list_r {A} (m1 m2 : M A) is :
m1 ⊥ m2 → m1 ⊥ delete_list is m2.
Proof. induction is; simpl; auto using map_disjoint_delete_r. Qed.
-
Lemma delete_list_union {A} (m1 m2 : M A) is :
delete_list is (m1 ∪ m2) = delete_list is m1 ∪ delete_list is m2.
Proof. apply delete_list_union_with. Qed.
(** ** Properties on disjointness of conversion to lists *)
Lemma map_disjoint_of_list_l {A} (m : M A) ixs :
- map_of_list ixs ⊥ m ↔ Forall (λ ix, m !! fst ix = None) ixs.
+ map_of_list ixs ⊥ m ↔ Forall (λ ix, m !! ix.1 = None) ixs.
Proof.
split.
* induction ixs; simpl; rewrite ?map_disjoint_insert_l in *; intuition.
- * induction 1; simpl.
- + apply map_disjoint_empty_l.
- + rewrite map_disjoint_insert_l. auto.
+ * induction 1; simpl; [apply map_disjoint_empty_l|].
+ rewrite map_disjoint_insert_l. auto.
Qed.
Lemma map_disjoint_of_list_r {A} (m : M A) ixs :
- m ⊥ map_of_list ixs ↔ Forall (λ ix, m !! fst ix = None) ixs.
+ m ⊥ map_of_list ixs ↔ Forall (λ ix, m !! ix.1 = None) ixs.
Proof. by rewrite (symmetry_iff (⊥)), map_disjoint_of_list_l. Qed.
-
Lemma map_disjoint_of_list_zip_l {A} (m : M A) is xs :
- is `same_length` xs →
+ length is = length xs →
map_of_list (zip is xs) ⊥ m ↔ Forall (λ i, m !! i = None) is.
Proof.
intro. rewrite map_disjoint_of_list_l.
- rewrite <-(zip_fst is xs) at 2 by done. by rewrite Forall_fmap.
+ rewrite <-(fst_zip is xs) at 2 by lia. by rewrite Forall_fmap.
Qed.
Lemma map_disjoint_of_list_zip_r {A} (m : M A) is xs :
- is `same_length` xs →
+ length is = length xs →
m ⊥ map_of_list (zip is xs) ↔ Forall (λ i, m !! i = None) is.
-Proof.
- intro. by rewrite (symmetry_iff (⊥)), map_disjoint_of_list_zip_l.
-Qed.
+Proof. intro. by rewrite (symmetry_iff (⊥)), map_disjoint_of_list_zip_l. Qed.
Lemma map_disjoint_of_list_zip_l_2 {A} (m : M A) is xs :
- is `same_length` xs → Forall (λ i, m !! i = None) is →
+ length is = length xs → Forall (λ i, m !! i = None) is →
map_of_list (zip is xs) ⊥ m.
Proof. intro. by rewrite map_disjoint_of_list_zip_l. Qed.
Lemma map_disjoint_of_list_zip_r_2 {A} (m : M A) is xs :
- is `same_length` xs → Forall (λ i, m !! i = None) is →
+ length is = length xs → Forall (λ i, m !! i = None) is →
m ⊥ map_of_list (zip is xs).
Proof. intro. by rewrite map_disjoint_of_list_zip_r. Qed.
@@ -1225,7 +1152,6 @@ Proof.
* apply map_disjoint_weaken_r with (⋃ ms); [done |].
apply map_union_sublist; auto using sublist_delete.
Qed.
-
Lemma union_insert_vec {A n} (ms : vec (M A) n) (i : fin n) m :
m ⊥ ⋃ delete (fin_to_nat i) (vec_to_list ms) →
⋃ vinsert i m ms = m ∪ ⋃ delete (fin_to_nat i) (vec_to_list ms).
@@ -1236,70 +1162,34 @@ Proof.
Qed.
(** ** Properties of the [difference_with] operation *)
-Section difference_with.
-Context {A} (f : A → A → option A).
-
-Lemma lookup_difference_with m1 m2 i z :
- difference_with f m1 m2 !! i = z ↔
- (m1 !! i = None ∧ z = None) ∨
- (∃ x, m1 !! i = Some x ∧ m2 !! i = None ∧ z = Some x) ∨
- (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ z = f x y).
-Proof.
- unfold difference_with, map_difference_with. rewrite (lookup_merge _).
- destruct (m1 !! i), (m2 !! i); compute; naive_solver.
-Qed.
-Lemma lookup_difference_with_Some m1 m2 i z :
- difference_with f m1 m2 !! i = Some z ↔
- (m1 !! i = Some z ∧ m2 !! i = None) ∨
- (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ f x y = Some z).
-Proof. rewrite lookup_difference_with. naive_solver. Qed.
-Lemma lookup_difference_with_None m1 m2 i :
- difference_with f m1 m2 !! i = None ↔
- (m1 !! i = None) ∨
- (∃ x y, m1 !! i = Some x ∧ m2 !! i = Some y ∧ f x y = None).
-Proof. rewrite lookup_difference_with. naive_solver. Qed.
-
-Lemma lookup_difference_with_Some_lr m1 m2 i x y z :
- m1 !! i = Some x → m2 !! i = Some y → f x y = Some z →
- difference_with f m1 m2 !! i = Some z.
-Proof. rewrite lookup_difference_with. naive_solver. Qed.
-Lemma lookup_difference_with_None_lr m1 m2 i x y :
- m1 !! i = Some x → m2 !! i = Some y → f x y = None →
- difference_with f m1 m2 !! i = None.
-Proof. rewrite lookup_difference_with. naive_solver. Qed.
-Lemma lookup_difference_with_Some_l m1 m2 i x :
- m1 !! i = Some x → m2 !! i = None → difference_with f m1 m2 !! i = Some x.
-Proof. rewrite lookup_difference_with. naive_solver. Qed.
-End difference_with.
+Lemma lookup_difference_with {A} (f : A → A → option A) m1 m2 i :
+ difference_with f m1 m2 !! i = difference_with f (m1 !! i) (m2 !! i).
+Proof. by rewrite <-lookup_merge by done. Qed.
(** ** Properties of the [difference] operation *)
Lemma lookup_difference_Some {A} (m1 m2 : M A) i x :
(m1 ∖ m2) !! i = Some x ↔ m1 !! i = Some x ∧ m2 !! i = None.
Proof.
- unfold difference, map_difference, difference_with, map_difference_with.
- rewrite (lookup_merge _).
+ unfold difference, map_difference; rewrite lookup_difference_with.
destruct (m1 !! i), (m2 !! i); compute; intuition congruence.
Qed.
-
Lemma map_disjoint_difference_l {A} (m1 m2 : M A) : m1 ⊆ m2 → m2 ∖ m1 ⊥ m1.
Proof.
- intros E i. specialize (E i). unfold difference, map_difference. intros x1 x2.
- rewrite lookup_difference_with_Some. intros [?| (?&?&?&?&?)] ?.
- * specialize (E x2). intuition congruence.
- * done.
+ intros Hm i; specialize (Hm i).
+ unfold difference, map_difference; rewrite lookup_difference_with.
+ by destruct (m1 !! i), (m2 !! i).
Qed.
Lemma map_disjoint_difference_r {A} (m1 m2 : M A) : m1 ⊆ m2 → m1 ⊥ m2 ∖ m1.
Proof. intros. symmetry. by apply map_disjoint_difference_l. Qed.
-
Lemma map_difference_union {A} (m1 m2 : M A) :
m1 ⊆ m2 → m1 ∪ m2 ∖ m1 = m2.
Proof.
- intro Hm1m2. apply map_eq. intros i.
+ rewrite map_subseteq_spec. intro Hm1m2. apply map_eq. intros i.
apply option_eq. intros v. specialize (Hm1m2 i).
unfold difference, map_difference, difference_with, map_difference_with.
rewrite lookup_union_Some_raw, (lookup_merge _).
- destruct (m1 !! i) as [v'|], (m2 !! i);
- try specialize (Hm1m2 v'); compute; intuition congruence.
+ destruct (m1 !! i) as [x'|], (m2 !! i);
+ try specialize (Hm1m2 x'); compute; intuition congruence.
Qed.
End theorems.
@@ -1371,15 +1261,14 @@ look ups yield [Some]. *)
Tactic Notation "simpl_map" "by" tactic3(tac) := repeat
match goal with
| H : context[ ∅ !! _ ] |- _ => rewrite lookup_empty in H
- | H : context[ (<[_:=_]>_) !! _ ] |- _ => rewrite lookup_insert in H
| H : context[ (<[_:=_]>_) !! _ ] |- _ =>
- rewrite lookup_insert_ne in H by tac
- | H : context[ (delete _ _) !! _] |- _ => rewrite lookup_delete in H
+ rewrite lookup_insert in H || rewrite lookup_insert_ne in H by tac
+ | H : context[ (alter _ _ _) !! _] |- _ =>
+ rewrite lookup_alter in H || rewrite lookup_alter_ne in H by tac
| H : context[ (delete _ _) !! _] |- _ =>
- rewrite lookup_delete_ne in H by tac
- | H : context[ {[ _ ]} !! _ ] |- _ => rewrite lookup_singleton in H
+ rewrite lookup_delete in H || rewrite lookup_delete_ne in H by tac
| H : context[ {[ _ ]} !! _ ] |- _ =>
- rewrite lookup_singleton_ne in H by tac
+ rewrite lookup_singleton in H || rewrite lookup_singleton_ne in H by tac
| H : context[ lookup (A:=?A) ?i (?m1 ∪ ?m2) ] |- _ =>
let x := fresh in evar (x:A);
let x' := eval unfold x in x in clear x;
@@ -1387,12 +1276,14 @@ Tactic Notation "simpl_map" "by" tactic3(tac) := repeat
assert ((m1 ∪ m2) !! i = Some x') as E by (clear H; by tac);
rewrite E in H; clear E
| |- context[ ∅ !! _ ] => rewrite lookup_empty
- | |- context[ (<[_:=_]>_) !! _ ] => rewrite lookup_insert
- | |- context[ (<[_:=_]>_) !! _ ] => rewrite lookup_insert_ne by tac
- | |- context[ (delete _ _) !! _ ] => rewrite lookup_delete
- | |- context[ (delete _ _) !! _ ] => rewrite lookup_delete_ne by tac
- | |- context[ {[ _ ]} !! _ ] => rewrite lookup_singleton
- | |- context[ {[ _ ]} !! _ ] => rewrite lookup_singleton_ne by tac
+ | |- context[ (<[_:=_]>_) !! _ ] =>
+ rewrite lookup_insert || rewrite lookup_insert_ne by tac
+ | |- context[ (alter _ _ _) !! _ ] =>
+ rewrite lookup_alter || rewrite lookup_alter_ne by tac
+ | |- context[ (delete _ _) !! _ ] =>
+ rewrite lookup_delete || rewrite lookup_delete_ne by tac
+ | |- context[ {[ _ ]} !! _ ] =>
+ rewrite lookup_singleton || rewrite lookup_singleton_ne by tac
| |- context [ lookup (A:=?A) ?i ?m ] =>
let x := fresh in evar (x:A);
let x' := eval unfold x in x in clear x;
@@ -1423,17 +1314,25 @@ Tactic Notation "simplify_map_equality" "by" tactic3(tac) :=
rewrite lookup_singleton_Some in H; destruct H
| H1 : ?m1 !! ?i = Some ?x, H2 : ?m2 !! ?i = Some ?y |- _ =>
let H3 := fresh in
- feed pose proof (lookup_weaken_inv m1 m2 i x y) as H3;
- [done | by tac | done | ];
+ feed pose proof (lookup_weaken_inv m1 m2 i x y) as H3; [done|by tac|done|];
clear H2; symmetry in H3
| H1 : ?m1 !! ?i = Some ?x, H2 : ?m2 !! ?i = None |- _ =>
let H3 := fresh in
- assert (m1 ⊆ m2) as H3 by tac;
- apply H3 in H1; congruence
+ apply (lookup_weaken _ m2) in H1; [congruence|by tac]
| H : ?m ∪ _ = ?m ∪ _ |- _ =>
- apply map_union_cancel_l in H; [| solve[tac] | solve [tac]]
+ apply map_union_cancel_l in H; [|by tac|by tac]
| H : _ ∪ ?m = _ ∪ ?m |- _ =>
- apply map_union_cancel_r in H; [| solve[tac] | solve [tac]]
+ apply map_union_cancel_r in H; [|by tac|by tac]
+ | H : {[?i,?x]} = ∅ |- _ => by destruct (singleton_ne_empty i x)
+ | H : ∅ = {[?i,?x]} |- _ => by destruct (singleton_ne_empty i x)
end.
+Tactic Notation "simplify_map_equality'" "by" tactic3(tac) :=
+ repeat (progress simpl in * || simplify_map_equality by tac).
+Tactic Notation "simplify_option_map_equality" "by" tactic3(tac) :=
+ repeat (simplify_option_equality || simplify_map_equality by tac).
Tactic Notation "simplify_map_equality" :=
simplify_map_equality by eauto with simpl_map map_disjoint.
+Tactic Notation "simplify_map_equality'" :=
+ simplify_map_equality' by eauto with simpl_map map_disjoint.
+Tactic Notation "simplify_option_map_equality" :=
+ simplify_option_map_equality by eauto with simpl_map map_disjoint.
diff --git a/theories/lexico.v b/theories/lexico.v
index 5559c4ee..1339db21 100644
--- a/theories/lexico.v
+++ b/theories/lexico.v
@@ -11,9 +11,9 @@ Notation cast_trichotomy T :=
| inright _ => inright _
end.
-Instance prod_lexico `{Lexico A} `{Lexico B} : Lexico (A * B) := λ p1 p2,
- (**i 1.) *) lexico (fst p1) (fst p2) ∨
- (**i 2.) *) fst p1 = fst p2 ∧ lexico (snd p1) (snd p2).
+Instance prod_lexico `{Lexico A, Lexico B} : Lexico (A * B) := λ p1 p2,
+ (**i 1.) *) lexico (p1.1) (p2.1) ∨
+ (**i 2.) *) p1.1 = p2.1 ∧ lexico (p1.2) (p2.2).
Instance bool_lexico : Lexico bool := λ b1 b2,
match b1, b2 with false, true => True | _, _ => False end.
@@ -32,12 +32,11 @@ Instance list_lexico `{Lexico A} : Lexico (list A) :=
Instance sig_lexico `{Lexico A} (P : A → Prop) `{∀ x, ProofIrrel (P x)} :
Lexico (sig P) := λ x1 x2, lexico (`x1) (`x2).
-Lemma prod_lexico_irreflexive `{Lexico A} `{Lexico B}
- `{!Irreflexive (@lexico A _)} (x : A) (y : B) :
- complement lexico y y → complement lexico (x,y) (x,y).
+Lemma prod_lexico_irreflexive `{Lexico A, Lexico B, !Irreflexive (@lexico A _)}
+ (x : A) (y : B) : complement lexico y y → complement lexico (x,y) (x,y).
Proof. intros ? [?|[??]]. by apply (irreflexivity lexico x). done. Qed.
-Lemma prod_lexico_transitive `{Lexico A} `{Lexico B}
- `{!Transitive (@lexico A _)} (x1 x2 x3 : A) (y1 y2 y3 : B) :
+Lemma prod_lexico_transitive `{Lexico A, Lexico B, !Transitive (@lexico A _)}
+ (x1 x2 x3 : A) (y1 y2 y3 : B) :
lexico (x1,y1) (x2,y2) → lexico (x2,y2) (x3,y3) →
(lexico y1 y2 → lexico y2 y3 → lexico y1 y3) → lexico (x1,y1) (x3,y3).
Proof.
@@ -46,7 +45,7 @@ Proof.
by left; transitivity x2.
Qed.
-Instance prod_lexico_po `{Lexico A} `{Lexico B} `{!StrictOrder (@lexico A _)}
+Instance prod_lexico_po `{Lexico A, Lexico B, !StrictOrder (@lexico A _)}
`{!StrictOrder (@lexico B _)} : StrictOrder (@lexico (A * B) _).
Proof.
split.
@@ -55,14 +54,13 @@ Proof.
* intros [??] [??] [??] ??.
eapply prod_lexico_transitive; eauto. apply transitivity.
Qed.
-Instance prod_lexico_trichotomyT `{Lexico A} `{tA: !TrichotomyT (@lexico A _)}
- `{Lexico B} `{tB:!TrichotomyT (@lexico B _)}: TrichotomyT (@lexico (A * B) _).
+Instance prod_lexico_trichotomyT `{Lexico A, tA : !TrichotomyT (@lexico A _)}
+ `{Lexico B, tB : !TrichotomyT (@lexico B _)}: TrichotomyT (@lexico (A * B) _).
Proof.
red; refine (λ p1 p2,
- match trichotomyT lexico (fst p1) (fst p2) with
+ match trichotomyT lexico (p1.1) (p2.1) with
| inleft (left _) => inleft (left _)
- | inleft (right _) =>
- cast_trichotomy (trichotomyT lexico (snd p1) (snd p2))
+ | inleft (right _) => cast_trichotomy (trichotomyT lexico (p1.2) (p2.2))
| inright _ => inright _
end); clear tA tB;
abstract (unfold lexico, prod_lexico; auto using injective_projections).
@@ -117,7 +115,7 @@ Proof.
end eq_refl).
Defined.
-Instance list_lexico_po `{Lexico A} `{!StrictOrder (@lexico A _)} :
+Instance list_lexico_po `{Lexico A, !StrictOrder (@lexico A _)} :
StrictOrder (@lexico (list A) _).
Proof.
split.
@@ -125,7 +123,7 @@ Proof.
* intros l1. induction l1 as [|x1 l1]; intros [|x2 l2] [|x3 l3] ??; try done.
eapply prod_lexico_transitive; eauto.
Qed.
-Instance list_lexico_trichotomy `{Lexico A} `{tA:!TrichotomyT (@lexico A _)} :
+Instance list_lexico_trichotomy `{Lexico A, tA : !TrichotomyT (@lexico A _)} :
TrichotomyT (@lexico (list A) _).
Proof.
refine (
@@ -140,14 +138,14 @@ Proof.
abstract (repeat (done || constructor || congruence || by inversion 1)).
Defined.
-Instance sig_lexico_po `{Lexico A} `{!StrictOrder (@lexico A _)}
+Instance sig_lexico_po `{Lexico A, !StrictOrder (@lexico A _)}
(P : A → Prop) `{∀ x, ProofIrrel (P x)} : StrictOrder (@lexico (sig P) _).
Proof.
unfold lexico, sig_lexico. split.
* intros [x ?] ?. by apply (irreflexivity lexico x).
* intros [x1 ?] [x2 ?] [x3 ?] ??. by transitivity x2.
Qed.
-Instance sig_lexico_trichotomy `{Lexico A} `{tA: !TrichotomyT (@lexico A _)}
+Instance sig_lexico_trichotomy `{Lexico A, tA : !TrichotomyT (@lexico A _)}
(P : A → Prop) `{∀ x, ProofIrrel (P x)} : TrichotomyT (@lexico (sig P) _).
Proof.
red; refine (λ x1 x2, cast_trichotomy (trichotomyT lexico (`x1) (`x2)));
diff --git a/theories/list.v b/theories/list.v
index 766ba58d..f416e5b1 100644
--- a/theories/list.v
+++ b/theories/list.v
@@ -38,24 +38,28 @@ Notation "(≢ₚ x )" := (λ y, y ≢ₚ x) (only parsing) : C_scope.
(** The operation [l !! i] gives the [i]th element of the list [l], or [None]
in case [i] is out of bounds. *)
Instance list_lookup {A} : Lookup nat A (list A) :=
- fix go (i : nat) (l : list A) {struct l} : option A :=
+ fix go i l {struct l} : option A := let _ : Lookup _ _ _ := @go in
match l with
- | [] => None
- | x :: l => match i with 0 => Some x | S i => @lookup _ _ _ go i l end
+ | [] => None | x :: l => match i with 0 => Some x | S i => l !! i end
end.
(** The operation [alter f i l] applies the function [f] to the [i]th element
of [l]. In case [i] is out of bounds, the list is returned unchanged. *)
Instance list_alter {A} (f : A → A) : AlterD nat A (list A) f :=
- fix go (i : nat) (l : list A) {struct l} :=
+ fix go i l {struct l} := let _ : AlterD _ _ _ f := @go in
match l with
| [] => []
- | x :: l => match i with 0 => f x :: l | S i => x :: @alter _ _ _ f go i l end
+ | x :: l => match i with 0 => f x :: l | S i => x :: alter f 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.
+Instance list_insert {A} : Insert nat A (list A) :=
+ fix go i y l {struct l} := let _ : Insert _ _ _ := @go in
+ match l with
+ | [] => []
+ | x :: l => match i with 0 => y :: l | S i => x :: <[i:=y]>l end
+ end.
(** 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,
@@ -70,23 +74,16 @@ Instance list_delete {A} : Delete nat (list A) :=
(** 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]) [].
+Definition list_singleton {A} (l : list A) : option A :=
+ match l with [x] => Some x | _ => None end.
(** The function [filter P l] returns the list of elements of [l] that
satisfies [P]. The order remains unchanged. *)
Instance list_filter {A} : Filter A (list A) :=
- fix go P _ l :=
+ fix go P _ l := let _ : Filter _ _ := @go in
match l with
| [] => []
- | x :: l =>
- if decide (P x)
- then x :: @filter _ _ (@go) _ _ l
- else @filter _ _ (@go) _ _ l
- end.
-Fixpoint filter_Some {A} (l : list (option A)) : list A :=
- match l with
- | [] => []
- | Some x :: l => x :: filter_Some l
- | None :: l => filter_Some l
+ | x :: l => if decide (P x) then x :: filter P l else filter P l
end.
(** The function [list_find P l] returns the first index [i] whose element
@@ -94,8 +91,7 @@ satisfies the predicate [P]. *)
Definition list_find {A} P `{∀ x, Decision (P x)} : list A → option nat :=
fix go l :=
match l with
- | [] => None
- | x :: l => if decide (P x) then Some 0 else S <$> go l
+ | [] => None | x :: l => if decide (P x) then Some 0 else S <$> go l
end.
(** The function [replicate n x] generates a list with length [n] of elements
@@ -106,10 +102,10 @@ Fixpoint replicate {A} (n : nat) (x : A) : list A :=
(** The function [reverse l] returns the elements of [l] in reverse order. *)
Definition reverse {A} (l : list A) : list A := rev_append l [].
-Fixpoint last' {A} (x : A) (l : list A) : A :=
- match l with [] => x | x :: l => last' x l end.
-Definition last {A} (l : list A) : option A :=
- match l with [] => None | x :: l => Some (last' x l) end.
+(** The function [last l] returns the last element of the list [l], or [None]
+if the list [l] is empty. *)
+Fixpoint last {A} (l : list A) : option A :=
+ match l with [] => None | [x] => Some x | _ :: l => last l end.
(** The function [resize n y l] takes the first [n] elements of [l] in case
[length l ≤ n], and otherwise appends elements with value [x] to [l] to obtain
@@ -121,30 +117,25 @@ Fixpoint resize {A} (n : nat) (y : A) (l : list A) : list A :=
end.
Arguments resize {_} !_ _ !_.
-(* The function [reshape k l] transforms [l] into a list of lists whose sizes are
-specified by [k]. In case [l] is too short, the resulting list will end with a
-a certain number of empty lists. In case [l] is too long, it will be truncated. *)
+(** The function [reshape k l] transforms [l] into a list of lists whose sizes
+are specified by [k]. In case [l] is too short, the resulting list will be
+padded with empty lists. In case [l] is too long, it will be truncated. *)
Fixpoint reshape {A} (szs : list nat) (l : list A) : list (list A) :=
match szs with
- | [] => []
- | sz :: szs => take sz l :: reshape szs (drop sz l)
+ | [] => [] | sz :: szs => take sz l :: reshape szs (drop sz l)
end.
Definition sublist_lookup {A} (i n : nat) (l : list A) : option (list A) :=
- guard (i + n ≤ length l); Some $ take n $ drop i l.
-Definition sublist_insert {A} (i : nat) (k l : list A) : list A :=
- take i l ++ take (length l - i) k ++ drop (i + length k) l.
+ guard (i + n ≤ length l); Some (take n (drop i l)).
+Definition sublist_alter {A} (f : list A → list A)
+ (i n : nat) (l : list A) : list A :=
+ take i l ++ f (take n (drop i l)) ++ drop (i + n) l.
(** Functions to fold over a list. We redefine [foldl] with the arguments in
the same order as in Haskell. *)
Notation foldr := fold_right.
-
Definition foldl {A B} (f : A → B → A) : A → list B → A :=
- fix go a l :=
- match l with
- | [] => a
- | x :: l => go (f a x) l
- end.
+ fix go a l := match l with [] => a | x :: l => go (f a x) l end.
(** The monadic operations. *)
Instance list_ret: MRet list := λ A x, x :: @nil A.
@@ -157,13 +148,9 @@ Instance list_bind {A B} (f : A → list B) : MBindD list f :=
Instance list_join: MJoin list :=
fix go A (ls : list (list A)) : list A :=
match ls with [] => [] | l :: ls => l ++ @mjoin _ go _ ls end.
-Definition mapM `{!MBind M} `{!MRet M} {A B}
- (f : A → M B) : list A → M (list B) :=
+Definition mapM `{MBind M, MRet M} {A B} (f : A → M B) : list A → M (list B) :=
fix go l :=
- match l with
- | [] => mret []
- | x :: l => y ↠f x; k ↠go l; mret (y :: k)
- end.
+ match l with [] => mret [] | x :: l => y ↠f x; k ↠go l; mret (y :: k) end.
(** We define stronger variants of map and fold that allow the mapped
function to use the index of the elements. *)
@@ -171,11 +158,6 @@ Definition imap_go {A B} (f : nat → A → B) : nat → list A → list B :=
fix go (n : nat) (l : list A) :=
match l with [] => [] | x :: l => f n x :: go (S n) l end.
Definition imap {A B} (f : nat → A → B) : list A → list B := imap_go f 0.
-
-Definition ifoldr {A B} (f : nat → B → A → A) (a : nat → A) :
- nat → list B → A := fix go n l :=
- match l with [] => a n | b :: l => f n b (go (S n) l) end.
-
Definition zipped_map {A B} (f : list A → list A → A → B) :
list A → list A → list B := fix go l k :=
match k with [] => [] | x :: k => f l k x :: go (x :: l) k end.
@@ -188,23 +170,21 @@ Inductive zipped_Forall {A} (P : list A → list A → A → Prop) :
Arguments zipped_Forall_nil {_ _} _.
Arguments zipped_Forall_cons {_ _} _ _ _ _ _.
-(** Zipping lists. *)
-Definition zip_with {A B C} (f : A → B → C) : list A → list B → list C :=
- fix go l1 l2 :=
- match l1, l2 with x1 :: l1, x2 :: l2 => f x1 x2 :: go l1 l2 | _ , _ => [] end.
-Notation zip := (zip_with pair).
+(** The function [mask f βs l] applies the function [f] to elements in [l] at
+positions that are [true] in [βs]. *)
+Fixpoint mask {A} (f : A → A) (βs : list bool) (l : list A) : list A :=
+ match βs, l with
+ | β :: βs, x :: l => (if β then f x else x) :: mask f βs l
+ | _, _ => l
+ end.
(** The function [permutations l] yields all permutations of [l]. *)
Fixpoint interleave {A} (x : A) (l : list A) : list (list A) :=
match l with
- | [] => [ [x] ]
- | y :: l => (x :: y :: l) :: ((y ::) <$> interleave x l)
+ | [] => [[x]]| y :: l => (x :: y :: l) :: ((y ::) <$> interleave x l)
end.
Fixpoint permutations {A} (l : list A) : list (list A) :=
- match l with
- | [] => [ [] ]
- | x :: l => permutations l ≫= interleave x
- end.
+ match l with [] => [[]] | x :: l => permutations l ≫= interleave x end.
(** The predicate [suffix_of] holds if the first list is a suffix of the second.
The predicate [prefix_of] holds if the first list is a prefix of the second. *)
@@ -215,7 +195,6 @@ Infix "`prefix_of`" := prefix_of (at level 70) : C_scope.
Section prefix_suffix_ops.
Context `{∀ x y : A, Decision (x = y)}.
-
Definition max_prefix_of : list A → list A → list A * list A * list A :=
fix go l1 l2 :=
match l1, l2 with
@@ -223,16 +202,14 @@ Section prefix_suffix_ops.
| l1, [] => (l1, [], [])
| x1 :: l1, x2 :: l2 =>
if decide_rel (=) x1 x2
- then snd_map (x1 ::) (go l1 l2)
- else (x1 :: l1, x2 :: l2, [])
+ then prod_map id (x1 ::) (go l1 l2) else (x1 :: l1, x2 :: l2, [])
end.
Definition max_suffix_of (l1 l2 : list A) : list A * list A * list A :=
match max_prefix_of (reverse l1) (reverse l2) with
| (k1, k2, k3) => (reverse k1, reverse k2, reverse k3)
end.
-
- Definition strip_prefix (l1 l2 : list A) := snd $ fst $ max_prefix_of l1 l2.
- Definition strip_suffix (l1 l2 : list A) := snd $ fst $ max_suffix_of l1 l2.
+ Definition strip_prefix (l1 l2 : list A) := (max_prefix_of l1 l2).1.2.
+ Definition strip_suffix (l1 l2 : list A) := (max_suffix_of l1 l2).1.2.
End prefix_suffix_ops.
(** A list [l1] is a sublist of [l2] if [l2] is obtained by removing elements
@@ -244,7 +221,7 @@ Inductive sublist {A} : relation (list A) :=
Infix "`sublist`" := sublist (at level 70) : C_scope.
(** A list [l2] contains a list [l1] if [l2] is obtained by removing elements
-from [l1] without changing the order. *)
+from [l1] while possiblity changing the order. *)
Inductive contains {A} : relation (list A) :=
| contains_nil : contains [] []
| contains_skip x l1 l2 : contains l1 l2 → contains (x :: l1) (x :: l2)
@@ -255,7 +232,6 @@ Infix "`contains`" := contains (at level 70) : C_scope.
Section contains_dec_help.
Context {A} {dec : ∀ x y : A, Decision (x = y)}.
-
Fixpoint list_remove (x : A) (l : list A) : option (list A) :=
match l with
| [] => None
@@ -263,23 +239,19 @@ Section contains_dec_help.
end.
Fixpoint list_remove_list (k : list A) (l : list A) : option (list A) :=
match k with
- | [] => Some l
- | x :: k => list_remove x l ≫= list_remove_list k
+ | [] => Some l | x :: k => list_remove x l ≫= list_remove_list k
end.
End contains_dec_help.
-(** The [same_length] view allows convenient induction over two lists with the
-same length. *)
-Inductive same_length {A B} : list A → list B → Prop :=
- | same_length_nil : same_length [] []
- | same_length_cons x1 x2 l1 l2 :
- same_length l1 l2 → same_length (x1 :: l1) (x2 :: l2).
-Infix "`same_length`" := same_length (at level 70) : C_scope.
+Inductive Forall3 {A B C} (P : A → B → C → Prop) :
+ list A → list B → list C → Prop :=
+ | Forall3_nil : Forall3 P [] [] []
+ | Forall3_cons x y z l k k' :
+ P x y z → Forall3 P l k k' → Forall3 P (x :: l) (y :: k) (z :: k').
(** Set operations on lists *)
Section list_set.
Context {A} {dec : ∀ x y : A, Decision (x = y)}.
-
Global Instance elem_of_list_dec {dec : ∀ x y : A, Decision (x = y)}
(x : A) : ∀ l, Decision (x ∈ l).
Proof.
@@ -290,29 +262,25 @@ Section list_set.
| y :: l => cast_if_or (decide (x = y)) (go l)
end); clear go dec; subst; try (by constructor); abstract by inversion 1.
Defined.
-
Fixpoint remove_dups (l : list A) : list A :=
match l with
| [] => []
| x :: l =>
if decide_rel (∈) x l then remove_dups l else x :: remove_dups l
end.
-
Fixpoint list_difference (l k : list A) : list A :=
match l with
| [] => []
| x :: l =>
if decide_rel (∈) x k
- then list_difference l k
- else x :: list_difference l k
+ then list_difference l k else x :: list_difference l k
end.
Fixpoint list_intersection (l k : list A) : list A :=
match l with
| [] => []
| x :: l =>
if decide_rel (∈) x k
- then x :: list_intersection l k
- else list_intersection l k
+ then x :: list_intersection l k else list_intersection l k
end.
Definition list_intersection_with (f : A → A → option A) :
list A → list A → list A := fix go l k :=
@@ -338,12 +306,22 @@ Tactic Notation "discriminate_list_equality" :=
(** The tactic [simplify_list_equality] simplifies hypotheses involving
equalities on lists using injectivity of [(::)] and [(++)]. Also, it simplifies
lookups in singleton lists. *)
+Lemma app_injective_1 {A} (l1 k1 l2 k2 : list A) :
+ length l1 = length k1 → l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2.
+Proof. revert k1. induction l1; intros [|??]; naive_solver. Qed.
+Lemma app_injective_2 {A} (l1 k1 l2 k2 : list A) :
+ length l2 = length k2 → l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2.
+Proof.
+ intros ? Hl. apply app_injective_1; auto.
+ apply (f_equal length) in Hl. rewrite !app_length in Hl. lia.
+Qed.
Ltac simplify_list_equality :=
repeat match goal with
| _ => progress simplify_equality
| H : _ ++ _ = _ ++ _ |- _ => first
- [ apply app_inj_tail in H; destruct H
- | apply app_inv_head in H | apply app_inv_tail in H ]
+ [ apply app_inv_head in H | apply app_inv_tail in H
+ | apply app_injective_1 in H; [destruct H|done]
+ | apply app_injective_2 in H; [destruct H|done] ]
| H : [?x] !! ?i = Some ?y |- _ =>
destruct i; [change (Some x = Some y) in H | discriminate]
end;
@@ -371,42 +349,38 @@ Global Instance: RightId (=) [] (@app A).
Proof. intro. apply app_nil_r. Qed.
Lemma app_nil l1 l2 : l1 ++ l2 = [] ↔ l1 = [] ∧ l2 = [].
-Proof. split. apply app_eq_nil. by intros [??]; subst. Qed.
+Proof. split. apply app_eq_nil. by intros [-> ->]. Qed.
Lemma app_singleton l1 l2 x :
l1 ++ l2 = [x] ↔ l1 = [] ∧ l2 = [x] ∨ l1 = [x] ∧ l2 = [].
-Proof. split. apply app_eq_unit. by intros [[??]|[??]]; subst. Qed.
-
+Proof. split. apply app_eq_unit. by intros [[-> ->]|[-> ->]]. Qed.
Lemma cons_middle x l1 l2 : l1 ++ x :: l2 = l1 ++ [x] ++ l2.
Proof. done. Qed.
-Lemma app_inj l1 k1 l2 k2 :
- length l1 = length k1 → l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2.
-Proof. revert k1. induction l1; intros [|??]; naive_solver. Qed.
-
Lemma list_eq l1 l2 : (∀ i, l1 !! i = l2 !! i) → l1 = l2.
Proof.
revert l2. induction l1; intros [|??] H.
* done.
* discriminate (H 0).
* discriminate (H 0).
- * f_equal; [by injection (H 0) |]. apply IHl1. intro. apply (H (S _)).
+ * f_equal; [by injection (H 0)|]. apply (IHl1 _ $ λ i, H (S i)).
Qed.
-Lemma list_eq_nil l : (∀ i, l !! i = None) → l = nil.
-Proof. intros. by apply list_eq. Qed.
-
Global Instance list_eq_dec {dec : ∀ x y, Decision (x = y)} : ∀ l k,
Decision (l = k) := list_eq_dec dec.
-Definition list_singleton_dec l : { x | l = [x] } + { length l ≠1 }.
-Proof. by refine match l with [x] => inleft (x↾_) | _ => inright _ end. Defined.
-
+Global Instance list_eq_nil_dec l : Decision (l = []).
+Proof. by refine match l with [] => left _ | _ => right _ end. Defined.
+Lemma list_singleton_reflect l :
+ option_reflect (λ x, l = [x]) (length l ≠1) (list_singleton l).
+Proof. by destruct l as [|? []]; constructor. Defined.
+
+Definition nil_length : length (@nil A) = 0 := eq_refl.
+Definition cons_length x l : length (x :: l) = S (length l) := eq_refl.
Lemma nil_or_length_pos l : l = [] ∨ length l ≠0.
Proof. destruct l; simpl; auto with lia. Qed.
-Lemma nil_length l : length l = 0 → l = [].
+Lemma nil_length_inv l : length l = 0 → l = [].
Proof. by destruct l. Qed.
Lemma lookup_nil i : @nil A !! i = None.
Proof. by destruct i. Qed.
Lemma lookup_tail l i : tail l !! i = l !! S i.
Proof. by destruct l. Qed.
-
Lemma lookup_lt_Some l i x : l !! i = Some x → i < length l.
Proof.
revert i. induction l; intros [|?] ?; simplify_equality'; auto with arith.
@@ -419,30 +393,25 @@ Proof.
Qed.
Lemma lookup_lt_is_Some l i : is_Some (l !! i) ↔ i < length l.
Proof. split; auto using lookup_lt_is_Some_1, lookup_lt_is_Some_2. Qed.
-
Lemma lookup_ge_None l i : l !! i = None ↔ length l ≤ i.
Proof. rewrite eq_None_not_Some, lookup_lt_is_Some. lia. Qed.
Lemma lookup_ge_None_1 l i : l !! i = None → length l ≤ i.
Proof. by rewrite lookup_ge_None. Qed.
Lemma lookup_ge_None_2 l i : length l ≤ i → l !! i = None.
Proof. by rewrite lookup_ge_None. Qed.
-
Lemma list_eq_length l1 l2 :
length l2 = length l1 →
(∀ i x y, l1 !! i = Some x → l2 !! i = Some y → x = y) → l1 = l2.
Proof.
- intros Hl ?. apply list_eq. intros i. destruct (l2 !! i) as [x|] eqn:Hx.
- * destruct (lookup_lt_is_Some_2 l1 i) as [y ?]; subst.
- + rewrite <-Hl. eauto using lookup_lt_Some.
- + naive_solver.
+ intros Hl ?; apply list_eq; intros i. destruct (l2 !! i) as [x|] eqn:Hx.
+ * destruct (lookup_lt_is_Some_2 l1 i) as [y ?]; [|naive_solver].
+ rewrite <-Hl. eauto using lookup_lt_Some.
* by rewrite lookup_ge_None, <-Hl, <-lookup_ge_None.
Qed.
-
Lemma lookup_app_l l1 l2 i : i < length l1 → (l1 ++ l2) !! i = l1 !! i.
Proof. revert i. induction l1; intros [|?]; simpl; auto with lia. Qed.
Lemma lookup_app_l_Some l1 l2 i x : l1 !! i = Some x → (l1 ++ l2) !! i = Some x.
Proof. intros. rewrite lookup_app_l; eauto using lookup_lt_Some. Qed.
-
Lemma lookup_app_r l1 l2 i : (l1 ++ l2) !! (length l1 + i) = l2 !! i.
Proof. revert i. induction l1; intros [|i]; simplify_equality'; auto. Qed.
Lemma lookup_app_r_alt l1 l2 i j :
@@ -454,33 +423,29 @@ Proof. by rewrite lookup_app_r. Qed.
Lemma lookup_app_minus_r l1 l2 i :
length l1 ≤ i → (l1 ++ l2) !! i = l2 !! (i - length l1).
Proof. intros. rewrite <-(lookup_app_r l1 l2). f_equal. lia. Qed.
-
Lemma lookup_app_inv l1 l2 i x :
(l1 ++ l2) !! i = Some x → l1 !! i = Some x ∨ l2 !! (i - length l1) = Some x.
Proof. revert i. induction l1; intros [|i] ?; simplify_equality'; auto. Qed.
-Lemma list_lookup_middle l1 l2 x : (l1 ++ x :: l2) !! length l1 = Some x.
-Proof. by induction l1; simpl. Qed.
+Lemma list_lookup_middle l1 l2 x n :
+ n = length l1 → (l1 ++ x :: l2) !! n = Some x.
+Proof. intros ->. by induction l1. Qed.
Lemma alter_length f l i : length (alter f i l) = length l.
-Proof. revert i. induction l; intros [|?]; simpl; auto with lia. Qed.
+Proof. revert i. by induction l; intros [|?]; f_equal'. Qed.
Lemma insert_length l i x : length (<[i:=x]>l) = length l.
-Proof. apply alter_length. Qed.
-
+Proof. revert i. by induction l; intros [|?]; f_equal'. Qed.
Lemma list_lookup_alter f l i : alter f i l !! i = f <$> l !! i.
Proof. revert i. induction l. done. intros [|i]. done. apply (IHl i). Qed.
Lemma list_lookup_alter_ne f l i j : i ≠j → alter f i l !! j = l !! j.
Proof.
- revert i j. induction l; [done|].
- intros [|i] [|j] ?; try done. apply (IHl i). congruence.
+ revert i j. induction l; [done|]. intros [] [] ?; simpl; auto with congruence.
Qed.
Lemma list_lookup_insert l i x : i < length l → <[i:=x]>l !! i = Some x.
+Proof. revert i. induction l; intros [|?] ?; f_equal'; auto with lia. Qed.
+Lemma list_lookup_insert_ne l i j x : i ≠j → <[i:=x]>l !! j = l !! j.
Proof.
- intros Hi. unfold insert, list_insert. rewrite list_lookup_alter.
- by destruct (lookup_lt_is_Some_2 l i); simplify_option_equality.
+ revert i j. induction l; [done|]. intros [] [] ?; simpl; auto with congruence.
Qed.
-Lemma list_lookup_insert_ne l i j x : i ≠j → <[i:=x]>l !! j = l !! j.
-Proof. apply list_lookup_alter_ne. Qed.
-
Lemma list_lookup_other l i x :
length l ≠1 → l !! i = Some x → ∃ j y, j ≠i ∧ l !! j = Some y.
Proof.
@@ -488,45 +453,40 @@ Proof.
* by exists 1 x1.
* by exists 0 x0.
Qed.
-
Lemma alter_app_l f l1 l2 i :
i < length l1 → alter f i (l1 ++ l2) = alter f i l1 ++ l2.
-Proof.
- revert i. induction l1; intros [|?] ?; simpl in *; f_equal; auto with lia.
-Qed.
+Proof. revert i. induction l1; intros [|?] ?; f_equal'; auto with lia. Qed.
Lemma alter_app_r f l1 l2 i :
alter f (length l1 + i) (l1 ++ l2) = l1 ++ alter f i l2.
-Proof. revert i. induction l1; intros [|?]; simpl in *; f_equal; auto. Qed.
+Proof. revert i. induction l1; intros [|?]; f_equal'; auto. Qed.
Lemma alter_app_r_alt f l1 l2 i :
length l1 ≤ i → alter f i (l1 ++ l2) = l1 ++ alter f (i - length l1) l2.
Proof.
intros. assert (i = length l1 + (i - length l1)) as Hi by lia.
rewrite Hi at 1. by apply alter_app_r.
Qed.
-Lemma list_alter_ext f g l i :
- (∀ x, l !! i = Some x → f x = g x) → alter f i l = alter g i l.
-Proof. revert i. induction l; intros [|?] ?; simpl; f_equal; auto. Qed.
+Lemma list_alter_ext f g l k i :
+ (∀ x, l !! i = Some x → f x = g x) → l = k → alter f i l = alter g i k.
+Proof. intros H ->. revert i H. induction k; intros [|?] ?; f_equal'; auto. Qed.
Lemma list_alter_compose f g l i :
alter (f ∘ g) i l = alter f i (alter g i l).
-Proof. revert i. induction l; intros [|?]; simpl; f_equal; auto. Qed.
+Proof. revert i. induction l; intros [|?]; f_equal'; auto. Qed.
Lemma list_alter_commute f g l i j :
i ≠j → alter f i (alter g j l) = alter g j (alter f i l).
-Proof.
- revert i j.
- induction l; intros [|?] [|?]; simpl; auto with f_equal congruence.
-Qed.
-
+Proof. revert i j. induction l; intros [|?][|?] ?; f_equal'; auto with lia. Qed.
Lemma insert_app_l l1 l2 i x :
i < length l1 → <[i:=x]>(l1 ++ l2) = <[i:=x]>l1 ++ l2.
-Proof. apply alter_app_l. Qed.
+Proof. revert i. induction l1; intros [|?] ?; f_equal'; auto with lia. Qed.
Lemma insert_app_r l1 l2 i x : <[length l1+i:=x]>(l1 ++ l2) = l1 ++ <[i:=x]>l2.
-Proof. apply alter_app_r. Qed.
+Proof. revert i. induction l1; intros [|?]; f_equal'; auto. Qed.
Lemma insert_app_r_alt l1 l2 i x :
length l1 ≤ i → <[i:=x]>(l1 ++ l2) = l1 ++ <[i - length l1:=x]>l2.
-Proof. apply alter_app_r_alt. Qed.
-
+Proof.
+ intros. assert (i = length l1 + (i - length l1)) as Hi by lia.
+ rewrite Hi at 1. by apply insert_app_r.
+Qed.
Lemma delete_middle l1 l2 x : delete (length l1) (l1 ++ x :: l2) = l1 ++ l2.
-Proof. induction l1; simpl; f_equal; auto. Qed.
+Proof. induction l1; f_equal'; auto. Qed.
(** ** Properties of the [elem_of] predicate *)
Lemma not_elem_of_nil x : x ∉ [].
@@ -536,11 +496,7 @@ Proof. intuition. by destruct (not_elem_of_nil x). Qed.
Lemma elem_of_nil_inv l : (∀ x, x ∉ l) → l = [].
Proof. destruct l. done. by edestruct 1; constructor. Qed.
Lemma elem_of_cons l x y : x ∈ y :: l ↔ x = y ∨ x ∈ l.
-Proof.
- split.
- * inversion 1; subst. by left. by right.
- * intros [?|?]; subst. by left. by right.
-Qed.
+Proof. split; [inversion 1; subst|intros [->|?]]; constructor (done). Qed.
Lemma not_elem_of_cons l x y : x ∉ y :: l ↔ x ≠y ∧ x ∉ l.
Proof. rewrite elem_of_cons. tauto. Qed.
Lemma elem_of_app l1 l2 x : x ∈ l1 ++ l2 ↔ x ∈ l1 ∨ x ∈ l2.
@@ -553,17 +509,13 @@ Lemma not_elem_of_app l1 l2 x : x ∉ l1 ++ l2 ↔ x ∉ l1 ∧ x ∉ l2.
Proof. rewrite elem_of_app. tauto. Qed.
Lemma elem_of_list_singleton x y : x ∈ [y] ↔ x = y.
Proof. rewrite elem_of_cons, elem_of_nil. tauto. Qed.
-
Global Instance elem_of_list_permutation_proper x : Proper ((≡ₚ) ==> iff) (x ∈).
Proof. induction 1; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed.
-
Lemma elem_of_list_split l x : x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2.
Proof.
- induction 1 as [x l|x y l ? [l1 [l2 ?]]].
- * by eexists [], l.
- * subst. by exists (y :: l1) l2.
+ induction 1 as [x l|x y l ? [l1 [l2 ->]]]; [by eexists [], l|].
+ by exists (y :: l1) l2.
Qed.
-
Lemma elem_of_list_lookup_1 l x : x ∈ l → ∃ i, l !! i = Some x.
Proof.
induction 1 as [|???? IH]; [by exists 0 |].
@@ -579,9 +531,7 @@ Proof. firstorder eauto using elem_of_list_lookup_1, elem_of_list_lookup_2. Qed.
(** ** Set operations on lists *)
Section list_set.
Context {dec : ∀ x y, Decision (x = y)}.
-
- Lemma elem_of_list_difference l k x :
- x ∈ list_difference l k ↔ x ∈ l ∧ x ∉ k.
+ Lemma elem_of_list_difference l k x : x ∈ list_difference l k ↔ x ∈ l ∧ x ∉ k.
Proof.
split; induction l; simpl; try case_decide;
rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
@@ -593,7 +543,6 @@ Section list_set.
* done.
* constructor. rewrite elem_of_list_difference; intuition. done.
Qed.
-
Lemma elem_of_list_intersection l k x :
x ∈ list_intersection l k ↔ x ∈ l ∧ x ∈ k.
Proof.
@@ -607,28 +556,25 @@ Section list_set.
* constructor. rewrite elem_of_list_intersection; intuition. done.
* done.
Qed.
-
Lemma elem_of_list_intersection_with f l k x :
x ∈ list_intersection_with f l k ↔ ∃ x1 x2,
x1 ∈ l ∧ x2 ∈ k ∧ f x1 x2 = Some x.
Proof.
split.
- * induction l as [|x1 l IH]; simpl.
- + by rewrite elem_of_nil.
- + intros Hx. setoid_rewrite elem_of_cons.
- cut ((∃ x2, x2 ∈ k ∧ f x1 x2 = Some x)
- ∨ x ∈ list_intersection_with f l k); [naive_solver|].
- clear IH. revert Hx. generalize (list_intersection_with f l k).
- induction k; simpl; [by auto|].
- case_match; setoid_rewrite elem_of_cons; naive_solver.
- * intros (x1 & x2 & Hx1 & Hx2 & Hx).
- induction Hx1 as [x1 | x1 ? l ? IH]; simpl.
+ * induction l as [|x1 l IH]; simpl; [by rewrite elem_of_nil|].
+ intros Hx. setoid_rewrite elem_of_cons.
+ cut ((∃ x2, x2 ∈ k ∧ f x1 x2 = Some x)
+ ∨ x ∈ list_intersection_with f l k); [naive_solver|].
+ clear IH. revert Hx. generalize (list_intersection_with f l k).
+ induction k; simpl; [by auto|].
+ case_match; setoid_rewrite elem_of_cons; naive_solver.
+ * intros (x1&x2&Hx1&Hx2&Hx). induction Hx1 as [x1|x1 ? l ? IH]; simpl.
+ generalize (list_intersection_with f l k).
induction Hx2; simpl; [by rewrite Hx; left |].
case_match; simpl; try setoid_rewrite elem_of_cons; auto.
+ generalize (IH Hx). clear Hx IH Hx2.
generalize (list_intersection_with f l k).
- induction k; simpl; intros; [done |].
+ induction k; simpl; intros; [done|].
case_match; simpl; rewrite ?elem_of_cons; auto.
Qed.
End list_set.
@@ -644,7 +590,6 @@ Lemma NoDup_cons_12 x l : NoDup (x :: l) → NoDup l.
Proof. rewrite NoDup_cons. by intros [??]. Qed.
Lemma NoDup_singleton x : NoDup [x].
Proof. constructor. apply not_elem_of_nil. constructor. Qed.
-
Lemma NoDup_app l k : NoDup (l ++ k) ↔ NoDup l ∧ (∀ x, x ∈ l → x ∉ k) ∧ NoDup k.
Proof.
induction l; simpl.
@@ -680,7 +625,6 @@ Qed.
Section no_dup_dec.
Context `{!∀ x y, Decision (x = y)}.
-
Global Instance NoDup_dec: ∀ l, Decision (NoDup l) :=
fix NoDup_dec l :=
match l return Decision (NoDup l) with
@@ -695,7 +639,6 @@ Section no_dup_dec.
end
end
end.
-
Lemma elem_of_remove_dups l x : x ∈ remove_dups l ↔ x ∈ l.
Proof.
split; induction l; simpl; repeat case_decide;
@@ -711,7 +654,6 @@ End no_dup_dec.
(** ** Properties of the [filter] function *)
Section filter.
Context (P : A → Prop) `{∀ x, Decision (P x)}.
-
Lemma elem_of_list_filter l x : x ∈ filter P l ↔ P x ∧ x ∈ l.
Proof.
unfold filter. induction l; simpl; repeat case_decide;
@@ -727,23 +669,20 @@ End filter.
(** ** Properties of the [find] function *)
Section find.
Context (P : A → Prop) `{∀ x, Decision (P x)}.
-
Lemma list_find_Some l i :
list_find P l = Some i → ∃ x, l !! i = Some x ∧ P x.
Proof.
- revert i. induction l; simpl; repeat case_decide;
- eauto with simplify_option_equality.
+ revert i. induction l; intros [] ?; simplify_option_equality; eauto.
Qed.
Lemma list_find_elem_of l x : x ∈ l → P x → ∃ i, list_find P l = Some i.
Proof.
- induction 1; simpl; repeat case_decide;
- naive_solver (by eauto with simplify_option_equality).
+ induction 1 as [|x y l ? IH]; intros; simplify_option_equality; eauto.
+ by destruct IH as [i ->]; [|exists (S i)].
Qed.
End find.
Section find_eq.
Context `{∀ x y, Decision (x = y)}.
-
Lemma list_find_eq_Some l i x : list_find (x =) l = Some i → l !! i = Some x.
Proof.
intros.
@@ -784,47 +723,48 @@ Proof.
by rewrite <-(reverse_involutive l1), <-(reverse_involutive l2), Hl.
Qed.
-(** ** Properties of the [take] function *)
-Definition take_drop := @firstn_skipn A.
+(** ** Properties of the [last] function *)
+Lemma last_snoc x l : last (l ++ [x]) = Some x.
+Proof. induction l as [|? []]; simpl; auto. Qed.
+(** ** Properties of the [take] function *)
+Definition take_drop i l : take i l ++ drop i l = l := firstn_skipn i l.
+Lemma take_drop_middle l i x :
+ l !! i = Some x → take i l ++ x :: drop (S i) l = l.
+Proof.
+ revert i x. induction l; intros [|?] ??; simplify_equality'; f_equal; auto.
+Qed.
Lemma take_nil n : take n (@nil A) = [].
Proof. by destruct n. Qed.
Lemma take_app l k : take (length l) (l ++ k) = l.
-Proof. induction l; simpl; f_equal; auto. Qed.
+Proof. induction l; f_equal'; auto. Qed.
Lemma take_app_alt l k n : n = length l → take n (l ++ k) = l.
Proof. intros Hn. by rewrite Hn, take_app. Qed.
Lemma take_app_le l k n : n ≤ length l → take n (l ++ k) = take n l.
-Proof.
- revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
-Qed.
+Proof. revert n. induction l; intros [|?] ?; f_equal'; auto with lia. Qed.
Lemma take_app_ge l k n :
length l ≤ n → take n (l ++ k) = l ++ take (n - length l) k.
-Proof.
- revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
-Qed.
+Proof. revert n. induction l; intros [|?] ?; f_equal'; auto with lia. Qed.
Lemma take_ge l n : length l ≤ n → take n l = l.
-Proof.
- revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
-Qed.
-
+Proof. revert n. induction l; intros [|?] ?; f_equal'; auto with lia. Qed.
Lemma take_take l n m : take n (take m l) = take (min n m) l.
-Proof. revert n m. induction l; intros [|?] [|?]; simpl; f_equal; auto. Qed.
+Proof. revert n m. induction l; intros [|?] [|?]; f_equal'; auto. Qed.
Lemma take_idempotent l n : take n (take n l) = take n l.
Proof. by rewrite take_take, Min.min_idempotent. Qed.
-
Lemma take_length l n : length (take n l) = min n (length l).
-Proof. revert n. induction l; intros [|?]; simpl; f_equal; done. Qed.
+Proof. revert n. induction l; intros [|?]; f_equal'; done. Qed.
Lemma take_length_le l n : n ≤ length l → length (take n l) = n.
Proof. rewrite take_length. apply Min.min_l. Qed.
Lemma take_length_ge l n : length l ≤ n → length (take n l) = length l.
Proof. rewrite take_length. apply Min.min_r. Qed.
-
-Lemma lookup_take l n i : i < n → take n l !! i = l !! i.
+Lemma take_drop_commute l n m :
+ n ≤ m → take (m - n) (drop n l) = drop n (take m l).
Proof.
- revert n i. induction l; intros [|n] i ?; trivial.
- * auto with lia.
- * destruct i; simpl; auto with arith.
+ revert n m. induction l; intros [|?] [|?] ?;
+ simpl; auto using take_nil with lia.
Qed.
+Lemma lookup_take l n i : i < n → take n l !! i = l !! i.
+Proof. revert n i. induction l; intros [|n] [|i] ?; simpl; auto with lia. Qed.
Lemma lookup_take_ge l n i : n ≤ i → take n l !! i = None.
Proof. revert n i. induction l; intros [|?] [|?] ?; simpl; auto with lia. Qed.
Lemma take_alter f l n i : n ≤ i → take n (alter f i l) = take n l.
@@ -834,23 +774,36 @@ Proof.
* by rewrite !lookup_take, !list_lookup_alter_ne by lia.
Qed.
Lemma take_insert l n i x : n ≤ i → take n (<[i:=x]>l) = take n l.
-Proof. apply take_alter. Qed.
+Proof.
+ intros. apply list_eq. intros j. destruct (le_lt_dec n j).
+ * by rewrite !lookup_take_ge.
+ * by rewrite !lookup_take, !list_lookup_insert_ne by lia.
+Qed.
(** ** Properties of the [drop] function *)
Lemma drop_nil n : drop n (@nil A) = [].
Proof. by destruct n. Qed.
-Lemma drop_app l k : drop (length l) (l ++ k) = k.
-Proof. induction l; simpl; f_equal; auto. Qed.
-Lemma drop_app_alt l k n : n = length l → drop n (l ++ k) = k.
-Proof. intros Hn. by rewrite Hn, drop_app. Qed.
Lemma drop_length l n : length (drop n l) = length l - n.
-Proof. revert n. by induction l; intros [|i]; simpl; f_equal. Qed.
+Proof. revert n. by induction l; intros [|i]; f_equal'. Qed.
Lemma drop_ge l n : length l ≤ n → drop n l = [].
Proof. revert n. induction l; intros [|??]; simpl in *; auto with lia. Qed.
Lemma drop_all l : drop (length l) l = [].
Proof. by apply drop_ge. Qed.
Lemma drop_drop l n1 n2 : drop n1 (drop n2 l) = drop (n2 + n1) l.
Proof. revert n2. induction l; intros [|?]; simpl; rewrite ?drop_nil; auto. Qed.
+Lemma drop_app_le l k n :
+ n ≤ length l → drop n (l ++ k) = drop n l ++ k.
+Proof. revert n. induction l; intros [|?]; simpl; auto with lia. Qed.
+Lemma drop_app l k : drop (length l) (l ++ k) = k.
+Proof. by rewrite drop_app_le, drop_all. Qed.
+Lemma drop_app_alt l k n : n = length l → drop n (l ++ k) = k.
+Proof. intros ->. by apply drop_app. Qed.
+Lemma drop_app_ge l k n :
+ length l ≤ n → drop n (l ++ k) = drop (n - length l) k.
+Proof.
+ intros. rewrite <-(Nat.sub_add (length l) n) at 1 by done.
+ by rewrite Nat.add_comm, <-drop_drop, drop_app.
+Qed.
Lemma lookup_drop l n i : drop n l !! i = l !! (n + i).
Proof. revert n i. induction l; intros [|i] ?; simpl; auto. Qed.
Lemma drop_alter f l n i : i < n → drop n (alter f i l) = drop n l.
@@ -859,10 +812,12 @@ Proof.
by rewrite !lookup_drop, !list_lookup_alter_ne by lia.
Qed.
Lemma drop_insert l n i x : i < n → drop n (<[i:=x]>l) = drop n l.
-Proof. apply drop_alter. Qed.
-
+Proof.
+ intros. apply list_eq. intros j.
+ by rewrite !lookup_drop, !list_lookup_insert_ne by lia.
+Qed.
Lemma delete_take_drop l i : delete i l = take i l ++ drop (S i) l.
-Proof. revert i. induction l; intros [|?]; simpl; auto using f_equal. Qed.
+Proof. revert i. induction l; intros [|?]; f_equal'; auto. Qed.
(** ** Properties of the [replicate] function *)
Lemma replicate_length n x : length (replicate n x) = n.
@@ -879,47 +834,43 @@ Proof.
by destruct (lookup_replicate_inv n x x' i).
* intros Hx ?. destruct Hx. exists x; auto using lookup_replicate.
Qed.
-
Lemma elem_of_replicate_inv x n y : x ∈ replicate n y → x = y.
Proof. induction n; simpl; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed.
Lemma replicate_S n x : replicate (S n) x = x :: replicate n x.
Proof. done. Qed.
Lemma replicate_plus n m x :
replicate (n + m) x = replicate n x ++ replicate m x.
-Proof. induction n; simpl; f_equal; auto. Qed.
-
+Proof. induction n; f_equal'; auto. Qed.
Lemma take_replicate n m x : take n (replicate m x) = replicate (min n m) x.
-Proof. revert m. by induction n; intros [|?]; simpl; f_equal. Qed.
+Proof. revert m. by induction n; intros [|?]; f_equal'. Qed.
Lemma take_replicate_plus n m x : take n (replicate (n + m) x) = replicate n x.
Proof. by rewrite take_replicate, min_l by lia. Qed.
Lemma drop_replicate n m x : drop n (replicate m x) = replicate (m - n) x.
-Proof. revert m. by induction n; intros [|?]; simpl; f_equal. Qed.
+Proof. revert m. by induction n; intros [|?]; f_equal'. Qed.
Lemma drop_replicate_plus n m x : drop n (replicate (n + m) x) = replicate m x.
Proof. rewrite drop_replicate. f_equal. lia. Qed.
-
Lemma replicate_as_elem_of x n l :
- l = replicate n x ↔ length l = n ∧ ∀ y, y ∈ l → y = x.
+ replicate n x = l ↔ length l = n ∧ ∀ y, y ∈ l → y = x.
Proof.
- split.
- * intros; subst. eauto using elem_of_replicate_inv, replicate_length.
- * intros [? Hl]; subst. induction l as [|y l IH]; simpl; f_equal.
- + apply Hl. by left.
- + apply IH. intros ??. apply Hl. by right.
+ split; [intros <-; eauto using elem_of_replicate_inv, replicate_length|].
+ intros [<- Hl]. symmetry. induction l as [|y l IH]; f_equal'.
+ * apply Hl. by left.
+ * apply IH. intros ??. apply Hl. by right.
Qed.
Lemma reverse_replicate n x : reverse (replicate n x) = replicate n x.
Proof.
- apply replicate_as_elem_of. rewrite reverse_length, replicate_length.
- split; auto.
+ symmetry. apply replicate_as_elem_of.
+ rewrite reverse_length, replicate_length. split; auto.
intros y. rewrite elem_of_reverse. by apply elem_of_replicate_inv.
Qed.
(** ** Properties of the [resize] function *)
Lemma resize_spec l n x : resize n x l = take n l ++ replicate (n - length l) x.
-Proof. revert n. induction l; intros [|?]; simpl; f_equal; auto. Qed.
+Proof. revert n. induction l; intros [|?]; f_equal'; auto. Qed.
Lemma resize_0 l x : resize 0 x l = [].
Proof. by destruct l. Qed.
Lemma resize_nil n x : resize n x [] = replicate n x.
-Proof. rewrite resize_spec. rewrite take_nil. simpl. f_equal. lia. Qed.
+Proof. rewrite resize_spec. rewrite take_nil. f_equal'. lia. Qed.
Lemma resize_ge l n x :
length l ≤ n → resize n x l = l ++ replicate (n - length l) x.
Proof. intros. by rewrite resize_spec, take_ge. Qed.
@@ -928,92 +879,59 @@ Proof.
intros. rewrite resize_spec, (proj2 (Nat.sub_0_le _ _)) by done.
simpl. by rewrite (right_id_L [] (++)).
Qed.
-
Lemma resize_all l x : resize (length l) x l = l.
Proof. intros. by rewrite resize_le, take_ge. Qed.
Lemma resize_all_alt l n x : n = length l → resize n x l = l.
-Proof. intros. subst. by rewrite resize_all. Qed.
-
+Proof. intros ->. by rewrite resize_all. Qed.
Lemma resize_plus l n m x :
resize (n + m) x l = resize n x l ++ resize m x (drop n l).
Proof.
- revert n m. induction l; intros [|?] [|?]; simpl; f_equal; auto.
+ revert n m. induction l; intros [|?] [|?]; f_equal'; auto.
* by rewrite Nat.add_0_r, (right_id_L [] (++)).
* by rewrite replicate_plus.
Qed.
Lemma resize_plus_eq l n m x :
length l = n → resize (n + m) x l = l ++ replicate m x.
-Proof.
- intros. subst. by rewrite resize_plus, resize_all, drop_all, resize_nil.
-Qed.
-
+Proof. intros <-. by rewrite resize_plus, resize_all, drop_all, resize_nil. Qed.
Lemma resize_app_le l1 l2 n x :
n ≤ length l1 → resize n x (l1 ++ l2) = resize n x l1.
Proof.
intros. by rewrite !resize_le, take_app_le by (rewrite ?app_length; lia).
Qed.
+Lemma resize_app l1 l2 n x : n = length l1 → resize n x (l1 ++ l2) = l1.
+Proof. intros ->. by rewrite resize_app_le, resize_all. Qed.
Lemma resize_app_ge l1 l2 n x :
length l1 ≤ n → resize n x (l1 ++ l2) = l1 ++ resize (n - length l1) x l2.
Proof.
intros. rewrite !resize_spec, take_app_ge, (associative_L (++)) by done.
do 2 f_equal. rewrite app_length. lia.
Qed.
-
Lemma resize_length l n x : length (resize n x l) = n.
Proof. rewrite resize_spec, app_length, replicate_length, take_length. lia. Qed.
Lemma resize_replicate x n m : resize n x (replicate m x) = replicate n x.
-Proof. revert m. induction n; intros [|?]; simpl; f_equal; auto. Qed.
-
-Lemma lookup_resize l n x i : i < n → i < length l → resize n x l !! i = l !! i.
-Proof.
- intros ??. destruct (decide (n < length l)).
- * by rewrite resize_le, lookup_take by lia.
- * by rewrite resize_ge, lookup_app_l by lia.
-Qed.
-Lemma lookup_resize_new l n x i :
- length l ≤ i → i < n → resize n x l !! i = Some x.
-Proof.
- intros ??. rewrite resize_ge by lia.
- replace i with (length l + (i - length l)) by lia.
- by rewrite lookup_app_r, lookup_replicate by lia.
-Qed.
-Lemma lookup_resize_old l n x i : n ≤ i → resize n x l !! i = None.
-Proof. intros ?. apply lookup_ge_None_2. by rewrite resize_length. Qed.
-
+Proof. revert m. induction n; intros [|?]; f_equal'; auto. Qed.
Lemma resize_resize l n m x : n ≤ m → resize n x (resize m x l) = resize n x l.
Proof.
revert n m. induction l; simpl.
* intros. by rewrite !resize_nil, resize_replicate.
- * intros [|?] [|?] ?; simpl; f_equal; auto with lia.
+ * intros [|?] [|?] ?; f_equal'; auto with lia.
Qed.
Lemma resize_idempotent l n x : resize n x (resize n x l) = resize n x l.
Proof. by rewrite resize_resize. Qed.
-
Lemma resize_take_le l n m x : n ≤ m → resize n x (take m l) = resize n x l.
-Proof.
- revert n m. induction l; intros [|?] [|?] ?; simpl; f_equal; auto with lia.
-Qed.
+Proof. revert n m. induction l; intros [|?][|?] ?; f_equal'; auto with lia. Qed.
Lemma resize_take_eq l n x : resize n x (take n l) = resize n x l.
Proof. by rewrite resize_take_le. Qed.
-
Lemma take_resize l n m x : take n (resize m x l) = resize (min n m) x l.
Proof.
- revert n m.
- induction l; intros [|?] [|?]; simpl; f_equal; auto using take_replicate.
+ revert n m. induction l; intros [|?][|?]; f_equal'; auto using take_replicate.
Qed.
Lemma take_resize_le l n m x : n ≤ m → take n (resize m x l) = resize n x l.
Proof. intros. by rewrite take_resize, Min.min_l. Qed.
Lemma take_resize_eq l n x : take n (resize n x l) = resize n x l.
Proof. intros. by rewrite take_resize, Min.min_l. Qed.
-Lemma take_length_resize l n x :
- length l ≤ n → take (length l) (resize n x l) = l.
-Proof. intros. by rewrite take_resize_le, resize_all. Qed.
-Lemma take_length_resize_alt l n m x :
- m = length l → m ≤ n → take m (resize n x l) = l.
-Proof. intros. subst. by apply take_length_resize. Qed.
Lemma take_resize_plus l n m x : take n (resize (n + m) x l) = resize n x l.
Proof. by rewrite take_resize, min_l by lia. Qed.
-
Lemma drop_resize_le l n m x :
n ≤ m → drop n (resize m x l) = resize (m - n) x (drop n l).
Proof.
@@ -1024,6 +942,21 @@ Qed.
Lemma drop_resize_plus l n m x :
drop n (resize (n + m) x l) = resize m x (drop n l).
Proof. rewrite drop_resize_le by lia. f_equal. lia. Qed.
+Lemma lookup_resize l n x i : i < n → i < length l → resize n x l !! i = l !! i.
+Proof.
+ intros ??. destruct (decide (n < length l)).
+ * by rewrite resize_le, lookup_take by lia.
+ * by rewrite resize_ge, lookup_app_l by lia.
+Qed.
+Lemma lookup_resize_new l n x i :
+ length l ≤ i → i < n → resize n x l !! i = Some x.
+Proof.
+ intros ??. rewrite resize_ge by lia.
+ replace i with (length l + (i - length l)) by lia.
+ by rewrite lookup_app_r, lookup_replicate by lia.
+Qed.
+Lemma lookup_resize_old l n x i : n ≤ i → resize n x l !! i = None.
+Proof. intros ?. apply lookup_ge_None_2. by rewrite resize_length. Qed.
End general_properties.
Section more_general_properties.
@@ -1033,157 +966,185 @@ Implicit Types l k : list A.
(** ** Properties of the [reshape] function *)
Lemma reshape_length szs l : length (reshape szs l) = length szs.
-Proof. revert l. induction szs; simpl; auto with f_equal. Qed.
-Lemma sublist_lookup_reshape l i n m :
- 0 < n → length l = m * n →
- reshape (replicate m n) l !! i = sublist_lookup (i * n) n l.
-Proof.
- intros Hn Hl. unfold sublist_lookup. apply option_eq; intros x; split.
- * intros Hx. case_option_guard as Hi.
- { f_equal. clear Hi. revert i l Hl Hx.
- induction m as [|m IH]; intros [|i] l ??; simplify_equality'; auto.
- rewrite <-drop_drop. apply IH; rewrite ?drop_length; auto with lia. }
- destruct Hi. rewrite Hl, <-Nat.mul_succ_l.
- apply Nat.mul_le_mono_r, Nat.le_succ_l. apply lookup_lt_Some in Hx.
- by rewrite reshape_length, replicate_length in Hx.
- * intros Hx. case_option_guard as Hi; simplify_equality'.
- revert i l Hl Hi. induction m as [|m IH]; auto with lia.
- intros [|i] l ??; simpl; [done|]. rewrite <-drop_drop.
- rewrite IH; rewrite ?drop_length; auto with lia.
-Qed.
+Proof. revert l. by induction szs; intros; f_equal'. 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. }
+ revert l. induction szs as [|sz szs IH]; simpl; intros l Hl; [by destruct l|].
by rewrite IH, take_drop by (rewrite drop_length; lia).
Qed.
Lemma sum_list_replicate n m : sum_list (replicate m n) = m * n.
Proof. induction m; simpl; auto. Qed.
-(** ** Properties of [sublist_lookup] and [sublist_insert] *)
-Lemma sublist_lookup_Some l i n k :
- sublist_lookup i n l = Some k ↔
- i + n ≤ length l ∧ length k = n ∧ ∀ j, j < n → l !! (i + j) = k !! j.
-Proof.
- unfold sublist_lookup in *. split.
- * intros Hk. simplify_option_equality. split_ands.
- + done.
- + by rewrite take_length_le by (rewrite drop_length; lia).
- + intros j ?. by rewrite lookup_take, lookup_drop by done.
- * intros (?&?&Hlookup). case_option_guard; [|lia].
- f_equal; apply list_eq; intros j. destruct (decide (j < n)).
- + by rewrite <-Hlookup, lookup_take, lookup_drop by done.
- + by rewrite lookup_take_ge, lookup_ge_None_2 by lia.
-Qed.
+(** ** Properties of [sublist_lookup] and [sublist_alter] *)
Lemma sublist_lookup_length l i n k :
sublist_lookup i n l = Some k → length k = n.
-Proof. rewrite sublist_lookup_Some. intuition. Qed.
-
-Lemma sublist_insert_length l i k :
- length (sublist_insert i k l) = length l.
-Proof.
- unfold sublist_insert. intros. rewrite !app_length, drop_length.
- destruct (decide (i + length k ≤ length l)).
- * rewrite !take_length_le, !take_length_ge by lia. lia.
- * destruct (decide (i < length l));
- rewrite ?take_length_ge, ?take_length_le by lia; lia.
-Qed.
-Lemma sublist_insert_ge l i k : length l ≤ i → sublist_insert i k l = l.
-Proof.
- unfold sublist_insert. intros ?. rewrite drop_ge by lia.
- rewrite take_ge, (proj2 (Nat.sub_0_le _ _)) by done; simpl.
- by rewrite (right_id [] (++)).
-Qed.
-Lemma lookup_sublist_insert l i k j :
- j < length l →
- i ≤ j < i + length k → sublist_insert i k l !! j = k !! (j - i).
-Proof.
- unfold sublist_insert. intros ? [??].
- rewrite lookup_app_minus_r by (rewrite take_length; lia).
- rewrite take_length_le by lia.
- by rewrite lookup_app_l, lookup_take by (rewrite ?take_length; lia).
-Qed.
-Lemma lookup_sublist_insert_ne l i k j :
- j < i ∨ i + length k ≤ j → sublist_insert i k l !! j = l !! j.
-Proof.
- destruct (decide (length l ≤ j)).
- { by rewrite !lookup_ge_None_2 by (by rewrite ?sublist_insert_length). }
- unfold sublist_insert. intros [?|?].
- { rewrite lookup_app_l by (rewrite take_length; apply Nat.min_glb_lt; lia).
- by rewrite lookup_take. }
- rewrite lookup_app_minus_r by (rewrite take_length_le; lia).
- rewrite take_length_le by lia.
- rewrite lookup_app_minus_r by (rewrite take_length_ge; lia).
- rewrite lookup_drop, take_length_ge by lia. f_equal. lia.
-Qed.
-Lemma lookup_sublist_proper l1 l2 i k j :
- l1 !! j = l2 !! j →
- sublist_insert i k l1 !! j = sublist_insert i k l2 !! j.
Proof.
- destruct (l2 !! j) as [x|] eqn:Hx2; intros Hx1.
- * destruct (decide (j < i ∨ i + length k ≤ j)).
- { by rewrite !lookup_sublist_insert_ne, Hx1, Hx2 by done. }
- by rewrite !lookup_sublist_insert by eauto using lookup_lt_Some with lia.
- * by rewrite !lookup_ge_None_2 by
- (rewrite ?sublist_insert_length; eauto using lookup_ge_None_1).
+ unfold sublist_lookup; intros; simplify_option_equality.
+ rewrite take_length, drop_length; lia.
Qed.
-
-Lemma lookup_sublist_all l n :
- length l = n → sublist_lookup 0 n l = Some l.
+Lemma sublist_lookup_all l n : length l = n → sublist_lookup 0 n l = Some l.
Proof.
intros. unfold sublist_lookup; case_option_guard; [|lia].
by rewrite take_ge by (rewrite drop_length; lia).
Qed.
-Lemma insert_sublist_all l k :
- length l = length k → sublist_insert 0 k l = k.
-Proof.
- intros Hlk. unfold sublist_insert. simpl.
- by rewrite <-Hlk, drop_all, take_ge, (right_id_L [] (++)) by lia.
+Lemma sublist_lookup_Some l i n :
+ i + n ≤ length l → sublist_lookup i n l = Some (take n (drop i l)).
+Proof. by unfold sublist_lookup; intros; simplify_option_equality. Qed.
+Lemma sublist_lookup_None l i n :
+ length l < i + n → sublist_lookup i n l = None.
+Proof. by unfold sublist_lookup; intros; simplify_option_equality by lia. Qed.
+Lemma sublist_eq l k n :
+ (n | length l) → (n | length k) →
+ (∀ i, sublist_lookup (i * n) n l = sublist_lookup (i * n) n k) → l = k.
+Proof.
+ revert l k. assert (∀ l i,
+ n ≠0 → (n | length l) → ¬n * i `div` n + n ≤ length l → length l ≤ i).
+ { intros l i ? [j ->] Hjn. apply Nat.nlt_ge; contradict Hjn.
+ rewrite <-Nat.mul_succ_r, (Nat.mul_comm n).
+ apply Nat.mul_le_mono_r, Nat.le_succ_l, Nat.div_lt_upper_bound; lia. }
+ intros l k Hl Hk Hlookup. destruct (decide (n = 0)) as [->|].
+ { by rewrite (nil_length_inv l),
+ (nil_length_inv k) by eauto using Nat.divide_0_l. }
+ apply list_eq; intros i. specialize (Hlookup (i `div` n)).
+ rewrite (Nat.mul_comm _ n) in Hlookup.
+ unfold sublist_lookup in *; simplify_option_equality;
+ [|by rewrite !lookup_ge_None_2 by auto].
+ apply (f_equal (!! i `mod` n)) in Hlookup.
+ by rewrite !lookup_take, !lookup_drop, <-!Nat.div_mod in Hlookup
+ by (auto using Nat.mod_upper_bound with lia).
+Qed.
+Lemma sublist_eq_same_length l k j n :
+ length l = j * n → length k = j * n →
+ (∀ i,i < j → sublist_lookup (i * n) n l = sublist_lookup (i * n) n k) → l = k.
+Proof.
+ intros Hl Hk ?. destruct (decide (n = 0)) as [->|].
+ { by rewrite (nil_length_inv l), (nil_length_inv k) by lia. }
+ apply sublist_eq with n; [by exists j|by exists j|].
+ intros i. destruct (decide (i < j)); [by auto|].
+ assert (∀ m, m = j * n → m < i * n + n).
+ { intros ? ->. replace (i * n + n) with (S i * n) by lia.
+ apply Nat.mul_lt_mono_pos_r; lia. }
+ by rewrite !sublist_lookup_None by auto.
Qed.
-
-Lemma sublist_insert_join_aux (ls : list (list A)) l i :
- let g k f j := sublist_insert j k (f (length k + j)) in
- length l = i + sum_list (length <$> ls) →
- foldr g (λ _, l) ls i = take i l ++ mjoin ls.
+Lemma sublist_lookup_reshape l i n m :
+ 0 < n → length l = m * n →
+ reshape (replicate m n) l !! i = sublist_lookup (i * n) n l.
Proof.
- intros g. revert i l. induction ls as [|l' ls IH]; simpl; intros i l ?.
- { by rewrite (right_id_L [] (++)), take_ge by lia. }
- unfold g at 1. rewrite IH by lia. unfold sublist_insert.
- rewrite (take_app_le _ _ i) by (rewrite take_length_le; lia).
- rewrite take_take, Nat.min_l by lia.
- rewrite app_length, take_length_le, (take_ge l') by lia.
- by rewrite drop_app_alt by (rewrite take_length_le; lia).
+ intros Hn Hl. unfold sublist_lookup. apply option_eq; intros x; split.
+ * intros Hx. case_option_guard as Hi.
+ { f_equal. clear Hi. revert i l Hl Hx.
+ induction m as [|m IH]; intros [|i] l ??; simplify_equality'; auto.
+ rewrite <-drop_drop. apply IH; rewrite ?drop_length; auto with lia. }
+ destruct Hi. rewrite Hl, <-Nat.mul_succ_l.
+ apply Nat.mul_le_mono_r, Nat.le_succ_l. apply lookup_lt_Some in Hx.
+ by rewrite reshape_length, replicate_length in Hx.
+ * intros Hx. case_option_guard as Hi; simplify_equality'.
+ revert i l Hl Hi. induction m as [|m IH]; [auto with lia|].
+ intros [|i] l ??; simpl; [done|]. rewrite <-drop_drop.
+ rewrite IH; rewrite ?drop_length; auto with lia.
Qed.
-Lemma sublist_insert_join (ls : list (list A)) l :
- let g k f i := sublist_insert i k (f (length k + i)) in
- length l = sum_list (length <$> ls) → foldr g (λ _, l) ls 0 = mjoin ls.
-Proof. intros. apply (sublist_insert_join_aux _ _ 0); lia. Qed.
+Lemma sublist_lookup_compose l1 l2 l3 i n j m :
+ sublist_lookup i n l1 = Some l2 → sublist_lookup j m l2 = Some l3 →
+ sublist_lookup (i + j) m l1 = Some l3.
+Proof.
+ unfold sublist_lookup; intros; simplify_option_equality;
+ repeat match goal with
+ | H : _ ≤ length _ |- _ => rewrite take_length, drop_length in H
+ end; rewrite <-?take_drop_commute, ?drop_drop, ?take_take, ?Min.min_l by lia;
+ auto with lia.
+Qed.
+
+Lemma sublist_alter_length f i n l :
+ (∀ k, sublist_lookup i n l = Some k → length (f k) = n) →
+ i + n ≤ length l → length (sublist_alter f i n l) = length l.
+Proof.
+ unfold sublist_alter. intros Hk ?. rewrite !app_length, Hk, !take_length,
+ !drop_length by auto using sublist_lookup_Some; lia.
+Qed.
+Lemma sublist_lookup_alter f i n l :
+ (∀ k, sublist_lookup i n l = Some k → length (f k) = n) →
+ i + n ≤ length l →
+ sublist_lookup i n (sublist_alter f i n l) = f <$> sublist_lookup i n l.
+Proof.
+ intros Hk ?. unfold sublist_lookup. rewrite sublist_alter_length by done.
+ case_option_guard; f_equal'; unfold sublist_alter.
+ rewrite drop_app_alt by (rewrite take_length; lia).
+ by rewrite take_app_alt by (rewrite Hk; eauto using sublist_lookup_Some).
+Qed.
+Lemma sublist_lookup_alter_ne f l i j n :
+ (∀ k, sublist_lookup j n l = Some k → length (f k) = n) →
+ j + n ≤ length l → i + n ≤ j ∨ j + n ≤ i →
+ sublist_lookup i n (sublist_alter f j n l) = sublist_lookup i n l.
+Proof.
+ intros Hk Hij ?. unfold sublist_lookup. rewrite sublist_alter_length by done.
+ case_option_guard; f_equal'; unfold sublist_alter. apply list_eq; intros ii.
+ destruct (decide (ii < n)); [|by rewrite !lookup_take_ge by lia].
+ rewrite !lookup_take, !lookup_drop by done.
+ destruct (decide (i + ii < j)).
+ { by rewrite lookup_app_l, lookup_take by (rewrite ?take_length; lia). }
+ rewrite lookup_app_minus_r by (rewrite take_length; lia).
+ rewrite take_length_le by lia. rewrite lookup_app_minus_r
+ by (rewrite Hk; eauto using sublist_lookup_Some; lia).
+ rewrite Hk, lookup_drop by eauto using sublist_lookup_Some. f_equal; lia.
+Qed.
+Lemma sublist_alter_all f l n : length l = n → sublist_alter f 0 n l = f l.
+Proof.
+ intros <-. unfold sublist_alter; simpl.
+ by rewrite drop_all, (right_id_L [] (++)), take_ge.
+Qed.
+
+(** ** Properties of the [mask] function *)
+Lemma mask_nil f βs : mask f βs (@nil A) = [].
+Proof. by destruct βs. Qed.
+Lemma mask_length f βs l : length (mask f βs l) = length l.
+Proof. revert βs. induction l; intros [|??]; f_equal'; auto. Qed.
+Lemma mask_true f l n : length l ≤ n → mask f (replicate n true) l = f <$> l.
+Proof. revert n. induction l; intros [|?] ?; f_equal'; auto with lia. Qed.
+Lemma mask_false f l n : mask f (replicate n false) l = l.
+Proof. revert l. induction n; intros [|??]; f_equal'; auto. Qed.
+Lemma mask_app f βs1 βs2 l :
+ mask f (βs1 ++ βs2) l
+ = mask f βs1 (take (length βs1) l) ++ mask f βs2 (drop (length βs1) l).
+Proof. revert l. induction βs1;intros [|??]; f_equal'; auto using mask_nil. Qed.
+Lemma mask_take f βs l n : mask f βs (take n l) = take n (mask f βs l).
+Proof. revert n βs. induction l; intros [|?] [|[] ?]; f_equal'; auto. Qed.
+(*
+Lemma lookup_mask_None x y βs l i :
+ βs !! i = None → mask x y βs l !! i = None.
+Proof. revert i l. induction βs; intros [] [] ?; simplify_equality'; auto. Qed.
+Lemma lookup_mask_true x y βs l i :
+ βs !! i = Some true → mask x y βs l !! i = Some y.
+Proof. revert i l. induction βs; intros [] [] ?; simplify_equality'; auto. Qed.
+Lemma lookup_mask x y βs l i :
+ βs !! i = Some false → i < length l → mask x y βs l !! i = l !! i.
+Proof.
+ revert i βs. induction l; intros [|?] [|??] ??;
+ simplify_equality'; auto with lia.
+Qed.
+*)
(** ** Properties of the [seq] function *)
Lemma fmap_seq j n : S <$> seq j n = seq (S j) n.
-Proof. revert j. induction n; simpl; auto with f_equal. Qed.
+Proof. revert j. induction n; intros; f_equal'; auto. Qed.
Lemma lookup_seq 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_seq_ge j n i : n ≤ i → seq j n !! i = None.
-Proof.
- revert j i. induction n as [|n IH]; intros j [|i] ?; simpl; auto with lia.
-Qed.
+Proof. revert j i. induction n; intros j [|i] ?; simpl; auto with lia. Qed.
Lemma lookup_seq_inv j n i j' : seq j n !! i = Some j' → j' = j + i ∧ i < n.
Proof.
- destruct (le_lt_dec n i).
- * by rewrite lookup_seq_ge.
- * rewrite lookup_seq by done. intuition congruence.
+ destruct (le_lt_dec n i); [by rewrite lookup_seq_ge|].
+ rewrite lookup_seq by done. intuition congruence.
Qed.
(** ** Properties of the [Permutation] predicate *)
Lemma Permutation_nil l : l ≡ₚ [] ↔ l = [].
-Proof. split. by intro; apply Permutation_nil. by intro; subst. Qed.
+Proof. split. by intro; apply Permutation_nil. by intros ->. Qed.
Lemma Permutation_singleton l x : l ≡ₚ [x] ↔ l = [x].
-Proof. split. by intro; apply Permutation_length_1_inv. by intro; subst. Qed.
+Proof. split. by intro; apply Permutation_length_1_inv. by intros ->. Qed.
Definition Permutation_skip := @perm_skip A.
Definition Permutation_swap := @perm_swap A.
Definition Permutation_singleton_inj := @Permutation_length_1 A.
@@ -1208,11 +1169,11 @@ Global Instance: ∀ k : list A, Injective (≡ₚ) (≡ₚ) (++ k).
Proof.
intros k l1 l2. rewrite !(commutative (++) _ k). by apply (injective (k ++)).
Qed.
-Lemma replicate_Permutation n x l : l ≡ₚ replicate n x → l = replicate n x.
+Lemma replicate_Permutation n x l : replicate n x ≡ₚ l → replicate n x = l.
Proof.
intros Hl. apply replicate_as_elem_of. split.
- * by rewrite Hl, replicate_length.
- * intros y. rewrite Hl. by apply elem_of_replicate_inv.
+ * by rewrite <-Hl, replicate_length.
+ * intros y. rewrite <-Hl. by apply elem_of_replicate_inv.
Qed.
Lemma reverse_Permutation l : reverse l ≡ₚ l.
Proof.
@@ -1225,54 +1186,43 @@ Global Instance: PreOrder (@prefix_of A).
Proof.
split.
* intros ?. eexists []. by rewrite (right_id_L [] (++)).
- * intros ??? [k1 ?] [k2 ?].
- exists (k1 ++ k2). subst. by rewrite (associative_L (++)).
+ * intros ???[k1->] [k2->]. exists (k1 ++ k2). by rewrite (associative_L (++)).
Qed.
-
Lemma prefix_of_nil l : [] `prefix_of` l.
Proof. by exists l. Qed.
Lemma prefix_of_nil_not x l : ¬x :: l `prefix_of` [].
-Proof. by intros [k E]. Qed.
+Proof. by intros [k ?]. Qed.
Lemma prefix_of_cons x l1 l2 : l1 `prefix_of` l2 → x :: l1 `prefix_of` x :: l2.
-Proof. intros [k E]. exists k. by subst. Qed.
+Proof. intros [k ->]. by exists k. Qed.
Lemma prefix_of_cons_alt x y l1 l2 :
x = y → l1 `prefix_of` l2 → x :: l1 `prefix_of` y :: l2.
-Proof. intro. subst. apply prefix_of_cons. Qed.
+Proof. intros ->. apply prefix_of_cons. Qed.
Lemma prefix_of_cons_inv_1 x y l1 l2 : x :: l1 `prefix_of` y :: l2 → x = y.
-Proof. intros [k E]. by injection E. Qed.
+Proof. by intros [k ?]; simplify_equality'. Qed.
Lemma prefix_of_cons_inv_2 x y l1 l2 :
x :: l1 `prefix_of` y :: l2 → l1 `prefix_of` l2.
-Proof. intros [k E]. exists k. by injection E. Qed.
-
+Proof. intros [k ?]; simplify_equality. by exists k. Qed.
Lemma prefix_of_app k l1 l2 : l1 `prefix_of` l2 → k ++ l1 `prefix_of` k ++ l2.
-Proof. intros [k' ?]. subst. exists k'. by rewrite (associative_L (++)). Qed.
+Proof. intros [k' ->]. exists k'. by rewrite (associative_L (++)). Qed.
Lemma prefix_of_app_alt k1 k2 l1 l2 :
k1 = k2 → l1 `prefix_of` l2 → k1 ++ l1 `prefix_of` k2 ++ l2.
-Proof. intro. subst. apply prefix_of_app. Qed.
+Proof. intros ->. apply prefix_of_app. Qed.
Lemma prefix_of_app_l l1 l2 l3 : l1 ++ l3 `prefix_of` l2 → l1 `prefix_of` l2.
-Proof.
- intros [k ?]. red. exists (l3 ++ k). subst. by rewrite <-(associative_L (++)).
-Qed.
+Proof. intros [k ->]. exists (l3 ++ k). by rewrite (associative_L (++)). Qed.
Lemma prefix_of_app_r l1 l2 l3 : l1 `prefix_of` l2 → l1 `prefix_of` l2 ++ l3.
-Proof.
- intros [k ?]. exists (k ++ l3). subst. by rewrite (associative_L (++)).
-Qed.
-
+Proof. intros [k ->]. exists (k ++ l3). by rewrite (associative_L (++)). Qed.
Lemma prefix_of_length l1 l2 : l1 `prefix_of` l2 → length l1 ≤ length l2.
-Proof. intros [??]. subst. rewrite app_length. lia. Qed.
+Proof. intros [? ->]. rewrite app_length. lia. Qed.
Lemma prefix_of_snoc_not l x : ¬l ++ [x] `prefix_of` l.
Proof. intros [??]. discriminate_list_equality. Qed.
-
Global Instance: PreOrder (@suffix_of A).
Proof.
split.
* intros ?. by eexists [].
- * intros ??? [k1 ?] [k2 ?].
- exists (k2 ++ k1). subst. by rewrite (associative_L (++)).
+ * intros ???[k1->] [k2->]. exists (k2 ++ k1). by rewrite (associative_L (++)).
Qed.
-
Global Instance prefix_of_dec `{∀ x y, Decision (x = y)} : ∀ l1 l2,
- Decision (l1 `prefix_of` l2) := fix go l1 l2 :=
+ Decision (l1 `prefix_of` l2) := fix go l1 l2 :=
match l1, l2 return { l1 `prefix_of` l2 } + { ¬l1 `prefix_of` l2 } with
| [], _ => left (prefix_of_nil _)
| _, [] => right (prefix_of_nil_not _ _)
@@ -1289,31 +1239,28 @@ Global Instance prefix_of_dec `{∀ x y, Decision (x = y)} : ∀ l1 l2,
Section prefix_ops.
Context `{∀ x y, Decision (x = y)}.
-
Lemma max_prefix_of_fst l1 l2 :
- l1 = snd (max_prefix_of l1 l2) ++ fst (fst (max_prefix_of l1 l2)).
+ l1 = (max_prefix_of l1 l2).2 ++ (max_prefix_of l1 l2).1.1.
Proof.
revert l2. induction l1; intros [|??]; simpl;
- repeat case_decide; simpl; f_equal; auto.
+ repeat case_decide; f_equal'; auto.
Qed.
Lemma max_prefix_of_fst_alt l1 l2 k1 k2 k3 :
max_prefix_of l1 l2 = (k1, k2, k3) → l1 = k3 ++ k1.
Proof.
- intro. pose proof (max_prefix_of_fst l1 l2).
+ intros. pose proof (max_prefix_of_fst l1 l2).
by destruct (max_prefix_of l1 l2) as [[]?]; simplify_equality.
Qed.
- Lemma max_prefix_of_fst_prefix l1 l2 :
- snd (max_prefix_of l1 l2) `prefix_of` l1.
+ Lemma max_prefix_of_fst_prefix l1 l2 : (max_prefix_of l1 l2).2 `prefix_of` l1.
Proof. eexists. apply max_prefix_of_fst. Qed.
Lemma max_prefix_of_fst_prefix_alt l1 l2 k1 k2 k3 :
max_prefix_of l1 l2 = (k1, k2, k3) → k3 `prefix_of` l1.
Proof. eexists. eauto using max_prefix_of_fst_alt. Qed.
-
Lemma max_prefix_of_snd l1 l2 :
- l2 = snd (max_prefix_of l1 l2) ++ snd (fst (max_prefix_of l1 l2)).
+ l2 = (max_prefix_of l1 l2).2 ++ (max_prefix_of l1 l2).1.2.
Proof.
revert l2. induction l1; intros [|??]; simpl;
- repeat case_decide; simpl; f_equal; auto.
+ repeat case_decide; f_equal'; auto.
Qed.
Lemma max_prefix_of_snd_alt l1 l2 k1 k2 k3 :
max_prefix_of l1 l2 = (k1, k2, k3) → l2 = k3 ++ k2.
@@ -1321,20 +1268,16 @@ Section prefix_ops.
intro. pose proof (max_prefix_of_snd l1 l2).
by destruct (max_prefix_of l1 l2) as [[]?]; simplify_equality.
Qed.
- Lemma max_prefix_of_snd_prefix l1 l2 :
- snd (max_prefix_of l1 l2) `prefix_of` l2.
+ Lemma max_prefix_of_snd_prefix l1 l2 : (max_prefix_of l1 l2).2 `prefix_of` l2.
Proof. eexists. apply max_prefix_of_snd. Qed.
Lemma max_prefix_of_snd_prefix_alt l1 l2 k1 k2 k3 :
max_prefix_of l1 l2 = (k1,k2,k3) → k3 `prefix_of` l2.
Proof. eexists. eauto using max_prefix_of_snd_alt. Qed.
-
Lemma max_prefix_of_max l1 l2 k :
- k `prefix_of` l1 → k `prefix_of` l2 →
- k `prefix_of` snd (max_prefix_of l1 l2).
+ k `prefix_of` l1 → k `prefix_of` l2 → k `prefix_of` (max_prefix_of l1 l2).2.
Proof.
- intros [l1' ?] [l2' ?]. subst.
- by induction k; simpl; repeat case_decide; simpl;
- auto using prefix_of_nil, prefix_of_cons.
+ intros [l1' ->] [l2' ->]. by induction k; simpl; repeat case_decide;
+ simpl; auto using prefix_of_nil, prefix_of_cons.
Qed.
Lemma max_prefix_of_max_alt l1 l2 k1 k2 k3 k :
max_prefix_of l1 l2 = (k1,k2,k3) →
@@ -1343,11 +1286,10 @@ Section prefix_ops.
intro. pose proof (max_prefix_of_max l1 l2 k).
by destruct (max_prefix_of l1 l2) as [[]?]; simplify_equality.
Qed.
-
Lemma max_prefix_of_max_snoc l1 l2 k1 k2 k3 x1 x2 :
max_prefix_of l1 l2 = (x1 :: k1, x2 :: k2, k3) → x1 ≠x2.
Proof.
- intros Hl ?. subst. destruct (prefix_of_snoc_not k3 x2).
+ intros Hl ->. destruct (prefix_of_snoc_not k3 x2).
eapply max_prefix_of_max_alt; eauto.
* rewrite (max_prefix_of_fst_alt _ _ _ _ _ Hl).
apply prefix_of_app, prefix_of_cons, prefix_of_nil.
@@ -1366,7 +1308,6 @@ Qed.
Lemma suffix_prefix_reverse l1 l2 :
l1 `suffix_of` l2 ↔ reverse l1 `prefix_of` reverse l2.
Proof. by rewrite prefix_suffix_reverse, !reverse_involutive. Qed.
-
Lemma suffix_of_nil l : [] `suffix_of` l.
Proof. exists l. by rewrite (right_id_L [] (++)). Qed.
Lemma suffix_of_nil_inv l : l `suffix_of` [] → l = [].
@@ -1375,17 +1316,15 @@ Lemma suffix_of_cons_nil_inv x l : ¬x :: l `suffix_of` [].
Proof. by intros [[] ?]. Qed.
Lemma suffix_of_snoc l1 l2 x :
l1 `suffix_of` l2 → l1 ++ [x] `suffix_of` l2 ++ [x].
-Proof. intros [k E]. exists k. subst. by rewrite (associative_L (++)). Qed.
+Proof. intros [k ->]. exists k. by rewrite (associative_L (++)). Qed.
Lemma suffix_of_snoc_alt x y l1 l2 :
x = y → l1 `suffix_of` l2 → l1 ++ [x] `suffix_of` l2 ++ [y].
-Proof. intro. subst. apply suffix_of_snoc. Qed.
-
+Proof. intros ->. apply suffix_of_snoc. Qed.
Lemma suffix_of_app l1 l2 k : l1 `suffix_of` l2 → l1 ++ k `suffix_of` l2 ++ k.
-Proof. intros [k' E]. exists k'. subst. by rewrite (associative_L (++)). Qed.
+Proof. intros [k' ->]. exists k'. by rewrite (associative_L (++)). Qed.
Lemma suffix_of_app_alt l1 l2 k1 k2 :
k1 = k2 → l1 `suffix_of` l2 → l1 ++ k1 `suffix_of` l2 ++ k2.
-Proof. intro. subst. apply suffix_of_app. Qed.
-
+Proof. intros ->. apply suffix_of_app. Qed.
Lemma suffix_of_snoc_inv_1 x y l1 l2 :
l1 ++ [x] `suffix_of` l2 ++ [y] → x = y.
Proof.
@@ -1403,32 +1342,24 @@ Proof.
intros [k' E]. exists k'. rewrite (associative_L (++)) in E.
by simplify_list_equality.
Qed.
-
Lemma suffix_of_cons_l l1 l2 x : x :: l1 `suffix_of` l2 → l1 `suffix_of` l2.
-Proof.
- intros [k ?]. exists (k ++ [x]). subst. by rewrite <-(associative_L (++)).
-Qed.
+Proof. intros [k ->]. exists (k ++ [x]). by rewrite <-(associative_L (++)). Qed.
Lemma suffix_of_app_l l1 l2 l3 : l3 ++ l1 `suffix_of` l2 → l1 `suffix_of` l2.
-Proof.
- intros [k ?]. exists (k ++ l3). subst. by rewrite <-(associative_L (++)).
-Qed.
+Proof. intros [k ->]. exists (k ++ l3). by rewrite <-(associative_L (++)). Qed.
Lemma suffix_of_cons_r l1 l2 x : l1 `suffix_of` l2 → l1 `suffix_of` x :: l2.
-Proof. intros [k ?]. exists (x :: k). by subst. Qed.
+Proof. intros [k ->]. by exists (x :: k). Qed.
Lemma suffix_of_app_r l1 l2 l3 : l1 `suffix_of` l2 → l1 `suffix_of` l3 ++ l2.
-Proof. intros [k ?]. exists (l3 ++ k). subst. by rewrite (associative_L _). Qed.
-
+Proof. intros [k ->]. exists (l3 ++ k). by rewrite (associative_L (++)). Qed.
Lemma suffix_of_cons_inv l1 l2 x y :
x :: l1 `suffix_of` y :: l2 → x :: l1 = y :: l2 ∨ x :: l1 `suffix_of` l2.
Proof.
- intros [[|? k] E]; [by left |].
+ intros [[|? k] E]; [by left|].
right. simplify_equality. by apply suffix_of_app_r.
Qed.
-
Lemma suffix_of_length l1 l2 : l1 `suffix_of` l2 → length l1 ≤ length l2.
-Proof. intros [??]. subst. rewrite app_length. lia. Qed.
+Proof. intros [? ->]. rewrite app_length. lia. Qed.
Lemma suffix_of_cons_not x l : ¬x :: l `suffix_of` l.
Proof. intros [??]. discriminate_list_equality. Qed.
-
Global Instance suffix_of_dec `{∀ x y, Decision (x = y)} l1 l2 :
Decision (l1 `suffix_of` l2).
Proof.
@@ -1440,7 +1371,7 @@ Section max_suffix_of.
Context `{∀ x y, Decision (x = y)}.
Lemma max_suffix_of_fst l1 l2 :
- l1 = fst (fst (max_suffix_of l1 l2)) ++ snd (max_suffix_of l1 l2).
+ l1 = (max_suffix_of l1 l2).1.1 ++ (max_suffix_of l1 l2).2.
Proof.
rewrite <-(reverse_involutive l1) at 1.
rewrite (max_prefix_of_fst (reverse l1) (reverse l2)). unfold max_suffix_of.
@@ -1453,19 +1384,16 @@ Section max_suffix_of.
intro. pose proof (max_suffix_of_fst l1 l2).
by destruct (max_suffix_of l1 l2) as [[]?]; simplify_equality.
Qed.
- Lemma max_suffix_of_fst_suffix l1 l2 :
- snd (max_suffix_of l1 l2) `suffix_of` l1.
+ Lemma max_suffix_of_fst_suffix l1 l2 : (max_suffix_of l1 l2).2 `suffix_of` l1.
Proof. eexists. apply max_suffix_of_fst. Qed.
Lemma max_suffix_of_fst_suffix_alt l1 l2 k1 k2 k3 :
max_suffix_of l1 l2 = (k1, k2, k3) → k3 `suffix_of` l1.
Proof. eexists. eauto using max_suffix_of_fst_alt. Qed.
-
Lemma max_suffix_of_snd l1 l2 :
- l2 = snd (fst (max_suffix_of l1 l2)) ++ snd (max_suffix_of l1 l2).
+ l2 = (max_suffix_of l1 l2).1.2 ++ (max_suffix_of l1 l2).2.
Proof.
rewrite <-(reverse_involutive l2) at 1.
- rewrite (max_prefix_of_snd (reverse l1) (reverse l2)).
- unfold max_suffix_of.
+ rewrite (max_prefix_of_snd (reverse l1) (reverse l2)). unfold max_suffix_of.
destruct (max_prefix_of (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
by rewrite reverse_app.
Qed.
@@ -1475,16 +1403,13 @@ Section max_suffix_of.
intro. pose proof (max_suffix_of_snd l1 l2).
by destruct (max_suffix_of l1 l2) as [[]?]; simplify_equality.
Qed.
- Lemma max_suffix_of_snd_suffix l1 l2 :
- snd (max_suffix_of l1 l2) `suffix_of` l2.
+ Lemma max_suffix_of_snd_suffix l1 l2 : (max_suffix_of l1 l2).2 `suffix_of` l2.
Proof. eexists. apply max_suffix_of_snd. Qed.
Lemma max_suffix_of_snd_suffix_alt l1 l2 k1 k2 k3 :
max_suffix_of l1 l2 = (k1,k2,k3) → k3 `suffix_of` l2.
Proof. eexists. eauto using max_suffix_of_snd_alt. Qed.
-
Lemma max_suffix_of_max l1 l2 k :
- k `suffix_of` l1 → k `suffix_of` l2 →
- k `suffix_of` snd (max_suffix_of l1 l2).
+ k `suffix_of` l1 → k `suffix_of` l2 → k `suffix_of` (max_suffix_of l1 l2).2.
Proof.
generalize (max_prefix_of_max (reverse l1) (reverse l2)).
rewrite !suffix_prefix_reverse. unfold max_suffix_of.
@@ -1498,11 +1423,10 @@ Section max_suffix_of.
intro. pose proof (max_suffix_of_max l1 l2 k).
by destruct (max_suffix_of l1 l2) as [[]?]; simplify_equality.
Qed.
-
Lemma max_suffix_of_max_snoc l1 l2 k1 k2 k3 x1 x2 :
max_suffix_of l1 l2 = (k1 ++ [x1], k2 ++ [x2], k3) → x1 ≠x2.
Proof.
- intros Hl ?. subst. destruct (suffix_of_cons_not x2 k3).
+ intros Hl ->. destruct (suffix_of_cons_not x2 k3).
eapply max_suffix_of_max_alt; eauto.
* rewrite (max_suffix_of_fst_alt _ _ _ _ _ Hl).
by apply (suffix_of_app [x2]), suffix_of_app_r.
@@ -1514,12 +1438,10 @@ End max_suffix_of.
(** ** Properties of the [sublist] predicate *)
Lemma sublist_length l1 l2 : l1 `sublist` l2 → length l1 ≤ length l2.
Proof. induction 1; simpl; auto with arith. Qed.
-
Lemma sublist_nil_l l : [] `sublist` l.
Proof. induction l; try constructor; auto. Qed.
Lemma sublist_nil_r l : l `sublist` [] ↔ l = [].
-Proof. split. by inversion 1. intros. subst. constructor. Qed.
-
+Proof. split. by inversion 1. intros ->. constructor. Qed.
Lemma sublist_app l1 l2 k1 k2 :
l1 `sublist` l2 → k1 `sublist` k2 → l1 ++ k1 `sublist` l2 ++ k2.
Proof. induction 1; simpl; try constructor; auto. Qed.
@@ -1527,22 +1449,18 @@ Lemma sublist_inserts_l k l1 l2 : l1 `sublist` l2 → l1 `sublist` k ++ l2.
Proof. induction k; try constructor; auto. Qed.
Lemma sublist_inserts_r k l1 l2 : l1 `sublist` l2 → l1 `sublist` l2 ++ k.
Proof. induction 1; simpl; try constructor; auto using sublist_nil_l. Qed.
-
Lemma sublist_cons_r x l k :
l `sublist` x :: k ↔ l `sublist` k ∨ ∃ l', l = x :: l' ∧ l' `sublist` k.
-Proof.
- split. inversion 1; eauto. intros [?|(?&?&?)]; subst; constructor; auto.
-Qed.
+Proof. split. inversion 1; eauto. intros [?|(?&->&?)]; constructor; auto. Qed.
Lemma sublist_cons_l x l k :
x :: l `sublist` k ↔ ∃ k1 k2, k = k1 ++ x :: k2 ∧ l `sublist` k2.
Proof.
split.
* intros Hlk. induction k as [|y k IH]; inversion Hlk.
+ eexists [], k. by repeat constructor.
- + destruct IH as (k1&k2&?&?); subst; auto. by exists (y :: k1) k2.
- * intros (k1&k2&?&?). subst. by apply sublist_inserts_l, sublist_skip.
+ + destruct IH as (k1&k2&->&?); auto. by exists (y :: k1) k2.
+ * intros (k1&k2&->&?). by apply sublist_inserts_l, sublist_skip.
Qed.
-
Lemma sublist_app_r l k1 k2 :
l `sublist` k1 ++ k2 ↔
∃ l1 l2, l = l1 ++ l2 ∧ l1 `sublist` k1 ∧ l2 `sublist` k2.
@@ -1588,7 +1506,6 @@ Proof.
rewrite (associative_L (++)) in E. simplify_list_equality.
eauto using sublist_inserts_r.
Qed.
-
Global Instance: PartialOrder (@sublist A).
Proof.
split; [split|].
@@ -1600,10 +1517,9 @@ Proof.
+ intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst.
eauto using sublist_inserts_l, sublist_cons.
* intros l1 l2 Hl12 Hl21. apply sublist_length in Hl21.
- induction Hl12; simpl in *; f_equal; auto with arith.
+ induction Hl12; f_equal'; auto with arith.
apply sublist_length in Hl12. lia.
Qed.
-
Lemma sublist_take l i : take i l `sublist` l.
Proof. rewrite <-(take_drop i l) at 2. by apply sublist_inserts_r. Qed.
Lemma sublist_drop l i : drop i l `sublist` l.
@@ -1615,7 +1531,6 @@ Proof.
induction is as [|i is IH]; simpl; [done |].
transitivity (delete_list is l); auto using sublist_delete.
Qed.
-
Lemma sublist_alt l1 l2 : l1 `sublist` l2 ↔ ∃ is, l1 = delete_list is l2.
Proof.
split.
@@ -1628,9 +1543,8 @@ Proof.
+ destruct (IH k) as [is His]. exists (is ++ [length k]).
unfold delete_list. rewrite fold_right_app. simpl.
by rewrite delete_middle.
- * intros [is ?]. subst. apply sublist_delete_list.
+ * intros [is ->]. apply sublist_delete_list.
Qed.
-
Lemma Permutation_sublist l1 l2 l3 :
l1 ≡ₚ l2 → l2 `sublist` l3 → ∃ l4, l1 `sublist` l4 ∧ l4 ≡ₚ l3.
Proof.
@@ -1678,17 +1592,15 @@ Lemma contains_nil_l l : [] `contains` l.
Proof. induction l; constructor; auto. Qed.
Lemma contains_nil_r l : l `contains` [] ↔ l = [].
Proof.
- split; [|intros; subst; constructor].
+ split; [|intros ->; constructor].
intros Hl. apply contains_length in Hl. destruct l; simpl in *; auto with lia.
Qed.
-
Global Instance: PreOrder (@contains A).
Proof.
split.
* intros l. induction l; constructor; auto.
* red. apply contains_trans.
Qed.
-
Lemma Permutation_contains l1 l2 : l1 ≡ₚ l2 → l1 `contains` l2.
Proof. induction 1; econstructor; eauto. Qed.
Lemma sublist_contains l1 l2 : l1 `sublist` l2 → l1 `contains` l2.
@@ -1713,7 +1625,6 @@ Qed.
Lemma contains_Permutation_length_eq l1 l2 :
length l2 = length l1 → l1 `contains` l2 → l1 ≡ₚ l2.
Proof. intro. apply contains_Permutation_length_le. lia. Qed.
-
Global Instance: Proper ((≡ₚ) ==> (≡ₚ) ==> iff) (@contains A).
Proof.
intros l1 l2 ? k1 k2 ?. split; intros.
@@ -1724,7 +1635,6 @@ Proof.
Qed.
Global Instance: AntiSymmetric (≡ₚ) (@contains A).
Proof. red. auto using contains_Permutation_length_le, contains_length. Qed.
-
Lemma contains_take l i : take i l `contains` l.
Proof. auto using sublist_take, sublist_contains. Qed.
Lemma contains_drop l i : drop i l `contains` l.
@@ -1733,7 +1643,6 @@ Lemma contains_delete l i : delete i l `contains` l.
Proof. auto using sublist_delete, sublist_contains. Qed.
Lemma contains_delete_list l is : delete_list is l `sublist` l.
Proof. auto using sublist_delete_list, sublist_contains. Qed.
-
Lemma contains_sublist_l l1 l3 :
l1 `contains` l3 ↔ ∃ l2, l1 `sublist` l2 ∧ l2 ≡ₚ l3.
Proof.
@@ -1755,7 +1664,6 @@ Proof.
rewrite contains_sublist_l.
split; intros (l2&?&?); eauto using sublist_Permutation, Permutation_sublist.
Qed.
-
Lemma contains_inserts_l k l1 l2 : l1 `contains` l2 → l1 `contains` k ++ l2.
Proof. induction k; try constructor; auto. Qed.
Lemma contains_inserts_r k l1 l2 : l1 `contains` l2 → l1 `contains` l2 ++ k.
@@ -1769,7 +1677,6 @@ Lemma contains_app l1 l2 k1 k2 :
Proof.
transitivity (l1 ++ k2); auto using contains_skips_l, contains_skips_r.
Qed.
-
Lemma contains_cons_r x l k :
l `contains` x :: k ↔ l `contains` k ∨ ∃ l', l ≡ₚ x :: l' ∧ l' `contains` k.
Proof.
@@ -1877,18 +1784,15 @@ Section contains_dec.
* case_decide; simplify_equality; eauto.
destruct (list_remove x l1) as [l|] eqn:?; simplify_equality.
destruct (IH l) as (?&?&?); simplify_option_equality; eauto.
- * repeat case_decide; simplify_option_equality;
- eauto using Permutation_swap.
+ * simplify_option_equality; eauto using Permutation_swap.
* destruct (IH1 k1) as (k2&?&?); trivial.
destruct (IH2 k2) as (k3&?&?); trivial.
exists k3. split; eauto. by transitivity k2.
Qed.
-
Lemma list_remove_Some l k x : list_remove x l = Some k → l ≡ₚ x :: k.
Proof.
revert k. induction l as [|y l IH]; simpl; intros k ?; [done |].
- case_decide; simplify_option_equality; [done|].
- by rewrite Permutation_swap, <-IH.
+ simplify_option_equality; auto. by rewrite Permutation_swap, <-IH.
Qed.
Lemma list_remove_Some_inv l k x :
l ≡ₚ x :: k → ∃ k', list_remove x l = Some k' ∧ k ≡ₚ k'.
@@ -1898,7 +1802,6 @@ Section contains_dec.
* simpl; by case_decide.
* by exists k'.
Qed.
-
Lemma list_remove_list_contains l1 l2 :
l1 `contains` l2 ↔ is_Some (list_remove_list l1 l2).
Proof.
@@ -1914,7 +1817,6 @@ Section contains_dec.
destruct (list_remove x l2) as [k'|] eqn:?; intros; simplify_equality.
rewrite contains_cons_l. eauto using list_remove_Some.
Qed.
-
Global Instance contains_dec l1 l2 : Decision (l1 `contains` l2).
Proof.
refine (cast_if (decide (is_Some (list_remove_list l1 l2))));
@@ -1929,64 +1831,31 @@ Section contains_dec.
End contains_dec.
End more_general_properties.
-(** ** Properties of the [same_length] predicate *)
-Instance: ∀ A, Reflexive (@same_length A A).
-Proof. intros A l. induction l; constructor; auto. Qed.
-Instance: ∀ A, Symmetric (@same_length A A).
-Proof. induction 1; constructor; auto. Qed.
-Hint Extern 0 (_ `same_length` _) => reflexivity.
-Hint Extern 0 (_ `same_length` _) => symmetry; assumption.
-
-Section same_length.
- Context {A B : Type}.
- Implicit Types l : list A. Implicit Types k : list B.
-
- Lemma same_length_length_1 l k : l `same_length` k → length l = length k.
- Proof. induction 1; simpl; auto. Qed.
- Lemma same_length_length_2 l k : length l = length k → l `same_length` k.
- Proof.
- revert k. induction l; intros [|??]; try discriminate;
- constructor; auto with arith.
- Qed.
- Lemma same_length_length l k : l `same_length` k ↔ length l = length k.
- Proof. split; auto using same_length_length_1, same_length_length_2. Qed.
-
- Lemma same_length_lookup l k i :
- l `same_length` k → is_Some (l !! i) → is_Some (k !! i).
- Proof. rewrite same_length_length. rewrite !lookup_lt_is_Some. lia. Qed.
-
- Lemma same_length_take l k n :
- l `same_length` k → take n l `same_length` take n k.
- Proof. intros Hl. revert n; induction Hl; intros [|n]; constructor; auto. Qed.
- Lemma same_length_drop l k n :
- l `same_length` k → drop n l `same_length` drop n k.
- Proof.
- intros Hl. revert n; induction Hl; intros [|]; simpl; try constructor; auto.
- Qed.
- Lemma same_length_resize l k x y n : resize n x l `same_length` resize n y k.
- Proof. apply same_length_length. by rewrite !resize_length. Qed.
-
- Lemma same_length_fmap {C D} (f : A → C) (g : B → D) l k :
- l `same_length` k → f <$> l `same_length` g <$> k.
- Proof. induction 1; simpl; constructor; auto. Qed.
-End same_length.
-
(** ** Properties of the [Forall] and [Exists] predicate *)
+Lemma Forall_Exists_dec {A} {P Q : A → Prop} (dec : ∀ x, {P x} + {Q x}) :
+ ∀ l, {Forall P l} + {Exists Q l}.
+Proof.
+ refine (
+ fix go l :=
+ match l return {Forall P l} + {Exists Q l} with
+ | [] => left _
+ | x :: l => cast_if_and (dec x) (go l)
+ end); clear go; intuition.
+Defined.
+
Section Forall_Exists.
Context {A} (P : A → Prop).
Definition Forall_nil_2 := @Forall_nil A.
Definition Forall_cons_2 := @Forall_cons A.
-
Lemma Forall_forall l : Forall P l ↔ ∀ x, x ∈ l → P x.
Proof.
split.
- * induction 1; inversion 1; subst; auto.
- * intros Hin. induction l; constructor.
- + apply Hin. constructor.
- + apply IHl. intros ??. apply Hin. by constructor.
+ { induction 1; inversion 1; subst; auto. }
+ intros Hin. induction l; constructor.
+ * apply Hin. constructor.
+ * apply IHl. intros ??. apply Hin. by constructor.
Qed.
-
Lemma Forall_nil : Forall P [] ↔ True.
Proof. done. Qed.
Lemma Forall_cons_1 x l : Forall P (x :: l) → P x ∧ Forall P l.
@@ -2005,18 +1874,15 @@ Section Forall_Exists.
Qed.
Lemma Forall_true l : (∀ x, P x) → Forall P l.
Proof. induction l; auto. Qed.
- Lemma Forall_impl l (Q : A → Prop) :
+ Lemma Forall_impl (Q : A → Prop) l :
Forall P l → (∀ x, P x → Q x) → Forall Q l.
Proof. intros H ?. induction H; auto. Defined.
-
Global Instance Forall_proper:
Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Forall A).
- Proof. split; subst; induction 1; constructor; firstorder. Qed.
-
+ Proof. split; subst; induction 1; constructor (by firstorder auto). Qed.
Lemma Forall_iff l (Q : A → Prop) :
(∀ x, P x ↔ Q x) → Forall P l ↔ Forall Q l.
Proof. intros H. apply Forall_proper. red. apply H. done. Qed.
-
Lemma Forall_delete l i : Forall P l → Forall P (delete i l).
Proof. intros H. revert i. by induction H; intros [|i]; try constructor. Qed.
Lemma Forall_lookup l : Forall P l ↔ ∀ i x, l !! i = Some x → P x.
@@ -2027,19 +1893,21 @@ Section Forall_Exists.
Proof. rewrite Forall_lookup. eauto. Qed.
Lemma Forall_lookup_2 l : (∀ i x, l !! i = Some x → P x) → Forall P l.
Proof. by rewrite Forall_lookup. Qed.
-
Lemma Forall_alter f l i :
- Forall P l → (∀ x, l !! i = Some x → P x → P (f x)) →
- Forall P (alter f i l).
+ Forall P l → (∀ x, l!!i = Some x → P x → P (f x)) → Forall P (alter f i l).
Proof.
intros Hl. revert i. induction Hl; simpl; intros [|i]; constructor; auto.
Qed.
-
+ Lemma Forall_alter_inv f l i :
+ Forall P (alter f i l) → (∀ x, l!!i = Some x → P (f x) → P x) → Forall P l.
+ Proof.
+ revert i. induction l; intros [|?]; simpl;
+ inversion_clear 1; constructor; eauto.
+ Qed.
Lemma Forall_replicate n x : P x → Forall P (replicate n x).
Proof. induction n; simpl; constructor; auto. Qed.
- Lemma Forall_replicate_eq n (x : A) : Forall (=x) (replicate n x).
+ Lemma Forall_replicate_eq n (x : A) : Forall (x =) (replicate n x).
Proof. induction n; simpl; constructor; auto. Qed.
-
Lemma Forall_take n l : Forall P l → Forall P (take n l).
Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
Lemma Forall_drop n l : Forall P l → Forall P (drop n l).
@@ -2049,22 +1917,41 @@ Section Forall_Exists.
intros ? Hl. revert n.
induction Hl; intros [|?]; simpl; auto using Forall_replicate.
Qed.
+ Lemma Forall_resize_inv n x l :
+ length l ≤ n → Forall P (resize n x l) → Forall P l.
+ Proof. intros ?. rewrite resize_ge, Forall_app by done. by intros []. Qed.
Lemma Forall_sublist_lookup l i n k :
sublist_lookup i n l = Some k → Forall P l → Forall P k.
Proof.
unfold sublist_lookup. intros; simplify_option_equality.
auto using Forall_take, Forall_drop.
Qed.
- Lemma Forall_sublist_insert l i k :
- Forall P l → Forall P k → Forall P (sublist_insert i k l).
+ Lemma Forall_sublist_alter f l i n :
+ i + n ≤ length l → Forall P l →
+ (∀ k, sublist_lookup i n l = Some k → Forall P k → Forall P (f k)) →
+ Forall P (sublist_alter f i n l).
Proof.
- unfold sublist_insert. auto using Forall_app_2, Forall_drop, Forall_take.
+ unfold sublist_alter.
+ auto 8 using Forall_app_2, Forall_drop, Forall_take, sublist_lookup_Some.
Qed.
Lemma Forall_reshape l szs : Forall P l → Forall (Forall P) (reshape szs l).
Proof.
revert l. induction szs; simpl; auto using Forall_take, Forall_drop.
Qed.
-
+(*
+ Lemma Forall_mask f βs l: P x → P y → Forall P l → Forall P (mask f βs l).
+ Proof.
+ intros ??. revert l. induction βs as [|[]]; intros ? [|????]; simpl; auto.
+ Qed.
+ Lemma Forall_resize_mask x y n βs l :
+ P y → Forall P (resize n x l) → length βs ≤ n → Forall P (mask x y βs l).
+ Proof.
+ intros ?. revert n l. induction βs as [|β βs IH]; [constructor|].
+ intros [|n] [|z l]; simpl; inversion_clear 1; intros; try lia.
+ * constructor. by destruct β. apply IH with n. by rewrite resize_nil. lia.
+ * constructor. by destruct β. apply IH with n; auto with lia.
+ Qed.
+*)
Lemma Forall_rev_ind (Q : list A → Prop) :
Q [] → (∀ x l, P x → Forall P l → Q l → Q (l ++ [x])) →
∀ l, Forall P l → Q l.
@@ -2072,16 +1959,12 @@ Section Forall_Exists.
intros ?? l. induction l using rev_ind; auto.
rewrite Forall_app, Forall_singleton; intros [??]; auto.
Qed.
-
Lemma Exists_exists l : Exists P l ↔ ∃ x, x ∈ l ∧ P x.
Proof.
split.
- * induction 1 as [x|y ?? IH].
- + exists x. split. constructor. done.
- + destruct IH as [x [??]]. exists x. split. by constructor. done.
- * intros [x [Hin ?]]. induction l.
- + by destruct (not_elem_of_nil x).
- + inversion Hin; subst. by left. right; auto.
+ * induction 1 as [x|y ?? [x [??]]]; exists x; by repeat constructor.
+ * intros [x [Hin ?]]. induction l; [by destruct (not_elem_of_nil x)|].
+ inversion Hin; subst. by left. right; auto.
Qed.
Lemma Exists_inv x l : Exists P (x :: l) → P x ∨ Exists P l.
Proof. inversion 1; intuition trivial. Qed.
@@ -2091,58 +1974,40 @@ Section Forall_Exists.
* induction l1; inversion 1; intuition.
* intros [H|H]; [induction H | induction l1]; simpl; intuition.
Qed.
-
+ Lemma Exists_impl (Q : A → Prop) l :
+ Exists P l → (∀ x, P x → Q x) → Exists Q l.
+ Proof. intros H ?. induction H; auto. Defined.
Global Instance Exists_proper:
Proper (pointwise_relation _ (↔) ==> (=) ==> (↔)) (@Exists A).
- Proof. split; subst; (induction 1; [left|right]; firstorder auto). Qed.
-
+ Proof. split; subst; induction 1; constructor (by firstorder auto). Qed.
Lemma Exists_not_Forall l : Exists (not ∘ P) l → ¬Forall P l.
Proof. induction 1; inversion_clear 1; contradiction. Qed.
Lemma Forall_not_Exists l : Forall (not ∘ P) l → ¬Exists P l.
Proof. induction 1; inversion_clear 1; contradiction. Qed.
Context {dec : ∀ x, Decision (P x)}.
-
- Fixpoint Forall_Exists_dec l : {Forall P l} + {Exists (not ∘ P) l}.
- Proof.
- refine (
- match l with
- | [] => left _
- | x :: l => cast_if_and (dec x) (Forall_Exists_dec l)
- end); clear Forall_Exists_dec; abstract intuition.
- Defined.
-
Lemma not_Forall_Exists l : ¬Forall P l → Exists (not ∘ P) l.
- Proof. intro. destruct (Forall_Exists_dec l); intuition. Qed.
-
+ Proof. intro. destruct (Forall_Exists_dec dec l); intuition. Qed.
+ Lemma not_Exists_Forall l : ¬Exists P l → Forall (not ∘ P) l.
+ Proof. by destruct (Forall_Exists_dec (λ x, swap_if (decide (P x))) l). Qed.
Global Instance Forall_dec l : Decision (Forall P l) :=
- match Forall_Exists_dec l with
+ match Forall_Exists_dec dec l with
| left H => left H
| right H => right (Exists_not_Forall _ H)
end.
-
- Fixpoint Exists_Forall_dec l : {Exists P l} + {Forall (not ∘ P) l}.
- Proof.
- refine (
- match l with
- | [] => right _
- | x :: l => cast_if_or (dec x) (Exists_Forall_dec l)
- end); clear Exists_Forall_dec; abstract intuition.
- Defined.
-
- Lemma not_Exists_Forall l : ¬Exists P l → Forall (not ∘ P) l.
- Proof. intro. destruct (Exists_Forall_dec l); intuition. Qed.
-
Global Instance Exists_dec l : Decision (Exists P l) :=
- match Exists_Forall_dec l with
- | left H => left H
- | right H => right (Forall_not_Exists _ H)
+ match Forall_Exists_dec (λ x, swap_if (decide (P x))) l with
+ | left H => right (Forall_not_Exists _ H)
+ | right H => left H
end.
End Forall_Exists.
Lemma replicate_as_Forall {A} (x : A) n l :
- l = replicate n x ↔ length l = n ∧ Forall (x =) l.
+ replicate n x = l ↔ length l = n ∧ Forall (x =) l.
Proof. rewrite replicate_as_elem_of, Forall_forall. naive_solver. Qed.
+Lemma replicate_as_Forall_2 {A} (x : A) n l :
+ length l = n → Forall (x =) l → replicate n x = l.
+Proof. by rewrite replicate_as_Forall. Qed.
Lemma Forall_swap {A B} (Q : A → B → Prop) l1 l2 :
Forall (λ y, Forall (Q y) l1) l2 ↔ Forall (λ x, Forall (flip Q x) l2) l1.
@@ -2160,52 +2025,72 @@ Qed.
(** ** Properties of the [Forall2] predicate *)
Section Forall2.
Context {A B} (P : A → B → Prop).
+ Implicit Types x : A.
+ Implicit Types y : B.
+ Implicit Types l : list A.
+ Implicit Types k : list B.
+ Lemma Forall2_same_length l k :
+ Forall2 (λ _ _, True) l k ↔ length l = length k.
+ Proof.
+ split; [by induction 1; f_equal'|].
+ revert k. induction l; intros [|??] ?; simplify_equality'; auto.
+ Qed.
+ Lemma Forall2_length l k : Forall2 P l k → length l = length k.
+ Proof. by induction 1; f_equal'. Qed.
+ Lemma Forall2_length_l l k n : Forall2 P l k → length l = n → length k = n.
+ Proof. intros ? <-; symmetry. by apply Forall2_length. Qed.
+ Lemma Forall2_length_r l k n : Forall2 P l k → length k = n → length l = n.
+ Proof. intros ? <-. by apply Forall2_length. Qed.
Lemma Forall2_nil_inv_l k : Forall2 P [] k → k = [].
Proof. by inversion 1. Qed.
- Lemma Forall2_nil_inv_r k : Forall2 P k [] → k = [].
+ Lemma Forall2_nil_inv_r l : Forall2 P l [] → l = [].
Proof. by inversion 1. Qed.
- Lemma Forall2_cons_inv l1 l2 x1 x2 :
- Forall2 P (x1 :: l1) (x2 :: l2) → P x1 x2 ∧ Forall2 P l1 l2.
+ Lemma Forall2_cons_inv x l y k :
+ Forall2 P (x :: l) (y :: k) → P x y ∧ Forall2 P l k.
Proof. by inversion 1. Qed.
- Lemma Forall2_cons_inv_l l1 k x1 :
- Forall2 P (x1 :: l1) k → ∃ x2 l2, P x1 x2 ∧ Forall2 P l1 l2 ∧ k = x2 :: l2.
+ Lemma Forall2_cons_inv_l x l k :
+ Forall2 P (x :: l) k → ∃ y k', P x y ∧ Forall2 P l k' ∧ k = y :: k'.
Proof. inversion 1; subst; eauto. Qed.
- Lemma Forall2_cons_inv_r k l2 x2 :
- Forall2 P k (x2 :: l2) → ∃ x1 l1, P x1 x2 ∧ Forall2 P l1 l2 ∧ k = x1 :: l1.
+ Lemma Forall2_cons_inv_r l k y :
+ Forall2 P l (y :: k) → ∃ x l', P x y ∧ Forall2 P l' k ∧ l = x :: l'.
Proof. inversion 1; subst; eauto. Qed.
- Lemma Forall2_cons_nil_inv l1 x1 : Forall2 P (x1 :: l1) [] → False.
+ Lemma Forall2_cons_nil_inv x l : Forall2 P (x :: l) [] → False.
Proof. by inversion 1. Qed.
- Lemma Forall2_nil_cons_inv l2 x2 : Forall2 P [] (x2 :: l2) → False.
+ Lemma Forall2_nil_cons_inv y k : Forall2 P [] (y :: k) → False.
Proof. by inversion 1. Qed.
+ Lemma Forall2_app_l l1 l2 k :
+ Forall2 P l1 (take (length l1) k) → Forall2 P l2 (drop (length l1) k) →
+ Forall2 P (l1 ++ l2) k.
+ Proof. intros. rewrite <-(take_drop (length l1) k). by apply Forall2_app. Qed.
+ Lemma Forall2_app_r l k1 k2 :
+ Forall2 P (take (length k1) l) k1 → Forall2 P (drop (length k1) l) k2 →
+ Forall2 P l (k1 ++ k2).
+ Proof. intros. rewrite <-(take_drop (length k1) l). by apply Forall2_app. Qed.
Lemma Forall2_app_inv l1 l2 k1 k2 :
- l1 `same_length` k1 →
+ length l1 = length k1 →
Forall2 P (l1 ++ l2) (k1 ++ k2) → Forall2 P l1 k1 ∧ Forall2 P l2 k2.
- Proof. induction 1. done. inversion 1; naive_solver. Qed.
+ Proof.
+ rewrite <-Forall2_same_length. induction 1; inversion 1; naive_solver.
+ Qed.
Lemma Forall2_app_inv_l l1 l2 k :
- Forall2 P (l1 ++ l2) k →
+ Forall2 P (l1 ++ l2) k ↔
∃ k1 k2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ k = k1 ++ k2.
- Proof. revert k. induction l1; simpl; inversion 1; naive_solver. Qed.
+ Proof.
+ split; [|intros (?&?&?&?&->); by apply Forall2_app].
+ revert k. induction l1; inversion 1; naive_solver.
+ Qed.
Lemma Forall2_app_inv_r l k1 k2 :
- Forall2 P l (k1 ++ k2) →
+ Forall2 P l (k1 ++ k2) ↔
∃ l1 l2, Forall2 P l1 k1 ∧ Forall2 P l2 k2 ∧ l = l1 ++ l2.
- Proof. revert l. induction k1; simpl; inversion 1; naive_solver. Qed.
-
- Lemma Forall2_length l1 l2 : Forall2 P l1 l2 → length l1 = length l2.
- Proof. induction 1; simpl; auto. Qed.
- Lemma Forall2_length_l l1 l2 n :
- Forall2 P l1 l2 → length l1 = n → length l2 = n.
- Proof. intros ? <-; symmetry. by apply Forall2_length. Qed.
- Lemma Forall2_length_r l1 l2 n :
- Forall2 P l1 l2 → length l2 = n → length l1 = n.
- Proof. intros ? <-. by apply Forall2_length. Qed.
- Lemma Forall2_same_length l1 l2 : Forall2 P l1 l2 → l1 `same_length` l2.
- Proof. induction 1; constructor; auto. Qed.
-
- Lemma Forall2_flip l1 l2 : Forall2 P l1 l2 ↔ Forall2 (flip P) l2 l1.
+ Proof.
+ split; [|intros (?&?&?&?&->); by apply Forall2_app].
+ revert l. induction k1; inversion 1; naive_solver.
+ Qed.
+ Lemma Forall2_flip l k : Forall2 (flip P) k l ↔ Forall2 P l k.
Proof. split; induction 1; constructor; auto. Qed.
- Lemma Forall2_impl (Q : A → B → Prop) l1 l2 :
- Forall2 P l1 l2 → (∀ x y, P x y → Q x y) → Forall2 Q l1 l2.
+ Lemma Forall2_impl (Q : A → B → Prop) l k :
+ Forall2 P l k → (∀ x y, P x y → Q x y) → Forall2 Q l k.
Proof. intros H ?. induction H; auto. Defined.
Lemma Forall2_unique l k1 k2 :
Forall2 P l k1 → Forall2 P l k2 →
@@ -2213,180 +2098,166 @@ Section Forall2.
Proof.
intros H. revert k2. induction H; inversion_clear 1; intros; f_equal; eauto.
Qed.
-
Lemma Forall2_Forall_l (Q : A → Prop) l k :
Forall2 P l k → Forall (λ y, ∀ x, P x y → Q x) k → Forall Q l.
Proof. induction 1; inversion_clear 1; eauto. Qed.
Lemma Forall2_Forall_r (Q : B → Prop) l k :
Forall2 P l k → Forall (λ x, ∀ y, P x y → Q y) l → Forall Q k.
Proof. induction 1; inversion_clear 1; eauto. Qed.
-
- Lemma Forall2_lookup_lr l1 l2 i x y :
- Forall2 P l1 l2 → l1 !! i = Some x → l2 !! i = Some y → P x y.
- Proof.
- intros H. revert i. induction H; [done|].
- intros [|?] ??; simplify_equality'; eauto.
- Qed.
- Lemma Forall2_lookup_l l1 l2 i x :
- Forall2 P l1 l2 → l1 !! i = Some x → ∃ y, l2 !! i = Some y ∧ P x y.
- Proof.
- intros H. revert i. induction H; [done|].
- intros [|?] ?; simplify_equality'; eauto.
- Qed.
- Lemma Forall2_lookup_r l1 l2 i y :
- Forall2 P l1 l2 → l2 !! i = Some y → ∃ x, l1 !! i = Some x ∧ P x y.
- Proof.
- intros H. revert i. induction H; [done|].
- intros [|?] ?; simplify_equality'; eauto.
- Qed.
- Lemma Forall2_lookup_2 l1 l2 :
- l1 `same_length` l2 →
- (∀ i x y, l1 !! i = Some x → l2 !! i = Some y → P x y) → Forall2 P l1 l2.
- Proof.
- eauto using Forall2_same_length, Forall2_lookup_lr.
- intros Hl Hlookup. induction Hl as [|????? IH]; constructor.
- * by apply (Hlookup 0).
- * apply IH. intros i. apply (Hlookup (S i)).
- Qed.
- Lemma Forall2_lookup l1 l2 :
- Forall2 P l1 l2 ↔ l1 `same_length` l2 ∧
- (∀ i x y, l1 !! i = Some x → l2 !! i = Some y → P x y).
- Proof.
- split.
- * eauto using Forall2_same_length, Forall2_lookup_lr.
- * intros [??]; eauto using Forall2_lookup_2.
- Qed.
- Lemma Forall2_alter_l f l1 l2 i :
- Forall2 P l1 l2 → (∀ x1 x2,
- l1 !! i = Some x1 → l2 !! i = Some x2 → P x1 x2 → P (f x1) x2) →
- Forall2 P (alter f i l1) l2.
- Proof.
- intros Hl. revert i. induction Hl; simpl; intros [|i]; constructor; auto.
- Qed.
- Lemma Forall2_alter_r f l1 l2 i :
- Forall2 P l1 l2 → (∀ x1 x2,
- l1 !! i = Some x1 → l2 !! i = Some x2 → P x1 x2 → P x1 (f x2)) →
- Forall2 P l1 (alter f i l2).
- Proof.
- intros Hl. revert i. induction Hl; simpl; intros [|i]; constructor; auto.
- Qed.
- Lemma Forall2_alter f g l1 l2 i :
- Forall2 P l1 l2 → (∀ x1 x2,
- l1 !! i = Some x1 → l2 !! i = Some x2 → P x1 x2 → P (f x1) (g x2)) →
- Forall2 P (alter f i l1) (alter g i l2).
- Proof.
- intros Hl. revert i. induction Hl; simpl; intros [|i]; constructor; auto.
- Qed.
- Lemma Forall2_delete l1 l2 i :
- Forall2 P l1 l2 → Forall2 P (delete i l1) (delete i l2).
- Proof.
- intros Hl12. revert i. induction Hl12; intros [|i]; simpl; intuition.
- Qed.
- Lemma Forall2_replicate_l l n x :
- Forall (P x) l → length l = n → Forall2 P (replicate n x) l.
- Proof.
- intros Hl. revert n.
- induction Hl; intros [|?] ?; simplify_equality; constructor; auto.
- Qed.
- Lemma Forall2_replicate_r l n x :
- Forall (flip P x) l → length l = n → Forall2 P l (replicate n x).
- Proof.
- intros Hl. revert n.
- induction Hl; intros [|?] ?; simplify_equality; constructor; auto.
- Qed.
- Lemma Forall2_replicate n x1 x2 :
- P x1 x2 → Forall2 P (replicate n x1) (replicate n x2).
+ Lemma Forall2_lookup_lr l k i x y :
+ Forall2 P l k → l !! i = Some x → k !! i = Some y → P x y.
+ Proof.
+ intros H. revert i. induction H; intros [|?] ??; simplify_equality'; eauto.
+ Qed.
+ Lemma Forall2_lookup_l l k i x :
+ Forall2 P l k → l !! i = Some x → ∃ y, k !! i = Some y ∧ P x y.
+ Proof.
+ intros H. revert i. induction H; intros [|?] ?; simplify_equality'; eauto.
+ Qed.
+ Lemma Forall2_lookup_r l k i y :
+ Forall2 P l k → k !! i = Some y → ∃ x, l !! i = Some x ∧ P x y.
+ Proof.
+ intros H. revert i. induction H; intros [|?] ?; simplify_equality'; eauto.
+ Qed.
+ Lemma Forall2_lookup_2 l k :
+ length l = length k →
+ (∀ i x y, l !! i = Some x → k !! i = Some y → P x y) → Forall2 P l k.
+ Proof.
+ rewrite <-Forall2_same_length. intros Hl Hlookup.
+ induction Hl as [|?????? IH]; constructor; [by apply (Hlookup 0)|].
+ apply IH. apply (λ i, Hlookup (S i)).
+ Qed.
+ Lemma Forall2_lookup l k :
+ Forall2 P l k ↔ length l = length k ∧
+ (∀ i x y, l !! i = Some x → k !! i = Some y → P x y).
+ Proof.
+ naive_solver eauto using Forall2_length, Forall2_lookup_lr,Forall2_lookup_2.
+ Qed.
+ Lemma Forall2_alter_l f l k i :
+ Forall2 P l k →
+ (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P (f x) y) →
+ Forall2 P (alter f i l) k.
+ Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+ Lemma Forall2_alter_r f l k i :
+ Forall2 P l k →
+ (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P x (f y)) →
+ Forall2 P l (alter f i k).
+ Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+ Lemma Forall2_alter f g l k i :
+ Forall2 P l k →
+ (∀ x y, l !! i = Some x → k !! i = Some y → P x y → P (f x) (g y)) →
+ Forall2 P (alter f i l) (alter g i k).
+ Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+ Lemma Forall2_insert l k x y i :
+ Forall2 P l k → P x y → Forall2 P (<[i:=x]> l) (<[i:=y]> k).
+ Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+ Lemma Forall2_delete l k i :
+ Forall2 P l k → Forall2 P (delete i l) (delete i k).
+ Proof. intros Hl. revert i. induction Hl; intros [|]; simpl; intuition. Qed.
+ Lemma Forall2_replicate_l k n x :
+ length k = n → Forall (P x) k → Forall2 P (replicate n x) k.
+ Proof. intros <-. induction 1; simpl; auto. Qed.
+ Lemma Forall2_replicate_r l n y :
+ length l = n → Forall (flip P y) l → Forall2 P l (replicate n y).
+ Proof. intros <-. induction 1; simpl; auto. Qed.
+ Lemma Forall2_replicate n x y :
+ P x y → Forall2 P (replicate n x) (replicate n y).
Proof. induction n; simpl; constructor; auto. Qed.
- Lemma Forall2_take l1 l2 n :
- Forall2 P l1 l2 → Forall2 P (take n l1) (take n l2).
- Proof. intros Hl1l2. revert n. induction Hl1l2; intros [|?]; simpl; auto. Qed.
- Lemma Forall2_drop l1 l2 n :
- Forall2 P l1 l2 → Forall2 P (drop n l1) (drop n l2).
- Proof. intros Hl1l2. revert n. induction Hl1l2; intros [|?]; simpl; auto. Qed.
- Lemma Forall2_resize l1 l2 x1 x2 n :
- P x1 x2 → Forall2 P l1 l2 → Forall2 P (resize n x1 l1) (resize n x2 l2).
- Proof.
- intros. rewrite !resize_spec, (Forall2_length l1 l2) by done.
+ Lemma Forall2_take l k n : Forall2 P l k → Forall2 P (take n l) (take n k).
+ Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+ Lemma Forall2_drop l k n : Forall2 P l k → Forall2 P (drop n l) (drop n k).
+ Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+ Lemma Forall2_resize l k x y n :
+ P x y → Forall2 P l k → Forall2 P (resize n x l) (resize n y k).
+ Proof.
+ intros. rewrite !resize_spec, (Forall2_length l k) by done.
auto using Forall2_app, Forall2_take, Forall2_replicate.
Qed.
-
- Lemma Forall2_resize_ge_l l1 l2 x1 x2 n m :
- P x1 x2 → Forall (flip P x2) l1 → n ≤ m →
- Forall2 P (resize n x1 l1) l2 → Forall2 P (resize m x1 l1) (resize m x2 l2).
+ Lemma Forall2_resize_ge_l l k x y n m :
+ P x y → Forall (flip P y) l → n ≤ m →
+ Forall2 P (resize n x l) k → Forall2 P (resize m x l) (resize m y k).
Proof.
- intros. assert (n = length l2).
- { by rewrite <-(Forall2_length (resize n x1 l1) l2), resize_length. }
- rewrite (le_plus_minus n m) by done. subst.
- rewrite !resize_plus, resize_all, drop_all, resize_nil.
- apply Forall2_app; [done |].
- apply Forall2_replicate_r; [| by rewrite resize_length].
- eauto using Forall_resize, Forall_drop.
+ intros. assert (n = length k) as ->.
+ { by rewrite <-(Forall2_length (resize n x l) k), resize_length. }
+ rewrite (le_plus_minus (length k) m), !resize_plus, resize_all,
+ drop_all, resize_nil by done; auto using Forall2_app, Forall2_replicate_r,
+ Forall_resize, Forall_drop, resize_length.
Qed.
- Lemma Forall2_resize_ge_r l1 l2 x1 x2 n m :
- P x1 x2 → Forall (P x1) l2 → n ≤ m →
- Forall2 P l1 (resize n x2 l2) → Forall2 P (resize m x1 l1) (resize m x2 l2).
+ Lemma Forall2_resize_ge_r l k x y n m :
+ P x y → Forall (P x) k → n ≤ m →
+ Forall2 P l (resize n y k) → Forall2 P (resize m x l) (resize m y k).
Proof.
- intros. assert (n = length l1).
- { by rewrite (Forall2_length l1 (resize n x2 l2)), resize_length. }
- rewrite (le_plus_minus n m) by done. subst.
- rewrite !resize_plus, resize_all, drop_all, resize_nil.
- apply Forall2_app; [done |].
- apply Forall2_replicate_l; [| by rewrite resize_length].
- eauto using Forall_resize, Forall_drop.
+ intros. assert (n = length l) as ->.
+ { by rewrite (Forall2_length l (resize n y k)), resize_length. }
+ rewrite (le_plus_minus (length l) m), !resize_plus, resize_all,
+ drop_all, resize_nil by done; auto using Forall2_app, Forall2_replicate_l,
+ Forall_resize, Forall_drop, resize_length.
Qed.
-
- Lemma Forall2_sublist_lookup_l l1 l2 n i k1 :
- Forall2 P l1 l2 → sublist_lookup n i l1 = Some k1 →
- ∃ k2, sublist_lookup n i l2 = Some k2 ∧ Forall2 P k1 k2.
+ Lemma Forall2_sublist_lookup_l l k n i l' :
+ Forall2 P l k → sublist_lookup n i l = Some l' →
+ ∃ k', sublist_lookup n i k = Some k' ∧ Forall2 P l' k'.
Proof.
- unfold sublist_lookup. intros Hl12 Hl1.
- exists (take i (drop n l2)); simplify_option_equality.
+ unfold sublist_lookup. intros Hlk Hl.
+ exists (take i (drop n k)); simplify_option_equality.
* auto using Forall2_take, Forall2_drop.
- * apply Forall2_length in Hl12; lia.
+ * apply Forall2_length in Hlk; lia.
Qed.
- Lemma Forall2_sublist_lookup_r l1 l2 n i k2 :
- Forall2 P l1 l2 → sublist_lookup n i l2 = Some k2 →
- ∃ k1, sublist_lookup n i l1 = Some k1 ∧ Forall2 P k1 k2.
+ Lemma Forall2_sublist_lookup_r l k n i k' :
+ Forall2 P l k → sublist_lookup n i k = Some k' →
+ ∃ l', sublist_lookup n i l = Some l' ∧ Forall2 P l' k'.
Proof.
- unfold sublist_lookup. intros Hl12 Hl2.
- exists (take i (drop n l1)); simplify_option_equality.
+ unfold sublist_lookup. intros Hlk Hk.
+ exists (take i (drop n l)); simplify_option_equality.
* auto using Forall2_take, Forall2_drop.
- * apply Forall2_length in Hl12; lia.
+ * apply Forall2_length in Hlk; lia.
Qed.
- Lemma Forall2_sublist_insert l1 l2 i k1 k2 :
- Forall2 P l1 l2 → Forall2 P k1 k2 →
- Forall2 P (sublist_insert i k1 l1) (sublist_insert i k2 l2).
+ Lemma Forall2_sublist_alter f g l k i n :
+ i + n ≤ length l → Forall2 P l k →
+ (∀ l' k', sublist_lookup i n l = Some l' → sublist_lookup i n k = Some k' →
+ Forall2 P l' k' → Forall2 P (f l') (g k')) →
+ Forall2 P (sublist_alter f i n l) (sublist_alter g i n k).
Proof.
- unfold sublist_insert. intros. erewrite !Forall2_length by eauto.
- auto using Forall2_app, Forall2_take, Forall2_drop.
+ unfold sublist_alter. intros. assert (i + n ≤ length k).
+ { by erewrite <-Forall2_length by eauto. }
+ auto 8 using Forall2_app, Forall2_drop, Forall2_take, sublist_lookup_Some.
Qed.
-
- Lemma Forall2_transitive {C} (Q : B → C → Prop) (R : A → C → Prop) l1 l2 l3 :
- (∀ x1 x2 x3, P x1 x2 → Q x2 x3 → R x1 x3) →
- Forall2 P l1 l2 → Forall2 Q l2 l3 → Forall2 R l1 l3.
+(*
+ Lemma Forall2_mask x x' y y' βs l k :
+ P x y → P x' y' →
+ Forall2 P l k → Forall2 P (mask x x' βs l) (mask y y' βs k).
Proof.
- intros ? Hl1l2. revert l3. induction Hl1l2; inversion_clear 1; eauto.
+ intros ??. revert l k. induction βs as [|[]]; destruct 1; simpl; auto.
Qed.
+ Lemma Forall2_mask_resize x y βs l k n :
+ length βs = n → Forall (P x) k → P x y →
+ Forall2 P l k → Forall2 P (mask x x βs l) (resize n y k).
+ Proof.
+ intros <- Hk ? Hlk. revert l k Hlk Hk. induction βs as [|[]]; destruct 1;
+ inversion_clear 1; simpl; constructor; rewrite <-?resize_nil; eauto.
+ Qed.
+*)
+ Lemma Forall2_transitive {C} (Q : B → C → Prop) (R : A → C → Prop) l k lC :
+ (∀ x y z, P x y → Q y z → R x z) →
+ Forall2 P l k → Forall2 Q k lC → Forall2 R l lC.
+ Proof. intros ? Hl. revert lC. induction Hl; inversion_clear 1; eauto. Qed.
Lemma Forall2_Forall (Q : A → A → Prop) l :
Forall (λ x, Q x x) l → Forall2 Q l l.
Proof. induction 1; constructor; auto. Qed.
-
- Global Instance Forall2_dec `{∀ x1 x2, Decision (P x1 x2)} :
- ∀ l1 l2, Decision (Forall2 P l1 l2).
+ Global Instance Forall2_dec `{dec : ∀ x y, Decision (P x y)} :
+ ∀ l k, Decision (Forall2 P l k).
Proof.
refine (
- fix go l1 l2 : Decision (Forall2 P l1 l2) :=
- match l1, l2 with
+ fix go l k : Decision (Forall2 P l k) :=
+ match l, k with
| [], [] => left _
- | x1 :: l1, x2 :: l2 => cast_if_and (decide (P x1 x2)) (go l1 l2)
+ | x :: l, y :: k => cast_if_and (decide (P x y)) (go l k)
| _, _ => right _
- end); clear go; abstract first [by constructor | by inversion 1].
+ end); clear dec go; abstract first [by constructor | by inversion 1].
Defined.
End Forall2.
Section Forall2_order.
Context {A} (R : relation A).
-
Global Instance: Reflexive R → Reflexive (Forall2 R).
Proof. intros ? l. induction l; by constructor. Qed.
Global Instance: Symmetric R → Symmetric (Forall2 R).
@@ -2399,7 +2270,6 @@ Section Forall2_order.
Proof. split; apply _. Qed.
Global Instance: AntiSymmetric (=) R → AntiSymmetric (=) (Forall2 R).
Proof. induction 2; inversion_clear 1; f_equal; auto. Qed.
-
Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (::).
Proof. by constructor. Qed.
Global Instance: Proper (Forall2 R ==> Forall2 R ==> Forall2 R) (++).
@@ -2414,32 +2284,67 @@ Section Forall2_order.
Proof. repeat intro. eauto using Forall2_drop. Qed.
Global Instance: Proper (R ==> Forall2 R ==> Forall2 R) (resize n).
Proof. repeat intro. eauto using Forall2_resize. Qed.
- Global Instance: Proper ((=) ==> R ==> Forall2 R ==> Forall2 R) insert.
- Proof. repeat intro. subst. apply Forall2_alter; auto. Qed.
End Forall2_order.
+Section Forall3.
+ Context {A B C} (P : A → B → C → Prop).
+ Lemma Forall3_impl (Q : A → B → C → Prop) l l' k :
+ Forall3 P l l' k → (∀ x y z, P x y z → Q x y z) → Forall3 Q l l' k.
+ Proof. intros Hl ?. induction Hl; constructor; auto. Defined.
+ Lemma Forall3_length_lm l l' k : Forall3 P l l' k → length l = length l'.
+ Proof. by induction 1; f_equal'. Qed.
+ Lemma Forall3_lookup_lmr l l' k i x y z :
+ Forall3 P l l' k →
+ l !! i = Some x → l' !! i = Some y → k !! i = Some z → P x y z.
+ Proof.
+ intros H. revert i. induction H; intros [|?] ???; simplify_equality'; eauto.
+ Qed.
+ Lemma Forall3_lookup_l l l' k i x :
+ Forall3 P l l' k → l !! i = Some x →
+ ∃ y z, l' !! i = Some y ∧ k !! i = Some z ∧ P x y z.
+ Proof.
+ intros H. revert i. induction H; intros [|?] ?; simplify_equality'; eauto.
+ Qed.
+ Lemma Forall3_lookup_m l l' k i y :
+ Forall3 P l l' k → l' !! i = Some y →
+ ∃ x z, l !! i = Some x ∧ k !! i = Some z ∧ P x y z.
+ Proof.
+ intros H. revert i. induction H; intros [|?] ?; simplify_equality'; eauto.
+ Qed.
+ Lemma Forall3_lookup_r l l' k i z :
+ Forall3 P l l' k → k !! i = Some z →
+ ∃ x y, l !! i = Some x ∧ l' !! i = Some y ∧ P x y z.
+ Proof.
+ intros H. revert i. induction H; intros [|?] ?; simplify_equality'; eauto.
+ Qed.
+ Lemma Forall3_alter_lm f g l l' k i :
+ Forall3 P l l' k →
+ (∀ x y z, l !! i = Some x → l' !! i = Some y → k !! i = Some z →
+ P x y z → P (f x) (g y) z) →
+ Forall3 P (alter f i l) (alter g i l') k.
+ Proof. intros Hl. revert i. induction Hl; intros [|]; constructor; auto. Qed.
+End Forall3.
+
(** * Properties of the monadic operations *)
Section fmap.
Context {A B : Type} (f : A → B).
Lemma list_fmap_id (l : list A) : id <$> l = l.
- Proof. induction l; simpl; f_equal; auto. Qed.
+ Proof. induction l; f_equal'; auto. Qed.
Lemma list_fmap_compose {C} (g : B → C) l : g ∘ f <$> l = g <$> f <$> l.
- Proof. induction l; simpl; f_equal; auto. Qed.
-
+ Proof. induction l; f_equal'; auto. Qed.
Lemma list_fmap_ext (g : A → B) (l1 l2 : list A) :
(∀ x, f x = g x) → l1 = l2 → fmap f l1 = fmap g l2.
- Proof. intros ? <-. induction l1; simpl; f_equal; auto. Qed.
-
+ Proof. intros ? <-. induction l1; f_equal'; auto. Qed.
Global Instance: Injective (=) (=) f → Injective (=) (=) (fmap f).
Proof.
- intros ? l1. induction l1 as [|x l1 IH].
- * by intros [|??].
- * intros [|??]; simpl; intros; f_equal; simplify_equality; auto.
+ intros ? l1. induction l1 as [|x l1 IH]; [by intros [|??]|].
+ intros [|??]; intros; f_equal'; simplify_equality; auto.
Qed.
+ Definition fmap_nil : f <$> [] = [] := eq_refl.
+ Definition fmap_cons x l : f <$> x :: l = f x :: f <$> l := eq_refl.
Lemma fmap_app l1 l2 : f <$> l1 ++ l2 = (f <$> l1) ++ (f <$> l2).
- Proof. induction l1; simpl; by f_equal. Qed.
-
+ Proof. by induction l1; f_equal'. Qed.
Lemma fmap_nil_inv k : f <$> k = [] → k = [].
Proof. by destruct k. Qed.
Lemma fmap_cons_inv y l k :
@@ -2448,22 +2353,31 @@ Section fmap.
Lemma fmap_app_inv l k1 k2 :
f <$> l = k1 ++ k2 → ∃ l1 l2, k1 = f <$> l1 ∧ k2 = f <$> l2 ∧ l = l1 ++ l2.
Proof.
- revert l. induction k1 as [|y k1 IH]; simpl.
- * intros l ?. by eexists [], l.
- * intros [|x l] ?; simplify_equality'.
- destruct (IH l) as [l1 [l2 [? [??]]]]; subst; [done |].
- by exists (x :: l1) l2.
+ revert l. induction k1 as [|y k1 IH]; simpl; [intros l ?; by eexists [],l|].
+ intros [|x l] ?; simplify_equality'.
+ destruct (IH l) as (l1&l2&->&->&->); [done|]. by exists (x :: l1) l2.
Qed.
-
Lemma fmap_length l : length (f <$> l) = length l.
- Proof. induction l; simpl; by f_equal. Qed.
+ Proof. by induction l; f_equal'. Qed.
Lemma fmap_reverse l : f <$> reverse l = reverse (f <$> l).
Proof.
- induction l; simpl; [done |]. by rewrite !reverse_cons, fmap_app, IHl.
+ induction l as [|?? IH]; simpl; by rewrite ?reverse_cons, ?fmap_app, ?IH.
Qed.
+ Lemma fmap_last l : last (f <$> l) = f <$> last l.
+ Proof. induction l as [|? []]; simpl; auto. Qed.
Lemma fmap_replicate n x : f <$> replicate n x = replicate n (f x).
- Proof. induction n; simpl; f_equal; auto. Qed.
-
+ Proof. by induction n; f_equal'. Qed.
+ Lemma fmap_take n l : f <$> take n l = take n (f <$> l).
+ Proof. revert n. by induction l; intros [|?]; f_equal'. Qed.
+ Lemma fmap_drop n l : f <$> drop n l = drop n (f <$> l).
+ Proof. revert n. by induction l; intros [|?]; f_equal'. Qed.
+ Lemma fmap_resize n x l : f <$> resize n x l = resize n (f x) (f <$> l).
+ Proof.
+ revert n. induction l; intros [|?]; f_equal'; auto using fmap_replicate.
+ Qed.
+ Lemma replicate_const_fmap (x : A) (l : list A) :
+ const x <$> l = replicate (length l) x.
+ Proof. by induction l; f_equal'. Qed.
Lemma list_lookup_fmap l i : (f <$> l) !! i = f <$> (l !! i).
Proof. revert i. induction l; by intros [|]. Qed.
Lemma list_lookup_fmap_inv l i x :
@@ -2472,12 +2386,9 @@ Section fmap.
intros Hi. rewrite list_lookup_fmap in Hi.
destruct (l !! i) eqn:?; simplify_equality; eauto.
Qed.
-
Lemma list_alter_fmap (g : A → A) (h : B → B) l i :
Forall (λ x, f (g x) = h (f x)) l → f <$> alter g i l = alter h i (f <$> l).
- Proof.
- intros Hl. revert i. induction Hl; intros [|i]; simpl; f_equal; auto.
- Qed.
+ Proof. intros Hl. revert i. by induction Hl; intros [|i]; f_equal'. Qed.
Lemma elem_of_list_fmap_1 l x : x ∈ l → f x ∈ f <$> l.
Proof. induction 1; simpl; rewrite elem_of_cons; intuition. Qed.
Lemma elem_of_list_fmap_1_alt l x y : x ∈ l → y = f x → y ∈ f <$> l.
@@ -2485,14 +2396,13 @@ Section fmap.
Lemma elem_of_list_fmap_2 l x : x ∈ f <$> l → ∃ y, x = f y ∧ y ∈ l.
Proof.
induction l as [|y l IH]; simpl; inversion_clear 1.
- + exists y. split; [done | by left].
- + destruct IH as [z [??]]. done. exists z. split; [done | by right].
+ * exists y. split; [done | by left].
+ * destruct IH as [z [??]]. done. exists z. split; [done | by right].
Qed.
Lemma elem_of_list_fmap l x : x ∈ f <$> l ↔ ∃ y, x = f y ∧ y ∈ l.
Proof.
- firstorder eauto using elem_of_list_fmap_1_alt, elem_of_list_fmap_2.
+ naive_solver eauto using elem_of_list_fmap_1_alt, elem_of_list_fmap_2.
Qed.
-
Lemma fmap_nodup_1 l : NoDup (f <$> l) → NoDup l.
Proof.
induction l; simpl; inversion_clear 1; constructor; auto.
@@ -2505,24 +2415,25 @@ Section fmap.
Qed.
Lemma fmap_nodup `{!Injective (=) (=) f} l : NoDup (f <$> l) ↔ NoDup l.
Proof. split; auto using fmap_nodup_1, fmap_nodup_2. Qed.
-
Global Instance fmap_sublist: Proper (sublist ==> sublist) (fmap f).
Proof. induction 1; simpl; econstructor; eauto. Qed.
Global Instance fmap_contains: Proper (contains ==> contains) (fmap f).
Proof. induction 1; simpl; econstructor; eauto. Qed.
Global Instance fmap_Permutation: Proper ((≡ₚ) ==> (≡ₚ)) (fmap f).
Proof. induction 1; simpl; econstructor; eauto. Qed.
-
+ Lemma Forall_fmap_ext_1 (g : A → B) (l : list A) :
+ Forall (λ x, f x = g x) l → fmap f l = fmap g l.
+ Proof. by induction 1; f_equal'. Qed.
Lemma Forall_fmap_ext (g : A → B) (l : list A) :
Forall (λ x, f x = g x) l ↔ fmap f l = fmap g l.
Proof.
- split.
- * induction 1; simpl; f_equal; auto.
- * induction l; simpl; constructor; simplify_equality; auto.
+ split; [auto using Forall_fmap_ext_1|].
+ induction l; simpl; constructor; simplify_equality; auto.
Qed.
Lemma Forall_fmap (P : B → Prop) l : Forall P (f <$> l) ↔ Forall (P ∘ f) l.
Proof. split; induction l; inversion_clear 1; constructor; auto. Qed.
-
+ Lemma Exists_fmap (P : B → Prop) l : Exists P (f <$> l) ↔ Exists (P ∘ f) l.
+ Proof. split; induction l; inversion 1; constructor (by auto). Qed.
Lemma Forall2_fmap_l {C} (P : B → C → Prop) l1 l2 :
Forall2 P (f <$> l1) l2 ↔ Forall2 (P ∘ f) l1 l2.
Proof.
@@ -2542,11 +2453,13 @@ Section fmap.
Lemma Forall2_fmap {C D} (g : C → D) (P : B → D → Prop) l1 l2 :
Forall2 P (f <$> l1) (g <$> l2) ↔ Forall2 (λ x1 x2, P (f x1) (g x2)) l1 l2.
Proof. split; auto using Forall2_fmap_1, Forall2_fmap_2. Qed.
-
Lemma list_fmap_bind {C} (g : B → list C) l : (f <$> l) ≫= g = l ≫= g ∘ f.
- Proof. induction l; simpl; f_equal; auto. Qed.
+ Proof. by induction l; f_equal'. Qed.
End fmap.
+Lemma list_alter_fmap_mono {A} (f : A → A) (g : A → A) l i :
+ Forall (λ x, f (g x) = g (f x)) l → f <$> alter g i l = alter g i (f <$> l).
+Proof. auto using list_alter_fmap. Qed.
Lemma NoDup_fmap_fst {A B} (l : list (A * B)) :
(∀ x y1 y2, (x,y1) ∈ l → (x,y2) ∈ l → y1 = y2) → NoDup l → NoDup (fst <$> l).
Proof.
@@ -2562,17 +2475,14 @@ Section bind.
Lemma list_bind_ext (g : A → list B) l1 l2 :
(∀ x, f x = g x) → l1 = l2 → l1 ≫= f = l2 ≫= g.
- Proof. intros ? <-. induction l1; simpl; f_equal; auto. Qed.
+ Proof. intros ? <-. by induction l1; f_equal'. Qed.
Lemma Forall_bind_ext (g : A → list B) (l : list A) :
Forall (λ x, f x = g x) l → l ≫= f = l ≫= g.
- Proof. induction 1; simpl; f_equal; auto. Qed.
-
+ Proof. by induction 1; f_equal'. Qed.
Global Instance bind_sublist: Proper (sublist ==> sublist) (mbind f).
Proof.
- induction 1; simpl; auto.
- * done.
- * by apply sublist_app.
- * by apply sublist_inserts_l.
+ induction 1; simpl; auto;
+ [done|by apply sublist_app|by apply sublist_inserts_l].
Qed.
Global Instance bind_contains: Proper (contains ==> contains) (mbind f).
Proof.
@@ -2590,11 +2500,12 @@ Section bind.
* by rewrite !(associative_L (++)), (commutative (++) (f _)).
* etransitivity; eauto.
Qed.
-
- Lemma bind_app (l1 l2 : list A) : (l1 ++ l2) ≫= f = (l1 ≫= f) ++ (l2 ≫= f).
- Proof.
- induction l1; simpl; [done|]. by rewrite <-(associative_L (++)), IHl1.
- Qed.
+ Lemma bind_cons x l : (x :: l) ≫= f = f x ++ l ≫= f.
+ Proof. done. Qed.
+ Lemma bind_singleton x : [x] ≫= f = f x.
+ Proof. simpl. by rewrite (right_id_L _ (++)). Qed.
+ Lemma bind_app l1 l2 : (l1 ++ l2) ≫= f = (l1 ≫= f) ++ (l2 ≫= f).
+ Proof. by induction l1; simpl; rewrite <-?(associative_L (++)); f_equal. Qed.
Lemma elem_of_list_bind (x : B) (l : list A) :
x ∈ l ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ l.
Proof.
@@ -2605,7 +2516,6 @@ Section bind.
+ destruct IH as [z [??]]. done. exists z. split; [done | by right].
* intros [y [Hx Hy]]. induction Hy; simpl; rewrite elem_of_app; intuition.
Qed.
-
Lemma Forall2_bind {C D} (g : C → list D) (P : B → D → Prop) l1 l2 :
Forall2 (λ x1 x2, Forall2 P (f x1) (g x2)) l1 l2 →
Forall2 P (l1 ≫= f) (l2 ≫= g).
@@ -2616,73 +2526,33 @@ Section ret_join.
Context {A : Type}.
Lemma list_join_bind (ls : list (list A)) : mjoin ls = ls ≫= id.
- Proof. induction ls; simpl; f_equal; auto. Qed.
-
+ Proof. by induction ls; f_equal'. Qed.
Global Instance mjoin_Permutation:
Proper (@Permutation (list A) ==> (≡ₚ)) mjoin.
Proof. intros ?? E. by rewrite !list_join_bind, E. Qed.
-
Lemma elem_of_list_ret (x y : A) : x ∈ @mret list _ A y ↔ x = y.
Proof. apply elem_of_list_singleton. Qed.
Lemma elem_of_list_join (x : A) (ls : list (list A)) :
x ∈ mjoin ls ↔ ∃ l, x ∈ l ∧ l ∈ ls.
Proof. by rewrite list_join_bind, elem_of_list_bind. Qed.
-
Lemma join_nil (ls : list (list A)) : mjoin ls = [] ↔ Forall (= []) ls.
Proof.
- split.
- * by induction ls as [|[|??] ?]; constructor; auto.
- * by induction 1 as [|[|??] ?].
+ split; [|by induction 1 as [|[|??] ?]].
+ by induction ls as [|[|??] ?]; constructor; auto.
Qed.
Lemma join_nil_1 (ls : list (list A)) : mjoin ls = [] → Forall (= []) ls.
Proof. by rewrite join_nil. Qed.
Lemma join_nil_2 (ls : list (list A)) : Forall (= []) ls → mjoin ls = [].
Proof. by rewrite join_nil. Qed.
-
Lemma join_length (ls : list (list A)) :
length (mjoin ls) = foldr (plus ∘ length) 0 ls.
Proof. by induction ls; simpl; rewrite ?app_length; f_equal. Qed.
Lemma join_length_same (ls : list (list A)) n :
Forall (λ l, length l = n) ls → length (mjoin ls) = length ls * n.
- Proof. rewrite join_length. by induction 1; simpl; f_equal. Qed.
-
+ Proof. rewrite join_length. by induction 1; f_equal'. Qed.
Lemma Forall_join (P : A → Prop) (ls: list (list A)) :
Forall (Forall P) ls → Forall P (mjoin ls).
Proof. induction 1; simpl; auto using Forall_app_2. Qed.
-
- Lemma lookup_join_same_length (ls : list (list A)) n i :
- n ≠0 → Forall (λ l, length l = n) ls →
- mjoin ls !! i = ls !! (i `div` n) ≫= (!! (i `mod` n)).
- Proof.
- intros Hn Hls. revert i. induction Hls as [|l ls ? Hls IH]; simpl; [done |].
- intros i. destruct (decide (i < n)) as [Hin|Hin].
- * rewrite <-(Nat.div_unique i n 0 i), <-(Nat.mod_unique i n 0 i) by lia.
- simpl. rewrite lookup_app_l; auto with lia.
- * replace i with ((i - n) + 1 * n) by lia.
- rewrite Nat.div_add, Nat.mod_add by done.
- replace (i - n + 1 * n) with (length l + (i - n)) by lia.
- by rewrite (Nat.add_comm _ 1), lookup_app_r, IH.
- Qed.
-
- (* This should be provable using the previous lemma in a shorter way *)
- Lemma alter_join_same_length f (ls : list (list A)) n i :
- n ≠0 → Forall (λ l, length l = n) ls →
- alter f i (mjoin ls) = mjoin (alter (alter f (i `mod` n)) (i `div` n) ls).
- Proof.
- intros Hn Hls. revert i. induction Hls as [|l ls ? Hls IH]; simpl; [done |].
- intros i. destruct (decide (i < n)) as [Hin|Hin].
- * rewrite <-(Nat.div_unique i n 0 i), <-(Nat.mod_unique i n 0 i) by lia.
- simpl. rewrite alter_app_l; auto with lia.
- * replace i with ((i - n) + 1 * n) by lia.
- rewrite Nat.div_add, Nat.mod_add by done.
- replace (i - n + 1 * n) with i by lia.
- rewrite (Nat.add_comm _ 1), alter_app_r_alt, IH by lia. by subst.
- Qed.
- Lemma insert_join_same_length (ls : list (list A)) n i x :
- n ≠0 → Forall (λ l, length l = n) ls →
- <[i:=x]>(mjoin ls) = mjoin (alter <[i `mod` n:=x]> (i `div` n) ls).
- Proof. apply alter_join_same_length. Qed.
-
Lemma Forall2_join {B} (P : A → B → Prop) ls1 ls2 :
Forall2 (Forall2 P) ls1 ls2 → Forall2 P (mjoin ls1) (mjoin ls2).
Proof. induction 1; simpl; auto using Forall2_app. Qed.
@@ -2699,7 +2569,6 @@ Section mapM.
Lemma Forall_mapM_ext (g : A → option B) l :
Forall (λ x, f x = g x) l → mapM f l = mapM g l.
Proof. induction 1 as [|?? Hfg ? IH]; simpl. done. by rewrite Hfg, IH. Qed.
-
Lemma mapM_Some_1 l k : mapM f l = Some k → Forall2 (λ x y, f x = Some y) l k.
Proof.
revert k. induction l as [|x l]; intros [|y k]; simpl; try done.
@@ -2716,7 +2585,6 @@ Section mapM.
Proof. split; auto using mapM_Some_1, mapM_Some_2. Qed.
Lemma mapM_length l k : mapM f l = Some k → length l = length k.
Proof. intros. by eapply Forall2_length, mapM_Some_1. Qed.
-
Lemma mapM_None_1 l : mapM f l = None → Exists (λ x, f x = None) l.
Proof.
induction l as [|x l IH]; simpl; [done|].
@@ -2729,7 +2597,6 @@ Section mapM.
Qed.
Lemma mapM_None l : mapM f l = None ↔ Exists (λ x, f x = None) l.
Proof. split; auto using mapM_None_1, mapM_None_2. Qed.
-
Lemma mapM_is_Some_1 l : is_Some (mapM f l) → Forall (is_Some ∘ f) l.
Proof.
unfold compose. setoid_rewrite <-not_eq_None_Some.
@@ -2742,7 +2609,6 @@ Section mapM.
Qed.
Lemma mapM_is_Some l : is_Some (mapM f l) ↔ Forall (is_Some ∘ f) l.
Proof. split; auto using mapM_is_Some_1, mapM_is_Some_2. Qed.
-
Lemma mapM_fmap_Some (g : B → A) (l : list B) :
(∀ x, f (g x) = Some x) → mapM f (g <$> l) = Some l.
Proof. intros. by induction l; simpl; simplify_option_equality. Qed.
@@ -2765,23 +2631,18 @@ Section permutations.
Lemma interleave_Permutation x l l' : l' ∈ interleave x l → l' ≡ₚ x :: l.
Proof.
revert l'. induction l as [|y l IH]; intros l'; simpl.
- * rewrite elem_of_list_singleton. intros. by subst.
- * rewrite elem_of_cons, elem_of_list_fmap. intros [?|[? [? H]]]; subst.
- + by constructor.
- + rewrite (IH _ H). constructor.
+ * rewrite elem_of_list_singleton. by intros ->.
+ * rewrite elem_of_cons, elem_of_list_fmap. intros [->|[? [-> H]]]; [done|].
+ rewrite (IH _ H). constructor.
Qed.
-
Lemma permutations_refl l : l ∈ permutations l.
Proof.
- induction l; simpl.
- * by apply elem_of_list_singleton.
- * apply elem_of_list_bind. eauto using interleave_cons.
+ induction l; simpl; [by apply elem_of_list_singleton|].
+ apply elem_of_list_bind. eauto using interleave_cons.
Qed.
Lemma permutations_skip x l l' :
l ∈ permutations l' → x :: l ∈ permutations (x :: l').
- Proof.
- intros Hl. simpl. apply elem_of_list_bind. eauto using interleave_cons.
- Qed.
+ Proof. intro. apply elem_of_list_bind; eauto using interleave_cons. Qed.
Lemma permutations_swap x y l : y :: x :: l ∈ permutations (x :: y :: l).
Proof.
simpl. apply elem_of_list_bind. exists (y :: l). split; simpl.
@@ -2791,18 +2652,16 @@ Section permutations.
Qed.
Lemma permutations_nil l : l ∈ permutations [] ↔ l = [].
Proof. simpl. by rewrite elem_of_list_singleton. Qed.
-
Lemma interleave_interleave_toggle x1 x2 l1 l2 l3 :
l1 ∈ interleave x1 l2 → l2 ∈ interleave x2 l3 → ∃ l4,
l1 ∈ interleave x2 l4 ∧ l4 ∈ interleave x1 l3.
Proof.
revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl.
- { intros Hl1 Hl2.
- rewrite elem_of_list_singleton in Hl2. subst. simpl in Hl1.
- rewrite elem_of_cons, elem_of_list_singleton in Hl1. exists [x1]. simpl.
- rewrite elem_of_cons, !elem_of_list_singleton. tauto. }
+ { rewrite !elem_of_list_singleton. intros ? ->. exists [x1].
+ change (interleave x2 [x1]) with ([[x2; x1]] ++ [[x1; x2]]).
+ by rewrite (commutative (++)), elem_of_list_singleton. }
rewrite elem_of_cons, elem_of_list_fmap.
- intros Hl1 [? | [l2' [??]]]; subst; simpl in *.
+ intros Hl1 [? | [l2' [??]]]; simplify_equality'.
* rewrite !elem_of_cons, elem_of_list_fmap in Hl1.
destruct Hl1 as [? | [? | [l4 [??]]]]; subst.
+ exists (x1 :: y :: l3). simpl. rewrite !elem_of_cons. tauto.
@@ -2822,11 +2681,10 @@ Section permutations.
l1 ∈ interleave x l4 ∧ l4 ∈ permutations l3.
Proof.
revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl.
- { intros Hl1 Hl2. eexists []. simpl.
- split; [| by rewrite elem_of_list_singleton].
- rewrite elem_of_list_singleton in Hl2. by rewrite Hl2 in Hl1. }
+ { rewrite elem_of_list_singleton. intros Hl1 ->. eexists [].
+ by rewrite elem_of_list_singleton. }
rewrite elem_of_cons, elem_of_list_fmap.
- intros Hl1 [? | [l2' [? Hl2']]]; subst; simpl in *.
+ intros Hl1 [? | [l2' [? Hl2']]]; simplify_equality'.
* rewrite elem_of_list_bind in Hl1.
destruct Hl1 as [l1' [??]]. by exists l1'.
* rewrite elem_of_list_bind in Hl1. setoid_rewrite elem_of_list_bind.
@@ -2837,17 +2695,16 @@ Section permutations.
l1 ∈ permutations l2 → l2 ∈ permutations l3 → l1 ∈ permutations l3.
Proof.
revert l1 l2. induction l3 as [|x l3 IH]; intros l1 l2; simpl.
- * intros Hl1 Hl2. rewrite elem_of_list_singleton in Hl2.
- by rewrite Hl2 in Hl1.
+ * rewrite !elem_of_list_singleton. intros Hl1 ->; simpl in *.
+ by rewrite elem_of_list_singleton in Hl1.
* rewrite !elem_of_list_bind. intros Hl1 [l2' [Hl2 Hl2']].
destruct (permutations_interleave_toggle x l1 l2 l2') as [? [??]]; eauto.
Qed.
-
Lemma permutations_Permutation l l' : l' ∈ permutations l ↔ l ≡ₚ l'.
Proof.
split.
* revert l'. induction l; simpl; intros l''.
- + rewrite elem_of_list_singleton. intros. subst. constructor.
+ + rewrite elem_of_list_singleton. by intros ->.
+ rewrite elem_of_list_bind. intros [l' [Hl'' ?]].
rewrite (interleave_Permutation _ _ _ Hl''). constructor; auto.
* induction 1; eauto using permutations_refl,
@@ -2857,144 +2714,163 @@ End permutations.
(** ** Properties of the folding functions *)
Definition foldr_app := @fold_right_app.
-
Lemma foldl_app {A B} (f : A → B → A) (l k : list B) (a : A) :
foldl f a (l ++ k) = foldl f (foldl f a l) k.
Proof. revert a. induction l; simpl; auto. Qed.
-
Lemma foldr_permutation {A B} (R : relation B) `{!Equivalence R}
(f : A → B → B) (b : B) `{!Proper ((=) ==> R ==> R) f}
(Hf : ∀ a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) :
Proper ((≡ₚ) ==> R) (foldr f b).
-Proof.
- induction 1; simpl.
- * done.
- * by f_equiv.
- * apply Hf.
- * etransitivity; eauto.
-Qed.
-
-Lemma ifoldr_app {A B} (f : nat → B → A → A) (a : nat → A) (l1 l2 : list B) n :
- ifoldr f a n (l1 ++ l2) = ifoldr f (λ n, ifoldr f a n l2) n l1.
-Proof. revert n a. induction l1; intros; simpl; f_equal; auto. Qed.
+Proof. induction 1; simpl; [done|by f_equiv|apply Hf|etransitivity; eauto]. Qed.
(** ** Properties of the [zip_with] and [zip] functions *)
Section zip_with.
Context {A B C : Type} (f : A → B → C).
+ Implicit Types x : A.
+ Implicit Types y : B.
+ Implicit Types l : list A.
+ Implicit Types k : list B.
+ Lemma zip_with_nil_r l : zip_with f l [] = [].
+ Proof. by destruct l. Qed.
+ Lemma zip_with_app l1 l2 k1 k2 :
+ length l1 = length k1 →
+ zip_with f (l1 ++ l2) (k1 ++ k2) = zip_with f l1 k1 ++ zip_with f l2 k2.
+ Proof. rewrite <-Forall2_same_length. induction 1; f_equal'; auto. Qed.
+ Lemma zip_with_app_l l1 l2 k :
+ zip_with f (l1 ++ l2) k
+ = zip_with f l1 (take (length l1) k) ++ zip_with f l2 (drop (length l1) k).
+ Proof.
+ revert k. induction l1; intros [|??]; f_equal'; auto. by destruct l2.
+ Qed.
+ Lemma zip_with_app_r l k1 k2 :
+ zip_with f l (k1 ++ k2)
+ = zip_with f (take (length k1) l) k1 ++ zip_with f (drop (length k1) l) k2.
+ Proof. revert l. induction k1; intros [|??]; f_equal'; auto. Qed.
+ Lemma zip_with_flip l k : zip_with (flip f) k l = zip_with f l k.
+ Proof. revert k. induction l; intros [|??]; f_equal'; auto. Qed.
Lemma zip_with_ext (g : A → B → C) l1 l2 k1 k2 :
(∀ x y, f x y = g x y) → l1 = l2 → k1 = k2 →
zip_with f l1 k1 = zip_with g l2 k2.
- Proof.
- intros ? <- <-. revert k1. induction l1; intros [|??]; simpl; f_equal; auto.
- Qed.
+ Proof. intros ? <-<-. revert k1. by induction l1; intros [|??]; f_equal'. Qed.
Lemma Forall_zip_with_ext_l (g : A → B → C) l k1 k2 :
Forall (λ x, ∀ y, f x y = g x y) l → k1 = k2 →
zip_with f l k1 = zip_with g l k2.
- Proof.
- intros Hl <-. revert k1. induction Hl; intros [|??]; simpl; f_equal; auto.
- Qed.
+ Proof. intros Hl <-. revert k1. by induction Hl; intros [|??]; f_equal'. Qed.
Lemma Forall_zip_with_ext_r (g : A → B → C) l1 l2 k :
l1 = l2 → Forall (λ y, ∀ x, f x y = g x y) k →
zip_with f l1 k = zip_with g l2 k.
- Proof.
- intros <- Hk. revert l1. induction Hk; intros [|??]; simpl; f_equal; auto.
- Qed.
-
- Lemma zip_with_fmap_l {D} (g : D → A) l k :
- zip_with f (g <$> l) k = zip_with (λ x, f (g x)) l k.
- Proof. revert k. induction l; intros [|??]; simpl; f_equal; auto. Qed.
- Lemma zip_with_fmap_r {D} (g : D → B) l k :
- zip_with f l (g <$> k) = zip_with (λ x y, f x (g y)) l k.
- Proof. revert k. induction l; intros [|??]; simpl; f_equal; auto. Qed.
-
- Lemma zip_with_nil_inv l1 l2 :
- zip_with f l1 l2 = [] → l1 = [] ∨ l2 = [].
- Proof. destruct l1, l2; simpl; auto with congruence. Qed.
- Lemma zip_with_cons_inv y l1 l2 k :
- zip_with f l1 l2 = y :: k →
- ∃ x1 x2 l1' l2', y = f x1 x2 ∧ k = zip_with f l1' l2' ∧
- l1 = x1 :: l1' ∧ l2 = x2 :: l2'.
- Proof. intros. destruct l1, l2; simplify_equality'; repeat eexists. Qed.
- Lemma zip_with_app_inv l1 l2 k' k'' :
- zip_with f l1 l2 = k' ++ k'' →
- ∃ l1' l1'' l2' l2'', k' = zip_with f l1' l2' ∧ k'' = zip_with f l1'' l2'' ∧
- l1 = l1' ++ l1'' ∧ l2 = l2' ++ l2''.
- Proof.
- revert l1 l2. induction k' as [|y k' IH]; simpl.
- * intros l1 l2 ?. by eexists [], l1, [], l2.
- * intros [|x1 l1] [|x2 l2] ?; simplify_equality'.
- destruct (IH l1 l2) as (l1'&l1''&l2'&l2''&?&?&?&?); subst; [done |].
- by exists (x1 :: l1') l1'' (x2 :: l2') l2''.
- Qed.
-
- Lemma zip_with_inj l1 l2 k1 k2 :
- (∀ x1 x2 y1 y2, f x1 x2 = f y1 y2 → x1 = y1 ∧ x2 = y2) →
- l1 `same_length` l2 → k1 `same_length` k2 →
- zip_with f l1 l2 = zip_with f k1 k2 → l1 = k1 ∧ l2 = k2.
- Proof.
- intros ? Hl. revert k1 k2. induction Hl; intros ?? [] ?;
- simplify_equality'; f_equal; naive_solver.
- Qed.
-
- Lemma zip_with_length l1 l2 :
- length l1 ≤ length l2 → length (zip_with f l1 l2) = length l1.
- Proof. revert l2. induction l1; intros [|??]; simpl; auto with lia. Qed.
-
- Lemma zip_with_fmap_fst_le (g : C → A) l1 l2 :
- (∀ x y, g (f x y) = x) → length l1 ≤ length l2 →
- g <$> zip_with f l1 l2 = l1.
- Proof.
- revert l2.
- induction l1; intros [|??] ??; simpl in *; f_equal; auto with lia.
- Qed.
- Lemma zip_with_fmap_snd_le (g : C → B) l1 l2 :
- (∀ x y, g (f x y) = y) → length l2 ≤ length l1 →
- g <$> zip_with f l1 l2 = l2.
- Proof.
- revert l1.
- induction l2; intros [|??] ??; simpl in *; f_equal; auto with lia.
- Qed.
- Lemma zip_with_fmap_fst (g : C → A) l1 l2 :
- (∀ x y, g (f x y) = x) → l1 `same_length` l2 → g <$> zip_with f l1 l2 = l1.
- Proof. induction 2; simpl; f_equal; auto. Qed.
- Lemma zip_with_fmap_snd (g : C → B) l1 l2 :
- (∀ x y, g (f x y) = y) → l1 `same_length` l2 → g <$> zip_with f l1 l2 = l2.
- Proof. induction 2; simpl; f_equal; auto. Qed.
-
- Lemma Forall_zip_with_fst (P : A → Prop) (Q : C → Prop) l1 l2 :
- Forall P l1 → Forall (λ y, ∀ x, P x → Q (f x y)) l2 →
- Forall Q (zip_with f l1 l2).
- Proof. intros Hl. revert l2. induction Hl; destruct 1; simpl in *; auto. Qed.
- Lemma Forall_zip_with_snd (P : B → Prop) (Q : C → Prop) l1 l2 :
- Forall (λ x, ∀ y, P y → Q (f x y)) l1 → Forall P l2 →
- Forall Q (zip_with f l1 l2).
- Proof. intros Hl. revert l2. induction Hl; destruct 1; simpl in *; auto. Qed.
-
+ Proof. intros <- Hk. revert l1. by induction Hk; intros [|??]; f_equal'. Qed.
+ Lemma zip_with_fmap_l {D} (g : D → A) lD k :
+ zip_with f (g <$> lD) k = zip_with (λ z, f (g z)) lD k.
+ Proof. revert k. by induction lD; intros [|??]; f_equal'. Qed.
+ Lemma zip_with_fmap_r {D} (g : D → B) l kD :
+ zip_with f l (g <$> kD) = zip_with (λ x z, f x (g z)) l kD.
+ Proof. revert kD. by induction l; intros [|??]; f_equal'. Qed.
+ Lemma zip_with_nil_inv l k : zip_with f l k = [] → l = [] ∨ k = [].
+ Proof. destruct l, k; intros; simplify_equality'; auto. Qed.
+ Lemma zip_with_cons_inv l k z lC :
+ zip_with f l k = z :: lC →
+ ∃ x y l' k', z = f x y ∧ lC = zip_with f l' k' ∧ l = x :: l' ∧ k = y :: k'.
+ Proof. intros. destruct l, k; simplify_equality'; repeat eexists. Qed.
+ Lemma zip_with_app_inv l k lC1 lC2 :
+ zip_with f l k = lC1 ++ lC2 →
+ ∃ l1 k1 l2 k2, lC1 = zip_with f l1 k1 ∧ lC2 = zip_with f l2 k2 ∧
+ l = l1 ++ l2 ∧ k = k1 ++ k2 ∧ length l1 = length k1.
+ Proof.
+ revert l k. induction lC1 as [|z lC1 IH]; simpl.
+ { intros l k ?. by eexists [], [], l, k. }
+ intros [|x l] [|y k] ?; simplify_equality'.
+ destruct (IH l k) as (l1&k1&l2&k2&->&->&->&->&?); [done |].
+ exists (x :: l1) (y :: k1) l2 k2; simpl; auto with congruence.
+ Qed.
+ Lemma zip_with_inj `{!Injective2 (=) (=) (=) f} l1 l2 k1 k2 :
+ length l1 = length k1 → length l2 = length k2 →
+ zip_with f l1 k1 = zip_with f l2 k2 → l1 = l2 ∧ k1 = k2.
+ Proof.
+ rewrite <-!Forall2_same_length. intros Hl. revert l2 k2.
+ induction Hl; intros ?? [] ?; f_equal; naive_solver.
+ Qed.
+ Lemma zip_with_length l k :
+ length (zip_with f l k) = min (length l) (length k).
+ Proof. revert k. induction l; intros [|??]; simpl; auto with lia. Qed.
+ Lemma zip_with_length_l l k :
+ length l ≤ length k → length (zip_with f l k) = length l.
+ Proof. rewrite zip_with_length; lia. Qed.
+ Lemma zip_with_length_r l k :
+ length k ≤ length l → length (zip_with f l k) = length k.
+ Proof. rewrite zip_with_length; lia. Qed.
+ Lemma zip_with_length_same_l P l k :
+ Forall2 P l k → length (zip_with f l k) = length l.
+ Proof. induction 1; simpl; auto. Qed.
+ Lemma zip_with_length_same_r P l k :
+ Forall2 P l k → length (zip_with f l k) = length k.
+ Proof. induction 1; simpl; auto. Qed.
+ Lemma fmap_zip_with_l (g : C → A) l k :
+ (∀ x y, g (f x y) = x) → length l ≤ length k → g <$> zip_with f l k = l.
+ Proof. revert k. induction l; intros [|??] ??; f_equal'; auto with lia. Qed.
+ Lemma fmap_zip_with_r (g : C → B) l k :
+ (∀ x y, g (f x y) = y) → length k ≤ length l → g <$> zip_with f l k = k.
+ Proof. revert l. induction k; intros [|??] ??; f_equal'; auto with lia. Qed.
Lemma zip_with_zip l k : zip_with f l k = curry f <$> zip l k.
- Proof. revert k. induction l; intros [|??]; simpl; auto with f_equal. Qed.
+ Proof. revert k. by induction l; intros [|??]; f_equal'. Qed.
Lemma zip_with_fst_snd lk :
zip_with f (fst <$> lk) (snd <$> lk) = curry f <$> lk.
- Proof. induction lk as [|[]]; simpl; auto with f_equal. Qed.
+ Proof. by induction lk as [|[]]; f_equal'. Qed.
+ Lemma zip_with_replicate_l n x k :
+ length k ≤ n → zip_with f (replicate n x) k = f x <$> k.
+ Proof. revert n. induction k; intros [|?] ?; f_equal'; auto with lia. Qed.
+ Lemma zip_with_replicate_r n y l :
+ length l ≤ n → zip_with f l (replicate n y) = flip f y <$> l.
+ Proof. revert n. induction l; intros [|?] ?; f_equal'; auto with lia. Qed.
+ Lemma zip_with_take n l k :
+ take n (zip_with f l k) = zip_with f (take n l) (take n k).
+ Proof. revert n k. by induction l; intros [|?] [|??]; f_equal'. Qed.
+ Lemma zip_with_drop n l k :
+ drop n (zip_with f l k) = zip_with f (drop n l) (drop n k).
+ Proof.
+ revert n k. induction l; intros [] []; f_equal'; auto using zip_with_nil_r.
+ Qed.
+ Lemma zip_with_take_l n l k :
+ length k ≤ n → zip_with f (take n l) k = zip_with f l k.
+ Proof. revert n k. induction l; intros [] [] ?; f_equal'; auto with lia. Qed.
+ Lemma zip_with_take_r n l k :
+ length l ≤ n → zip_with f l (take n k) = zip_with f l k.
+ Proof. revert n k. induction l; intros [] [] ?; f_equal'; auto with lia. Qed.
+ Lemma Forall_zip_with_fst (P : A → Prop) (Q : C → Prop) l k :
+ Forall P l → Forall (λ y, ∀ x, P x → Q (f x y)) k →
+ Forall Q (zip_with f l k).
+ Proof. intros Hl. revert k. induction Hl; destruct 1; simpl in *; auto. Qed.
+ Lemma Forall_zip_with_snd (P : B → Prop) (Q : C → Prop) l k :
+ Forall (λ x, ∀ y, P y → Q (f x y)) l → Forall P k →
+ Forall Q (zip_with f l k).
+ Proof. intros Hl. revert k. induction Hl; destruct 1; simpl in *; auto. Qed.
End zip_with.
Section zip.
Context {A B : Type}.
Implicit Types l : list A.
Implicit Types k : list B.
-
- Lemma zip_length l k : length l ≤ length k → length (zip l k) = length l.
- Proof. by apply zip_with_length. Qed.
- Lemma zip_fmap_fst_le l k : length l ≤ length k → fst <$> zip l k = l.
- Proof. by apply zip_with_fmap_fst_le. Qed.
- Lemma zip_fmap_snd l k : length k ≤ length l → snd <$> zip l k = k.
- Proof. by apply zip_with_fmap_snd_le. Qed.
- Lemma zip_fst l k : l `same_length` k → fst <$> zip l k = l.
- Proof. by apply zip_with_fmap_fst. Qed.
- Lemma zip_snd l k : l `same_length` k → snd <$> zip l k = k.
- Proof. by apply zip_with_fmap_snd. Qed.
+ Lemma fst_zip l k : length l ≤ length k → fst <$> zip l k = l.
+ Proof. by apply fmap_zip_with_l. Qed.
+ Lemma snd_zip l k : length k ≤ length l → snd <$> zip l k = k.
+ Proof. by apply fmap_zip_with_r. Qed.
Lemma zip_fst_snd (lk : list (A * B)) : zip (fst <$> lk) (snd <$> lk) = lk.
- Proof. induction lk as [|[]]; simpl; auto with f_equal. Qed.
+ Proof. by induction lk as [|[]]; f_equal'. Qed.
+ Lemma Forall2_fst P l1 l2 k1 k2 :
+ length l2 = length k2 → Forall2 P l1 k1 →
+ Forall2 (λ x y, P (x.1) (y.1)) (zip l1 l2) (zip k1 k2).
+ Proof.
+ rewrite <-Forall2_same_length. intros Hlk2 Hlk1. revert l2 k2 Hlk2.
+ induction Hlk1; intros ?? [|??????]; simpl; auto.
+ Qed.
+ Lemma Forall2_snd P l1 l2 k1 k2 :
+ length l1 = length k1 → Forall2 P l2 k2 →
+ Forall2 (λ x y, P (x.2) (y.2)) (zip l1 l2) (zip k1 k2).
+ Proof.
+ rewrite <-Forall2_same_length. intros Hlk1 Hlk2. revert l1 k1 Hlk1.
+ induction Hlk2; intros ?? [|??????]; simpl; auto.
+ Qed.
End zip.
Lemma elem_of_zipped_map {A B} (f : list A → list A → A → B) l k x :
@@ -3003,26 +2879,20 @@ Lemma elem_of_zipped_map {A B} (f : list A → list A → A → B) l k x :
Proof.
split.
* revert l. induction k as [|z k IH]; simpl; intros l; inversion_clear 1.
- + by eexists [], k, z.
- + destruct (IH (z :: l)) as [k' [k'' [y [??]]]]; [done |]; subst.
- eexists (z :: k'), k'', y. split; [done |].
- by rewrite reverse_cons, <-(associative_L (++)).
- * intros [k' [k'' [y [??]]]]; subst.
- revert l. induction k' as [|z k' IH]; intros l; [by left|].
- right. by rewrite reverse_cons, <-!(associative_L (++)).
+ { by eexists [], k, z. }
+ destruct (IH (z :: l)) as (k'&k''&y&->&->); [done |].
+ eexists (z :: k'), k'', y. by rewrite reverse_cons, <-(associative_L (++)).
+ * intros (k'&k''&y&->&->). revert l. induction k' as [|z k' IH]; [by left|].
+ intros l; right. by rewrite reverse_cons, <-!(associative_L (++)).
Qed.
-
Section zipped_list_ind.
Context {A} (P : list A → list A → Prop).
Context (Pnil : ∀ l, P l []) (Pcons : ∀ l k x, P (x :: l) k → P l (x :: k)).
-
Fixpoint zipped_list_ind l k : P l k :=
match k with
- | [] => Pnil _
- | x :: k => Pcons _ _ _ (zipped_list_ind (x :: l) k)
+ | [] => Pnil _ | x :: k => Pcons _ _ _ (zipped_list_ind (x :: l) k)
end.
End zipped_list_ind.
-
Lemma zipped_Forall_app {A} (P : list A → list A → A → Prop) l k k' :
zipped_Forall P l (k ++ k') → zipped_Forall P (reverse k ++ l) k'.
Proof.
@@ -3037,9 +2907,7 @@ Note that we represent [(x ::)] as [rapp (rnode [x])]. For now, we abstract
over the type of constants, but later we use [nat]s and a list representing
a corresponding environment. *)
Inductive rlist (A : Type) :=
- | rnil : rlist A
- | rnode : A → rlist A
- | rapp : rlist A → rlist A → rlist A.
+ rnil : rlist A | rnode : A → rlist A | rapp : rlist A → rlist A → rlist A.
Arguments rnil {_}.
Arguments rnode {_} _.
Arguments rapp {_} _ _.
@@ -3047,11 +2915,8 @@ Arguments rapp {_} _ _.
Module rlist.
Fixpoint to_list {A} (t : rlist A) : list A :=
match t with
- | rnil => []
- | rnode l => [l]
- | rapp t1 t2 => to_list t1 ++ to_list t2
+ | rnil => [] | rnode l => [l] | rapp t1 t2 => to_list t1 ++ to_list t2
end.
-
Notation env A := (list (list A)) (only parsing).
Definition eval {A} (E : env A) : rlist nat → list A :=
fix go t :=
@@ -3162,50 +3027,71 @@ Ltac simplify_zip_equality := repeat
apply zip_with_cons_inv in H; destruct H as (?&?&?&?&?&?&?&?)
| H : _ :: _ = zip_with _ _ _ |- _ => symmetry in H
| H : zip_with _ _ _ = _ ++ _ |- _ =>
- apply zip_with_app_inv in H; destruct H as (?&?&?&?&?&?&?&?)
+ apply zip_with_app_inv in H; destruct H as (?&?&?&?&?&?&?&?&?)
| H : _ ++ _ = zip_with _ _ _ |- _ => symmetry in H
end.
-
Ltac decompose_Forall_hyps := repeat
match goal with
| H : Forall _ [] |- _ => clear H
| H : Forall _ (_ :: _) |- _ => rewrite Forall_cons in H; destruct H
| H : Forall _ (_ ++ _) |- _ => rewrite Forall_app in H; destruct H
- | H : Forall _ (_ <$> _) |- _ => rewrite Forall_fmap in H
| H : Forall2 _ [] [] |- _ => clear H
| H : Forall2 _ (_ :: _) [] |- _ => destruct (Forall2_cons_nil_inv _ _ _ H)
| H : Forall2 _ [] (_ :: _) |- _ => destruct (Forall2_nil_cons_inv _ _ _ H)
- | H : Forall2 _ [] ?l |- _ => apply Forall2_nil_inv_l in H; subst l
+ | H : Forall2 _ [] ?k |- _ => apply Forall2_nil_inv_l in H; subst k
| H : Forall2 _ ?l [] |- _ => apply Forall2_nil_inv_r in H; subst l
| H : Forall2 _ (_ :: _) (_ :: _) |- _ =>
apply Forall2_cons_inv in H; destruct H
- | H : Forall2 _ (_ :: _) ?l |- _ =>
- apply Forall2_cons_inv_l in H; destruct H as (? & ? & ? & ? & ?); subst l
+ | H : Forall2 _ (_ :: _) ?k |- _ =>
+ let k_hd := fresh k "_hd" in let k_tl := fresh k "_tl" in
+ apply Forall2_cons_inv_l in H; destruct H as (k_hd&k_tl&?&?&->);
+ rename k_tl into k
| H : Forall2 _ ?l (_ :: _) |- _ =>
- apply Forall2_cons_inv_r in H; destruct H as (? & ? & ? & ? & ?); subst l
+ let l_hd := fresh l "_hd" in let l_tl := fresh l "_tl" in
+ apply Forall2_cons_inv_r in H; destruct H as (l_hd&l_tl&?&?&->);
+ rename l_tl into l
| H : Forall2 _ (_ ++ _) (_ ++ _) |- _ =>
- destruct (Forall2_app_inv _ _ _ _ _ H); [eauto using Forall2_same_length |]
- | H : Forall2 _ (_ ++ _) ?l |- _ =>
- apply Forall2_app_inv_l in H; destruct H as (? & ? & ? & ? & ?); subst l
- | H : Forall2 _ ?l (_ ++ _) |- _ =>
- apply Forall2_app_inv_r in H; destruct H as (? & ? & ? & ? & ?); subst l
+ apply Forall2_app_inv in H;
+ [destruct H | by eauto using Forall2_length, eq_sym]
+ | H : Forall2 _ (_ ++ _) ?k |- _ => first
+ [ let k1 := fresh k "_1" in let k2 := fresh k "_2" in
+ apply Forall2_app_inv_l in H; destruct H as (k1&k2&?&?&->)
+ | apply Forall2_app_inv_l in H; destruct H as (?&?&?&?&?)]
+ | H : Forall2 _ ?l (_ ++ _) |- _ => first
+ [ let l1 := fresh l "_1" in let l2 := fresh l "_2" in
+ apply Forall2_app_inv_r in H; destruct H as (l1&l2&?&?&->)
+ | apply Forall2_app_inv_r in H; destruct H as (?&?&?&?&?) ]
| H : Forall ?P ?l, H1 : ?l !! _ = Some ?x |- _ =>
unless (P x) by done;
let E := fresh in
assert (P x) as E by (apply (Forall_lookup_1 P _ _ _ H H1)); lazy beta in E
- | H : Forall2 ?P ?l1 ?l2 |- _ =>
+ | H : Forall2 ?P ?l ?k |- _ =>
lazymatch goal with
- | H1 : l1 !! ?i = Some ?x, H2 : l2 !! ?i = Some ?y |- _ =>
- unless (P x y) by done;
- let E := fresh in
- assert (P x y) as E by (apply (Forall2_lookup_lr P _ _ _ _ _ H H1 H2));
+ | H1 : l !! ?i = Some ?x, H2 : k !! ?i = Some ?y |- _ =>
+ unless (P x y) by done; let E := fresh in
+ assert (P x y) as E by (by apply (Forall2_lookup_lr P l k i x y));
lazy beta in E
- | H1 : l1 !! _ = Some ?x |- _ =>
+ | H1 : l !! _ = Some ?x |- _ =>
destruct (Forall2_lookup_l P _ _ _ _ H H1) as (?&?&?)
- | H2 : l2 !! _ = Some ?y |- _ =>
+ | H2 : k !! _ = Some ?y |- _ =>
destruct (Forall2_lookup_r P _ _ _ _ H H2) as (?&?&?)
end
+ | H : Forall3 ?P ?l ?l' ?k |- _ =>
+ lazymatch goal with
+ | H1:l !! ?i = Some ?x, H2:l' !! ?i = Some ?y, H3:k !! ?i = Some ?z |- _ =>
+ unless (P x y z) by done; let E := fresh in
+ assert (P x y z) as E by (by apply (Forall3_lookup_lmr P l l' k i x y z));
+ lazy beta in E
+ | H1 : l !! _ = Some ?x |- _ =>
+ destruct (Forall3_lookup_l P _ _ _ _ _ H H1) as (?&?&?&?&?)
+ | H2 : l' !! _ = Some ?y |- _ =>
+ destruct (Forall3_lookup_m P _ _ _ _ _ H H2) as (?&?&?&?&?)
+ | H3 : k !! _ = Some ?z |- _ =>
+ destruct (Forall3_lookup_r P _ _ _ _ _ H H3) as (?&?&?&?&?)
+ end
end.
+Ltac decompose_Forall_hyps' :=
+ repeat (progress simplify_equality' || decompose_Forall_hyps).
Ltac decompose_Forall := repeat
match goal with
| |- Forall _ _ => by apply Forall_true
@@ -3222,10 +3108,11 @@ Ltac decompose_Forall := repeat
| |- Forall2 _ (_ <$> _) _ => apply Forall2_fmap_l
| |- Forall2 _ _ (_ <$> _) => apply Forall2_fmap_r
| _ => progress decompose_Forall_hyps
+ | H : Forall _ (_ <$> _) |- _ => rewrite Forall_fmap in H
| |- Forall _ _ =>
apply Forall_lookup_2; intros ???; progress decompose_Forall_hyps
| |- Forall2 _ _ _ =>
- apply Forall2_lookup_2; [by eauto using Forall2_same_length|];
+ apply Forall2_lookup_2; [by eauto using Forall2_length|];
intros ?????; progress decompose_Forall_hyps
end.
diff --git a/theories/listset.v b/theories/listset.v
index 6592895b..42b3971d 100644
--- a/theories/listset.v
+++ b/theories/listset.v
@@ -15,7 +15,7 @@ Instance listset_elem_of: ElemOf A (listset A) := λ x l, x ∈ listset_car l.
Instance listset_empty: Empty (listset A) := Listset [].
Instance listset_singleton: Singleton A (listset A) := λ x, Listset [x].
Instance listset_union: Union (listset A) := λ l k,
- match l, k with Listset l', Listset k' => Listset (l' ++ k') end.
+ let (l') := l in let (k') := k in Listset (l' ++ k').
Global Instance: SimpleCollection A (listset A).
Proof.
@@ -28,19 +28,13 @@ Qed.
Context `{∀ x y : A, Decision (x = y)}.
Instance listset_intersection: Intersection (listset A) := λ l k,
- match l, k with
- | Listset l', Listset k' => Listset (list_intersection l' k')
- end.
+ let (l') := l in let (k') := k in Listset (list_intersection l' k').
Instance listset_difference: Difference (listset A) := λ l k,
- match l, k with
- | Listset l', Listset k' => Listset (list_difference l' k')
- end.
+ let (l') := l in let (k') := k in Listset (list_difference l' k').
Instance listset_intersection_with: IntersectionWith A (listset A) := λ f l k,
- match l, k with
- | Listset l', Listset k' => Listset (list_intersection_with f l' k')
- end.
+ let (l') := l in let (k') := k in Listset (list_intersection_with f l' k').
Instance listset_filter: Filter A (listset A) := λ P _ l,
- match l with Listset l' => Listset (filter P l') end.
+ let (l') := l in Listset (filter P l').
Instance: Collection A (listset A).
Proof.
@@ -49,9 +43,7 @@ Proof.
* intros [?] [?]. apply elem_of_list_intersection.
* intros [?] [?]. apply elem_of_list_difference.
Qed.
-
Instance listset_elems: Elements A (listset A) := remove_dups ∘ listset_car.
-
Global Instance: FinCollection A (listset A).
Proof.
split.
@@ -59,7 +51,6 @@ Proof.
* symmetry. apply elem_of_remove_dups.
* intros. apply remove_dups_nodup.
Qed.
-
Global Instance: CollectionOps A (listset A).
Proof.
split.
@@ -92,9 +83,9 @@ Hint Extern 1 (Filter _ (listset _)) =>
Instance listset_ret: MRet listset := λ A x, {[ x ]}.
Instance listset_fmap: FMap listset := λ A B f l,
- match l with Listset l' => Listset (f <$> l') end.
+ let (l') := l in Listset (f <$> l').
Instance listset_bind: MBind listset := λ A B f l,
- match l with Listset l' => Listset (mbind (listset_car ∘ f) l') end.
+ let (l') := l in Listset (mbind (listset_car ∘ f) l').
Instance listset_join: MJoin listset := λ A, mbind id.
Instance: CollectionMonad listset.
diff --git a/theories/listset_nodup.v b/theories/listset_nodup.v
index 42c15949..b7c5ddf9 100644
--- a/theories/listset_nodup.v
+++ b/theories/listset_nodup.v
@@ -6,8 +6,7 @@ is the only constraint on the carrier set. *)
Require Export base decidable collections list.
Record listset_nodup A := ListsetNoDup {
- listset_nodup_car : list A;
- listset_nodup_prf : NoDup listset_nodup_car
+ listset_nodup_car : list A; listset_nodup_prf : NoDup listset_nodup_car
}.
Arguments ListsetNoDup {_} _ _.
Arguments listset_nodup_car {_} _.
@@ -24,7 +23,7 @@ Instance listset_nodup_empty: Empty C := LS [] (@NoDup_nil_2 _).
Instance listset_nodup_singleton: Singleton A C := λ x,
LS [x] (NoDup_singleton x).
Instance listset_nodup_difference: Difference C := λ l k,
- LS _ (list_difference_nodup _ (listset_nodup_car k) (listset_nodup_prf l)).
+ let (l',Hl) := l in let (k',Hk) := k in LS _ (list_difference_nodup _ k' Hl).
Definition listset_nodup_union_raw (l k : list A) : list A :=
list_difference l k ++ k.
@@ -44,31 +43,28 @@ Proof.
* done.
Qed.
Instance listset_nodup_union: Union C := λ l k,
- LS _ (listset_nodup_union_raw_nodup _ _
- (listset_nodup_prf l) (listset_nodup_prf k)).
+ let (l',Hl) := l in let (k',Hk) := k
+ in LS _ (listset_nodup_union_raw_nodup _ _ Hl Hk).
Instance listset_nodup_intersection: Intersection C := λ l k,
- LS _ (list_intersection_nodup _
- (listset_nodup_car k) (listset_nodup_prf l)).
-Instance listset_nodup_intersection_with:
- IntersectionWith A C := λ f l k,
- LS (remove_dups
- (list_intersection_with f (listset_nodup_car l) (listset_nodup_car k)))
- (remove_dups_nodup _).
-Instance listset_nodup_filter: Filter A C :=
- λ P _ l, LS _ (filter_nodup P _ (listset_nodup_prf l)).
+ let (l',Hl) := l in let (k',Hk) := k
+ in LS _ (list_intersection_nodup _ k' Hl).
+Instance listset_nodup_intersection_with: IntersectionWith A C := λ f l k,
+ let (l',Hl) := l in let (k',Hk) := k
+ in LS (remove_dups (list_intersection_with f l' k')) (remove_dups_nodup _).
+Instance listset_nodup_filter: Filter A C := λ P _ l,
+ let (l',Hl) := l in LS _ (filter_nodup P _ Hl).
Instance: Collection A C.
Proof.
split; [split | | ].
* by apply not_elem_of_nil.
* by apply elem_of_list_singleton.
- * intros. apply elem_of_listset_nodup_union_raw.
- * intros. apply elem_of_list_intersection.
- * intros. apply elem_of_list_difference.
+ * intros [??] [??] ?. apply elem_of_listset_nodup_union_raw.
+ * intros [??] [??] ?. apply elem_of_list_intersection.
+ * intros [??] [??] ?. apply elem_of_list_difference.
Qed.
Global Instance listset_nodup_elems: Elements A C := listset_nodup_car.
-
Global Instance: FinCollection A C.
Proof.
split.
@@ -76,15 +72,14 @@ Proof.
* done.
* by intros [??].
Qed.
-
Global Instance: CollectionOps A C.
Proof.
split.
* apply _.
- * intros. unfold intersection_with, listset_nodup_intersection_with,
- elem_of, listset_nodup_elem_of. simpl.
+ * intros ? [??] [??] ?. unfold intersection_with, elem_of,
+ listset_nodup_intersection_with, listset_nodup_elem_of; simpl.
rewrite elem_of_remove_dups. by apply elem_of_list_intersection_with.
- * intros. apply elem_of_list_filter.
+ * intros [??] ???. apply elem_of_list_filter.
Qed.
End list_collection.
diff --git a/theories/map.v b/theories/map.v
new file mode 100644
index 00000000..14ac9cfc
--- /dev/null
+++ b/theories/map.v
@@ -0,0 +1,144 @@
+(* Copyright (c) 2012-2013, Robbert Krebbers. *)
+(* This file is distributed under the terms of the BSD license. *)
+Require Export separation.
+Require Import refinements.
+
+Record map (A : Set) := Map { map_car : indexmap (list A) }.
+Arguments Map {_} _.
+Arguments map_car {_} _.
+Add Printing Constructor map.
+Instance: Injective (=) (=) (@Map A).
+Proof. by injection 1. Qed.
+
+Instance map_ops {A : Set} `{SeparationOps A} : SeparationOps (map A) := {
+ sep_empty := Map ∅;
+ sep_union m1 m2 :=
+ let (m1) := m1 in let (m2) := m2 in
+ Map (union_with (λ xs1 xs2, Some (xs1 ∪* xs2)) m1 m2);
+ sep_difference m1 m2 :=
+ let (m1) := m1 in let (m2) := m2 in
+ Map (difference_with (λ xs1 xs2,
+ let xs' := xs1 ∖* xs2 in guard (¬Forall (∅ =) xs'); Some xs'
+ ) m1 m2);
+ sep_half m := let (m) := m in Map (½* <$> m);
+ sep_valid m :=
+ let (m) := m in map_Forall (λ _ xs, Forall sep_valid xs ∧ ¬Forall (∅ =) xs) m;
+ sep_disjoint m1 m2 :=
+ let (m1) := m1 in let (m2) := m2 in map_Forall2
+ (λ xs1 xs2, xs1 ⊥* xs2 ∧ ¬Forall (∅ =) xs1 ∧ ¬Forall (∅ =) xs2)
+ (λ xs1, Forall sep_valid xs1 ∧ ¬Forall (∅ =) xs1)
+ (λ xs2, Forall sep_valid xs2 ∧ ¬Forall (∅ =) xs2) m1 m2;
+ sep_splittable m :=
+ let (m) := m in
+ map_Forall (λ _ xs,
+ Forall sep_valid xs ∧ ¬Forall (∅ =) xs ∧ Forall sep_splittable xs) m;
+ sep_subseteq m1 m2 :=
+ let (m1) := m1 in let (m2) := m2 in map_Forall2
+ (λ xs1 w2, xs1 ⊆* w2 ∧ ¬Forall (∅ =) xs1)
+ (λ xs1, False)
+ (λ xs2, Forall sep_valid xs2 ∧ ¬Forall (∅ =) xs2) m1 m2;
+ sep_unmapped m := map_car m = ∅;
+ sep_unshared m := False
+}.
+Proof.
+ * intros []; apply _.
+ * intros [] []; apply _.
+ * intros [] []; apply _.
+ * solve_decision.
+ * intros []; apply _.
+Defined.
+
+Instance map_sep {A : Set} `{Separation A} : Separation (map A).
+Proof.
+ split.
+ * destruct (sep_inhabited A) as (x&?&?).
+ eexists (Map {[fresh ∅, [x]]}).
+ split; [|by intro]. intros o w ?; simplify_map_equality'. split.
+ + by rewrite Forall_singleton.
+ + by inversion_clear 1; decompose_Forall_hyps'.
+ * sep_unfold; intros [m1] [m2] Hm o w; specialize (Hm o); simpl in *.
+ intros Hx. rewrite Hx in Hm.
+ destruct (m2 !! o); intuition eauto using seps_disjoint_valid_l.
+ * sep_unfold; intros [m1] [m2] Hm o w; specialize (Hm o); simpl in *.
+ rewrite lookup_union_with. intros. destruct (m1 !! o), (m2 !! o);
+ simplify_equality'; intuition eauto using seps_union_valid, seps_positive_l.
+ * sep_unfold. intros [m] Hm o; specialize (Hm o); simplify_map_equality'.
+ destruct (m !! o); eauto.
+ * sep_unfold; intros [m] ?; f_equal'. by rewrite (left_id_L ∅ _).
+ * sep_unfold. intros [m1] [m2] Hm o; specialize (Hm o); simpl in *.
+ destruct (m1 !! o), (m2 !! o); intuition.
+ * sep_unfold; intros [m1] [m2] Hm; f_equal'. apply union_with_commutative.
+ intros o w1 w2 ??; specialize (Hm o); simplify_option_equality.
+ f_equal; intuition auto using seps_commutative.
+ * sep_unfold; intros [m1] [m2] [m3] Hm Hm' o; specialize (Hm o);
+ specialize (Hm' o); simpl in *; rewrite lookup_union_with in Hm'.
+ destruct (m1 !! o) eqn:?, (m2 !! o), (m3 !! o); simplify_equality';
+ intuition eauto using seps_disjoint_valid_l, seps_disjoint_ll.
+ * sep_unfold; intros [m1] [m2] [m3] Hm Hm' o; specialize (Hm o);
+ specialize (Hm' o); simpl in *; rewrite lookup_union_with in Hm' |- *.
+ destruct (m1 !! o) eqn:?, (m2 !! o), (m3 !! o); simplify_equality';
+ intuition eauto using seps_disjoint_valid_l, seps_disjoint_move_l,
+ seps_union_valid, seps_positive_l, seps_disjoint_lr.
+ * sep_unfold; intros [m1] [m2] [m3] Hm Hm'; f_equal'.
+ apply map_eq; intros o; specialize (Hm o); specialize (Hm' o); simpl in *;
+ rewrite !lookup_union_with; rewrite lookup_union_with in Hm'.
+ destruct (m1 !! o) eqn:?, (m2 !! o), (m3 !! o); simplify_equality'; eauto.
+ f_equal; intuition auto using seps_associative.
+ * sep_unfold; intros [m1] [m2] _; rewrite !(injective_iff Map); intros Hm.
+ apply map_eq; intros o. rewrite lookup_empty.
+ apply (f_equal (!! o)) in Hm; rewrite lookup_union_with, lookup_empty in Hm.
+ by destruct (m1 !! o), (m2 !! o); simplify_equality'.
+ * sep_unfold; intros [m1] [m2] [m3] Hm Hm'; rewrite !(injective_iff Map);
+ intros Hm''; apply map_eq; intros o.
+ specialize (Hm o); specialize (Hm' o);
+ apply (f_equal (!! o)) in Hm''; rewrite !lookup_union_with in Hm''.
+ destruct (m1 !! o) eqn:?, (m2 !! o), (m3 !! o); simplify_equality';
+ f_equal; naive_solver eauto using seps_cancel_l,
+ seps_cancel_empty_l, seps_cancel_empty_r.
+ * sep_unfold; intros [m1] [m2] Hm o; specialize (Hm o).
+ rewrite lookup_union_with. destruct (m1 !! o), (m2 !! o); simpl;
+ intuition auto using seps_union_subseteq_l, seps_reflexive.
+ * sep_unfold; intros [m1] [m2] Hm o; specialize (Hm o).
+ rewrite lookup_difference_with; destruct (m1 !! o), (m2 !! o);
+ simplify_option_equality;
+ intuition eauto using seps_disjoint_difference, seps_disjoint_valid_l.
+ * sep_unfold; intros [m1] [m2] Hm; f_equal; apply map_eq; intros o;
+ specialize (Hm o); rewrite lookup_union_with, lookup_difference_with.
+ destruct (m1 !! o), (m2 !! o); simplify_option_equality; f_equal;
+ intuition eauto using seps_union_difference, seps_difference_empty_rev.
+ * sep_unfold; intros [m] Hm o w; specialize (Hm o).
+ rewrite lookup_union_with; intros; destruct (m !! o); simplify_equality'.
+ intuition eauto using seps_union_valid,
+ seps_splittable_union, seps_positive_l.
+ * sep_unfold; intros [m1] [m2] Hm Hm' o w ?; specialize (Hm o);
+ specialize (Hm' o); simplify_option_equality.
+ destruct (m2 !! o); naive_solver eauto using seps_disjoint_difference,
+ seps_disjoint_valid_l, seps_splittable_weaken.
+ * sep_unfold; intros [m] Hm o; specialize (Hm o); rewrite lookup_fmap.
+ destruct (m !! o); try naive_solver
+ auto using seps_half_empty_rev, seps_disjoint_half.
+ * sep_unfold; intros [m] Hm; f_equal; apply map_eq; intros o;
+ specialize (Hm o); rewrite lookup_union_with, lookup_fmap.
+ destruct (m !! o); f_equal'; naive_solver auto using seps_union_half.
+ * sep_unfold; intros [m1] [m2] Hm Hm'; f_equal; apply map_eq; intros o;
+ rewrite lookup_fmap, !lookup_union_with, !lookup_fmap;
+ specialize (Hm o); specialize (Hm' o); rewrite lookup_union_with in Hm'.
+ destruct (m1 !! o), (m2 !! o); simplify_equality'; f_equal; auto.
+ naive_solver auto using seps_union_half_distr.
+ * sep_unfold; intros [m] ????; simplify_map_equality'.
+ * done.
+ * sep_unfold; intros [m1] [m2] ? Hm; simplify_equality'. apply map_empty.
+ intros o. specialize (Hm o); simplify_map_equality. by destruct (m1 !! o).
+ * sep_unfold; intros [m1] [m2] ???; simpl in *; subst.
+ by rewrite (left_id_L ∅ (union_with _)).
+ * sep_unfold; intros [m]. split; [done|].
+ intros [? Hm]. destruct (sep_inhabited A) as (x&?&?).
+ specialize (Hm (Map {[fresh (dom _ m), [x]]}));
+ feed specialize Hm; [|simplify_map_equality'].
+ intros o. destruct (m !! o) as [w|] eqn:Hw; simplify_map_equality'.
+ { rewrite lookup_singleton_ne; eauto. intros <-.
+ eapply (is_fresh (dom indexset m)), fin_map_dom.elem_of_dom_2; eauto. }
+ destruct ({[_]} !! _) eqn:?; simplify_map_equality; split.
+ + by rewrite Forall_singleton.
+ + by inversion_clear 1; decompose_Forall_hyps'.
+Qed.
diff --git a/theories/natmap.v b/theories/natmap.v
index 2d0d1202..236a62f2 100644
--- a/theories/natmap.v
+++ b/theories/natmap.v
@@ -11,17 +11,16 @@ Definition natmap_wf {A} (l : natmap_raw A) :=
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) :
+Lemma natmap_wf_inv {A} (o : option A) (l : natmap_raw A) :
natmap_wf (o :: l) → natmap_wf l.
Proof. by destruct l. Qed.
Lemma natmap_wf_lookup {A} (l : natmap_raw A) :
natmap_wf l → l ≠[] → ∃ i x, mjoin (l !! i) = Some x.
Proof.
intros Hwf Hl. induction l as [|[x|] l IH]; simpl; [done| |].
- * exists 0. simpl. eauto.
- * destruct IH as (i&x&?); eauto using natmap_wf_inv.
- { intro. subst. by destruct Hwf. }
- by exists (S i) x.
+ { exists 0. simpl. eauto. }
+ destruct IH as (i&x&?); eauto using natmap_wf_inv; [|by exists (S i) x].
+ intros ->. by destruct Hwf.
Qed.
Definition natmap (A : Type) : Type := sig (@natmap_wf A).
@@ -31,17 +30,10 @@ Instance natmap_lookup {A} : Lookup nat A (natmap A) :=
λ i m, match m with exist l _ => mjoin (l !! i) end.
Fixpoint natmap_singleton_raw {A} (i : nat) (x : A) : natmap_raw A :=
- match i with
- | 0 => [Some x]
- | S i => None :: natmap_singleton_raw i x
- end.
+ match i with 0 => [Some x]| S i => None :: natmap_singleton_raw i x end.
Lemma natmap_singleton_wf {A} (i : nat) (x : A) :
natmap_wf (natmap_singleton_raw i x).
-Proof.
- unfold natmap_wf, last.
- induction i as [|i]; simpl; repeat case_match; simplify_equality; eauto.
- by destruct i.
-Qed.
+Proof. unfold natmap_wf. induction i as [|[]]; simplify_equality'; eauto. Qed.
Lemma natmap_lookup_singleton_raw {A} (i : nat) (x : A) :
mjoin (natmap_singleton_raw i x !! i) = Some x.
Proof. induction i; simpl; auto. Qed.
@@ -51,10 +43,7 @@ Proof. revert j; induction i; intros [|?]; simpl; auto with congruence. Qed.
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.
+ match o, l with None, [] => [] | _, _ => o :: l end.
Lemma natmap_cons_canon_wf {A} (o : option A) (l : natmap_raw A) :
natmap_wf l → natmap_wf (natmap_cons_canon o l).
Proof. unfold natmap_wf, last. destruct o, l; simpl; eauto. Qed.
@@ -72,13 +61,11 @@ Definition natmap_alter_raw {A} (f : option A → option A) :
match l with
| [] =>
match f None with
- | Some x => natmap_singleton_raw i x
- | None => []
+ | Some x => natmap_singleton_raw i x | None => []
end
| o :: l =>
match i with
- | 0 => natmap_cons_canon (f o) l
- | S i => natmap_cons_canon o (go i l)
+ | 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 :
@@ -103,50 +90,47 @@ Proof.
rewrite natmap_lookup_singleton_raw_ne; congruence.
Qed.
-Definition natmap_merge_aux {A B} (f : option A → option B) :
+Definition natmap_omap_raw {A B} (f : A → option B) :
natmap_raw A → natmap_raw B :=
fix go l :=
- match l with
- | [] => []
- | o :: l => natmap_cons_canon (f o) (go l)
- end.
-Lemma natmap_merge_aux_wf {A B} (f : option A → option B) l :
- natmap_wf l → natmap_wf (natmap_merge_aux f l).
+ match l with [] => [] | o :: l => natmap_cons_canon (o ≫= f) (go l) end.
+Lemma natmap_omap_raw_wf {A B} (f : A → option B) l :
+ natmap_wf l → natmap_wf (natmap_omap_raw f l).
Proof. induction l; simpl; eauto using natmap_cons_canon_wf, natmap_wf_inv. Qed.
-Lemma natmap_lookup_merge_aux {A B} (f : option A → option B) l i :
- f None = None →
- mjoin (natmap_merge_aux f l !! i) = f (mjoin (l !! i)).
+Lemma natmap_lookup_omap_raw {A B} (f : A → option B) l i :
+ mjoin (natmap_omap_raw f l !! i) = mjoin (l !! i) ≫= f.
Proof.
revert i. induction l; intros [|?]; simpl; autorewrite with natmap; auto.
Qed.
-Hint Rewrite @natmap_lookup_merge_aux : natmap.
+Hint Rewrite @natmap_lookup_omap_raw : natmap.
+Global Instance natmap_omap: OMap natmap := λ A B f l,
+ _ ↾ natmap_omap_raw_wf f _ (proj2_sig l).
Definition natmap_merge_raw {A B C} (f : option A → option B → option C) :
natmap_raw A → natmap_raw B → natmap_raw C :=
fix go l1 l2 :=
match l1, l2 with
- | [], l2 => natmap_merge_aux (f None) l2
- | l1, [] => natmap_merge_aux (flip f None) l1
+ | [], 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)
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).
Proof.
revert l2. induction l1; intros [|??]; simpl;
- eauto using natmap_merge_aux_wf, natmap_cons_canon_wf, natmap_wf_inv.
+ 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)).
Proof.
intros. revert i l2. induction l1; intros [|?] [|??]; simpl;
- autorewrite with natmap; auto.
+ 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,
- match m1, m2 with
- | exist l1 Hl1, exist l2 Hl2 =>
- natmap_merge_raw f _ _ ↾ natmap_merge_wf _ _ _ Hl1 Hl2
- end.
+ let (l1, Hl1) := m1 in let (l2, Hl2) := m2 in
+ natmap_merge_raw f _ _ ↾ natmap_merge_wf _ _ _ Hl1 Hl2.
Fixpoint natmap_to_list_raw {A} (i : nat) (l : natmap_raw A) : list (nat * A) :=
match l with
@@ -194,9 +178,8 @@ Definition natmap_map_raw {A B} (f : A → B) : natmap_raw A → natmap_raw B :=
Lemma natmap_map_wf {A B} (f : A → B) l :
natmap_wf l → natmap_wf (natmap_map_raw f l).
Proof.
- unfold natmap_wf, last.
- induction l; simpl; repeat case_match; simplify_equality; eauto.
- simpl. by rewrite fmap_is_Some.
+ 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).
@@ -228,9 +211,15 @@ Proof.
* intros ??? [??] ?. apply natmap_lookup_map_raw.
* intros ? [??]. by apply natmap_to_list_raw_nodup.
* intros ? [??] ??. by apply natmap_elem_of_to_list_raw.
+ * intros ??? [??] ?. by apply natmap_lookup_omap_raw.
* intros ????? [??] [??] ?. by apply natmap_lookup_merge_raw.
Qed.
+Lemma list_to_natmap_wf {A} (l : list A) : natmap_wf (Some <$> l).
+Proof. unfold natmap_wf. rewrite fmap_last. destruct (last l); simpl; eauto. Qed.
+Definition list_to_natmap {A} (l : list A) : natmap A :=
+ (Some <$> l) ↾ list_to_natmap_wf l.
+
(** 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.
diff --git a/theories/nmap.v b/theories/nmap.v
index 49fab13d..a33fb8a6 100644
--- a/theories/nmap.v
+++ b/theories/nmap.v
@@ -20,7 +20,6 @@ Proof.
| 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 ∅.
Instance Nlookup {A} : Lookup N A (Nmap A) := λ i t,
match i with
@@ -34,24 +33,25 @@ Instance Npartial_alter {A} : PartialAlter N A (Nmap A) := λ f i t,
end.
Instance Nto_list {A} : FinMapToList N A (Nmap A) := λ t,
match t with
- | NMap o t => default [] o (λ x, [(0,x)]) ++ (fst_map Npos <$> map_to_list t)
+ | NMap o t =>
+ default [] o (λ x, [(0,x)]) ++ (prod_map Npos id <$> map_to_list t)
end.
+Instance Nomap: 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,
match t1, t2 with
| NMap o1 t1, NMap o2 t2 => NMap (f o1 o2) (merge f t1 t2)
end.
Instance Nfmap: FMap Nmap := λ A B f t,
- match t with NMap o t => NMap (fmap f o) (fmap f t) end.
+ match t with NMap o t => NMap (f <$> o) (f <$> t) end.
Instance: FinMap N Nmap.
Proof.
split.
- * intros ? [??] [??] H. f_equal.
- + apply (H 0).
- + apply map_eq. intros i. apply (H (Npos i)).
+ * intros ? [??] [??] H. f_equal; [apply (H 0)|].
+ apply map_eq. intros i. apply (H (Npos i)).
* by intros ? [|?].
- * intros ? f [? t] [|i]; simpl; [done |].
- apply lookup_partial_alter.
+ * 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.
@@ -75,8 +75,8 @@ Proof.
- rewrite elem_of_list_fmap.
destruct i as [|i]; simpl; [done |].
intros. exists (i, x). by rewrite elem_of_map_to_list.
- * intros ??? f ? [o1 t1] [o2 t2] [|?]; simpl; [done|].
- apply (lookup_merge f t1 t2).
+ * intros ?? f [??] [|?]; simpl; [done|]; apply (lookup_omap f).
+ * intros ??? f ? [??] [??] [|?]; simpl; [done|]; apply (lookup_merge f).
Qed.
(** * Finite sets *)
diff --git a/theories/numbers.v b/theories/numbers.v
index ba4e4fbd..0fea1590 100644
--- a/theories/numbers.v
+++ b/theories/numbers.v
@@ -4,7 +4,7 @@
natural numbers, and the type [Z] for integers. It also declares some useful
notations. *)
Require Export Eqdep PArith NArith ZArith NPeano.
-Require Import Qcanon.
+Require Import QArith Qcanon.
Require Export base decidable.
Open Scope nat_scope.
@@ -15,12 +15,15 @@ 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.
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" := (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.
@@ -71,14 +74,26 @@ Lemma Nat_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 (Nat_mul_split_l n x2 x1 y2 y1); auto with lia. Qed.
+Notation lcm := Nat.lcm.
+Notation divide := Nat.divide.
+Notation "( x | y )" := (divide x y) : nat_scope.
+Instance: PartialOrder divide.
+Proof.
+ repeat split; try apply _. intros ??. apply Nat.divide_antisym_nonneg; lia.
+Qed.
+Hint Extern 0 (_ | _) => reflexivity.
+Lemma Nat_divide_ne_0 x y : (x | y) → y ≠0 → x ≠0.
+Proof. intros Hxy Hy ->. by apply Hy, Nat.divide_0_l. Qed.
+
(** * Notations and properties of [positive] *)
Open Scope positive_scope.
Infix "≤" := Pos.le : positive_scope.
-Notation "x ≤ y ≤ z" := (x ≤ y ∧ y ≤ z)%positive : positive_scope.
-Notation "x ≤ y < z" := (x ≤ y ∧ y < z)%positive : positive_scope.
-Notation "x < y < z" := (x < y ∧ y < z)%positive : positive_scope.
-Notation "x < y ≤ z" := (x < y ∧ y ≤ z)%positive : 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" := (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.
@@ -116,11 +131,11 @@ Fixpoint Preverse_go (p1 p2 : positive) : positive :=
Definition Preverse : positive → positive := Preverse_go 1.
Global Instance: LeftId (=) 1 (++).
-Proof. intros p. induction p; simpl; intros; f_equal; auto. Qed.
+Proof. intros p. by induction p; intros; f_equal'. Qed.
Global Instance: RightId (=) 1 (++).
Proof. done. Qed.
Global Instance: Associative (=) (++).
-Proof. intros ?? p. induction p; simpl; intros; f_equal; auto. Qed.
+Proof. intros ?? p. by induction p; intros; f_equal'. Qed.
Global Instance: ∀ p : positive, Injective (=) (=) (++ p).
Proof. intros p ???. induction p; simplify_equality; auto. Qed.
@@ -148,13 +163,10 @@ Lemma Preverse_xI p : Preverse (p~1) = (1~1) ++ Preverse p.
Proof Preverse_app p (1~1).
Fixpoint Plength (p : positive) : nat :=
- match p with
- | 1 => 0%nat
- | p~0 | p~1 => S (Plength p)
- end.
+ match p with 1 => 0%nat | p~0 | p~1 => S (Plength p) end.
Lemma Papp_length p1 p2 :
Plength (p1 ++ p2) = (Plength p2 + Plength p1)%nat.
-Proof. induction p2; simpl; f_equal; auto. Qed.
+Proof. by induction p2; f_equal'. Qed.
Close Scope positive_scope.
@@ -164,6 +176,7 @@ 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" := (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.
@@ -201,6 +214,7 @@ 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.
@@ -211,6 +225,11 @@ 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.
+Instance: Injective (=) (=) Zpos.
+Proof. by injection 1. Qed.
+Instance: Injective (=) (=) Zneg.
+Proof. by injection 1. Qed.
+
Instance Z_eq_dec: ∀ x y : Z, Decision (x = y) := Z.eq_dec.
Instance Z_le_dec: ∀ x y : Z, Decision (x ≤ y) := Z_le_dec.
Instance Z_lt_dec: ∀ x y : Z, Decision (x < y) := Z_lt_dec.
@@ -281,15 +300,25 @@ Close Scope Z_scope.
(** * Notations and properties of [Qc] *)
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.
+Notation "x - y" := (x + -y) : Qc_scope.
+Notation "x / y" := (x * /y) : 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.
+Hint Extern 1 (_ ≤ _) => reflexivity || discriminate.
+Arguments Qred _ : simpl never.
+
Instance Qc_eq_dec: ∀ x y : Qc, Decision (x = y) := Qc_eq_dec.
Program Instance Qc_le_dec (x y : Qc) : Decision (x ≤ y) :=
if Qclt_le_dec y x then right _ else left _.
@@ -306,12 +335,14 @@ Instance: StrictOrder (<).
Proof.
split; red. intros x Hx. by destruct (Qclt_not_eq x x). apply Qclt_trans.
Qed.
-
+Lemma Qcmult_0_l x : 0 * x = 0.
+Proof. ring. Qed.
+Lemma Qcmult_0_r x : x * 0 = 0.
+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.
@@ -330,12 +361,16 @@ Instance: Injective (=) (=) Qcopp.
Proof.
intros x y H. by rewrite <-(Qcopp_involutive x), H, Qcopp_involutive.
Qed.
-Instance: Injective (=) (=) (Qcplus z).
+Instance: ∀ z, Injective (=) (=) (Qcplus z).
Proof.
intros z x y H. by apply (anti_symmetric (≤));
rewrite (Qcplus_le_mono_l _ _ z), H.
Qed.
-
+Instance: ∀ z, Injective (=) (=) (λ x, x + z).
+Proof.
+ intros z x y H. by apply (anti_symmetric (≤));
+ 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|].
@@ -350,7 +385,6 @@ Proof.
intros. transitivity (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].
@@ -365,6 +399,57 @@ Proof.
intros. transitivity (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. transitivity (0 * y); [by rewrite Qcmult_0_l|].
+ by apply Qcmult_le_mono_nonneg_r.
+Qed.
+
+Lemma inject_Z_Qred n : Qred (inject_Z n) = inject_Z n.
+Proof. apply Qred_identity; auto using Z.gcd_1_r. Qed.
+Coercion Qc_of_Z (n : Z) : Qc := Qcmake _ (inject_Z_Qred n).
+Lemma Z2Qc_inj_0 : Qc_of_Z 0 = 0.
+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.
Close Scope Qc_scope.
(** * Conversions *)
diff --git a/theories/option.v b/theories/option.v
index b9e583d0..384d9e3f 100644
--- a/theories/option.v
+++ b/theories/option.v
@@ -4,13 +4,17 @@
data type that are not in the Coq standard library. *)
Require Export base tactics decidable.
+Inductive option_reflect {A} (P : A → Prop) (Q : Prop) : option A → Type :=
+ | ReflectSome x : P x → option_reflect P Q (Some x)
+ | ReflectNone : Q → option_reflect P Q None.
+
(** * General definitions and theorems *)
(** Basic properties about equality. *)
-Lemma None_ne_Some `(a : A) : None ≠Some a.
+Lemma None_ne_Some {A} (a : A) : None ≠Some a.
Proof. congruence. Qed.
-Lemma Some_ne_None `(a : A) : Some a ≠None.
+Lemma Some_ne_None {A} (a : A) : Some a ≠None.
Proof. congruence. Qed.
-Lemma eq_None_ne_Some `(x : option A) a : x = None → x ≠Some a.
+Lemma eq_None_ne_Some {A} (x : option A) a : x = None → x ≠Some a.
Proof. congruence. Qed.
Instance Some_inj {A} : Injective (=) (=) (@Some A).
Proof. congruence. Qed.
@@ -18,6 +22,7 @@ Proof. congruence. Qed.
(** The non dependent elimination principle on the option type. *)
Definition default {A B} (b : B) (x : option A) (f : A → B) : B :=
match x with None => b | Some a => f a end.
+Hint Extern 1000 => simpl (default _ (Some _) _) || simpl (default _ None _).
(** The [from_option] function allows us to get the value out of the option
type by specifying a default value. *)
@@ -69,18 +74,19 @@ Lemma not_eq_None_Some `(x : option A) : x ≠None ↔ is_Some x.
Proof. rewrite eq_None_not_Some. split. apply dec_stable. tauto. Qed.
(** Equality on [option] is decidable. *)
+Instance option_eq_None_dec {A} (x : option A) : Decision (x = None) :=
+ match x with Some _ => right (Some_ne_None _) | None => left eq_refl end.
+Instance option_None_eq_dec {A} (x : option A) : Decision (None = x) :=
+ match x with Some _ => right (None_ne_Some _) | None => left eq_refl end.
Instance option_eq_dec `{dec : ∀ x y : A, Decision (x = y)}
- (x y : option A) : Decision (x = y) :=
+ (x y : option A) : Decision (x = y).
+Proof.
+ refine
match x, y with
- | Some a, Some b =>
- match dec a b with
- | left H => left (f_equal _ H)
- | right H => right (H ∘ injective Some _ _)
- end
- | Some _, None => right (Some_ne_None _)
- | None, Some _ => right (None_ne_Some _)
- | None, None => left eq_refl
- end.
+ | Some a, Some b => cast_if (decide (a = b))
+ | None, None => left _ | _, _ => right _
+ end; abstract congruence.
+Defined.
(** * Monadic operations *)
Instance option_ret: MRet option := @Some.
@@ -99,9 +105,11 @@ Lemma fmap_Some {A B} (f : A → B) x y :
Proof. destruct x; naive_solver. Qed.
Lemma fmap_None {A B} (f : A → B) x : f <$> x = None ↔ x = None.
Proof. by destruct x. Qed.
-
Lemma option_fmap_id {A} (x : option A) : id <$> x = x.
Proof. by destruct x. Qed.
+Lemma option_fmap_compose {A B} (f : A → B) {C} (g : B → C) x :
+ g ∘ f <$> x = g <$> f <$> x.
+Proof. by destruct x. Qed.
Lemma option_fmap_bind {A B C} (f : A → B) (g : B → option C) x :
(f <$> x) ≫= g = x ≫= g ∘ f.
Proof. by destruct x. Qed.
@@ -120,10 +128,11 @@ Proof. split. by destruct x as [a|]; [exists a|]. by intros (?&->&?). Qed.
Lemma bind_None {A B} (f : A → option B) (x : option A) :
x ≫= f = None ↔ x = None ∨ ∃ a, x = Some a ∧ f a = None.
Proof.
- split.
- * destruct x; intros; simplify_equality'; eauto.
- * by intros [->|(?&->&?)].
+ split; [|by intros [->|(?&->&?)]].
+ destruct x; intros; simplify_equality'; eauto.
Qed.
+Lemma bind_with_Some {A} (x : option A) : x ≫= Some = x.
+Proof. by destruct x. Qed.
Tactic Notation "case_option_guard" "as" ident(Hx) :=
match goal with
@@ -144,90 +153,61 @@ Lemma option_guard_False {A} (P : Prop) `{Decision P} (x : option A) :
¬P → guard P; x = None.
Proof. intros. by case_option_guard. Qed.
-Tactic Notation "simplify_option_equality" "by" tactic3(tac) := repeat
- match goal with
- | _ => progress (unfold default in *)
+Tactic Notation "simplify_option_equality" "by" tactic3(tac) :=
+ let assert_Some_None A o H := first
+ [ let x := fresh in evar (x:A); let x' := eval unfold x in x in clear x;
+ assert (o = Some x') as H by tac
+ | assert (o = None) as H by tac ]
+ in repeat match goal with
| _ => progress simplify_equality'
| H : context [mbind (M:=option) (A:=?A) ?f ?o] |- _ =>
- let Hx := fresh in
- first
- [ let x := fresh in evar (x:A);
- let x' := eval unfold x in x in clear x;
- assert (o = Some x') as Hx by tac
- | assert (o = None) as Hx by tac ];
- rewrite Hx in H; clear Hx
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx in H; clear Hx
| H : context [fmap (M:=option) (A:=?A) ?f ?o] |- _ =>
- let Hx := fresh in
- first
- [ let x := fresh in evar (x:A);
- let x' := eval unfold x in x in clear x;
- assert (o = Some x') as Hx by tac
- | assert (o = None) as Hx by tac ];
- rewrite Hx in H; clear Hx
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx in H; clear Hx
+ | H : context [default (A:=?A) _ ?o _] |- _ =>
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx in H; clear Hx
| H : context [ match ?o with _ => _ end ] |- _ =>
match type of o with
| option ?A =>
- let Hx := fresh in
- first
- [ let x := fresh in evar (x:A);
- let x' := eval unfold x in x in clear x;
- assert (o = Some x') as Hx by tac
- | assert (o = None) as Hx by tac ];
- rewrite Hx in H; clear Hx
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx in H; clear Hx
end
- | H : mbind (M:=option) ?f ?o = ?x |- _ =>
+ | H : mbind (M:=option) _ ?o = ?x |- _ =>
match o with Some _ => fail 1 | None => fail 1 | _ => idtac end;
match x with Some _ => idtac | None => idtac | _ => fail 1 end;
destruct o eqn:?
- | H : ?x = mbind (M:=option) ?f ?o |- _ =>
+ | H : ?x = mbind (M:=option) _ ?o |- _ =>
match o with Some _ => fail 1 | None => fail 1 | _ => idtac end;
match x with Some _ => idtac | None => idtac | _ => fail 1 end;
destruct o eqn:?
- | H : fmap (M:=option) ?f ?o = ?x |- _ =>
+ | H : fmap (M:=option) _ ?o = ?x |- _ =>
match o with Some _ => fail 1 | None => fail 1 | _ => idtac end;
match x with Some _ => idtac | None => idtac | _ => fail 1 end;
destruct o eqn:?
- | H : ?x = fmap (M:=option) ?f ?o |- _ =>
+ | H : ?x = fmap (M:=option) _ ?o |- _ =>
match o with Some _ => fail 1 | None => fail 1 | _ => idtac end;
match x with Some _ => idtac | None => idtac | _ => fail 1 end;
destruct o eqn:?
| |- context [mbind (M:=option) (A:=?A) ?f ?o] =>
- let Hx := fresh in
- first
- [ let x := fresh in evar (x:A);
- let x' := eval unfold x in x in clear x;
- assert (o = Some x') as Hx by tac
- | assert (o = None) as Hx by tac ];
- rewrite Hx; clear Hx
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx; clear Hx
| |- context [fmap (M:=option) (A:=?A) ?f ?o] =>
- let Hx := fresh in
- first
- [ let x := fresh in evar (x:A);
- let x' := eval unfold x in x in clear x;
- assert (o = Some x') as Hx by tac
- | assert (o = None) as Hx by tac ];
- rewrite Hx; clear Hx
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx; clear Hx
+ | |- context [default (A:=?A) _ ?o _] =>
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx; clear Hx
+ | |- context [from_option (A:=?A) _ ?o] =>
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx; clear Hx
| |- context [ match ?o with _ => _ end ] =>
match type of o with
| option ?A =>
- let Hx := fresh in
- first
- [ let x := fresh in evar (x:A);
- let x' := eval unfold x in x in clear x;
- assert (o = Some x') as Hx by tac
- | assert (o = None) as Hx by tac ];
- rewrite Hx; clear Hx
+ let Hx := fresh in assert_Some_None A o Hx; rewrite Hx; clear Hx
end
- | H1 : ?o = Some ?x, H2 : ?o = Some ?y |- _ =>
- assert (y = x) by congruence; clear H2
- | H1 : ?o = Some ?x, H2 : ?o = None |- _ => congruence
+ | _ => rewrite decide_True by tac
+ | _ => rewrite decide_False by tac
+ | _ => rewrite option_guard_True by tac
+ | _ => rewrite option_guard_False by tac
+ | _ => progress case_decide
| _ => progress case_option_guard
end.
-Tactic Notation "simplify_option_equality" :=
- simplify_option_equality by eauto.
-
-Hint Extern 800 =>
- progress simplify_option_equality : simplify_option_equality.
+Tactic Notation "simplify_option_equality" := simplify_option_equality by eauto.
(** * Union, intersection and difference *)
Instance option_union_with {A} : UnionWith A (option A) := λ f x y,
@@ -248,21 +228,18 @@ Instance option_difference_with {A} : DifferenceWith A (option A) := λ f x y,
Section option_union_intersection_difference.
Context {A} (f : A → A → option A).
-
Global Instance: LeftId (=) None (union_with f).
Proof. by intros [?|]. Qed.
Global Instance: RightId (=) None (union_with f).
Proof. by intros [?|]. Qed.
Global Instance: Commutative (=) f → Commutative (=) (union_with f).
Proof. by intros ? [?|] [?|]; compute; rewrite 1?(commutative f). Qed.
-
Global Instance: LeftAbsorb (=) None (intersection_with f).
Proof. by intros [?|]. Qed.
Global Instance: RightAbsorb (=) None (intersection_with f).
Proof. by intros [?|]. Qed.
Global Instance: Commutative (=) f → Commutative (=) (intersection_with f).
Proof. by intros ? [?|] [?|]; compute; rewrite 1?(commutative f). Qed.
-
Global Instance: RightId (=) None (difference_with f).
Proof. by intros [?|]. Qed.
End option_union_intersection_difference.
diff --git a/theories/orders.v b/theories/orders.v
index 78ee688c..4e6b6e0c 100644
--- a/theories/orders.v
+++ b/theories/orders.v
@@ -19,7 +19,6 @@ Section orders.
Proof. by intros <-. Qed.
Lemma anti_symmetric_iff `{!PartialOrder R} X Y : X = Y ↔ R X Y ∧ R Y X.
Proof. intuition (subst; auto). Qed.
-
Lemma strict_spec X Y : X ⊂ Y ↔ X ⊆ Y ∧ Y ⊈ X.
Proof. done. Qed.
Lemma strict_include X Y : X ⊂ Y → X ⊆ Y.
@@ -40,7 +39,6 @@ Section orders.
* by transitivity Y.
* contradict HYZ. by transitivity X.
Qed.
-
Global Instance: Irreflexive (strict R).
Proof. firstorder. Qed.
Global Instance: Transitive R → StrictOrder (strict R).
@@ -48,11 +46,9 @@ Section orders.
split; try apply _.
eauto using strict_transitive_r, strict_include.
Qed.
-
Global Instance preorder_subset_dec_slow `{∀ X Y, Decision (X ⊆ Y)}
(X Y : A) : Decision (X ⊂ Y) | 100 := _.
-
- Lemma strict_spec_alt `{!PartialOrder R} X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠Y.
+ Lemma strict_spec_alt `{!AntiSymmetric (=) R} X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠Y.
Proof.
split.
* intros [? HYX]. split. done. by intros <-.
@@ -64,12 +60,10 @@ Section orders.
refine (cast_if_and (decide (X ⊆ Y)) (decide (Y ⊆ X)));
abstract (rewrite anti_symmetric_iff; tauto).
Defined.
-
Lemma total_not `{!Total R} X Y : X ⊈ Y → Y ⊆ X.
Proof. intros. destruct (total R X Y); tauto. Qed.
Lemma total_not_strict `{!Total R} X Y : X ⊈ Y → Y ⊂ X.
Proof. red; auto using total_not. Qed.
-
Global Instance trichotomy_total
`{!Trichotomy (strict R)} `{!Reflexive R} : Total R.
Proof.
@@ -308,7 +302,6 @@ Section merge_sort_correct.
* rewrite IH, merge_list_to_stack_Permutation; simpl.
by rewrite Permutation_middle.
Qed.
-
Lemma Sorted_merge_sort l : Sorted R (merge_sort R l).
Proof. apply Sorted_merge_sort_aux. by constructor. Qed.
Lemma merge_sort_Permutation l : merge_sort R l ≡ₚ l.
@@ -322,106 +315,87 @@ End merge_sort_correct.
(** We extend the canonical pre-order [⊆] to a partial order by defining setoid
equality as [λ X Y, X ⊆ Y ∧ Y ⊆ X]. We prove that this indeed gives rise to a
setoid. *)
+Instance preorder_equiv `{SubsetEq A} : Equiv A := λ X Y, X ⊆ Y ∧ Y ⊆ X.
+
Section preorder.
- Context `{SubsetEq A} `{!PreOrder (⊆)}.
+ Context `{SubsetEq A} `{!PreOrder (@subseteq A _)}.
- Global Instance preorder_equiv: Equiv A := λ X Y, X ⊆ Y ∧ Y ⊆ X.
Instance preorder_equivalence: @Equivalence A (≡).
Proof.
split.
* done.
* by intros ?? [??].
- * by intros x y z [??] [??]; split; transitivity y.
+ * by intros X Y Z [??] [??]; split; transitivity Y.
Qed.
-
Global Instance: Proper ((≡) ==> (≡) ==> iff) (⊆).
Proof.
- unfold equiv, preorder_equiv.
- intros x1 y1 ? x2 y2 ?. split; intro.
- * transitivity x1. tauto. transitivity x2; tauto.
- * transitivity y1. tauto. transitivity y2; tauto.
+ unfold equiv, preorder_equiv. intros X1 Y1 ? X2 Y2 ?. split; intro.
+ * transitivity X1. tauto. transitivity X2; tauto.
+ * transitivity Y1. tauto. transitivity Y2; tauto.
Qed.
-
Lemma subset_spec X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≢ Y.
Proof.
split.
- * intros [? HYX]. split. done. contradict HYX. by rewrite HYX.
+ * intros [? HYX]. split. done. contradict HYX. by rewrite <-HYX.
* intros [? HXY]. split. done. by contradict HXY.
Qed.
- Section leibniz.
- Context `{!LeibnizEquiv A}.
-
- Lemma subset_spec_L X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠Y.
- Proof. unfold_leibniz. apply subset_spec. Qed.
- End leibniz.
-
Section dec.
Context `{∀ X Y : A, Decision (X ⊆ Y)}.
-
Global Instance preorder_equiv_dec_slow (X Y : A) :
Decision (X ≡ Y) | 100 := _.
-
Lemma subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y.
Proof. rewrite subset_spec. destruct (decide (X ≡ Y)); tauto. Qed.
Lemma not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y.
Proof. rewrite subset_spec. destruct (decide (X ≡ Y)); tauto. Qed.
-
- Context `{!LeibnizEquiv A}.
-
- Lemma subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y.
- Proof. unfold_leibniz. apply subseteq_inv. Qed.
- Lemma not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y.
- Proof. unfold_leibniz. apply not_subset_inv. Qed.
End dec.
End preorder.
+Section preorder_leibniz.
+ Context `{SubsetEq A} `{!PreOrder (@subseteq A _)} `{!LeibnizEquiv A}.
+ Lemma subset_spec_L X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠Y.
+ Proof. unfold_leibniz. apply subset_spec. Qed.
+
+ Context `{∀ X Y : A, Decision (X ⊆ Y)}.
+ Lemma subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y.
+ Proof. unfold_leibniz. apply subseteq_inv. Qed.
+ Lemma not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y.
+ Proof. unfold_leibniz. apply not_subset_inv. Qed.
+End preorder_leibniz.
+
Typeclasses Opaque preorder_equiv.
Hint Extern 0 (@Equivalence _ (≡)) =>
class_apply preorder_equivalence : typeclass_instances.
(** * Partial orders *)
Section partialorder.
- Context `{SubsetEq A} `{!PartialOrder (⊆)}.
-
+ Context `{SubsetEq A} `{!PartialOrder (@subseteq A _)}.
Global Instance: LeibnizEquiv A.
- Proof.
- split.
- * intros [??]. by apply (anti_symmetric (⊆)).
- * intros. by subst.
- Qed.
+ Proof. split. intros [??]. by apply (anti_symmetric (⊆)). by intros ->. Qed.
End partialorder.
(** * Join semi lattices *)
(** General purpose theorems on join semi lattices. *)
Section bounded_join_sl.
Context `{BoundedJoinSemiLattice A}.
+ Implicit Types X Y : A.
+ Implicit Types Xs Ys : list A.
Hint Resolve subseteq_empty union_subseteq_l union_subseteq_r union_least.
-
- Lemma union_subseteq_l_alt x1 x2 y : x1 ⊆ x2 → x1 ⊆ x2 ∪ y.
- Proof. intros. transitivity x2; auto. Qed.
- Lemma union_subseteq_r_alt x1 x2 y : x1 ⊆ x2 → x1 ⊆ y ∪ x2.
- Proof. intros. transitivity x2; auto. Qed.
- Hint Resolve union_subseteq_l_alt union_subseteq_r_alt.
-
- Lemma union_preserving_l x y1 y2 : y1 ⊆ y2 → x ∪ y1 ⊆ x ∪ y2.
+ Lemma union_subseteq_l_transitive X1 X2 Y : X1 ⊆ X2 → X1 ⊆ X2 ∪ Y.
+ Proof. intros. transitivity X2; auto. Qed.
+ Lemma union_subseteq_r_transitive X1 X2 Y : X1 ⊆ X2 → X1 ⊆ Y ∪ X2.
+ Proof. intros. transitivity X2; auto. Qed.
+ Hint Resolve union_subseteq_l_transitive union_subseteq_r_transitive.
+ Lemma union_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2.
Proof. auto. Qed.
- Lemma union_preserving_r x1 x2 y : x1 ⊆ x2 → x1 ∪ y ⊆ x2 ∪ y.
+ Lemma union_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y.
Proof. auto. Qed.
- Lemma union_preserving x1 x2 y1 y2 : x1 ⊆ x2 → y1 ⊆ y2 → x1 ∪ y1 ⊆ x2 ∪ y2.
+ Lemma union_preserving X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2.
Proof. auto. Qed.
-
- Lemma union_empty x : x ∪ ∅ ⊆ x.
+ Lemma union_empty X : X ∪ ∅ ⊆ X.
Proof. by apply union_least. Qed.
- Lemma union_commutative_1 x y : x ∪ y ⊆ y ∪ x.
- Proof. auto. Qed.
- Lemma union_associative_1 x y z : (x ∪ y) ∪ z ⊆ x ∪ (y ∪ z).
- Proof. auto. Qed.
- Lemma union_associative_2 x y z : x ∪ (y ∪ z) ⊆ (x ∪ y) ∪ z.
- Proof. auto. Qed.
-
- Global Instance union_proper: Proper ((≡) ==> (≡) ==> (≡)) (∪).
+ Global Instance union_proper : Proper ((≡) ==> (≡) ==> (≡)) (∪).
Proof.
unfold equiv, preorder_equiv.
split; apply union_preserving; simpl in *; tauto.
@@ -433,54 +407,45 @@ Section bounded_join_sl.
Global Instance: RightId (≡) ∅ (∪).
Proof. split; eauto. Qed.
Global Instance: Commutative (≡) (∪).
- Proof. split; apply union_commutative_1. Qed.
+ Proof. split; auto. Qed.
Global Instance: Associative (≡) (∪).
- Proof. split. apply union_associative_2. apply union_associative_1. Qed.
-
+ Proof. split; auto. Qed.
Lemma subseteq_union X Y : X ⊆ Y ↔ X ∪ Y ≡ Y.
- Proof. repeat split; eauto. intros E. rewrite <-E. auto. Qed.
+ Proof. repeat split; eauto. intros HXY. rewrite <-HXY. auto. Qed.
Lemma subseteq_union_1 X Y : X ⊆ Y → X ∪ Y ≡ Y.
Proof. apply subseteq_union. Qed.
Lemma subseteq_union_2 X Y : X ∪ Y ≡ Y → X ⊆ Y.
Proof. apply subseteq_union. Qed.
-
Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅.
Proof. split; eauto. Qed.
-
- Global Instance union_list_proper: Proper (Forall2 (≡) ==> (≡)) union_list.
- Proof.
- induction 1; simpl.
- * done.
- * by apply union_proper.
- Qed.
-
+ Global Instance union_list_proper:
+ Proper (Forall2 (≡) ==> (≡)) union_list.
+ Proof. induction 1; simpl. done. by apply union_proper. Qed.
Lemma union_list_nil : ⋃ @nil A = ∅.
Proof. done. Qed.
- Lemma union_list_cons (X : A) (Xs : list A) : ⋃ (X :: Xs) = X ∪ ⋃ Xs.
+ Lemma union_list_cons X Xs : ⋃ (X :: Xs) = X ∪ ⋃ Xs.
Proof. done. Qed.
- Lemma union_list_singleton (X : A) : ⋃ [X] ≡ X.
+ Lemma union_list_singleton X : ⋃ [X] ≡ X.
Proof. simpl. by rewrite (right_id ∅ _). Qed.
- Lemma union_list_app (Xs1 Xs2 : list A) : ⋃ (Xs1 ++ Xs2) ≡ ⋃ Xs1 ∪ ⋃ Xs2.
+ Lemma union_list_app Xs1 Xs2 : ⋃ (Xs1 ++ Xs2) ≡ ⋃ Xs1 ∪ ⋃ Xs2.
Proof.
- induction Xs1 as [|X Xs1 IH]; simpl.
- * by rewrite (left_id ∅ _).
- * by rewrite IH, (associative _).
+ induction Xs1 as [|X Xs1 IH]; simpl; [by rewrite (left_id ∅ _)|].
+ by rewrite IH, (associative _).
Qed.
- Lemma union_list_reverse (Xs : list A) : ⋃ (reverse Xs) ≡ ⋃ Xs.
+ Lemma union_list_reverse Xs : ⋃ (reverse Xs) ≡ ⋃ Xs.
Proof.
induction Xs as [|X Xs IH]; simpl; [done |].
by rewrite reverse_cons, union_list_app,
union_list_singleton, (commutative _), IH.
Qed.
- Lemma union_list_preserving (Xs Ys : list A) : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
+ Lemma union_list_preserving Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
Proof. induction 1; simpl; auto using union_preserving. Qed.
-
Lemma empty_union X Y : X ∪ Y ≡ ∅ ↔ X ≡ ∅ ∧ Y ≡ ∅.
Proof.
split.
- * intros E. split; apply equiv_empty;
- by transitivity (X ∪ Y); [auto | rewrite E].
- * intros [E1 E2]. by rewrite E1, E2, (left_id _ _).
+ * intros HXY. split; apply equiv_empty;
+ by transitivity (X ∪ Y); [auto | rewrite HXY].
+ * intros [HX HY]. by rewrite HX, HY, (left_id _ _).
Qed.
Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (≡ ∅) Xs.
Proof.
@@ -491,7 +456,6 @@ Section bounded_join_sl.
Section leibniz.
Context `{!LeibnizEquiv A}.
-
Global Instance: Idempotent (=) (∪).
Proof. intros ?. unfold_leibniz. apply (idempotent _). Qed.
Global Instance: LeftId (=) ∅ (∪).
@@ -502,14 +466,12 @@ Section bounded_join_sl.
Proof. intros ??. unfold_leibniz. apply (commutative _). Qed.
Global Instance: Associative (=) (∪).
Proof. intros ???. unfold_leibniz. apply (associative _). Qed.
-
Lemma subseteq_union_L X Y : X ⊆ Y ↔ X ∪ Y = Y.
Proof. unfold_leibniz. apply subseteq_union. Qed.
Lemma subseteq_union_1_L X Y : X ⊆ Y → X ∪ Y = Y.
Proof. unfold_leibniz. apply subseteq_union_1. Qed.
Lemma subseteq_union_2_L X Y : X ∪ Y = Y → X ⊆ Y.
Proof. unfold_leibniz. apply subseteq_union_2. Qed.
-
Lemma equiv_empty_L X : X ⊆ ∅ → X = ∅.
Proof. unfold_leibniz. apply equiv_empty. Qed.
Lemma union_list_singleton_L (X : A) : ⋃ [X] = X.
@@ -518,21 +480,18 @@ Section bounded_join_sl.
Proof. unfold_leibniz. apply union_list_app. Qed.
Lemma union_list_reverse_L (Xs : list A) : ⋃ (reverse Xs) = ⋃ Xs.
Proof. unfold_leibniz. apply union_list_reverse. Qed.
-
Lemma empty_union_L X Y : X ∪ Y = ∅ ↔ X = ∅ ∧ Y = ∅.
Proof. unfold_leibniz. apply empty_union. Qed.
Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (= ∅) Xs.
- Proof. unfold_leibniz. apply empty_union_list. Qed.
+ Proof. unfold_leibniz. by rewrite empty_union_list. Qed.
End leibniz.
Section dec.
Context `{∀ X Y : A, Decision (X ⊆ Y)}.
-
Lemma non_empty_union X Y : X ∪ Y ≢ ∅ → X ≢ ∅ ∨ Y ≢ ∅.
Proof. rewrite empty_union. destruct (decide (X ≡ ∅)); intuition. Qed.
Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (≢ ∅) Xs.
Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed.
-
Context `{!LeibnizEquiv A}.
Lemma non_empty_union_L X Y : X ∪ Y ≠∅ → X ≠∅ ∨ Y ≠∅.
Proof. unfold_leibniz. apply non_empty_union. Qed.
@@ -545,31 +504,24 @@ End bounded_join_sl.
(** The dual of the above section, but now for meet semi lattices. *)
Section meet_sl.
Context `{MeetSemiLattice A}.
+ Implicit Types X Y : A.
+ Implicit Types Xs Ys : list A.
Hint Resolve intersection_subseteq_l intersection_subseteq_r
intersection_greatest.
-
- Lemma intersection_subseteq_l_alt x1 x2 y : x1 ⊆ x2 → x1 ∩ y ⊆ x2.
- Proof. intros. transitivity x1; auto. Qed.
- Lemma intersection_subseteq_r_alt x1 x2 y : x1 ⊆ x2 → y ∩ x1 ⊆ x2.
- Proof. intros. transitivity x1; auto. Qed.
- Hint Resolve intersection_subseteq_l_alt intersection_subseteq_r_alt.
-
- Lemma intersection_preserving_l x y1 y2 : y1 ⊆ y2 → x ∩ y1 ⊆ x ∩ y2.
- Proof. auto. Qed.
- Lemma intersection_preserving_r x1 x2 y : x1 ⊆ x2 → x1 ∩ y ⊆ x2 ∩ y.
- Proof. auto. Qed.
- Lemma intersection_preserving x1 x2 y1 y2 :
- x1 ⊆ x2 → y1 ⊆ y2 → x1 ∩ y1 ⊆ x2 ∩ y2.
+ Lemma intersection_subseteq_l_transitive X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2.
+ Proof. intros. transitivity X1; auto. Qed.
+ Lemma intersection_subseteq_r_transitive X1 X2 Y : X1 ⊆ X2 → Y ∩ X1 ⊆ X2.
+ Proof. intros. transitivity X1; auto. Qed.
+ Hint Resolve intersection_subseteq_l_transitive
+ intersection_subseteq_r_transitive.
+ Lemma intersection_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∩ Y1 ⊆ X ∩ Y2.
Proof. auto. Qed.
-
- Lemma intersection_commutative_1 x y : x ∩ y ⊆ y ∩ x.
- Proof. auto. Qed.
- Lemma intersection_associative_1 x y z : (x ∩ y) ∩ z ⊆ x ∩ (y ∩ z).
+ Lemma intersection_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2 ∩ Y.
Proof. auto. Qed.
- Lemma intersection_associative_2 x y z : x ∩ (y ∩ z) ⊆ (x ∩ y) ∩ z.
+ Lemma intersection_preserving X1 X2 Y1 Y2 :
+ X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∩ Y1 ⊆ X2 ∩ Y2.
Proof. auto. Qed.
-
Global Instance: Proper ((≡) ==> (≡) ==> (≡)) (∩).
Proof.
unfold equiv, preorder_equiv. split;
@@ -578,14 +530,11 @@ Section meet_sl.
Global Instance: Idempotent (≡) (∩).
Proof. split; eauto. Qed.
Global Instance: Commutative (≡) (∩).
- Proof. split; apply intersection_commutative_1. Qed.
+ Proof. split; auto. Qed.
Global Instance: Associative (≡) (∩).
- Proof.
- split. apply intersection_associative_2. apply intersection_associative_1.
- Qed.
-
+ Proof. split; auto. Qed.
Lemma subseteq_intersection X Y : X ⊆ Y ↔ X ∩ Y ≡ X.
- Proof. repeat split; eauto. intros E. rewrite <-E. auto. Qed.
+ Proof. repeat split; eauto. intros HXY. rewrite <-HXY. auto. 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.
@@ -593,14 +542,12 @@ Section meet_sl.
Section leibniz.
Context `{!LeibnizEquiv A}.
-
Global Instance: Idempotent (=) (∩).
Proof. intros ?. unfold_leibniz. apply (idempotent _). Qed.
Global Instance: Commutative (=) (∩).
Proof. intros ??. unfold_leibniz. apply (commutative _). Qed.
Global Instance: Associative (=) (∩).
Proof. intros ???. unfold_leibniz. apply (associative _). Qed.
-
Lemma subseteq_intersection_L X Y : X ⊆ Y ↔ X ∩ Y = X.
Proof. unfold_leibniz. apply subseteq_intersection. Qed.
Lemma subseteq_intersection_1_L X Y : X ⊆ Y → X ∩ Y = X.
@@ -616,47 +563,42 @@ Section lower_bounded_lattice.
Global Instance: LeftAbsorb (≡) ∅ (∩).
Proof.
- split.
- * by apply intersection_subseteq_l.
- * by apply subseteq_empty.
+ split. by apply intersection_subseteq_l. by apply subseteq_empty.
Qed.
Global Instance: RightAbsorb (≡) ∅ (∩).
Proof. intros ?. by rewrite (commutative _), (left_absorb _ _). Qed.
Global Instance: LeftDistr (≡) (∪) (∩).
Proof.
- intros x y z. split.
+ intros X Y Z. split.
* apply union_least.
{ apply intersection_greatest; auto using union_subseteq_l. }
apply intersection_greatest.
- + apply union_subseteq_r_alt, intersection_subseteq_l.
- + apply union_subseteq_r_alt, intersection_subseteq_r.
+ + apply union_subseteq_r_transitive, intersection_subseteq_l.
+ + apply union_subseteq_r_transitive, intersection_subseteq_r.
* apply lbl_distr.
Qed.
Global Instance: RightDistr (≡) (∪) (∩).
- Proof. intros x y z. by rewrite !(commutative _ _ z), (left_distr _ _). Qed.
+ Proof. intros X Y Z. by rewrite !(commutative _ _ Z), (left_distr _ _). Qed.
Global Instance: LeftDistr (≡) (∩) (∪).
Proof.
- intros x y z. split.
+ intros X Y Z. split.
* rewrite (left_distr (∪) (∩)).
apply intersection_greatest.
- { apply union_subseteq_r_alt, intersection_subseteq_l. }
+ { apply union_subseteq_r_transitive, intersection_subseteq_l. }
rewrite (right_distr (∪) (∩)). apply intersection_preserving.
+ apply union_subseteq_l.
+ done.
* apply intersection_greatest.
{ apply union_least; auto using intersection_subseteq_l. }
apply union_least.
- + apply intersection_subseteq_r_alt, union_subseteq_l.
- + apply intersection_subseteq_r_alt, union_subseteq_r.
+ + apply intersection_subseteq_r_transitive, union_subseteq_l.
+ + apply intersection_subseteq_r_transitive, union_subseteq_r.
Qed.
Global Instance: RightDistr (≡) (∩) (∪).
- Proof.
- intros x y z. by rewrite !(commutative _ _ z), (left_distr _ _).
- Qed.
+ Proof. intros X Y Z. by rewrite !(commutative _ _ Z), (left_distr _ _). Qed.
Section leibniz.
Context `{!LeibnizEquiv A}.
-
Global Instance: LeftAbsorb (=) ∅ (∩).
Proof. intros ?. unfold_leibniz. apply (left_absorb _ _). Qed.
Global Instance: RightAbsorb (=) ∅ (∩).
diff --git a/theories/pmap.v b/theories/pmap.v
index fff29fce..800bfe16 100644
--- a/theories/pmap.v
+++ b/theories/pmap.v
@@ -85,14 +85,12 @@ Global Instance Pempty {A} : Empty (Pmap A) :=
(∅ : Pmap_raw A) ↾ bool_decide_pack _ Pmap_wf_leaf.
Instance Plookup_raw {A} : Lookup positive A (Pmap_raw A) :=
- fix Plookup_raw (i : positive) (t : Pmap_raw A) {struct t} : option A :=
+ fix go (i : positive) (t : Pmap_raw A) {struct t} : option A :=
match t with
| PLeaf => None
| PNode l o r =>
match i with
- | 1 => o
- | i~0 => @lookup _ _ _ Plookup_raw i l
- | i~1 => @lookup _ _ _ Plookup_raw i r
+ | 1 => o | i~0 => @lookup _ _ _ go i l | i~1 => @lookup _ _ _ go i r
end
end.
Instance Plookup {A} : Lookup positive A (Pmap A) := λ i t, `t !! i.
@@ -100,7 +98,7 @@ Instance Plookup {A} : Lookup positive A (Pmap A) := λ i t, `t !! i.
Lemma Plookup_empty {A} i : (∅ : Pmap_raw A) !! i = None.
Proof. by destruct i. Qed.
-Lemma Pmap_ne_lookup `(t : Pmap_raw A) : Pmap_ne t → ∃ i x, t !! i = Some x.
+Lemma Pmap_ne_lookup {A} (t : Pmap_raw A) : Pmap_ne t → ∃ i x, t !! i = Some x.
Proof.
induction 1 as [? x ?| l r ? IHl | l r ? IHr].
* intros. by exists 1 x.
@@ -145,52 +143,41 @@ Fixpoint Psingleton_raw {A} (i : positive) (x : A) : Pmap_raw A :=
| i~0 => PNode (Psingleton_raw i x) None PLeaf
| i~1 => PNode PLeaf None (Psingleton_raw i x)
end.
-
Lemma Psingleton_ne {A} i (x : A) : Pmap_ne (Psingleton_raw i x).
Proof. induction i; simpl; intuition. Qed.
Local Hint Resolve Psingleton_ne.
Lemma Psingleton_wf {A} i (x : A) : Pmap_wf (Psingleton_raw i x).
Proof. induction i; simpl; intuition. Qed.
Local Hint Resolve Psingleton_wf.
-
Lemma Plookup_singleton {A} i (x : A) : Psingleton_raw i x !! i = Some x.
Proof. by induction i. Qed.
Lemma Plookup_singleton_ne {A} i j (x : A) :
i ≠j → Psingleton_raw i x !! j = None.
Proof. revert j. induction i; intros [?|?|]; simpl; auto. congruence. Qed.
-Definition PNode_canon `(l : Pmap_raw A) (o : option A) (r : Pmap_raw A) :=
- match l, o, r with
- | PLeaf, None, PLeaf => PLeaf
- | _, _, _ => PNode l o r
- end.
-
-Lemma PNode_canon_wf `(l : Pmap_raw A) (o : option A) (r : Pmap_raw A) :
+Definition PNode_canon {A} (l : Pmap_raw A) (o : option A) (r : Pmap_raw A) :=
+ match l, o, r with PLeaf, None, PLeaf => PLeaf | _, _, _ => PNode l o r end.
+Lemma PNode_canon_wf {A} (l : Pmap_raw A) (o : option A) (r : Pmap_raw A) :
Pmap_wf l → Pmap_wf r → Pmap_wf (PNode_canon l o r).
Proof. intros H1 H2. destruct H1, o, H2; simpl; intuition. Qed.
Local Hint Resolve PNode_canon_wf.
-
-Lemma PNode_canon_lookup_xH `(l : Pmap_raw A) o (r : Pmap_raw A) :
+Lemma PNode_canon_lookup_xH {A} (l : Pmap_raw A) o (r : Pmap_raw A) :
PNode_canon l o r !! 1 = o.
Proof. by destruct l,o,r. Qed.
-Lemma PNode_canon_lookup_xO `(l : Pmap_raw A) o (r : Pmap_raw A) i :
+Lemma PNode_canon_lookup_xO {A} (l : Pmap_raw A) o (r : Pmap_raw A) i :
PNode_canon l o r !! i~0 = l !! i.
Proof. by destruct l,o,r. Qed.
-Lemma PNode_canon_lookup_xI `(l : Pmap_raw A) o (r : Pmap_raw A) i :
+Lemma PNode_canon_lookup_xI {A} (l : Pmap_raw A) o (r : Pmap_raw A) i :
PNode_canon l o r !! i~1 = r !! i.
Proof. by destruct l,o,r. Qed.
-Ltac PNode_canon_rewrite := repeat (
- rewrite PNode_canon_lookup_xH || rewrite PNode_canon_lookup_xO ||
- rewrite PNode_canon_lookup_xI).
+Ltac PNode_canon_rewrite := repeat first
+ [ rewrite PNode_canon_lookup_xH | rewrite PNode_canon_lookup_xO
+ | rewrite PNode_canon_lookup_xI].
Instance Ppartial_alter_raw {A} : PartialAlter positive A (Pmap_raw A) :=
fix go f i t {struct t} : Pmap_raw A :=
match t with
- | PLeaf =>
- match f None with
- | None => PLeaf
- | Some x => Psingleton_raw i x
- end
+ | PLeaf => match f None with None => PLeaf | Some x => Psingleton_raw i x end
| PNode l o r =>
match i with
| 1 => PNode_canon l (f o) r
@@ -198,7 +185,6 @@ Instance Ppartial_alter_raw {A} : PartialAlter positive A (Pmap_raw A) :=
| i~1 => PNode_canon l o (@partial_alter _ _ _ go f i r)
end
end.
-
Lemma Ppartial_alter_wf {A} f i (t : Pmap_raw A) :
Pmap_wf t → Pmap_wf (partial_alter f i t).
Proof.
@@ -207,18 +193,14 @@ Proof.
* intros [?|?|]; simpl; intuition.
* intros [?|?|]; simpl; intuition.
Qed.
-
Instance Ppartial_alter {A} : PartialAlter positive A (Pmap A) := λ f i t,
dexist (partial_alter f i (`t)) (Ppartial_alter_wf f i _ (proj2_dsig t)).
-
Lemma Plookup_alter {A} f i (t : Pmap_raw A) :
partial_alter f i t !! i = f (t !! i).
Proof.
revert i. induction t.
- * intros i. change (
- match f None with
- | Some x => Psingleton_raw i x | None => PLeaf
- end !! i = f None). destruct (f None).
+ * intros i. change (match f None with Some x => Psingleton_raw i x
+ | None => PLeaf end !! i = f None); destruct (f None).
+ intros. apply Plookup_singleton.
+ by destruct i.
* intros [?|?|]; simpl; by PNode_canon_rewrite.
@@ -227,44 +209,35 @@ Lemma Plookup_alter_ne {A} f i j (t : Pmap_raw A) :
i ≠j → partial_alter f i t !! j = t !! j.
Proof.
revert i j. induction t as [|l IHl ? r IHr].
- * intros. change (
- match f None with
- | Some x => Psingleton_raw i x | None => PLeaf
- end !! j = None). destruct (f None).
- + intros. by apply Plookup_singleton_ne.
- + done.
+ * intros. change (match f None with Some x => Psingleton_raw i x
+ | None => PLeaf end !! j = None); destruct (f None); [|done].
+ intros. by apply Plookup_singleton_ne.
* intros [?|?|] [?|?|]; simpl; PNode_canon_rewrite; auto; congruence.
Qed.
Instance Pfmap_raw {A B} (f : A → B) : FMapD Pmap_raw f :=
- fix go (t : Pmap_raw A) : Pmap_raw B :=
- let _ : FMapD Pmap_raw f := @go in
+ fix go (t : Pmap_raw A) := let _ : FMapD _ _ := @go in
match t with
- | PLeaf => PLeaf
- | PNode l x r => PNode (f <$> l) (f <$> x) (f <$> r)
+ | PLeaf => PLeaf | PNode l x r => PNode (f <$> l) (f <$> x) (f <$> r)
end.
-
Lemma Pfmap_ne `(f : A → B) (t : Pmap_raw A) : Pmap_ne t → Pmap_ne (fmap f t).
Proof. induction 1; simpl; auto. Qed.
Local Hint Resolve Pfmap_ne.
Lemma Pfmap_wf `(f : A → B) (t : Pmap_raw A) : Pmap_wf t → Pmap_wf (fmap f t).
Proof. induction 1; simpl; intuition. Qed.
-
Global Instance Pfmap {A B} (f : A → B) : FMapD Pmap f := λ t,
dexist _ (Pfmap_wf f _ (proj2_dsig t)).
-
Lemma Plookup_fmap {A B} (f : A → B) (t : Pmap_raw A) i :
- fmap f t !! i = fmap f (t !! i).
+ (f <$> t) !! i = f <$> t !! i.
Proof. revert i. induction t. done. by intros [?|?|]; simpl. Qed.
-Fixpoint Pto_list_raw {A} (j: positive) (t: Pmap_raw A)
+Fixpoint Pto_list_raw {A} (j : positive) (t : Pmap_raw A)
(acc : list (positive * A)) : list (positive * A) :=
match t with
| PLeaf => acc
| PNode l o r => default [] o (λ x, [(Preverse j, x)]) ++
Pto_list_raw (j~0) l (Pto_list_raw (j~1) r acc)
end%list.
-
Lemma Pelem_of_to_list {A} (t : Pmap_raw A) j i acc x :
(i,x) ∈ Pto_list_raw j t acc ↔
(∃ i', i = i' ++ Preverse j ∧ t !! i' = Some x) ∨ (i,x) ∈ acc.
@@ -332,72 +305,70 @@ Proof.
apply IHr; auto. intros i x Hi.
apply (Hin (i~1) x). by rewrite Preverse_xI, (associative_L _) in Hi.
Qed.
-
Global Instance Pto_list {A} : FinMapToList positive A (Pmap A) :=
λ t, Pto_list_raw 1 (`t) [].
-Fixpoint Pmerge_aux `(f : option A → option B) (t : Pmap_raw A) : Pmap_raw B :=
+Instance Pomap_raw {A B} (f : A → option B) : OMapD Pmap_raw f :=
+ fix go (t : Pmap_raw A) := let _ : OMapD _ _ := @go in
match t with
- | PLeaf => PLeaf
- | PNode l o r => PNode_canon (Pmerge_aux f l) (f o) (Pmerge_aux f r)
+ | PLeaf => PLeaf | PNode l o r => PNode_canon (omap f l) (o ≫= f) (omap f r)
end.
-
-Lemma Pmerge_aux_wf `(f : option A → option B) (t : Pmap_raw A) :
- Pmap_wf t → Pmap_wf (Pmerge_aux f t).
+Lemma Pomap_wf {A B} (f : A → option B) (t : Pmap_raw A) :
+ Pmap_wf t → Pmap_wf (omap f t).
Proof. induction 1; simpl; auto. Qed.
-Local Hint Resolve Pmerge_aux_wf.
-
-Lemma Pmerge_aux_spec `(f : option A → option B) (Hf : f None = None)
- (t : Pmap_raw A) i : Pmerge_aux f t !! i = f (t !! i).
+Local Hint Resolve Pomap_wf.
+Lemma Pomap_lookup {A B} (f : A → option B) (t : Pmap_raw A) i :
+ omap f t !! i = t !! i ≫= f.
Proof.
revert i. induction t as [| l IHl o r IHr ]; [done |].
intros [?|?|]; simpl; PNode_canon_rewrite; auto.
Qed.
+Global Instance Pomap: OMap Pmap := λ A B f t,
+ dexist _ (Pomap_wf f _ (proj2_dsig t)).
-Global Instance Pmerge_raw : Merge Pmap_raw :=
+Instance Pmerge_raw : Merge Pmap_raw :=
fix Pmerge_raw A B C f t1 t2 : Pmap_raw C :=
match t1, t2 with
- | PLeaf, t2 => Pmerge_aux (f None) t2
- | t1, PLeaf => Pmerge_aux (flip f None) t1
+ | PLeaf, t2 => omap (f None ∘ Some) t2
+ | t1, PLeaf => omap (flip f None ∘ Some) t1
| PNode l1 o1 r1, PNode l2 o2 r2 =>
PNode_canon (@merge _ Pmerge_raw A B C f l1 l2)
(f o1 o2) (@merge _ Pmerge_raw A B C f r1 r2)
end.
-Local Arguments Pmerge_aux _ _ _ _ : simpl never.
-
+Local Arguments omap _ _ _ _ _ _ : simpl never.
Lemma Pmerge_wf {A B C} (f : option A → option B → option C) t1 t2 :
Pmap_wf t1 → Pmap_wf t2 → Pmap_wf (merge f t1 t2).
Proof. intros t1wf. revert t2. induction t1wf; destruct 1; simpl; auto. Qed.
Global Instance Pmerge: Merge Pmap := λ A B C f t1 t2,
dexist _ (Pmerge_wf f _ _ (proj2_dsig t1) (proj2_dsig t2)).
-
Lemma Pmerge_spec {A B C} (f : option A → option B → option C)
(Hf : f None None = None) (t1 : Pmap_raw A) t2 i :
merge f t1 t2 !! i = f (t1 !! i) (t2 !! i).
Proof.
- revert t2 i. induction t1 as [| l1 IHl1 o1 r1 IHr1 ].
- * intros. unfold merge. simpl. by rewrite Pmerge_aux_spec.
- * destruct t2 as [| l2 o2 r2 ].
- + unfold merge, Pmerge_raw. intros. by rewrite Pmerge_aux_spec.
- + intros [?|?|]; simpl; by PNode_canon_rewrite.
+ revert t2 i. induction t1 as [|l1 IHl1 o1 r1 IHr1]; intros t2 i.
+ { unfold merge; simpl. rewrite Pomap_lookup. by destruct (t2 !! i). }
+ destruct t2 as [|l2 o2 r2].
+ * unfold merge, Pmerge_raw. rewrite Pomap_lookup.
+ by destruct (PNode _ _ _ !! i).
+ * destruct i; simpl; by PNode_canon_rewrite.
Qed.
(** * Instantiation of the finite map interface *)
Global Instance: FinMap positive Pmap.
Proof.
split.
- * intros ? [t1?] [t2?]. intros. apply dsig_eq. simpl.
+ * intros ? [t1 ?] [t2 ?] ?. apply dsig_eq; simpl.
apply Pmap_wf_eq_get; trivial; by apply (bool_decide_unpack _).
- * by destruct i.
+ * by intros ? [].
* intros ?? [??] ?. by apply Plookup_alter.
* intros ?? [??] ??. by apply Plookup_alter_ne.
* intros ??? [??]. by apply Plookup_fmap.
- * intros ? [??]. apply Pto_list_nodup.
- + intros ??. by rewrite elem_of_nil.
- + constructor.
+ * intros ? [??]. apply Pto_list_nodup; [|constructor].
+ intros ??. by rewrite elem_of_nil.
* intros ? [??] i x; unfold map_to_list, Pto_list.
rewrite Pelem_of_to_list, elem_of_nil.
split. by intros [(?&->&?)|]. by left; exists i.
+ * intros ?? ? [??] ?. by apply Pomap_lookup.
* intros ??? ?? [??] [??] ?. by apply Pmerge_spec.
Qed.
diff --git a/theories/tactics.v b/theories/tactics.v
index e9687ca0..a15dc055 100644
--- a/theories/tactics.v
+++ b/theories/tactics.v
@@ -40,6 +40,7 @@ Tactic Notation "by" tactic(tac) :=
tactic [split_and] only splits a conjunction. *)
Ltac split_and := match goal with |- _ ∧ _ => split end.
Ltac split_ands := repeat split_and.
+Ltac split_ands' := repeat (hnf; split_and).
(** The tactic [case_match] destructs an arbitrary match in the conclusion or
assumptions, and generates a corresponding equality. This tactic is best used
@@ -160,8 +161,13 @@ Ltac simplify_equality := repeat
(* before [injection'] to circumvent bug #2939 in some situations *)
| H : _ = _ |- _ => injection' H
| H : ?x = ?x |- _ => clear H
+ (* unclear how to generalize the below *)
+ | H1 : ?o = Some ?x, H2 : ?o = Some ?y |- _ =>
+ assert (y = x) by congruence; clear H2
+ | H1 : ?o = Some ?x, H2 : ?o = None |- _ => congruence
end.
Ltac simplify_equality' := repeat (progress simpl in * || simplify_equality).
+Ltac f_equal' := simpl in *; f_equal.
(** Given a tactic [tac2] generating a list of terms, [iter tac1 tac2]
runs [tac x] for each element [x] until [tac x] succeeds. If it does not
@@ -271,8 +277,7 @@ Tactic Notation "naive_solver" tactic(tac) :=
| H : ∃ _, _ |- _ => destruct H
| H : ?P → ?Q, H2 : ?Q |- _ => specialize (H H2)
(**i simplify and solve equalities *)
- | |- _ => progress simpl in *
- | |- _ => progress simplify_equality
+ | |- _ => progress simplify_equality'
(**i solve the goal *)
| |- _ =>
solve
diff --git a/theories/vector.v b/theories/vector.v
index 90abce08..f54d1840 100644
--- a/theories/vector.v
+++ b/theories/vector.v
@@ -29,10 +29,7 @@ Notation "8" := (FS 7) : fin_scope. Notation "9" := (FS 8) : fin_scope.
Notation "10" := (FS 9) : fin_scope.
Fixpoint fin_to_nat {n} (i : fin n) : nat :=
- match i with
- | 0%fin => 0
- | FS _ i => S (fin_to_nat i)
- end.
+ match i with 0%fin => 0 | FS _ i => S (fin_to_nat i) end.
Coercion fin_to_nat : fin >-> nat.
Notation fin_of_nat := Fin.of_nat_lt.
@@ -60,28 +57,23 @@ Notation fin_0_inv := Fin.case0.
Definition fin_S_inv {n} (P : fin (S n) → Type)
(H0 : P 0%fin) (HS : ∀ i, P (FS i)) (i : fin (S n)) : P i.
Proof.
- revert P H0 HS. refine (
- match i with
- | 0%fin => λ _ H0 _, H0
- | FS _ i => λ _ _ HS, HS i
- end).
+ revert P H0 HS.
+ refine match i with 0%fin => λ _ H0 _, H0 | FS _ i => λ _ _ HS, HS i end.
Defined.
Ltac inv_fin i :=
match type of i with
| fin 0 =>
- revert dependent i;
- match goal with |- ∀ i, @?P i => apply (fin_0_inv P) end
+ revert dependent i; match goal with |- ∀ i, @?P i => apply (fin_0_inv P) end
| fin (S ?n) =>
- revert dependent i;
- match goal with |- ∀ i, @?P i => apply (fin_S_inv P) end
+ revert dependent i; match goal with |- ∀ i, @?P i => apply (fin_S_inv P) end
end.
Instance: Injective (=) (=) (@FS n).
Proof. intros n i j. apply Fin.FS_inj. Qed.
Instance: Injective (=) (=) (@fin_to_nat n).
Proof.
- intros n i. induction i; intros j; inv_fin j; simpl; auto with lia f_equal.
+ intros n i. induction i; intros j; inv_fin j; intros; f_equal'; auto with lia.
Qed.
Lemma fin_to_nat_lt {n} (i : fin n) : fin_to_nat i < n.
Proof. induction i; simpl; lia. Qed.
@@ -91,10 +83,7 @@ Proof.
Qed.
Fixpoint fin_enum (n : nat) : list (fin n) :=
- match n with
- | 0 => []
- | S n => 0%fin :: FS <$> fin_enum n
- end.
+ match n with 0 => [] | S n => 0%fin :: FS <$> fin_enum n end.
Program Instance fin_finite n : Finite (fin n) := {| enum := fin_enum n |}.
Next Obligation.
intros n. induction n; simpl; constructor.
@@ -180,42 +169,32 @@ Notation vec_0_inv := Vector.case0.
Definition vec_S_inv {A n} (P : vec A (S n) → Type)
(Hcons : ∀ x v, P (x ::: v)) v : P v.
Proof.
- revert P Hcons. refine (
- match v with
- | [#] => tt
- | x ::: v => λ P Hcons, Hcons x v
- end).
+ revert P Hcons.
+ refine match v with [#] => tt | x ::: v => λ P Hcons, Hcons x v end.
Defined.
Ltac inv_vec v :=
match type of v with
| vec _ 0 =>
- revert dependent v;
- match goal with |- ∀ v, @?P v => apply (vec_0_inv P) end
+ revert dependent v; match goal with |- ∀ v, @?P v => apply (vec_0_inv P) end
| vec _ (S ?n) =>
- revert dependent v;
- match goal with |- ∀ v, @?P v => apply (vec_S_inv P) end
+ revert dependent v; match goal with |- ∀ v, @?P v => apply (vec_S_inv P) end
end.
(** The following tactic performs case analysis on all hypotheses of the shape
[fin 0], [fin (S n)], [vec A 0] and [vec A (S n)] until no further case
analyses are possible. *)
-Ltac inv_all_vec_fin :=
- block_goal;
+Ltac inv_all_vec_fin := block_goal;
repeat match goal with
| v : vec _ _ |- _ => inv_vec v; intros
| i : fin _ |- _ => inv_fin i; intros
- end;
- unblock_goal.
+ end; unblock_goal.
(** We define a coercion from [vec] to [list] and show that it preserves the
operations on vectors. We also define a function to go in the other way, but
do not define it as a coercion, as it would otherwise introduce ambiguity. *)
Fixpoint vec_to_list {A n} (v : vec A n) : list A :=
- match v with
- | [#] => []
- | x ::: v => x :: vec_to_list v
- end.
+ match v with [#] => [] | x ::: v => x :: vec_to_list v end.
Coercion vec_to_list : vec >-> list.
Notation list_to_vec := Vector.of_list.
@@ -224,17 +203,14 @@ Lemma vec_to_list_cons {A n} x (v : vec A n) :
Proof. done. Qed.
Lemma vec_to_list_app {A n m} (v : vec A n) (w : vec A m) :
vec_to_list (v +++ w) = vec_to_list v ++ vec_to_list w.
-Proof. by induction v; simpl; f_equal. Qed.
-
+Proof. by induction v; f_equal'. Qed.
Lemma vec_to_list_of_list {A} (l : list A): vec_to_list (list_to_vec l) = l.
-Proof. by induction l; simpl; f_equal. Qed.
-
+Proof. by induction l; f_equal'. Qed.
Lemma vec_to_list_length {A n} (v : vec A n) : length (vec_to_list v) = n.
Proof. induction v; simpl; by f_equal. Qed.
Lemma vec_to_list_same_length {A B n} (v : vec A n) (w : vec B n) :
- v `same_length` w.
-Proof. apply same_length_length. by rewrite !vec_to_list_length. Qed.
-
+ length v = length w.
+Proof. by rewrite !vec_to_list_length. Qed.
Lemma vec_to_list_inj1 {A n m} (v : vec A n) (w : vec A m) :
vec_to_list v = vec_to_list w → n = m.
Proof.
@@ -247,15 +223,12 @@ Proof.
revert w. induction v; intros w; inv_vec w; intros;
simplify_equality'; f_equal; eauto.
Qed.
-
Lemma vlookup_middle {A n m} (v : vec A n) (w : vec A m) x :
∃ i : fin (n + S m), x = (v +++ x ::: w) !!! i.
Proof.
- induction v; simpl.
- * by eexists 0%fin.
- * destruct IHv as [i ?]. by exists (FS i).
+ induction v; simpl; [by eexists 0%fin|].
+ destruct IHv as [i ?]. by exists (FS i).
Qed.
-
Lemma vec_to_list_lookup_middle {A n} (v : vec A n) (l k : list A) x :
vec_to_list v = l ++ x :: k →
∃ i : fin n, l = take i v ∧ x = v !!! i ∧ k = drop (S i) v.
@@ -268,27 +241,22 @@ Proof.
* eexists 0%fin. simpl. by rewrite vec_to_list_of_list.
* destruct IHl as [i ?]. exists (FS i). simpl. intuition congruence.
Qed.
-
Lemma vec_to_list_drop_lookup {A n} (v : vec A n) (i : fin n) :
drop i v = v !!! i :: drop (S i) v.
Proof. induction i; inv_vec v; simpl; intros; [done | by rewrite IHi]. Qed.
Lemma vec_to_list_take_drop_lookup {A n} (v : vec A n) (i : fin n) :
vec_to_list v = take i v ++ v !!! i :: drop (S i) v.
-Proof.
- rewrite <-(take_drop i v) at 1. f_equal. apply vec_to_list_drop_lookup.
-Qed.
+Proof. rewrite <-(take_drop i v) at 1. by rewrite vec_to_list_drop_lookup. Qed.
Lemma elem_of_vlookup {A n} (v : vec A n) x :
x ∈ vec_to_list v ↔ ∃ i, v !!! i = x.
Proof.
split.
* induction v; simpl; [by rewrite elem_of_nil |].
- inversion 1; subst.
- + by eexists 0%fin.
- + destruct IHv as [i ?]; trivial. by exists (FS i).
- * intros [i ?]; subst. induction v; inv_fin i.
- + by left.
- + right. apply IHv.
+ inversion 1; subst; [by eexists 0%fin|].
+ destruct IHv as [i ?]; trivial. by exists (FS i).
+ * intros [i ?]; subst. induction v as [|??? IH]; inv_fin i; [by left|].
+ right; apply IH.
Qed.
Lemma Forall_vlookup {A} (P : A → Prop) {n} (v : vec A n) :
Forall P (vec_to_list v) ↔ ∀ i, P (v !!! i).
@@ -307,14 +275,11 @@ Lemma Forall2_vlookup {A B} (P : A → B → Prop) {n}
Forall2 P (vec_to_list v1) (vec_to_list v2) ↔ ∀ i, P (v1 !!! i) (v2 !!! i).
Proof.
split.
- * vec_double_ind v1 v2.
- + intros _ i. inv_fin i.
- + intros n v1 v2 IH a b; simpl. inversion_clear 1.
- intros i. inv_fin i; simpl; auto.
- * vec_double_ind v1 v2.
- + constructor.
- + intros ??? IH ?? H.
- constructor. apply (H 0%fin). apply IH, (λ i, H (FS i)).
+ * vec_double_ind v1 v2; [intros _ i; inv_fin i |].
+ intros n v1 v2 IH a b; simpl. inversion_clear 1.
+ intros i. inv_fin i; simpl; auto.
+ * vec_double_ind v1 v2; [constructor|].
+ intros ??? IH ?? H. constructor. apply (H 0%fin). apply IH, (λ i, H (FS i)).
Qed.
(** The function [vmap f v] applies a function [f] element wise to [v]. *)
@@ -362,4 +327,4 @@ Proof.
intros. apply IHi. congruence.
Qed.
Lemma vlookup_insert_self {A n} i (v : vec A n) : vinsert i (v !!! i) v = v.
-Proof. by induction v; inv_fin i; simpl; intros; f_equal. Qed.
+Proof. by induction v; inv_fin i; intros; f_equal'. Qed.
--
GitLab