From 361308c7b173f353afd99499e8bfcf168fdab1ca Mon Sep 17 00:00:00 2001
From: Robbert Krebbers <mail@robbertkrebbers.nl>
Date: Tue, 7 May 2013 17:01:37 +0200
Subject: [PATCH] Lots of refactoring. and new results on permutations and list
containment.
The refactoring includes:
* Use infix notations for the various list relations
* More consistent naming
* Put lemmas on one line whenever possible
* Change proofs into one-liners when possible
* Make better use of the "Implicit Types" command
* Improve the order of the list module by placing all definitions at the start,
then the proofs, and finally the tactics.
Besides, there is some new machinery for proofs by reflection on lists. It is
used for a decision procedure for permutations and list containment.
---
theories/base.v | 174 +-
theories/collections.v | 128 +-
theories/decidable.v | 1 +
theories/fin_collections.v | 22 +-
theories/fin_map_dom.v | 71 +-
theories/fin_maps.v | 549 +++----
theories/fresh_numbers.v | 6 +-
theories/list.v | 3093 ++++++++++++++++++------------------
theories/listset.v | 38 +-
theories/listset_nodup.v | 9 +-
theories/mapset.v | 51 +-
theories/natmap.v | 65 +-
theories/nmap.v | 27 +-
theories/numbers.v | 62 +-
theories/option.v | 97 +-
theories/orders.v | 71 +-
theories/pmap.v | 46 +-
theories/tactics.v | 42 +-
theories/vector.v | 83 +-
19 files changed, 2204 insertions(+), 2431 deletions(-)
diff --git a/theories/base.v b/theories/base.v
index 88654324..10c91ff0 100644
--- a/theories/base.v
+++ b/theories/base.v
@@ -107,17 +107,11 @@ Instance unit_inhabited: Inhabited unit := populate ().
Instance list_inhabited {A} : Inhabited (list A) := populate [].
Instance prod_inhabited {A B} (iA : Inhabited A)
(iB : Inhabited B) : Inhabited (A * B) :=
- match iA, iB with
- | populate x, populate y => populate (x,y)
- end.
+ match iA, iB with populate x, populate y => populate (x,y) end.
Instance sum_inhabited_l {A B} (iA : Inhabited A) : Inhabited (A + B) :=
- match iA with
- | populate x => populate (inl x)
- end.
+ match iA with populate x => populate (inl x) end.
Instance sum_inhabited_r {A B} (iB : Inhabited A) : Inhabited (A + B) :=
- match iB with
- | populate y => populate (inl y)
- end.
+ match iB with populate y => populate (inl y) end.
Instance option_inhabited {A} : Inhabited (option A) := populate None.
(** ** Proof irrelevant types *)
@@ -187,8 +181,7 @@ Notation "(∪)" := union (only parsing) : C_scope.
Notation "( x ∪)" := (union x) (only parsing) : C_scope.
Notation "(∪ x )" := (λ y, union y x) (only parsing) : C_scope.
-Definition union_list `{Empty A}
- `{Union A} : list A → A := fold_right (∪) ∅.
+Definition union_list `{Empty A} `{Union A} : list A → A := fold_right (∪) ∅.
Arguments union_list _ _ _ !_ /.
Notation "⋃ l" := (union_list l) (at level 20, format "⋃ l") : C_scope.
@@ -208,9 +201,14 @@ Notation "(∖ x )" := (λ y, difference y x) (only parsing) : C_scope.
Class Singleton A B := singleton: A → B.
Instance: Params (@singleton) 3.
-Notation "{[ x ]}" := (singleton x) : C_scope.
+Notation "{[ x ]}" := (singleton x) (at level 1) : C_scope.
Notation "{[ x ; y ; .. ; z ]}" :=
- (union .. (union (singleton x) (singleton y)) .. (singleton z)) : C_scope.
+ (union .. (union (singleton x) (singleton y)) .. (singleton z))
+ (at level 1) : C_scope.
+Notation "{[ x , y ]}" := (singleton (x,y))
+ (at level 1, y at next level) : C_scope.
+Notation "{[ x , y , z ]}" := (singleton (x,y,z))
+ (at level 1, y at next level, z at next level) : C_scope.
Class SubsetEq A := subseteq: A → A → Prop.
Instance: Params (@subseteq) 2.
@@ -222,6 +220,8 @@ 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.
Hint Extern 0 (_ ⊆ _) => reflexivity.
@@ -251,43 +251,51 @@ Class Disjoint A := disjoint : A → A → Prop.
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.
-
-Inductive list_disjoint `{Empty A} `{Union A}
- `{Disjoint A} : list A → Prop :=
- | disjoint_nil :
- list_disjoint []
- | disjoint_cons X Xs :
- X ⊥ ⋃ Xs →
- list_disjoint Xs →
- list_disjoint (X :: Xs).
-Lemma list_disjoint_cons_inv `{Empty A} `{Union A} `{Disjoint A} X Xs :
- list_disjoint (X :: Xs) →
- X ⊥ ⋃ Xs ∧ list_disjoint Xs.
-Proof. inversion_clear 1; auto. Qed.
-
-Class Filter A B :=
- filter: ∀ (P : A → Prop) `{∀ x, Decision (P x)}, B → B.
-
-(* Arguments filter {_ _ _} _ {_} !_ / : simpl nomatch. *)
+Notation "( X ⊥.)" := (disjoint X) (only parsing) : C_scope.
+Notation "(.⊥ X )" := (λ Y, disjoint Y X) (only parsing) : C_scope.
+
+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.
+
+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.
+
+ 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.
+
+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.
+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.
-Notation "X ⊆@{ E } Y" := (subseteq_env E X Y)
- (at level 70, format "X ⊆@{ E } Y") : C_scope.
-Notation "(⊆@{ E } )" := (subseteq_env E)
+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
@@ -314,16 +322,16 @@ Arguments mret {_ _ _} _.
Class MBindD (M : Type → Type) {A B} (f : A → M B) := mbind: M A → M B.
Notation MBind M := (∀ {A B} (f : A → M B), MBindD M f)%type.
Instance: Params (@mbind) 5.
-Arguments mbind {_ _ _} _ {_} !_ / : simpl nomatch.
+Arguments mbind {_ _ _} _ {_} !_ /.
Class MJoin (M : Type → Type) := mjoin: ∀ {A}, M (M A) → M A.
Instance: Params (@mjoin) 3.
-Arguments mjoin {_ _ _} !_ / : simpl nomatch.
+Arguments mjoin {_ _ _} !_ /.
Class FMapD (M : Type → Type) {A B} (f : A → B) := fmap: M A → M B.
Notation FMap M := (∀ {A B} (f : A → B), FMapD M f)%type.
Instance: Params (@fmap) 6.
-Arguments fmap {_ _ _} _ {_} !_ / : simpl nomatch.
+Arguments fmap {_ _ _} _ {_} !_ /.
Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope.
Notation "( m ≫=)" := (λ f, mbind f m) (only parsing) : C_scope.
@@ -331,21 +339,22 @@ Notation "(≫= f )" := (mbind f) (only parsing) : C_scope.
Notation "(≫=)" := (λ m f, mbind f m) (only parsing) : C_scope.
Notation "x ↠y ; z" := (y ≫= (λ x : _, z))
- (at level 65, only parsing, next at level 35, right associativity) : C_scope.
+ (at level 65, next at level 35, only parsing, right associativity) : C_scope.
Infix "<$>" := fmap (at level 60, right associativity) : C_scope.
Class MGuard (M : Type → Type) :=
- mguard: ∀ P {dec : Decision P} {A}, M A → M A.
-Notation "'guard' P ; o" := (mguard P o)
- (at level 65, only parsing, next at level 35, right associativity) : C_scope.
-Arguments mguard _ _ _ !_ _ !_ / : simpl nomatch.
+ mguard: ∀ P {dec : Decision P} {A}, (P → M A) → M A.
+Arguments mguard _ _ _ !_ _ _ /.
+Notation "'guard' P ; o" := (mguard P (λ _, o))
+ (at level 65, next at level 35, only parsing, right associativity) : C_scope.
+Notation "'guard' P 'as' H ; o" := (mguard P (λ H, o))
+ (at level 65, next at level 35, only parsing, right associativity) : C_scope.
(** ** Operations on maps *)
(** In this section we define operational type classes for the operations
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.
+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.
@@ -356,8 +365,7 @@ Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch.
(** The function insert [<[k:=a]>m] should update the element at key [k] with
value [a] in [m]. *)
-Class Insert (K A M : Type) :=
- insert: K → A → M → M.
+Class Insert (K A M : Type) := insert: K → A → M → M.
Instance: Params (@insert) 4.
Notation "<[ k := a ]>" := (insert k a)
(at level 5, right associativity, format "<[ k := a ]>") : C_scope.
@@ -366,15 +374,13 @@ Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch.
(** The function delete [delete k m] should delete the value at key [k] in
[m]. If the key [k] is not a member of [m], the original map should be
returned. *)
-Class Delete (K M : Type) :=
- delete: K → M → M.
+Class Delete (K M : Type) := delete: K → M → M.
Instance: Params (@delete) 3.
Arguments delete _ _ _ !_ !_ / : simpl nomatch.
(** The function [alter f k m] should update the value at key [k] using the
function [f], which is called with the original value. *)
-Class AlterD (K A M : Type) (f : A → A) :=
- alter: K → M → M.
+Class AlterD (K A M : Type) (f : A → A) := alter: K → M → M.
Notation Alter K A M := (∀ (f : A → A), AlterD K A M f)%type.
Instance: Params (@alter) 5.
Arguments alter {_ _ _} _ {_} !_ !_ / : simpl nomatch.
@@ -409,9 +415,8 @@ Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
fold_right delete m l.
Instance: Params (@delete_list) 3.
-Definition insert_consecutive `{Insert nat A M}
- (i : nat) (l : list A) (m : M) : M :=
- fold_right (λ x f i, <[i:=x]>(f (S i))) (λ _, m) l i.
+Definition insert_consecutive `{Insert nat A M} (i : nat) (l : list A)
+ (m : M) : M := fold_right (λ x f i, <[i:=x]>(f (S i))) (λ _, m) l i.
Instance: Params (@insert_consecutive) 3.
(** The function [union_with f m1 m2] is supposed to yield the union of [m1]
@@ -441,8 +446,11 @@ Arguments intersection_with_list _ _ _ _ _ !_ /.
(** These operational type classes allow us to refer to common mathematical
properties in a generic way. For example, for injectivity of [(k ++)] it
allows us to write [injective (k ++)] instead of [app_inv_head k]. *)
-Class Injective {A B} (R : relation A) S (f : A → B) : Prop :=
- injective: ∀ x y : A, S (f x) (f y) → R x y.
+Class Injective {A B} (R : relation A) (S : relation B) (f : A → B) : Prop :=
+ injective: ∀ x y, S (f x) (f y) → R x y.
+Class Injective2 {A B C} (R1 : relation A) (R2 : relation B)
+ (S : relation C) (f : A → B → C) : Prop :=
+ injective2: ∀ x1 x2 y1 y2, S (f x1 x2) (f y1 y2) → R1 x1 y1 ∧ R2 x2 y2.
Class Idempotent {A} (R : relation A) (f : A → A → A) : Prop :=
idempotent: ∀ x, R (f x x) x.
Class Commutative {A B} (R : relation A) (f : B → B → A) : Prop :=
@@ -461,11 +469,12 @@ Class LeftDistr {A} (R : relation A) (f g : A → A → A) : Prop :=
left_distr: ∀ x y z, R (f x (g y z)) (g (f x y) (f x z)).
Class RightDistr {A} (R : relation A) (f g : A → A → A) : Prop :=
right_distr: ∀ y z x, R (f (g y z) x) (g (f y x) (f z x)).
-Class AntiSymmetric {A} (R : relation A) : Prop :=
- anti_symmetric: ∀ x y, R x y → R y x → x = y.
+Class AntiSymmetric {A} (R S : relation A) : Prop :=
+ anti_symmetric: ∀ x y, S x y → S y x → R x y.
Arguments irreflexivity {_} _ {_} _ _.
Arguments injective {_ _ _ _} _ {_} _ _ _.
+Arguments injective2 {_ _ _ _ _ _} _ {_} _ _ _ _ _.
Arguments idempotent {_ _} _ {_} _.
Arguments commutative {_ _ _} _ {_} _ _.
Arguments left_id {_ _} _ _ {_} _.
@@ -475,8 +484,10 @@ Arguments left_absorb {_ _} _ _ {_} _.
Arguments right_absorb {_ _} _ _ {_} _.
Arguments left_distr {_ _} _ _ {_} _ _ _.
Arguments right_distr {_ _} _ _ {_} _ _ _.
-Arguments anti_symmetric {_} _ {_} _ _ _ _.
+Arguments anti_symmetric {_ _} _ {_} _ _ _ _.
+Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R).
+Proof. tauto. Qed.
Instance: Commutative (↔) (@eq A).
Proof. red. intuition. Qed.
Instance: Commutative (↔) (λ x y, @eq A y x).
@@ -524,34 +535,31 @@ Proof. red. intuition. Qed.
Instance: RightDistr (↔) (∨) (∧).
Proof. red. intuition. Qed.
-(** The following lemmas are more specific versions of the projections of the
-above type classes. These lemmas allow us to enforce Coq not to use the setoid
-rewriting mechanism. *)
-Lemma idempotent_eq {A} (f : A → A → A) `{!Idempotent (=) f} x :
- f x x = x.
+(** 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. *)
+Lemma idempotent_L {A} (f : A → A → A) `{!Idempotent (=) f} x : f x x = x.
Proof. auto. Qed.
-Lemma commutative_eq {A B} (f : B → B → A) `{!Commutative (=) f} x y :
+Lemma commutative_L {A B} (f : B → B → A) `{!Commutative (=) f} x y :
f x y = f y x.
Proof. auto. Qed.
-Lemma left_id_eq {A} (i : A) (f : A → A → A) `{!LeftId (=) i f} x :
- f i x = x.
+Lemma left_id_L {A} (i : A) (f : A → A → A) `{!LeftId (=) i f} x : f i x = x.
Proof. auto. Qed.
-Lemma right_id_eq {A} (i : A) (f : A → A → A) `{!RightId (=) i f} x :
- f x i = x.
+Lemma right_id_L {A} (i : A) (f : A → A → A) `{!RightId (=) i f} x : f x i = x.
Proof. auto. Qed.
-Lemma associative_eq {A} (f : A → A → A) `{!Associative (=) f} x y z :
+Lemma associative_L {A} (f : A → A → A) `{!Associative (=) f} x y z :
f x (f y z) = f (f x y) z.
Proof. auto. Qed.
-Lemma left_absorb_eq {A} (i : A) (f : A → A → A) `{!LeftAbsorb (=) i f} x :
+Lemma left_absorb_L {A} (i : A) (f : A → A → A) `{!LeftAbsorb (=) i f} x :
f i x = i.
Proof. auto. Qed.
-Lemma right_absorb_eq {A} (i : A) (f : A → A → A) `{!RightAbsorb (=) i f} x :
+Lemma right_absorb_L {A} (i : A) (f : A → A → A) `{!RightAbsorb (=) i f} x :
f x i = i.
Proof. auto. Qed.
-Lemma left_distr_eq {A} (f g : A → A → A) `{!LeftDistr (=) f g} x y z :
+Lemma left_distr_L {A} (f g : A → A → A) `{!LeftDistr (=) f g} x y z :
f x (g y z) = g (f x y) (f x z).
Proof. auto. Qed.
-Lemma right_distr_eq {A} (f g : A → A → A) `{!RightDistr (=) f g} y z x :
+Lemma right_distr_L {A} (f g : A → A → A) `{!RightDistr (=) f g} y z x :
f (g y z) x = g (f y x) (f z x).
Proof. auto. Qed.
@@ -561,9 +569,9 @@ Class BoundedPreOrder A `{Empty A} `{SubsetEq A} : Prop := {
bounded_preorder :>> PreOrder (⊆);
subseteq_empty x : ∅ ⊆ x
}.
-Class PartialOrder A `{SubsetEq A} : Prop := {
- po_preorder :>> PreOrder (⊆);
- po_antisym :> AntiSymmetric (⊆)
+Class PartialOrder {A} (R : relation A) : Prop := {
+ po_preorder :> PreOrder R;
+ po_antisym :> AntiSymmetric (=) R
}.
(** We do not include equality in the following interfaces so as to avoid the
@@ -663,12 +671,10 @@ Class CollectionMonad M `{∀ A, ElemOf A (M A)}
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;
- elem_of_ret {A} (x y : A) :
- x ∈ mret y ↔ x = y;
+ elem_of_ret {A} (x y : A) : x ∈ mret y ↔ x = y;
elem_of_fmap {A B} (f : A → B) (X : M A) (x : B) :
x ∈ f <$> X ↔ ∃ y, x = f y ∧ y ∈ X;
- elem_of_join {A} (X : M (M A)) (x : A) :
- x ∈ mjoin X ↔ ∃ Y, x ∈ Y ∧ Y ∈ X
+ elem_of_join {A} (X : M (M A)) (x : A) : x ∈ mjoin X ↔ ∃ Y, x ∈ Y ∧ Y ∈ X
}.
(** The function [fresh X] yields an element that is not contained in [X]. We
diff --git a/theories/collections.v b/theories/collections.v
index 7d4c52db..754efa11 100644
--- a/theories/collections.v
+++ b/theories/collections.v
@@ -42,8 +42,7 @@ Section simple_collection.
Global Instance elem_of_proper: Proper ((=) ==> (≡) ==> iff) (∈) | 5.
Proof. intros ???. subst. firstorder. Qed.
- Lemma elem_of_union_list (Xs : list C) (x : A) :
- x ∈ ⋃ Xs ↔ ∃ X, X ∈ Xs ∧ x ∈ X.
+ Lemma elem_of_union_list Xs x : x ∈ ⋃ Xs ↔ ∃ X, X ∈ Xs ∧ x ∈ X.
Proof.
split.
* induction Xs; simpl; intros HXs.
@@ -249,13 +248,11 @@ Section collection.
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.
+ 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.
+ rewrite elem_of_difference. destruct (decide (x ∈ Y)); tauto.
Qed.
Lemma union_difference X Y : X ⊆ Y → Y ≡ X ∪ Y ∖ X.
Proof.
@@ -303,19 +300,18 @@ Section collection_ops.
(∀ x y z, Q x → P y → f x y = Some z → P z) →
∀ x, x ∈ intersection_with_list f Y Xs → P x.
Proof.
- intros HY HXs Hf.
- induction Xs; simplify_option_equality; [done |].
+ intros HY HXs Hf. induction Xs; simplify_option_equality; [done |].
intros x Hx. rewrite elem_of_intersection_with in Hx.
decompose_Forall. destruct Hx as (? & ? & ? & ? & ?). eauto.
Qed.
End collection_ops.
(** * Sets without duplicates up to an equivalence *)
-Section no_dup.
+Section NoDup.
Context `{SimpleCollection A B} (R : relation A) `{!Equivalence R}.
Definition elem_of_upto (x : A) (X : B) := ∃ y, y ∈ X ∧ R x y.
- Definition no_dup (X : B) := ∀ x y, x ∈ X → y ∈ X → R x y → x = y.
+ Definition set_NoDup (X : B) := ∀ x y, x ∈ X → y ∈ X → R x y → x = y.
Global Instance: Proper ((≡) ==> iff) (elem_of_upto x).
Proof. intros ??? E. unfold elem_of_upto. by setoid_rewrite E. Qed.
@@ -325,7 +321,7 @@ Section no_dup.
* rewrite <-E1, <-E2; intuition.
* rewrite E1, E2; intuition.
Qed.
- Global Instance: Proper ((≡) ==> iff) no_dup.
+ Global Instance: Proper ((≡) ==> iff) set_NoDup.
Proof. firstorder. Qed.
Lemma elem_of_upto_elem_of x X : x ∈ X → elem_of_upto x X.
@@ -341,60 +337,63 @@ Section no_dup.
Lemma not_elem_of_upto x X : ¬elem_of_upto x X → ∀ y, y ∈ X → ¬R x y.
Proof. unfold elem_of_upto. esolve_elem_of. Qed.
- Lemma no_dup_empty: no_dup ∅.
- Proof. unfold no_dup. solve_elem_of. Qed.
- Lemma no_dup_add x X : ¬elem_of_upto x X → no_dup X → no_dup ({[ x ]} ∪ X).
- Proof. unfold no_dup, elem_of_upto. esolve_elem_of. Qed.
- Lemma no_dup_inv_add x X : x ∉ X → no_dup ({[ x ]} ∪ X) → ¬elem_of_upto x X.
+ Lemma set_NoDup_empty: set_NoDup ∅.
+ Proof. unfold set_NoDup. solve_elem_of. Qed.
+ Lemma set_NoDup_add x X :
+ ¬elem_of_upto x X → set_NoDup X → set_NoDup ({[ x ]} ∪ X).
+ Proof. unfold set_NoDup, elem_of_upto. esolve_elem_of. Qed.
+ Lemma set_NoDup_inv_add x X :
+ x ∉ X → set_NoDup ({[ x ]} ∪ X) → ¬elem_of_upto x X.
Proof.
intros Hin Hnodup [y [??]].
rewrite (Hnodup x y) in Hin; solve_elem_of.
Qed.
- Lemma no_dup_inv_union_l X Y : no_dup (X ∪ Y) → no_dup X.
- Proof. unfold no_dup. solve_elem_of. Qed.
- Lemma no_dup_inv_union_r X Y : no_dup (X ∪ Y) → no_dup Y.
- Proof. unfold no_dup. solve_elem_of. Qed.
-End no_dup.
+ Lemma set_NoDup_inv_union_l X Y : set_NoDup (X ∪ Y) → set_NoDup X.
+ Proof. unfold set_NoDup. solve_elem_of. Qed.
+ Lemma set_NoDup_inv_union_r X Y : set_NoDup (X ∪ Y) → set_NoDup Y.
+ Proof. unfold set_NoDup. solve_elem_of. Qed.
+End NoDup.
(** * Quantifiers *)
Section quantifiers.
Context `{SimpleCollection A B} (P : A → Prop).
- Definition cforall X := ∀ x, x ∈ X → P x.
- Definition cexists X := ∃ x, x ∈ X ∧ P x.
-
- Lemma cforall_empty : cforall ∅.
- Proof. unfold cforall. solve_elem_of. Qed.
- Lemma cforall_singleton x : cforall {[ x ]} ↔ P x.
- Proof. unfold cforall. solve_elem_of. Qed.
- Lemma cforall_union X Y : cforall X → cforall Y → cforall (X ∪ Y).
- Proof. unfold cforall. solve_elem_of. Qed.
- Lemma cforall_union_inv_1 X Y : cforall (X ∪ Y) → cforall X.
- Proof. unfold cforall. solve_elem_of. Qed.
- Lemma cforall_union_inv_2 X Y : cforall (X ∪ Y) → cforall Y.
- Proof. unfold cforall. solve_elem_of. Qed.
-
- Lemma cexists_empty : ¬cexists ∅.
- Proof. unfold cexists. esolve_elem_of. Qed.
- Lemma cexists_singleton x : cexists {[ x ]} ↔ P x.
- Proof. unfold cexists. esolve_elem_of. Qed.
- Lemma cexists_union_1 X Y : cexists X → cexists (X ∪ Y).
- Proof. unfold cexists. esolve_elem_of. Qed.
- Lemma cexists_union_2 X Y : cexists Y → cexists (X ∪ Y).
- Proof. unfold cexists. esolve_elem_of. Qed.
- Lemma cexists_union_inv X Y : cexists (X ∪ Y) → cexists X ∨ cexists Y.
- Proof. unfold cexists. esolve_elem_of. Qed.
+ Definition set_Forall X := ∀ x, x ∈ X → P x.
+ Definition set_Exists X := ∃ x, x ∈ X ∧ P x.
+
+ Lemma set_Forall_empty : set_Forall ∅.
+ Proof. unfold set_Forall. solve_elem_of. Qed.
+ Lemma set_Forall_singleton x : set_Forall {[ x ]} ↔ P x.
+ Proof. unfold set_Forall. solve_elem_of. Qed.
+ Lemma set_Forall_union X Y : set_Forall X → set_Forall Y → set_Forall (X ∪ Y).
+ Proof. unfold set_Forall. solve_elem_of. Qed.
+ Lemma set_Forall_union_inv_1 X Y : set_Forall (X ∪ Y) → set_Forall X.
+ Proof. unfold set_Forall. solve_elem_of. Qed.
+ Lemma set_Forall_union_inv_2 X Y : set_Forall (X ∪ Y) → set_Forall Y.
+ Proof. unfold set_Forall. solve_elem_of. Qed.
+
+ Lemma set_Exists_empty : ¬set_Exists ∅.
+ Proof. unfold set_Exists. esolve_elem_of. Qed.
+ Lemma set_Exists_singleton x : set_Exists {[ x ]} ↔ P x.
+ Proof. unfold set_Exists. esolve_elem_of. Qed.
+ Lemma set_Exists_union_1 X Y : set_Exists X → set_Exists (X ∪ Y).
+ Proof. unfold set_Exists. esolve_elem_of. Qed.
+ Lemma set_Exists_union_2 X Y : set_Exists Y → set_Exists (X ∪ Y).
+ Proof. unfold set_Exists. esolve_elem_of. Qed.
+ Lemma set_Exists_union_inv X Y :
+ set_Exists (X ∪ Y) → set_Exists X ∨ set_Exists Y.
+ Proof. unfold set_Exists. esolve_elem_of. Qed.
End quantifiers.
Section more_quantifiers.
Context `{Collection A B}.
- Lemma cforall_weaken (P Q : A → Prop) (Hweaken : ∀ x, P x → Q x) X :
- cforall P X → cforall Q X.
- Proof. unfold cforall. naive_solver. Qed.
- Lemma cexists_weaken (P Q : A → Prop) (Hweaken : ∀ x, P x → Q x) X :
- cexists P X → cexists Q X.
- Proof. unfold cexists. naive_solver. Qed.
+ Lemma set_Forall_weaken (P Q : A → Prop) (Hweaken : ∀ x, P x → Q x) X :
+ set_Forall P X → set_Forall Q X.
+ Proof. unfold set_Forall. naive_solver. Qed.
+ Lemma set_Exists_weaken (P Q : A → Prop) (Hweaken : ∀ x, P x → Q x) X :
+ set_Exists P X → set_Exists Q X.
+ Proof. unfold set_Exists. naive_solver. Qed.
End more_quantifiers.
(** * Fresh elements *)
@@ -417,8 +416,7 @@ Section fresh.
Global Instance fresh_list_proper: Proper ((=) ==> (≡) ==> (=)) fresh_list.
Proof.
- intros ? n ?. subst.
- induction n; simpl; intros ?? E; f_equal.
+ intros ? n ?. subst. induction n; simpl; intros ?? E; f_equal.
* by rewrite E.
* apply IHn. by rewrite E.
Qed.
@@ -437,10 +435,8 @@ Section fresh.
Lemma fresh_list_nodup n X : NoDup (fresh_list n X).
Proof.
- revert X.
- induction n; simpl; constructor; auto.
- intros Hin. apply fresh_list_is_fresh in Hin.
- solve_elem_of.
+ revert X. induction n; simpl; constructor; auto.
+ intros Hin. apply fresh_list_is_fresh in Hin. solve_elem_of.
Qed.
End fresh.
@@ -455,7 +451,10 @@ Section collection_monad.
Context `{CollectionMonad M}.
Global Instance collection_guard: MGuard M := λ P dec A x,
- if dec then x else ∅.
+ match dec with
+ | left H => x H
+ | _ => ∅
+ end.
Global Instance collection_fmap_proper {A B} (f : A → B) :
Proper ((≡) ==> (≡)) (fmap f).
@@ -495,8 +494,7 @@ Section collection_monad.
Proof. revert l; induction k; esolve_elem_of. Qed.
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.
+ 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;
@@ -504,14 +502,10 @@ Section collection_monad.
Qed.
Lemma elem_of_mapM_Forall {A B} (f : A → M B) (P : B → Prop) l k :
- l ∈ mapM f k →
- Forall (λ x, ∀ y, y ∈ f x → P y) k →
- Forall P l.
+ l ∈ mapM f k → Forall (λ x, ∀ y, y ∈ f x → P y) k → Forall P l.
Proof. rewrite elem_of_mapM. apply Forall2_Forall_l. Qed.
- Lemma elem_of_mapM_Forall2_l {A B C} (f : A → M B)
- (P : B → C → Prop) l1 l2 k :
- l1 ∈ mapM f k →
- Forall2 (λ x y, ∀ z, z ∈ f x → P z y) k l2 →
+ Lemma elem_of_mapM_Forall2_l {A B C} (f : A → M B) (P: B → C → Prop) l1 l2 k :
+ l1 ∈ mapM f k → Forall2 (λ x y, ∀ z, z ∈ f x → P z y) k l2 →
Forall2 P l1 l2.
Proof.
rewrite elem_of_mapM. intros Hl1. revert l2.
diff --git a/theories/decidable.v b/theories/decidable.v
index ecce3512..25de0bf4 100644
--- a/theories/decidable.v
+++ b/theories/decidable.v
@@ -76,6 +76,7 @@ Notation cast_if_and3 S1 S2 S3 := (if S1 then cast_if_and S2 S3 else right _).
Notation cast_if_and4 S1 S2 S3 S4 :=
(if S1 then cast_if_and3 S2 S3 S4 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 _).
Notation cast_if_not S := (if S then right _ else left _).
diff --git a/theories/fin_collections.v b/theories/fin_collections.v
index 46969612..1cfb0a47 100644
--- a/theories/fin_collections.v
+++ b/theories/fin_collections.v
@@ -13,7 +13,7 @@ Definition collection_fold `{Elements A C} {B}
Section fin_collection.
Context `{FinCollection A C}.
-Global Instance elements_proper: Proper ((≡) ==> Permutation) elements.
+Global Instance elements_proper: Proper ((≡) ==> (≡ₚ)) elements.
Proof.
intros ?? E. apply NoDup_Permutation.
* apply elements_nodup.
@@ -176,10 +176,8 @@ Proof.
apply Hadd. solve_elem_of. apply IH. esolve_elem_of.
Qed.
-Lemma collection_fold_proper {B} (R : relation B)
- `{!Equivalence R}
- (f : A → B → B) (b : B)
- `{!Proper ((=) ==> R ==> R) f}
+Lemma collection_fold_proper {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) (collection_fold f b).
Proof.
@@ -188,22 +186,22 @@ Proof.
* by rewrite E.
Qed.
-Global Instance cforall_dec `(P : A → Prop)
- `{∀ x, Decision (P x)} X : Decision (cforall P X) | 100.
+Global Instance set_Forall_dec `(P : A → Prop)
+ `{∀ x, Decision (P x)} X : Decision (set_Forall P X) | 100.
Proof.
refine (cast_if (decide (Forall P (elements X))));
- abstract (unfold cforall; setoid_rewrite elements_spec;
+ abstract (unfold set_Forall; setoid_rewrite elements_spec;
by rewrite <-Forall_forall).
Defined.
-Global Instance cexists_dec `(P : A → Prop) `{∀ x, Decision (P x)} X :
- Decision (cexists P X) | 100.
+Global Instance set_Exists_dec `(P : A → Prop) `{∀ x, Decision (P x)} X :
+ Decision (set_Exists P X) | 100.
Proof.
refine (cast_if (decide (Exists P (elements X))));
- abstract (unfold cexists; setoid_rewrite elements_spec;
+ abstract (unfold set_Exists; setoid_rewrite elements_spec;
by rewrite <-Exists_exists).
Defined.
Global Instance rel_elem_of_dec `{∀ x y, Decision (R x y)} x X :
- Decision (elem_of_upto R x X) | 100 := decide (cexists (R x) X).
+ Decision (elem_of_upto R x X) | 100 := decide (set_Exists (R x) X).
End fin_collection.
diff --git a/theories/fin_map_dom.v b/theories/fin_map_dom.v
index 2ca9a583..78ee121d 100644
--- a/theories/fin_map_dom.v
+++ b/theories/fin_map_dom.v
@@ -6,46 +6,34 @@ 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)}
+ `{∀ 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} := {
+ `{∀ 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)
}.
-Section theorems.
+Section fin_map_dom.
Context `{FinMapDom K M D}.
-Lemma not_elem_of_dom {A} (m : M A) i :
- i ∉ dom D m ↔ m !! i = None.
+Lemma not_elem_of_dom {A} (m : M A) i : i ∉ dom 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.
+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.
Qed.
-Lemma subset_dom {A} (m1 m2 : M A) :
- m1 ⊂ m2 → dom D m1 ⊂ dom D m2.
+Lemma subset_dom {A} (m1 m2 : M A) : m1 ⊂ m2 → dom 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.
- feed inversion Hdom. eauto.
- by erewrite (Hss1 i) in Hi by eauto.
+ feed inversion Hdom. eauto. by erewrite (Hss1 i) in Hi by eauto.
Qed.
Lemma dom_empty {A} : dom D (@empty (M A) _) ≡ ∅.
@@ -54,38 +42,32 @@ Proof.
* rewrite elem_of_dom, lookup_empty. by inversion 1.
* solve_elem_of.
Qed.
-Lemma dom_empty_inv {A} (m : M A) :
- dom D m ≡ ∅ → m = ∅.
+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.
+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, !is_Some_alt.
setoid_rewrite lookup_insert_Some.
destruct (decide (i = j)); esolve_elem_of.
Qed.
-Lemma dom_insert_subseteq {A} (m : M A) i x :
- dom D m ⊆ dom D (<[i:=x]>m).
+Lemma dom_insert_subseteq {A} (m : M A) i x : dom D m ⊆ dom D (<[i:=x]>m).
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).
+ 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 ]}.
+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 ]}.
+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, !is_Some_alt.
@@ -99,27 +81,22 @@ 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 ≡ ∅.
+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.
setoid_rewrite elem_of_dom. setoid_rewrite is_Some_alt. naive_solver.
Qed.
-Lemma map_disjoint_dom_1 {A} (m1 m2 : M A) :
- m1 ⊥ m2 → dom D m1 ∩ dom D m2 ≡ ∅.
+Lemma map_disjoint_dom_1 {A} (m1 m2 : M A) : m1 ⊥ m2 → dom 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.
+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.
+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, !is_Some_alt.
- setoid_rewrite lookup_union_Some_raw.
- destruct (m1 !! i); naive_solver.
+ setoid_rewrite lookup_union_Some_raw. destruct (m1 !! i); naive_solver.
Qed.
Lemma dom_intersection {A} (m1 m2 : M A) :
@@ -131,12 +108,10 @@ Proof.
setoid_rewrite is_Some_alt. naive_solver.
Qed.
-Lemma dom_difference {A} (m1 m2 : M A) :
- dom D (m1 ∖ m2) ≡ dom D m1 ∖ dom D m2.
+Lemma dom_difference {A} (m1 m2 : M A) : dom D (m1 ∖ m2) ≡ dom D m1 ∖ dom D m2.
Proof.
apply elem_of_equiv. intros i.
rewrite elem_of_difference, !elem_of_dom, !is_Some_alt.
- setoid_rewrite lookup_difference_Some.
- destruct (m2 !! i); naive_solver.
+ setoid_rewrite lookup_difference_Some. destruct (m2 !! i); naive_solver.
Qed.
-End theorems.
+End fin_map_dom.
diff --git a/theories/fin_maps.v b/theories/fin_maps.v
index 5c4acc4e..0eb686e5 100644
--- a/theories/fin_maps.v
+++ b/theories/fin_maps.v
@@ -26,24 +26,17 @@ 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)}
+ `{∀ 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)} := {
- map_eq {A} (m1 m2 : M A) :
- (∀ i, m1 !! i = m2 !! i) → m1 = m2;
- lookup_empty {A} i :
- (∅ : M A) !! i = None;
+ 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 :
partial_alter f i m !! i = f (m !! i);
lookup_partial_alter_ne {A} f (m : M A) i j :
i ≠j → partial_alter f i m !! j = m !! j;
- lookup_fmap {A B} (f : A → B) (m : M A) i :
- (f <$> m) !! i = f <$> m !! i;
- map_to_list_nodup {A} (m : M A) :
- NoDup (map_to_list m);
+ lookup_fmap {A B} (f : A → B) (m : M A) i : (f <$> m) !! i = f <$> m !! i;
+ 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_merge {A B C} (f : option A → option B → option C)
@@ -89,8 +82,7 @@ Instance map_disjoint `{∀ A, Lookup K A (M A)} : Disjoint (M A) :=
that are disjoint. However, as working with partial functions is inconvenient
in Coq, we define the union as a total function. In case both finite maps
have a value at the same index, we take the value of the first map. *)
-Instance map_union `{Merge M} {A} : Union (M A) :=
- union_with (λ x _, Some x).
+Instance map_union `{Merge M} {A} : Union (M A) := union_with (λ x _, Some x).
Instance map_intersection `{Merge M} {A} : Intersection (M A) :=
intersection_with (λ x _, Some x).
@@ -107,7 +99,7 @@ Global Instance map_subseteq {A} : SubsetEq (M A) := λ m1 m2,
∀ i x, m1 !! i = Some x → m2 !! i = Some x.
Global Instance: BoundedPreOrder (M A).
Proof. split; [firstorder |]. intros m i x. by rewrite lookup_empty. Qed.
-Global Instance : PartialOrder (M A).
+Global Instance : PartialOrder (@subseteq (M A) _).
Proof.
split; [apply _ |].
intros ????. apply map_eq. intros i. apply option_eq. naive_solver.
@@ -127,14 +119,8 @@ Proof.
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.
+ 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.
@@ -157,12 +143,10 @@ Proof.
* intros. by rewrite !lookup_partial_alter_ne.
Qed.
Lemma partial_alter_commute {A} (m : M A) i j f g :
- i ≠j →
- partial_alter f i (partial_alter g j m) =
+ 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)).
+ 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)).
@@ -173,25 +157,18 @@ 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)).
+ intros. apply map_eq. intros ii. destruct (decide (i = ii)).
* subst. by rewrite lookup_partial_alter.
* by rewrite lookup_partial_alter_ne.
Qed.
-Lemma partial_alter_self {A} (m : M A) i :
- partial_alter (λ _, m !! i) i m = m.
+Lemma partial_alter_self {A} (m : M A) i : partial_alter (λ _, m !! i) i m = m.
Proof. by apply partial_alter_self_alt. Qed.
Lemma partial_alter_subseteq {A} (m : M A) i f :
- m !! i = None →
- m ⊆ partial_alter f i m.
-Proof.
- intros Hi j x Hj. rewrite lookup_partial_alter_ne; congruence.
-Qed.
+ m !! i = None → m ⊆ partial_alter f i m.
+Proof. intros Hi j x Hj. rewrite lookup_partial_alter_ne; congruence. Qed.
Lemma partial_alter_subset {A} (m : M A) i f :
- m !! i = None →
- is_Some (f (m !! i)) →
- m ⊂ partial_alter f i m.
+ m !! i = None → is_Some (f (m !! i)) → m ⊂ partial_alter f i m.
Proof.
intros Hi Hfi. split.
* by apply partial_alter_subseteq.
@@ -201,11 +178,9 @@ Proof.
Qed.
(** ** Properties of the [alter] operation *)
-Lemma lookup_alter {A} (f : A → A) m i :
- alter f i m !! i = f <$> m !! i.
+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.
+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 lookup_alter_Some {A} (f : A → A) m i j y :
@@ -224,8 +199,7 @@ Proof.
* by rewrite lookup_alter_ne.
Qed.
-Lemma alter_None {A} (f : A → A) m i :
- m !! i = None → alter f i m = m.
+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.
@@ -256,7 +230,7 @@ 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)]} = ∅.
+Lemma delete_singleton {A} i (x : A) : delete i {[i, x]} = ∅.
Proof. setoid_rewrite <-partial_alter_compose. apply delete_empty. Qed.
Lemma delete_commute {A} (m : M A) i j :
delete i (delete j m) = delete j (delete i m).
@@ -265,11 +239,9 @@ 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.
+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)).
+ intros. apply map_eq. intros j. destruct (decide (i = j)).
* subst. by rewrite lookup_delete.
* by apply lookup_delete_ne.
Qed.
@@ -291,35 +263,27 @@ Proof.
by apply partial_alter_self_alt.
Qed.
-Lemma delete_subseteq {A} (m : M A) i :
- delete i m ⊆ m.
+Lemma delete_subseteq {A} (m : M A) i : delete i m ⊆ m.
Proof. 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.
+ m1 ⊆ m2 → delete i m1 ⊆ delete i m2.
Proof. 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.
+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).
Qed.
-Lemma delete_subset {A} (m : M A) i :
- is_Some (m !! i) →
- delete i m ⊂ m.
+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.
(** ** Properties of the [insert] operation *)
Lemma lookup_insert {A} (m : M A) i x : <[i:=x]>m !! i = Some x.
Proof. unfold insert. apply lookup_partial_alter. Qed.
-Lemma lookup_insert_rev {A} (m : M A) i x y :
- <[i:=x]>m !! i = Some y → x = y.
+Lemma lookup_insert_rev {A} (m : M A) i x y : <[i:=x]>m !! i = Some y → x = y.
Proof. rewrite lookup_insert. congruence. Qed.
-Lemma lookup_insert_ne {A} (m : M A) i j x :
- i ≠j → <[i:=x]>m !! j = m !! j.
+Lemma lookup_insert_ne {A} (m : M A) i j x : i ≠j → <[i:=x]>m !! j = m !! j.
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).
@@ -344,18 +308,12 @@ Proof.
* intros [??]. by rewrite lookup_insert_ne.
Qed.
-Lemma insert_subseteq {A} (m : M A) i x :
- m !! i = None →
- m ⊆ <[i:=x]>m.
+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.
+Lemma insert_subset {A} (m : M A) i x : m !! i = None → m ⊂ <[i:=x]>m.
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.
+ m1 !! i = None → m1 ⊆ m2 → m1 ⊆ <[i:=x]>m2.
Proof.
intros ?? j ?. destruct (decide (j = i)); subst.
* congruence.
@@ -363,9 +321,7 @@ Proof.
Qed.
Lemma insert_delete_subseteq {A} (m1 m2 : M A) i x :
- m1 !! i = None →
- <[i:=x]> m1 ⊆ m2 →
- m1 ⊆ delete i m2.
+ m1 !! i = None → <[i:=x]> m1 ⊆ m2 → m1 ⊆ delete i m2.
Proof.
intros Hi Hix j y Hj. destruct (decide (i = j)); subst.
* congruence.
@@ -373,20 +329,15 @@ Proof.
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.
+ 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 lookup_insert. congruence.
- * rewrite lookup_insert_ne by done. apply Hi.
- by rewrite lookup_delete_ne.
+ * 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.
+ m1 !! i = None → <[i:=x]> m1 ⊂ m2 → m1 ⊂ delete i m2.
Proof.
intros ? [Hm12 Hm21]. split.
* eauto using insert_delete_subseteq.
@@ -395,13 +346,11 @@ Proof.
Qed.
Lemma insert_subset_inv {A} (m1 m2 : M A) i x :
- m1 !! i = None →
- <[i:=x]> m1 ⊂ m2 →
+ m1 !! i = None → <[i:=x]> m1 ⊂ m2 →
∃ m2', m2 = <[i:=x]>m2' ∧ m1 ⊂ m2' ∧ m2' !! i = None.
Proof.
intros Hi Hm1m2. exists (delete i m2). split_ands.
- * rewrite insert_delete. done.
- eapply lookup_weaken, subset_subseteq; eauto.
+ * rewrite insert_delete. done. eapply lookup_weaken, subset_subseteq; eauto.
by rewrite lookup_insert.
* eauto using insert_delete_subset.
* by rewrite lookup_delete.
@@ -409,37 +358,34 @@ Qed.
(** ** Properties of the singleton maps *)
Lemma lookup_singleton_Some {A} i j (x y : A) :
- {[(i, x)]} !! j = Some y ↔ i = j ∧ x = y.
+ {[i, x]} !! j = Some y ↔ i = j ∧ x = y.
Proof.
unfold singleton, map_singleton.
- rewrite lookup_insert_Some, lookup_empty. simpl.
- intuition congruence.
+ rewrite lookup_insert_Some, lookup_empty. simpl. intuition congruence.
Qed.
-Lemma lookup_singleton_None {A} i j (x : A) :
- {[(i, x)]} !! j = None ↔ i ≠j.
+Lemma lookup_singleton_None {A} i j (x : A) : {[i, x]} !! j = None ↔ i ≠j.
Proof.
unfold singleton, map_singleton.
rewrite lookup_insert_None, lookup_empty. simpl. tauto.
Qed.
-Lemma lookup_singleton {A} i (x : A) : {[(i, x)]} !! i = Some x.
+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.
+Lemma lookup_singleton_ne {A} i j (x : A) : i ≠j → {[i, x]} !! j = None.
Proof. by rewrite lookup_singleton_None. Qed.
-Lemma insert_singleton {A} i (x y : A) : <[i:=y]>{[(i, x)]} = {[(i, y)]}.
+Lemma insert_singleton {A} i (x y : A) : <[i:=y]>{[i, x]} = {[i, y]}.
Proof.
unfold singleton, map_singleton, insert, map_insert.
by rewrite <-partial_alter_compose.
Qed.
-Lemma alter_singleton {A} (f : A → A) i x :
- alter f i {[ (i,x) ]} = {[ (i, f x) ]}.
+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.
* 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) ]}.
+ 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.
@@ -448,20 +394,13 @@ 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.
+ (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 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.
+ 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. }
@@ -473,8 +412,7 @@ Proof.
* rewrite lookup_insert_ne; auto.
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.
+ map_of_list l !! i = Some x → (i,x) ∈ l.
Proof.
induction l as [|[j y] l IH]; simpl.
{ by rewrite lookup_empty. }
@@ -483,23 +421,18 @@ Proof.
* rewrite 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.
+ 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.
+ i ∉ fst <$> l → map_of_list l !! i = None.
Proof.
rewrite elem_of_list_fmap, eq_None_not_Some, is_Some_alt.
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.
+ map_of_list l !! i = None → i ∉ fst <$> l.
Proof.
induction l as [|[j y] l IH]; simpl.
{ rewrite elem_of_nil. tauto. }
@@ -510,86 +443,67 @@ 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.
+ split; 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) →
- Permutation l1 l2 →
- map_of_list l1 = map_of_list l2.
+ NoDup (fst <$> l1) → l1 ≡ₚ l2 → map_of_list l1 = map_of_list l2.
Proof.
intros ? Hperm. apply map_eq. intros i. apply option_eq. intros x.
by rewrite <-!elem_of_map_of_list; rewrite <-?Hperm.
Qed.
Lemma map_of_list_inj {A} (l1 l2 : list (K * A)) :
- NoDup (fst <$> l1) →
- NoDup (fst <$> l2) →
- map_of_list l1 = map_of_list l2 →
- Permutation l1 l2.
+ NoDup (fst <$> l1) → NoDup (fst <$> l2) →
+ map_of_list l1 = map_of_list l2 → l1 ≡ₚ l2.
Proof.
- intros ?? Hl1l2.
- apply NoDup_Permutation; auto using (NoDup_fmap_1 fst).
+ intros ?? Hl1l2. apply NoDup_Permutation; auto using (NoDup_fmap_1 fst).
intros [i x]. by rewrite !elem_of_map_of_list, Hl1l2.
Qed.
-Lemma map_of_to_list {A} (m : M A) :
- map_of_list (map_to_list m) = m.
+Lemma map_of_to_list {A} (m : M A) : map_of_list (map_to_list m) = m.
Proof.
apply map_eq. intros i. apply option_eq. intros x.
by rewrite <-elem_of_map_of_list, elem_of_map_to_list
by auto using map_to_list_key_nodup.
Qed.
Lemma map_to_of_list {A} (l : list (K * A)) :
- NoDup (fst <$> l) →
- Permutation (map_to_list (map_of_list l)) l.
-Proof.
- auto using map_of_list_inj, map_to_list_key_nodup, map_of_to_list.
-Qed.
+ NoDup (fst <$> l) → map_to_list (map_of_list l) ≡ₚ l.
+Proof. auto using map_of_list_inj, map_to_list_key_nodup, map_of_to_list. Qed.
Lemma map_to_list_inj {A} (m1 m2 : M A) :
- Permutation (map_to_list m1) (map_to_list m2) →
- m1 = m2.
+ map_to_list m1 ≡ₚ map_to_list m2 → m1 = m2.
Proof.
- intros.
- rewrite <-(map_of_to_list m1), <-(map_of_to_list m2).
+ 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).
+Lemma map_to_list_empty {A} : map_to_list ∅ = @nil (K * A).
Proof.
apply elem_of_nil_inv. intros [i x].
rewrite elem_of_map_to_list. apply lookup_empty_Some.
Qed.
Lemma map_to_list_insert {A} (m : M A) i x :
- m !! i = None →
- Permutation (map_to_list (<[i:=x]>m)) ((i,x) :: map_to_list m).
+ m !! i = None → map_to_list (<[i:=x]>m) ≡ₚ (i,x) :: map_to_list m.
Proof.
intros. apply map_of_list_inj; simpl.
* apply map_to_list_key_nodup.
* constructor; auto using map_to_list_key_nodup.
- rewrite elem_of_list_fmap.
- intros [[??] [? Hlookup]]; subst; simpl in *.
+ rewrite elem_of_list_fmap. intros [[??] [? Hlookup]]; subst; simpl in *.
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)) = ∅.
+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) :
- Permutation (map_to_list m) [] → m = ∅.
+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 = ∅.
+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 :
- Permutation (map_to_list m) ((i,x) :: l) →
- m = <[i:=x]>(map_of_list l).
+ map_to_list m ≡ₚ (i,x) :: l → m = <[i:=x]>(map_of_list l).
Proof.
intros Hperm. apply map_to_list_inj.
assert (NoDup (fst <$> (i, x) :: l)) as Hnodup.
@@ -601,12 +515,10 @@ Qed.
(** * Induction principles *)
Lemma map_ind {A} (P : M A → Prop) :
- P ∅ →
- (∀ i x m, m !! i = None → P m → P (<[i:=x]>m)) →
- ∀ m, P m.
+ 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, Permutation (map_to_list m) l → P m).
+ 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.
@@ -618,8 +530,7 @@ Proof.
Qed.
Lemma map_to_list_length {A} (m1 m2 : M A) :
- m1 ⊂ m2 →
- length (map_to_list m1) < length (map_to_list m2).
+ 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.
@@ -642,14 +553,11 @@ Qed.
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).
- * intros Hforall i x.
- rewrite <-elem_of_map_to_list. by apply (Hforall (i,x)).
+ * intros Hforall [i x]. rewrite elem_of_map_to_list. by apply (Hforall i x).
+ * intros Hforall i x. rewrite <-elem_of_map_to_list. by apply (Hforall (i,x)).
Qed.
Context `{∀ i x, Decision (P i x)}.
@@ -676,8 +584,7 @@ Lemma merge_Some {A B C} (f : option A → option B → option C)
(∀ 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 _).
+ intros Hlookup. apply map_eq. intros. rewrite Hlookup. apply (lookup_merge _).
Qed.
Section merge.
@@ -686,12 +593,12 @@ Context {A} (f : option A → option A → option A).
Global Instance: LeftId (=) None f → LeftId (=) ∅ (merge f).
Proof.
intros ??. apply map_eq. intros.
- by rewrite !(lookup_merge f), lookup_empty, (left_id None f).
+ by rewrite !(lookup_merge f), lookup_empty, (left_id_L None f).
Qed.
Global Instance: RightId (=) None f → RightId (=) ∅ (merge f).
Proof.
intros ??. apply map_eq. intros.
- by rewrite !(lookup_merge f), lookup_empty, (right_id None f).
+ by rewrite !(lookup_merge f), lookup_empty, (right_id_L None f).
Qed.
Context `{!PropHolds (f None None = None)}.
@@ -711,16 +618,13 @@ Lemma merge_associative m1 m2 m3 :
Proof. intros. apply map_eq. intros. by rewrite !(lookup_merge f). Qed.
Global Instance: Associative (=) f → Associative (=) (merge f).
Proof.
- intros ????. apply merge_associative. intros. by apply (associative f).
+ intros ????. apply merge_associative. intros. by apply (associative_L f).
Qed.
Lemma merge_idempotent m1 :
- (∀ i, f (m1 !! i) (m1 !! i) = m1 !! i) →
- merge f m1 m1 = m1.
+ (∀ i, f (m1 !! i) (m1 !! i) = m1 !! i) → merge f m1 m1 = m1.
Proof. intros. apply map_eq. intros. by rewrite !(lookup_merge f). Qed.
Global Instance: Idempotent (=) f → Idempotent (=) (merge f).
-Proof.
- intros ??. apply merge_idempotent. intros. by apply (idempotent f).
-Qed.
+Proof. intros ??. apply merge_idempotent. intros. by apply (idempotent f). Qed.
Lemma partial_alter_merge (g g1 g2 : option A → option A) m1 m2 i :
g (f (m1 !! i) (m2 !! i)) = f (g1 (m1 !! i)) (g2 (m2 !! i)) →
@@ -771,11 +675,9 @@ 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.
+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 ∅.
+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) :
@@ -819,8 +721,7 @@ 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.
+ unfold disjoint, map_disjoint. rewrite map_not_intersection_forall.
* naive_solver.
* right. auto.
Qed.
@@ -833,9 +734,7 @@ Lemma map_disjoint_empty_r {A} (m : M A) : m ⊥ ∅.
Proof. apply map_intersection_forall_empty_r. Qed.
Lemma map_disjoint_weaken {A} (m1 m1' m2 m2' : M A) :
- m1' ⊥ m2' →
- m1 ⊆ m1' → m2 ⊆ m2' →
- m1 ⊥ m2.
+ m1' ⊥ m2' → m1 ⊆ m1' → m2 ⊆ m2' → m1 ⊥ m2.
Proof.
intros Hdisjoint Hm1 Hm2 i x1 x2 Hx1 Hx2.
destruct (Hdisjoint i x1 x2); auto.
@@ -848,49 +747,42 @@ Lemma map_disjoint_weaken_r {A} (m1 m2 m2' : M A) :
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.
+ m1 ⊥ m2 → m1 !! i = Some x → m2 !! i = None.
Proof.
intros Hdisjoint ?. rewrite eq_None_not_Some, is_Some_alt.
intros [x2 ?]. by apply (Hdisjoint i x x2).
Qed.
Lemma map_disjoint_Some_r {A} (m1 m2 : M A) i x:
- m1 ⊥ m2 →
- m2 !! i = Some x →
- m1 !! i = None.
+ 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.
+Lemma map_disjoint_singleton_l {A} (m : M A) i x : {[i, x]} ⊥ m ↔ m !! i = None.
Proof.
split.
- * intro. apply (map_disjoint_Some_l {[(i, x)]} _ _ x);
+ * intro. apply (map_disjoint_Some_l {[i, x]} _ _ x);
auto using lookup_singleton.
* intros ? j y1 y2. destruct (decide (i = j)); subst.
+ 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.
+ 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.
+ 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)]}.
+ 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.
+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 lookup_delete_None. tauto.
Qed.
-Lemma map_disjoint_delete_r {A} (m1 m2 : M A) i :
- m1 ⊥ m2 → m1 ⊥ delete i m2.
+Lemma map_disjoint_delete_r {A} (m1 m2 : M A) i : m1 ⊥ m2 → m1 ⊥ delete i m2.
Proof. symmetry. by apply map_disjoint_delete_l. Qed.
(** ** Properties of the [union_with] operation *)
@@ -920,20 +812,14 @@ Lemma lookup_union_with_None m1 m2 i :
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 →
+ 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.
+ 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.
+ m1 !! i = None → m2 !! i = Some y → union_with f m1 m2 !! i = Some y.
Proof. rewrite lookup_union_with. naive_solver. Qed.
Global Instance: LeftId (@eq (M A)) ∅ (union_with f).
@@ -952,8 +838,7 @@ 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.
+ (∀ 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.
@@ -998,15 +883,13 @@ Lemma insert_union_with m1 m2 i x :
<[i:=x]>(union_with f m1 m2) = union_with f (<[i:=x]>m1) (<[i:=x]>m2).
Proof. intros. apply (partial_alter_merge _). simpl. auto. Qed.
Lemma insert_union_with_l m1 m2 i x :
- m2 !! i = None →
- <[i:=x]>(union_with f m1 m2) = union_with f (<[i:=x]>m1) m2.
+ m2 !! i = None → <[i:=x]>(union_with f m1 m2) = union_with f (<[i:=x]>m1) m2.
Proof.
intros Hm2. unfold union_with, map_union_with.
rewrite (insert_merge_l _). done. by rewrite Hm2.
Qed.
Lemma insert_union_with_r m1 m2 i x :
- m1 !! i = None →
- <[i:=x]>(union_with f m1 m2) = union_with f m1 (<[i:=x]>m2).
+ m1 !! i = None → <[i:=x]>(union_with f m1 m2) = union_with f m1 (<[i:=x]>m2).
Proof.
intros Hm1. unfold union_with, map_union_with.
rewrite (insert_merge_r _). done. by rewrite Hm1.
@@ -1029,86 +912,62 @@ Lemma lookup_union_Some_raw {A} (m1 m2 : M A) i x :
(m1 ∪ m2) !! i = Some x ↔
m1 !! i = Some x ∨ (m1 !! i = None ∧ m2 !! i = Some x).
Proof.
- unfold union, map_union, union_with, map_union_with.
- rewrite (lookup_merge _).
+ unfold union, map_union, union_with, map_union_with. rewrite (lookup_merge _).
destruct (m1 !! i), (m2 !! i); compute; intuition congruence.
Qed.
Lemma lookup_union_None {A} (m1 m2 : M A) i :
(m1 ∪ m2) !! i = None ↔ m1 !! i = None ∧ m2 !! i = None.
Proof.
- unfold union, map_union, union_with, map_union_with.
- rewrite (lookup_merge _).
+ 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.
+ 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.
+ 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.
+ 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.
+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.
+Lemma map_subseteq_union {A} (m1 m2 : M A) : m1 ⊆ m2 → m1 ∪ m2 = m2.
Proof.
- intros Hm1m2.
- apply map_eq. intros i. apply option_eq. intros x.
+ 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].
+ 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.
+Lemma map_union_subseteq_l {A} (m1 m2 : M A) : m1 ⊆ m1 ∪ m2.
Proof. intros ? i x. rewrite lookup_union_Some_raw. intuition. Qed.
-Lemma map_union_subseteq_r {A} (m1 m2 : M A) :
- m1 ⊥ m2 →
- m2 ⊆ m1 ∪ m2.
+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.
+ 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.
+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.
+ 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.
+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.
Lemma map_union_preserving_r {A} (m1 m2 m3 : M A) :
- m2 ⊥ m3 →
- m1 ⊆ m2 →
- m1 ∪ m3 ⊆ m2 ∪ m3.
+ m2 ⊥ m3 → m1 ⊆ m2 → m1 ∪ m3 ⊆ m2 ∪ m3.
Proof.
intros. rewrite !(map_union_commutative _ m3)
by eauto using map_disjoint_weaken_l.
@@ -1116,39 +975,27 @@ Proof.
Qed.
Lemma map_union_reflecting_l {A} (m1 m2 m3 : M A) :
- m3 ⊥ m1 →
- m3 ⊥ m2 →
- m3 ∪ m1 ⊆ m3 ∪ m2 →
- m1 ⊆ m2.
+ 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.
+ 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).
Qed.
Lemma map_union_reflecting_r {A} (m1 m2 m3 : M A) :
- m1 ⊥ m3 →
- m2 ⊥ m3 →
- m1 ∪ m3 ⊆ m2 ∪ m3 →
- m1 ⊆ m2.
+ m1 ⊥ m3 → m2 ⊥ m3 → m1 ∪ m3 ⊆ m2 ∪ m3 → m1 ⊆ m2.
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.
+ 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.
Qed.
Lemma map_union_cancel_r {A} (m1 m2 m3 : M A) :
- m1 ⊥ m3 →
- m2 ⊥ m3 →
- m1 ∪ m3 = m2 ∪ m3 →
- m1 = m2.
+ 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.
@@ -1157,14 +1004,12 @@ Qed.
Lemma map_disjoint_union_l {A} (m1 m2 m3 : M A) :
m1 ∪ m2 ⊥ m3 ↔ m1 ⊥ m3 ∧ m2 ⊥ m3.
Proof.
- rewrite !map_disjoint_alt.
- setoid_rewrite lookup_union_None. naive_solver.
+ rewrite !map_disjoint_alt. setoid_rewrite lookup_union_None. naive_solver.
Qed.
Lemma map_disjoint_union_r {A} (m1 m2 m3 : M A) :
m1 ⊥ m2 ∪ m3 ↔ m1 ⊥ m2 ∧ m1 ⊥ m3.
Proof.
- rewrite !map_disjoint_alt.
- setoid_rewrite lookup_union_None. naive_solver.
+ rewrite !map_disjoint_alt. setoid_rewrite lookup_union_None. naive_solver.
Qed.
Lemma map_disjoint_union_l_2 {A} (m1 m2 m3 : M A) :
m1 ⊥ m3 → m2 ⊥ m3 → m1 ∪ m2 ⊥ m3.
@@ -1173,8 +1018,7 @@ 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.
+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.
rewrite lookup_union_Some_raw.
@@ -1183,8 +1027,7 @@ Proof.
* rewrite !lookup_singleton_ne, lookup_insert_ne; intuition congruence.
Qed.
Lemma insert_union_singleton_r {A} (m : M A) i x :
- m !! i = None →
- <[i:=x]>m = m ∪ {[(i,x)]}.
+ m !! i = None → <[i:=x]>m = m ∪ {[i,x]}.
Proof.
intro. rewrite insert_union_singleton_l, map_union_commutative; [done |].
by apply map_disjoint_singleton_l.
@@ -1212,21 +1055,19 @@ 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 (∪)). Qed.
+Proof. by rewrite !insert_union_singleton_l, (associative_L (∪)). Qed.
Lemma insert_union_r {A} (m1 m2 : M A) i x :
- m1 !! i = None →
- <[i:=x]>(m1 ∪ m2) = m1 ∪ <[i:=x]>m2.
+ m1 !! i = None → <[i:=x]>(m1 ∪ m2) = m1 ∪ <[i:=x]>m2.
Proof.
- intro. rewrite !insert_union_singleton_l, !(associative (∪)).
+ intro. rewrite !insert_union_singleton_l, !(associative_L (∪)).
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.
+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 _ _).
+ * by rewrite (left_id_L _ _).
* by rewrite IHl, insert_union_l.
Qed.
@@ -1236,7 +1077,7 @@ Proof. apply delete_union_with. Qed.
(** ** Properties of the [union_list] operation *)
Lemma map_disjoint_union_list_l {A} (ms : list (M A)) (m : M A) :
- ⋃ ms ⊥ m ↔ Forall (⊥ m) ms.
+ ⋃ ms ⊥ m ↔ Forall (.⊥ m) ms.
Proof.
split.
* induction ms; simpl; rewrite ?map_disjoint_union_l; intuition.
@@ -1245,20 +1086,18 @@ Proof.
+ 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.
+ 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.
+ 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.
+ Forall (.⊥ m) ms → m ⊥ ⋃ ms.
Proof. by rewrite map_disjoint_union_list_r. Qed.
Lemma map_union_sublist {A} (ms1 ms2 : list (M A)) :
- list_disjoint ms2 →
- sublist ms1 ms2 →
- ⋃ ms1 ⊆ ⋃ ms2.
+ ⊥ ms2 → ms1 `sublist` ms2 → ⋃ ms1 ⊆ ⋃ ms2.
Proof.
intros Hms2. revert ms1.
induction Hms2 as [|m2 ms2]; intros ms1; [by inversion 1|].
@@ -1291,22 +1130,19 @@ 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.
+ induction is; simpl; [done |]. rewrite elem_of_cons. intros.
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.
+ 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.
+ induction is; simpl; [done |]. rewrite elem_of_cons. intros.
rewrite IHis, delete_insert_ne; intuition.
Qed.
@@ -1336,38 +1172,34 @@ Lemma map_disjoint_of_list_r {A} (m : M A) 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 :
- same_length is xs →
+ is `same_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 <-(zip_fst is xs) at 2 by done. by rewrite Forall_fmap.
Qed.
Lemma map_disjoint_of_list_zip_r {A} (m : M A) is xs :
- same_length is xs →
+ is `same_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.
Lemma map_disjoint_of_list_zip_l_2 {A} (m : M A) is xs :
- same_length is xs →
- Forall (λ i, m !! i = None) is →
+ is `same_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 :
- same_length is xs →
- Forall (λ i, m !! i = None) is →
+ is `same_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.
(** ** Properties with respect to vectors *)
Lemma union_delete_vec {A n} (ms : vec (M A) n) (i : fin n) :
- list_disjoint ms →
- ms !!! i ∪ ⋃ delete (fin_to_nat i) (vec_to_list ms) = ⋃ ms.
+ ⊥ ms → ms !!! i ∪ ⋃ delete (fin_to_nat i) (vec_to_list ms) = ⋃ ms.
Proof.
induction ms as [|m ? ms]; inversion_clear 1;
inv_fin i; simpl; [done | intros i].
- rewrite (map_union_commutative m), (associative_eq _ _), IHms.
+ rewrite (map_union_commutative m), (associative_L (∪)), IHms.
* by rewrite map_union_commutative.
* done.
* apply map_disjoint_weaken_r with (⋃ ms); [done |].
@@ -1378,10 +1210,9 @@ 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).
Proof.
- induction ms as [|m' ? ms IH];
- inv_fin i; simpl; [done | intros i Hdisjoint].
+ induction ms as [|m' ? ms IH]; inv_fin i; simpl; [done | intros i Hdisjoint].
rewrite map_disjoint_union_r in Hdisjoint.
- rewrite IH, !(associative_eq (∪)), (map_union_commutative m); intuition.
+ rewrite IH, !(associative_L (∪)), (map_union_commutative m); intuition.
Qed.
(** ** Properties of the [difference_with] operation *)
@@ -1409,21 +1240,15 @@ Lemma lookup_difference_with_None m1 m2 i :
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 →
+ 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 →
+ 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.
+ 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.
@@ -1436,19 +1261,14 @@ Proof.
destruct (m1 !! i), (m2 !! i); compute; intuition congruence.
Qed.
-Lemma map_disjoint_difference_l {A} (m1 m2 : M A) :
- m1 ⊆ m2 →
- m2 ∖ m1 ⊥ m1.
+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.
+ 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.
Qed.
-Lemma map_disjoint_difference_r {A} (m1 m2 : M A) :
- m1 ⊆ m2 →
- m1 ⊥ m2 ∖ m1.
+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) :
@@ -1456,8 +1276,7 @@ Lemma map_difference_union {A} (m1 m2 : M A) :
Proof.
intro Hm1m2. apply map_eq. intros i.
apply option_eq. intros v. specialize (Hm1m2 i).
- unfold difference, map_difference,
- difference_with, map_difference_with.
+ 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.
@@ -1472,30 +1291,23 @@ maps. This tactic does not yield any information loss as all simplifications
performed are reversible. *)
Ltac decompose_map_disjoint := repeat
match goal with
- | H : _ ∪ _ ⊥ _ |- _ =>
- apply map_disjoint_union_l in H; destruct H
- | H : _ ⊥ _ ∪ _ |- _ =>
- apply map_disjoint_union_r in H; destruct H
+ | H : _ ∪ _ ⊥ _ |- _ => apply map_disjoint_union_l in H; destruct H
+ | H : _ ⊥ _ ∪ _ |- _ => apply map_disjoint_union_r in H; destruct H
| H : {[ _ ]} ⊥ _ |- _ => apply map_disjoint_singleton_l in H
| H : _ ⊥ {[ _ ]} |- _ => apply map_disjoint_singleton_r in H
- | H : <[_:=_]>_ ⊥ _ |- _ =>
- apply map_disjoint_insert_l in H; destruct H
- | H : _ ⊥ <[_:=_]>_ |- _ =>
- apply map_disjoint_insert_r in H; destruct H
+ | H : <[_:=_]>_ ⊥ _ |- _ => apply map_disjoint_insert_l in H; destruct H
+ | H : _ ⊥ <[_:=_]>_ |- _ => apply map_disjoint_insert_r in H; destruct H
| H : ⋃ _ ⊥ _ |- _ => apply map_disjoint_union_list_l in H
| H : _ ⊥ ⋃ _ |- _ => apply map_disjoint_union_list_r in H
| H : ∅ ⊥ _ |- _ => clear H
| H : _ ⊥ ∅ |- _ => clear H
- | H : list_disjoint [] |- _ => clear H
- | H : list_disjoint [_] |- _ => clear H
- | H : list_disjoint (_ :: _) |- _ =>
- apply list_disjoint_cons_inv in H; destruct H
- | H : Forall (⊥ _) _ |- _ => rewrite Forall_vlookup in H
- | H : Forall (⊥ _) [] |- _ => clear H
- | H : Forall (⊥ _) (_ :: _) |- _ =>
- rewrite Forall_cons in H; destruct H
- | H : Forall (⊥ _) (_ :: _) |- _ =>
- rewrite Forall_app in H; destruct H
+ | H : ⊥ [] |- _ => clear H
+ | H : ⊥ [_] |- _ => clear H
+ | H : ⊥ (_ :: _) |- _ => apply disjoint_list_cons in H; destruct H
+ | H : Forall (.⊥ _) _ |- _ => rewrite Forall_vlookup in H
+ | H : Forall (.⊥ _) [] |- _ => clear H
+ | H : Forall (.⊥ _) (_ :: _) |- _ => rewrite Forall_cons in H; destruct H
+ | H : Forall (.⊥ _) (_ :: _) |- _ => rewrite Forall_app in H; destruct H
end.
(** To prove a disjointness property, we first decompose all hypotheses, and
@@ -1513,8 +1325,8 @@ Hint Extern 2 ({[ _ ]} ⊥ _) =>
apply map_disjoint_singleton_l_2 : map_disjoint.
Hint Extern 2 (_ ⊥ {[ _ ]}) =>
apply map_disjoint_singleton_r_2 : map_disjoint.
-Hint Extern 2 (list_disjoint []) => apply disjoint_nil : map_disjoint.
-Hint Extern 2 (list_disjoint (_ :: _)) => apply disjoint_cons : map_disjoint.
+Hint Extern 2 (⊥ []) => apply disjoint_nil_2 : map_disjoint.
+Hint Extern 2 (⊥ (_ :: _)) => apply disjoint_cons_2 : map_disjoint.
Hint Extern 2 (_ ∪ _ ⊥ _) => apply map_disjoint_union_l_2 : map_disjoint.
Hint Extern 2 (_ ⊥ _ ∪ _) => apply map_disjoint_union_r_2 : map_disjoint.
Hint Extern 2 (<[_:=_]>_ ⊥ _) => apply map_disjoint_insert_l_2 : map_disjoint.
@@ -1532,7 +1344,7 @@ Hint Extern 2 (delete_list _ _ ⊥ _) =>
Hint Extern 2 (_ ⊥ delete_list _ _) =>
apply map_disjoint_delete_list_r : map_disjoint.
-(** The tactic [simpl_map by tac] simplifies occurrences of finite map look
+(** The tactic [simpl_map by tac] simplifies occurrences of finite map look
ups. It uses [tac] to discharge generated inequalities. Look ups in unions do
not have nice equational properties, hence it invokes [tac] to prove that such
look ups yield [Some]. *)
@@ -1572,19 +1384,17 @@ Tactic Notation "simpl_map" "by" tactic3(tac) := repeat
Create HintDb simpl_map.
Tactic Notation "simpl_map" := simpl_map by eauto with simpl_map map_disjoint.
-Hint Extern 80 ((_ ∪ _) !! _ = Some _) =>
- apply lookup_union_Some_l : simpl_map.
-Hint Extern 81 ((_ ∪ _) !! _ = Some _) =>
- apply lookup_union_Some_r : simpl_map.
-Hint Extern 80 ({[ _ ]} !! _ = Some _) =>
- apply lookup_singleton : simpl_map.
-Hint Extern 80 (<[_:=_]> _ !! _ = Some _) =>
- apply lookup_insert : simpl_map.
+Hint Extern 80 ((_ ∪ _) !! _ = Some _) => apply lookup_union_Some_l : simpl_map.
+Hint Extern 81 ((_ ∪ _) !! _ = Some _) => apply lookup_union_Some_r : simpl_map.
+Hint Extern 80 ({[ _ ]} !! _ = Some _) => apply lookup_singleton : simpl_map.
+Hint Extern 80 (<[_:=_]> _ !! _ = Some _) => apply lookup_insert : simpl_map.
(** Now we take everything together and also discharge conflicting look ups,
simplify overlapping look ups, and perform cancellations of equalities
involving unions. *)
-Tactic Notation "simplify_map_equality" "by" tactic3(tac) := repeat
+Tactic Notation "simplify_map_equality" "by" tactic3(tac) :=
+ decompose_map_disjoint;
+ repeat
match goal with
| _ => progress simpl_map by tac
| _ => progress simplify_equality
@@ -1606,5 +1416,4 @@ Tactic Notation "simplify_map_equality" "by" tactic3(tac) := repeat
apply map_union_cancel_r in H; [| solve[tac] | solve [tac]]
end.
Tactic Notation "simplify_map_equality" :=
- decompose_map_disjoint;
simplify_map_equality by eauto with simpl_map map_disjoint.
diff --git a/theories/fresh_numbers.v b/theories/fresh_numbers.v
index 84f0ec2c..1e8c5d85 100644
--- a/theories/fresh_numbers.v
+++ b/theories/fresh_numbers.v
@@ -28,9 +28,7 @@ Proof.
split.
* apply _.
* intros. unfold fresh, Nfresh.
- setoid_replace X with Y; [done |].
- by apply elem_of_equiv.
+ setoid_replace X with Y; [done |]. by apply elem_of_equiv.
* intros X E. assert (1 ≤ 0)%N as []; [| done].
- apply N.add_le_mono_r with (Nmax X).
- by apply Nmax_max.
+ apply N.add_le_mono_r with (Nmax X). by apply Nmax_max.
Qed.
diff --git a/theories/list.v b/theories/list.v
index 4aa91394..d874ece4 100644
--- a/theories/list.v
+++ b/theories/list.v
@@ -2,8 +2,7 @@
(* This file is distributed under the terms of the BSD license. *)
(** This file collects general purpose definitions and theorems on lists that
are not in the Coq standard library. *)
-
-Require Import Permutation.
+Require Export Permutation.
Require Export numbers base decidable option.
Arguments length {_} _.
@@ -12,13 +11,10 @@ Arguments app {_} _ _.
Arguments Permutation {_} _ _.
Arguments Forall_cons {_} _ _ _ _ _.
-Notation Forall_nil_2 := Forall_nil.
-Notation Forall_cons_2 := Forall_cons.
-
Notation tail := tl.
Notation take := firstn.
Notation drop := skipn.
-Notation take_drop := firstn_skipn.
+
Arguments take {_} !_ !_ /.
Arguments drop {_} !_ !_ /.
@@ -29,6 +25,15 @@ Notation "(++)" := app (only parsing) : C_scope.
Notation "( l ++)" := (app l) (only parsing) : C_scope.
Notation "(++ k )" := (λ l, app l k) (only parsing) : C_scope.
+Infix "≡ₚ" := Permutation (at level 70, no associativity) : C_scope.
+Notation "(≡ₚ)" := Permutation (only parsing) : C_scope.
+Notation "( x ≡ₚ)" := (Permutation 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.
+
(** * Definitions *)
(** The operation [l !! i] gives the [i]th element of the list [l], or [None]
in case [i] is out of bounds. *)
@@ -36,11 +41,7 @@ Instance list_lookup {A} : Lookup nat A (list A) :=
fix go (i : nat) (l : list A) {struct l} : option A :=
match l with
| [] => None
- | x :: l =>
- match i with
- | 0 => Some x
- | S i => @lookup _ _ _ go i l
- end
+ | x :: l => match i with 0 => Some x | S i => @lookup _ _ _ go i l end
end.
(** The operation [alter f i l] applies the function [f] to the [i]th element
@@ -49,11 +50,7 @@ Instance list_alter {A} (f : A → A) : AlterD nat A (list A) f :=
fix go (i : nat) (l : list A) {struct l} :=
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 go i l end
end.
(** The operation [delete i l] removes the [i]th element of [l] and moves
@@ -63,17 +60,12 @@ Instance list_delete {A} : Delete nat (list A) :=
fix go (i : nat) (l : list A) {struct l} : list A :=
match l with
| [] => []
- | x :: l =>
- match i with
- | 0 => l
- | S i => x :: @delete _ _ go i l
- end
+ | x :: l => match i with 0 => l | S i => x :: @delete _ _ go i l end
end.
(** The operation [<[i:=x]> l] overwrites the element at position [i] with the
value [x]. In case [i] is out of bounds, the list is returned unchanged. *)
-Instance list_insert {A} : Insert nat A (list A) := λ i x,
- alter (λ _, x) i.
+Instance list_insert {A} : Insert nat A (list A) := λ i x, alter (λ _, x) i.
(** The function [option_list o] converts an element [Some x] into the
singleton list [[x]], and [None] into the empty list [[]]. *)
@@ -86,32 +78,23 @@ Instance list_filter {A} : Filter A (list A) :=
match l with
| [] => []
| x :: l =>
- if decide (P x)
- then x :: @filter _ _ (@go) _ _ l
- else @filter _ _ (@go) _ _ l
+ if decide (P x)
+ then x :: @filter _ _ (@go) _ _ l
+ else @filter _ _ (@go) _ _ l
end.
(** The function [replicate n x] generates a list with length [n] of elements
with value [x]. *)
Fixpoint replicate {A} (n : nat) (x : A) : list A :=
- match n with
- | 0 => []
- | S n => x :: replicate n x
- end.
+ match n with 0 => [] | S n => x :: replicate n x end.
(** 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.
+ 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.
+ match l with [] => None | x :: l => Some (last' x 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
@@ -119,11 +102,7 @@ a list of length [n]. *)
Fixpoint resize {A} (n : nat) (y : A) (l : list A) : list A :=
match l with
| [] => replicate n y
- | x :: l =>
- match n with
- | 0 => []
- | S n => x :: resize n y l
- end
+ | x :: l => match n with 0 => [] | S n => x :: resize n y l end
end.
Arguments resize {_} !_ _ !_.
@@ -142,48 +121,41 @@ Definition foldl {A B} (f : A → B → A) : A → list B → A :=
Instance list_ret: MRet list := λ A x, x :: @nil A.
Instance list_fmap {A B} (f : A → B) : FMapD list f :=
fix go (l : list A) :=
- match l with
- | [] => []
- | x :: l => f x :: @fmap _ _ _ f go l
- end.
+ match l with [] => [] | x :: l => f x :: @fmap _ _ _ f go l end.
Instance list_bind {A B} (f : A → list B) : MBindD list f :=
fix go (l : list A) :=
- match l with
- | [] => []
- | x :: l => f x ++ @mbind _ _ _ f go l
- end.
+ match l with [] => [] | x :: l => f x ++ @mbind _ _ _ f go l end.
Instance list_join: MJoin list :=
fix go A (ls : list (list A)) : list A :=
- match ls with
- | [] => []
- | l :: ls => l ++ @mjoin _ go _ ls
- end.
+ match ls with [] => [] | l :: ls => l ++ @mjoin _ go _ ls end.
(** We define stronger variants of map and fold that allow the mapped
function to use the index of the elements. *)
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.
+ 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 : nat) (l : list B) : A :=
- match l with
- | nil => a n
- | b :: l => f n b (go (S n) l)
- end.
+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.
+
+Inductive zipped_Forall {A} (P : list A → list A → A → Prop) :
+ list A → list A → Prop :=
+ | zipped_Forall_nil l : zipped_Forall P l []
+ | zipped_Forall_cons l k x :
+ P l k x → zipped_Forall P (x :: l) k → zipped_Forall P l (x :: k).
+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.
+ match l1, l2 with x1 :: l1, x2 :: l2 => f x1 x2 :: go l1 l2 | _ , _ => [] end.
Notation zip := (zip_with pair).
(** The function [permutations l] yields all permutations of [l]. *)
@@ -202,6 +174,8 @@ Fixpoint permutations {A} (l : list A) : list (list A) :=
The predicate [prefix_of] holds if the first list is a prefix of the second. *)
Definition suffix_of {A} : relation (list A) := λ l1 l2, ∃ k, l2 = k ++ l1.
Definition prefix_of {A} : relation (list A) := λ l1 l2, ∃ k, l2 = l1 ++ k.
+Infix "`suffix_of`" := suffix_of (at level 70) : C_scope.
+Infix "`prefix_of`" := prefix_of (at level 70) : C_scope.
Section prefix_suffix_ops.
Context `{∀ x y : A, Decision (x = y)}.
@@ -212,9 +186,9 @@ Section prefix_suffix_ops.
| [], l2 => ([], l2, [])
| l1, [] => (l1, [], [])
| x1 :: l1, x2 :: l2 =>
- if decide_rel (=) x1 x2
- then snd_map (x1 ::) (go l1 l2)
- else (x1 :: l1, x2 :: l2, [])
+ if decide_rel (=) x1 x2
+ then snd_map (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
@@ -229,15 +203,89 @@ End prefix_suffix_ops.
from [l1] without changing the order. *)
Inductive sublist {A} : relation (list A) :=
| sublist_nil : sublist [] []
- | sublist_cons x l1 l2 : sublist l1 l2 → sublist (x :: l1) (x :: l2)
- | sublist_cons_skip x l1 l2 : sublist l1 l2 → sublist l1 (x :: l2).
+ | sublist_skip x l1 l2 : sublist l1 l2 → sublist (x :: l1) (x :: l2)
+ | sublist_insert x l1 l2 : sublist l1 l2 → sublist l1 (x :: l2).
+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. *)
+Inductive contains {A} : relation (list A) :=
+ | contains_nil : contains [] []
+ | contains_skip x l1 l2 : contains l1 l2 → contains (x :: l1) (x :: l2)
+ | contains_swap x y l : contains (y :: x :: l) (x :: y :: l)
+ | contains_insert x l1 l2 : contains l1 l2 → contains l1 (x :: l2)
+ | contains_trans l1 l2 l3 : contains l1 l2 → contains l2 l3 → contains l1 l3.
+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
+ | y :: l => if decide (x = y) then Some l else (y ::) <$> list_remove x l
+ 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
+ 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 x y l k :
- same_length l k → same_length (x :: l) (y :: k).
+ | 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.
+
+(** 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.
+ refine (
+ fix go l :=
+ match l return Decision (x ∈ l) with
+ | [] => right _
+ | 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
+ 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
+ end.
+ Definition list_intersection_with (f : A → A → option A) :
+ list A → list A → list A := fix go l k :=
+ match l with
+ | [] => []
+ | x :: l => foldr (λ y,
+ match f x y with None => id | Some z => (z ::) end) (go l k) k
+ end.
+End list_set.
(** * Basic tactics on lists *)
(** The tactic [discriminate_list_equality] discharges a goal if it contains
@@ -245,44 +293,41 @@ a list equality involving [(::)] and [(++)] of two lists that have a different
length as one of its hypotheses. *)
Tactic Notation "discriminate_list_equality" hyp(H) :=
apply (f_equal length) in H;
- repeat (simpl in H || rewrite app_length in H);
- exfalso; lia.
+ repeat (simpl in H || rewrite app_length in H); exfalso; lia.
Tactic Notation "discriminate_list_equality" :=
- solve [repeat_on_hyps (fun H => discriminate_list_equality H)].
+ match goal with
+ | H : @eq (list _) _ _ |- _ => discriminate_list_equality H
+ end.
(** The tactic [simplify_list_equality] simplifies hypotheses involving
equalities on lists using injectivity of [(::)] and [(++)]. Also, it simplifies
lookups in singleton lists. *)
-Lemma cons_inv {A} (l1 l2 : list A) x1 x2 :
- x1 :: l1 = x2 :: l2 → x1 = x2 ∧ l1 = l2.
-Proof. by injection 1. Qed.
-
-Ltac simplify_list_equality := repeat
- match goal with
- | H : _ :: _ = _ :: _ |- _ =>
- apply cons_inv in H; destruct H
- (* to circumvent bug #2939 in some situations *)
+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_inj_tail in H; destruct H
+ | apply app_inv_head in H | apply app_inv_tail in H ]
| H : [?x] !! ?i = Some ?y |- _ =>
- destruct i; [change (Some x = Some y) in H|discriminate]
- | _ => progress simplify_equality
- | H : _ |- _ => discriminate_list_equality H
- end.
+ destruct i; [change (Some x = Some y) in H | discriminate]
+ end;
+ try discriminate_list_equality.
(** * General theorems *)
Section general_properties.
Context {A : Type}.
+Implicit Types x y z : A.
+Implicit Types l k : list A.
-Global Instance: ∀ x : A, Injective (=) (=) (x ::).
+Global Instance: Injective2 (=) (=) (=) (@cons A).
+Proof. by injection 1. Qed.
+Global Instance: ∀ x, Injective (=) (=) (x ::).
Proof. by injection 1. Qed.
-Global Instance: ∀ l : list A, Injective (=) (=) (:: l).
+Global Instance: ∀ l, Injective (=) (=) (:: l).
Proof. by injection 1. Qed.
-Global Instance: ∀ k : list A, Injective (=) (=) (k ++).
+Global Instance: ∀ k, Injective (=) (=) (k ++).
Proof. intros ???. apply app_inv_head. Qed.
-Global Instance: ∀ k : list A, Injective (=) (=) (++ k).
+Global Instance: ∀ k, Injective (=) (=) (++ k).
Proof. intros ???. apply app_inv_tail. Qed.
Global Instance: Associative (=) (@app A).
Proof. intros ???. apply app_assoc. Qed.
@@ -291,49 +336,44 @@ Proof. done. Qed.
Global Instance: RightId (=) [] (@app A).
Proof. intro. apply app_nil_r. Qed.
-Lemma app_inj (l1 k1 l2 k2 : list A) :
- length l1 = length k1 →
- l1 ++ l2 = k1 ++ k2 → l1 = k1 ∧ l2 = k2.
+Lemma app_nil l1 l2 : l1 ++ l2 = [] ↔ l1 = [] ∧ l2 = [].
+Proof. split. apply app_eq_nil. by intros [??]; subst. 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.
+
+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 : list A) : (∀ i, l1 !! i = l2 !! i)%C → l1 = l2.
+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. intro. apply (H (S _)).
Qed.
-Lemma list_eq_nil (l : list A) : (∀ i, l !! i = None) → l = nil.
+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 : A, Decision (x = y)} : ∀ l k,
+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 : list A) :
- { x | l = [x] } + { length l ≠1 }.
-Proof.
- by refine (
- match l with
- | [x] => inleft (x ↾ _)
- | _ => inright _
- end).
-Defined.
+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: Proper (Permutation ==> (=)) (@length A).
-Proof. induction 1; simpl; auto with lia. Qed.
-
-Lemma nil_or_length_pos (l : list A) : l = [] ∨ length l ≠0.
+Lemma nil_or_length_pos l : l = [] ∨ length l ≠0.
Proof. destruct l; simpl; auto with lia. Qed.
-Lemma nil_length (l : list A) : length l = 0 → l = [].
+Lemma nil_length 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 : list A) i : tail l !! i = l !! S i.
+Lemma lookup_tail l i : tail l !! i = l !! S i.
Proof. by destruct l. Qed.
-Lemma lookup_lt_length (l : list A) i :
- is_Some (l !! i) ↔ i < length l.
+Lemma lookup_lt_length l i : is_Some (l !! i) ↔ i < length l.
Proof.
revert i. induction l.
* split; by inversion 1.
@@ -341,115 +381,85 @@ Proof.
+ split; eauto with arith.
+ by rewrite <-NPeano.Nat.succ_lt_mono.
Qed.
-Lemma lookup_lt_length_1 (l : list A) i :
- is_Some (l !! i) → i < length l.
+Lemma lookup_lt_length_1 l i : is_Some (l !! i) → i < length l.
Proof. apply lookup_lt_length. Qed.
-Lemma lookup_lt_length_alt (l : list A) i x :
- l !! i = Some x → i < length l.
+Lemma lookup_lt_length_alt l i x : l !! i = Some x → i < length l.
Proof. intros Hl. by rewrite <-lookup_lt_length, Hl. Qed.
-Lemma lookup_lt_length_2 (l : list A) i :
- i < length l → is_Some (l !! i).
+Lemma lookup_lt_length_2 l i : i < length l → is_Some (l !! i).
Proof. apply lookup_lt_length. Qed.
-Lemma lookup_ge_length (l : list A) i :
- l !! i = None ↔ length l ≤ i.
+Lemma lookup_ge_length l i : l !! i = None ↔ length l ≤ i.
Proof. rewrite eq_None_not_Some, lookup_lt_length. lia. Qed.
-Lemma lookup_ge_length_1 (l : list A) i :
- l !! i = None → length l ≤ i.
+Lemma lookup_ge_length_1 l i : l !! i = None → length l ≤ i.
Proof. by rewrite lookup_ge_length. Qed.
-Lemma lookup_ge_length_2 (l : list A) i :
- length l ≤ i → l !! i = None.
+Lemma lookup_ge_length_2 l i : length l ≤ i → l !! i = None.
Proof. by rewrite lookup_ge_length. Qed.
-Lemma list_eq_length_eq (l1 l2 : list A) :
+Lemma list_eq_length_eq l1 l2 :
length l2 = length l1 →
- (∀ i x y, l1 !! i = Some x → l2 !! i = Some y → x = y) →
- l1 = l2.
+ (∀ i x y, l1 !! i = Some x → l2 !! i = Some y → x = y) → l1 = l2.
Proof.
intros Hlength Hlookup. apply list_eq. intros i.
destruct (l2 !! i) as [x|] eqn:E.
- * feed inversion (lookup_lt_length_2 l1 i) as [y].
- { pose proof (lookup_lt_length_alt l2 i x E). lia. }
- f_equal. eauto.
+ * feed inversion (lookup_lt_length_2 l1 i) as [y]; [|eauto with f_equal].
+ pose proof (lookup_lt_length_alt l2 i x E). lia.
* rewrite lookup_ge_length in E |- *. lia.
Qed.
-Lemma lookup_app_l (l1 l2 : list A) i :
- i < length l1 →
- (l1 ++ l2) !! i = l1 !! i.
+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 : list A) i x :
- l1 !! i = Some x →
- (l1 ++ l2) !! i = Some x.
+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_length_alt. Qed.
-
-Lemma lookup_app_r (l1 l2 : list A) i :
- (l1 ++ l2) !! (length l1 + i) = l2 !! i.
+Lemma lookup_app_r l1 l2 i : (l1 ++ l2) !! (length l1 + i) = l2 !! i.
Proof.
- revert i.
- induction l1; intros [|i]; simpl in *; simplify_equality; auto.
+ revert i. induction l1; intros [|i]; simpl in *; simplify_equality; auto.
Qed.
-Lemma lookup_app_r_alt (l1 l2 : list A) i :
- length l1 ≤ i →
- (l1 ++ l2) !! i = l2 !! (i - length l1).
+Lemma lookup_app_r_alt l1 l2 i :
+ length l1 ≤ i → (l1 ++ l2) !! i = l2 !! (i - length l1).
Proof.
intros. assert (i = length l1 + (i - length l1)) as Hi by lia.
rewrite Hi at 1. by apply lookup_app_r.
Qed.
-Lemma lookup_app_r_Some (l1 l2 : list A) i x :
- l2 !! i = Some x →
- (l1 ++ l2) !! (length l1 + i) = Some x.
+Lemma lookup_app_r_Some l1 l2 i x :
+ l2 !! i = Some x → (l1 ++ l2) !! (length l1 + i) = Some x.
Proof. by rewrite lookup_app_r. Qed.
-Lemma lookup_app_r_Some_alt (l1 l2 : list A) i x :
- length l1 ≤ i →
- l2 !! (i - length l1) = Some x →
- (l1 ++ l2) !! i = Some x.
+Lemma lookup_app_r_Some_alt l1 l2 i x :
+ length l1 ≤ i → l2 !! (i - length l1) = Some x → (l1 ++ l2) !! i = Some x.
Proof. intro. by rewrite lookup_app_r_alt. Qed.
-
-Lemma lookup_app_inv (l1 l2 : list A) i x :
- (l1 ++ l2) !! i = Some x →
- l1 !! i = Some x ∨ l2 !! (i - length l1) = Some x.
+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] ?; simpl in *; simplify_equality; auto.
+ revert i. induction l1; intros [|i] ?; simpl in *; simplify_equality; auto.
Qed.
-
-Lemma list_lookup_middle (l1 l2 : list A) (x : A) :
- (l1 ++ x :: l2) !! length l1 = Some x.
+Lemma list_lookup_middle l1 l2 x : (l1 ++ x :: l2) !! length l1 = Some x.
Proof. by induction l1; simpl. Qed.
-Lemma alter_length (f : A → A) l i :
- length (alter f i l) = length l.
+Lemma alter_length f l i : length (alter f i l) = length l.
Proof. revert i. induction l; intros [|?]; simpl; auto with lia. Qed.
-Lemma insert_length (l : list A) i x :
- length (<[i:=x]>l) = length l.
+Lemma insert_length l i x : length (<[i:=x]>l) = length l.
Proof. apply alter_length. Qed.
-Lemma list_lookup_alter (f : A → A) l i :
- alter f i l !! i = f <$> l !! i.
+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 : A → A) l i j :
+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.
Qed.
-Lemma list_lookup_insert (l : list A) i x :
- i < length l →
- <[i:=x]>l !! i = Some x.
+Lemma list_lookup_insert l i x : i < length l → <[i:=x]>l !! i = Some x.
Proof.
- intros Hi. unfold insert, list_insert.
- rewrite list_lookup_alter.
+ intros Hi. unfold insert, list_insert. rewrite list_lookup_alter.
by feed inversion (lookup_lt_length_2 l i).
Qed.
-Lemma list_lookup_insert_ne (l : list A) i j x :
+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 : list A) i x :
- length l ≠1 →
- l !! i = Some x →
- ∃ j y, j ≠i ∧ l !! j = Some y.
+Lemma list_lookup_other l i x :
+ length l ≠1 → l !! i = Some x → ∃ j y, j ≠i ∧ l !! j = Some y.
Proof.
intros Hl Hi.
destruct i; destruct l as [|x0 [|x1 l]]; simpl in *; simplify_equality.
@@ -457,146 +467,165 @@ Proof.
* by exists 0 x0.
Qed.
-Lemma alter_app_l (f : A → A) (l1 l2 : list A) i :
- i < length l1 →
- alter f i (l1 ++ l2) = alter f i l1 ++ l2.
+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.
+ revert i. induction l1; intros [|?] ?; simpl in *; f_equal; auto with lia.
Qed.
-Lemma alter_app_r (f : A → A) (l1 l2 : list A) i :
+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.
-Lemma alter_app_r_alt (f : A → A) (l1 l2 : list A) i :
- length l1 ≤ i →
- alter f i (l1 ++ l2) = l1 ++ alter f (i - length l1) l2.
+Proof. revert i. induction l1; intros [|?]; simpl in *; 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 insert_app_l (l1 l2 : list A) i x :
- i < length l1 →
- <[i:=x]>(l1 ++ l2) = <[i:=x]>l1 ++ l2.
+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.
-Lemma insert_app_r (l1 l2 : list A) i x :
- <[length l1 + i:=x]>(l1 ++ l2) = l1 ++ <[i:=x]>l2.
+Lemma insert_app_r l1 l2 i x : <[length l1+i:=x]>(l1 ++ l2) = l1 ++ <[i:=x]>l2.
Proof. apply alter_app_r. Qed.
-Lemma insert_app_r_alt (l1 l2 : list A) i x :
- length l1 ≤ i →
- <[i:=x]>(l1 ++ l2) = l1 ++ <[i - length l1:=x]>l2.
+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.
-Lemma insert_consecutive_length (l : list A) i k :
+Lemma insert_consecutive_length l i k :
length (insert_consecutive i k l) = length l.
Proof. revert i. by induction k; intros; simpl; rewrite ?insert_length. Qed.
-Lemma delete_middle (l1 l2 : list A) x :
- delete (length l1) (l1 ++ x :: l2) = l1 ++ l2.
+Lemma delete_middle l1 l2 x : delete (length l1) (l1 ++ x :: l2) = l1 ++ l2.
Proof. induction l1; simpl; f_equal; auto. Qed.
(** ** Properties of the [elem_of] predicate *)
-Lemma not_elem_of_nil (x : A) : x ∉ [].
+Lemma not_elem_of_nil x : x ∉ [].
Proof. by inversion 1. Qed.
-Lemma elem_of_nil (x : A) : x ∈ [] ↔ False.
+Lemma elem_of_nil x : x ∈ [] ↔ False.
Proof. intuition. by destruct (not_elem_of_nil x). Qed.
-Lemma elem_of_nil_inv (l : list A) : (∀ x, x ∉ l) → l = [].
+Lemma elem_of_nil_inv l : (∀ x, x ∉ l) → l = [].
Proof. destruct l. done. by edestruct 1; constructor. Qed.
-Lemma elem_of_cons (l : list A) x y :
- x ∈ y :: l ↔ x = y ∨ x ∈ l.
+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.
-Lemma not_elem_of_cons (l : list A) x y :
- x ∉ y :: l ↔ x ≠y ∧ x ∉ l.
+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 : list A) x :
- x ∈ l1 ++ l2 ↔ x ∈ l1 ∨ x ∈ l2.
+Lemma elem_of_app l1 l2 x : x ∈ l1 ++ l2 ↔ x ∈ l1 ∨ x ∈ l2.
Proof.
induction l1.
- * split; [by right|]. intros [Hx|]; [|done].
- by destruct (elem_of_nil x).
+ * split; [by right|]. intros [Hx|]; [|done]. by destruct (elem_of_nil x).
* simpl. rewrite !elem_of_cons, IHl1. tauto.
Qed.
-Lemma not_elem_of_app (l1 l2 : list A) x :
- x ∉ l1 ++ l2 ↔ x ∉ l1 ∧ x ∉ l2.
+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 : A) : x ∈ [y] ↔ x = y.
+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 : A) :
- Proper (Permutation ==> iff) (x ∈).
+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 : list A) x :
- x ∈ l → ∃ l1 l2, l = l1 ++ x :: l2.
+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.
Qed.
-Global Instance elem_of_list_dec {dec : ∀ x y : A, Decision (x = y)} :
- ∀ (x : A) l, Decision (x ∈ l).
+Lemma elem_of_list_lookup_1 l x : x ∈ l → ∃ i, l !! i = Some x.
Proof.
- intros x. refine (
- fix go l :=
- match l return Decision (x ∈ l) with
- | [] => right (not_elem_of_nil _)
- | y :: l => cast_if_or (decide_rel (=) x y) (go l)
- end); clear go dec; subst; try (by constructor); by inversion 1.
-Defined.
-
-Lemma elem_of_list_lookup_1 (l : list A) x :
- x ∈ l → ∃ i, l !! i = Some x.
-Proof.
- induction 1 as [|???? IH].
- * by exists 0.
- * destruct IH as [i ?]; auto. by exists (S i).
+ induction 1 as [|???? IH]; [by exists 0 |].
+ destruct IH as [i ?]; auto. by exists (S i).
Qed.
-Lemma elem_of_list_lookup_2 (l : list A) i x :
- l !! i = Some x → x ∈ l.
+Lemma elem_of_list_lookup_2 l i x : l !! i = Some x → x ∈ l.
Proof.
revert i. induction l; intros [|i] ?;
simpl; simplify_equality; constructor; eauto.
Qed.
-Lemma elem_of_list_lookup (l : list A) x :
- x ∈ l ↔ ∃ i, l !! i = Some x.
-Proof.
- firstorder eauto using
- elem_of_list_lookup_1, elem_of_list_lookup_2.
-Qed.
+Lemma elem_of_list_lookup l x : x ∈ l ↔ ∃ i, l !! i = Some x.
+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.
+ Proof.
+ split; induction l; simpl; try case_decide;
+ rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
+ Qed.
+ Lemma list_difference_nodup l k : NoDup l → NoDup (list_difference l k).
+ Proof.
+ induction 1; simpl; try case_decide.
+ * constructor.
+ * 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.
+ split; induction l; simpl; repeat case_decide;
+ rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
+ Qed.
+ Lemma list_intersection_nodup l k : NoDup l → NoDup (list_intersection l k).
+ Proof.
+ induction 1; simpl; try case_decide.
+ * constructor.
+ * 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.
+ + generalize (list_intersection_with f l k).
+ induction Hx2; simpl; [by rewrite Hx; left |].
+ case_match; simpl; try setoid_rewrite elem_of_cons; auto.
+ + generalize (IH Hx). clear Hx IH Hx2.
+ generalize (list_intersection_with f l k).
+ induction k; simpl; intros; [done |].
+ case_match; simpl; rewrite ?elem_of_cons; auto.
+ Qed.
+End list_set.
(** ** Properties of the [NoDup] predicate *)
Lemma NoDup_nil : NoDup (@nil A) ↔ True.
Proof. split; constructor. Qed.
-Lemma NoDup_cons (x : A) l : NoDup (x :: l) ↔ x ∉ l ∧ NoDup l.
+Lemma NoDup_cons x l : NoDup (x :: l) ↔ x ∉ l ∧ NoDup l.
Proof. split. by inversion 1. intros [??]. by constructor. Qed.
-Lemma NoDup_cons_11 (x : A) l : NoDup (x :: l) → x ∉ l.
+Lemma NoDup_cons_11 x l : NoDup (x :: l) → x ∉ l.
Proof. rewrite NoDup_cons. by intros [??]. Qed.
-Lemma NoDup_cons_12 (x : A) l : NoDup (x :: l) → NoDup l.
+Lemma NoDup_cons_12 x l : NoDup (x :: l) → NoDup l.
Proof. rewrite NoDup_cons. by intros [??]. Qed.
-Lemma NoDup_singleton (x : A) : NoDup [x].
+Lemma NoDup_singleton x : NoDup [x].
Proof. constructor. apply not_elem_of_nil. constructor. Qed.
-Lemma NoDup_app (l k : list A) :
- NoDup (l ++ k) ↔ NoDup l ∧ (∀ x, x ∈ l → x ∉ k) ∧ NoDup k.
+Lemma NoDup_app l k : NoDup (l ++ k) ↔ NoDup l ∧ (∀ x, x ∈ l → x ∉ k) ∧ NoDup k.
Proof.
induction l; simpl.
- * rewrite NoDup_nil.
- setoid_rewrite elem_of_nil. naive_solver.
+ * rewrite NoDup_nil. setoid_rewrite elem_of_nil. naive_solver.
* rewrite !NoDup_cons.
setoid_rewrite elem_of_cons. setoid_rewrite elem_of_app. naive_solver.
Qed.
-Global Instance NoDup_proper:
- Proper (Permutation ==> iff) (@NoDup A).
+Global Instance NoDup_proper: Proper ((≡ₚ) ==> iff) (@NoDup A).
Proof.
induction 1 as [|x l k Hlk IH | |].
* by rewrite !NoDup_nil.
@@ -605,559 +634,1043 @@ Proof.
* intuition.
Qed.
-Lemma NoDup_Permutation (l k : list A) :
- NoDup l → NoDup k → (∀ x, x ∈ l ↔ x ∈ k) → Permutation l k.
+Lemma NoDup_Permutation l k : NoDup l → NoDup k → (∀ x, x ∈ l ↔ x ∈ k) → l ≡ₚ k.
Proof.
intros Hl. revert k. induction Hl as [|x l Hin ? IH].
- * intros k _ Hk.
- rewrite (elem_of_nil_inv k); [done |].
+ * intros k _ Hk. rewrite (elem_of_nil_inv k); [done |].
intros x. rewrite <-Hk, elem_of_nil. intros [].
- * intros k Hk Hlk.
- destruct (elem_of_list_split k x) as [l1 [l2 ?]]; subst.
+ * intros k Hk Hlk. destruct (elem_of_list_split k x) as [l1 [l2 ?]]; subst.
{ rewrite <-Hlk. by constructor. }
rewrite <-Permutation_middle, NoDup_cons in Hk.
- destruct Hk as [??].
- apply Permutation_cons_app, IH; [done |].
+ destruct Hk as [??]. apply Permutation_cons_app, IH; [done |].
intros y. specialize (Hlk y).
- rewrite <-Permutation_middle, !elem_of_cons in Hlk.
- naive_solver.
+ rewrite <-Permutation_middle, !elem_of_cons in Hlk. naive_solver.
Qed.
-Global Instance NoDup_dec {dec : ∀ x y : A, Decision (x = y)} :
- ∀ (l : list A), Decision (NoDup l) :=
- fix NoDup_dec l :=
- match l return Decision (NoDup l) with
- | [] => left NoDup_nil_2
- | x :: l =>
- match decide_rel (∈) x l with
- | left Hin => right (λ H, NoDup_cons_11 _ _ H Hin)
- | right Hin =>
- match NoDup_dec l with
- | left H => left (NoDup_cons_2 _ _ Hin H)
- | right H => right (H ∘ NoDup_cons_12 _ _)
- end
- end
- end.
-
-Section remove_dups.
- Context `{!∀ x y : A, Decision (x = y)}.
+Section no_dup_dec.
+ Context `{!∀ x y, Decision (x = y)}.
- Fixpoint remove_dups (l : list A) : list A :=
- match l with
- | [] => []
+ Global Instance NoDup_dec: ∀ l, Decision (NoDup l) :=
+ fix NoDup_dec l :=
+ match l return Decision (NoDup l) with
+ | [] => left NoDup_nil_2
| x :: l =>
- if decide_rel (∈) x l then remove_dups l else x :: remove_dups l
+ match decide_rel (∈) x l with
+ | left Hin => right (λ H, NoDup_cons_11 _ _ H Hin)
+ | right Hin =>
+ match NoDup_dec l with
+ | left H => left (NoDup_cons_2 _ _ Hin H)
+ | right H => right (H ∘ NoDup_cons_12 _ _)
+ end
+ end
end.
- Lemma elem_of_remove_dups l x :
- x ∈ remove_dups l ↔ x ∈ l.
+ Lemma elem_of_remove_dups l x : x ∈ remove_dups l ↔ x ∈ l.
Proof.
split; induction l; simpl; repeat case_decide;
rewrite ?elem_of_cons; intuition (simplify_equality; auto).
Qed.
-
Lemma remove_dups_nodup l : NoDup (remove_dups l).
Proof.
induction l; simpl; repeat case_decide; try constructor; auto.
by rewrite elem_of_remove_dups.
Qed.
-End remove_dups.
+End no_dup_dec.
(** ** Properties of the [filter] function *)
-Lemma elem_of_list_filter `{∀ x : A, Decision (P x)} l x :
- x ∈ filter P l ↔ P x ∧ x ∈ l.
-Proof.
- unfold filter. induction l; simpl; repeat case_decide;
- rewrite ?elem_of_nil, ?elem_of_cons; naive_solver.
-Qed.
-Lemma filter_nodup P `{∀ x : A, Decision (P x)} l :
- NoDup l → NoDup (filter P l).
-Proof.
- unfold filter. induction 1; simpl; repeat case_decide;
- rewrite ?NoDup_nil, ?NoDup_cons, ?elem_of_list_filter; tauto.
-Qed.
+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;
+ rewrite ?elem_of_nil, ?elem_of_cons; naive_solver.
+ Qed.
+ Lemma filter_nodup l : NoDup l → NoDup (filter P l).
+ Proof.
+ unfold filter. induction 1; simpl; repeat case_decide;
+ rewrite ?NoDup_nil, ?NoDup_cons, ?elem_of_list_filter; tauto.
+ Qed.
+End filter.
(** ** Properties of the [reverse] function *)
Lemma reverse_nil : reverse [] = @nil A.
Proof. done. Qed.
-Lemma reverse_singleton (x : A) : reverse [x] = [x].
+Lemma reverse_singleton x : reverse [x] = [x].
Proof. done. Qed.
-Lemma reverse_cons (l : list A) x : reverse (x :: l) = reverse l ++ [x].
+Lemma reverse_cons l x : reverse (x :: l) = reverse l ++ [x].
Proof. unfold reverse. by rewrite <-!rev_alt. Qed.
-Lemma reverse_snoc (l : list A) x : reverse (l ++ [x]) = x :: reverse l.
+Lemma reverse_snoc l x : reverse (l ++ [x]) = x :: reverse l.
Proof. unfold reverse. by rewrite <-!rev_alt, rev_unit. Qed.
-Lemma reverse_app (l1 l2 : list A) :
- reverse (l1 ++ l2) = reverse l2 ++ reverse l1.
+Lemma reverse_app l1 l2 : reverse (l1 ++ l2) = reverse l2 ++ reverse l1.
Proof. unfold reverse. rewrite <-!rev_alt. apply rev_app_distr. Qed.
-Lemma reverse_length (l : list A) : length (reverse l) = length l.
+Lemma reverse_length l : length (reverse l) = length l.
Proof. unfold reverse. rewrite <-!rev_alt. apply rev_length. Qed.
-Lemma reverse_involutive (l : list A) : reverse (reverse l) = l.
+Lemma reverse_involutive l : reverse (reverse l) = l.
Proof. unfold reverse. rewrite <-!rev_alt. apply rev_involutive. Qed.
(** ** Properties of the [take] function *)
-Lemma take_nil n :
- take n (@nil A) = [].
+Definition take_drop := @firstn_skipn A.
+
+Lemma take_nil n : take n (@nil A) = [].
Proof. by destruct n. Qed.
-Lemma take_app (l k : list A) :
- take (length l) (l ++ k) = l.
+Lemma take_app l k : take (length l) (l ++ k) = l.
Proof. induction l; simpl; f_equal; auto. Qed.
-Lemma take_app_alt (l k : list A) n :
- n = length l →
- take n (l ++ k) = l.
+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 : list A) n :
- n ≤ length l →
- take n (l ++ k) = take n l.
+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.
+ revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
Qed.
-Lemma take_app_ge (l k : list A) n :
- length l ≤ n →
- take n (l ++ k) = l ++ take (n - length l) k.
+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.
+ revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
Qed.
-Lemma take_ge (l : list A) n :
- length l ≤ n →
- take n l = l.
+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.
+ revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
Qed.
-Lemma take_take (l : list A) n m :
- take n (take m l) = take (min n m) l.
+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.
-Lemma take_idempotent (l : list A) n :
- take n (take n l) = take n l.
+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 : list A) n :
- length (take n l) = min n (length l).
+Lemma take_length l n : length (take n l) = min n (length l).
Proof. revert n. induction l; intros [|?]; simpl; f_equal; done. Qed.
-Lemma take_length_alt (l : list A) n :
- n ≤ length l →
- length (take n l) = n.
+Lemma take_length_alt l n : n ≤ length l → length (take n l) = n.
Proof. rewrite take_length. apply Min.min_l. Qed.
-Lemma lookup_take (l : list A) n i :
- i < n → take n l !! i = l !! i.
+Lemma lookup_take l n i : i < n → take n l !! i = l !! i.
Proof.
revert n i. induction l; intros [|n] i ?; trivial.
* auto with lia.
* destruct i; simpl; auto with arith.
Qed.
-Lemma lookup_take_ge (l : list A) n i :
- n ≤ i → take n l !! i = None.
+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.
+ revert n i. induction l; intros [|?] [|?] ?; simpl; auto with lia.
Qed.
-Lemma take_alter (f : A → A) l n i :
- n ≤ i → take n (alter f i l) = take n l.
+Lemma take_alter f l n i : n ≤ i → take n (alter f i l) = take n l.
Proof.
intros. apply list_eq. intros j. destruct (le_lt_dec n j).
* by rewrite !lookup_take_ge.
* by rewrite !lookup_take, !list_lookup_alter_ne by lia.
Qed.
-Lemma take_insert (l : list A) n i x :
- n ≤ i → take n (<[i:=x]>l) = take n l.
-Proof take_alter _ _ _ _.
+Lemma take_insert l n i x : n ≤ i → take n (<[i:=x]>l) = take n l.
+Proof. apply take_alter. Qed.
(** ** Properties of the [drop] function *)
-Lemma drop_nil n :
- drop n (@nil A) = [].
+Lemma drop_nil n : drop n (@nil A) = [].
Proof. by destruct n. Qed.
-Lemma drop_app (l k : list A) :
- drop (length l) (l ++ k) = k.
+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 : list A) n :
- n = length l →
- drop n (l ++ k) = k.
+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 : list A) n :
- length (drop n l) = length l - n.
-Proof.
- revert n. by induction l; intros [|i]; simpl; f_equal.
-Qed.
-Lemma drop_all (l : list A) :
- drop (length l) l = [].
+Lemma drop_length l n : length (drop n l) = length l - n.
+Proof. revert n. by induction l; intros [|i]; simpl; f_equal. Qed.
+Lemma drop_all l : drop (length l) l = [].
Proof. induction l; simpl; auto. Qed.
-Lemma drop_all_alt (l : list A) n :
- n = length l →
- drop n l = [].
+Lemma drop_all_alt l n : n = length l → drop n l = [].
Proof. intros. subst. by rewrite drop_all. Qed.
-Lemma lookup_drop (l : list A) n i :
- drop n l !! i = l !! (n + i).
+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 : A → A) l n i :
- i < n → drop n (alter f i l) = drop n l.
+Lemma drop_alter f l n i : i < n → drop n (alter f i l) = drop n l.
Proof.
intros. apply list_eq. intros j.
by rewrite !lookup_drop, !list_lookup_alter_ne by lia.
Qed.
-Lemma drop_insert (l : list A) n i x :
- i < n → drop n (<[i:=x]>l) = drop n l.
-Proof drop_alter _ _ _ _.
+Lemma drop_insert l n i x : i < n → drop n (<[i:=x]>l) = drop n l.
+Proof. apply drop_alter. Qed.
-Lemma delete_take_drop (l : list A) i :
- delete i l = take i l ++ drop (S i) l.
+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.
(** ** Properties of the [replicate] function *)
-Lemma replicate_length n (x : A) : length (replicate n x) = n.
+Lemma replicate_length n x : length (replicate n x) = n.
Proof. induction n; simpl; auto. Qed.
-Lemma lookup_replicate n (x : A) i :
- i < n →
- replicate n x !! i = Some x.
-Proof.
- revert i.
- induction n; intros [|?]; naive_solver auto with lia.
-Qed.
-Lemma lookup_replicate_inv n (x y : A) i :
+Lemma lookup_replicate n x i : i < n → replicate n x !! i = Some x.
+Proof. revert i. induction n; intros [|?]; naive_solver auto with lia. Qed.
+Lemma lookup_replicate_inv n x y i :
replicate n x !! i = Some y → y = x ∧ i < n.
-Proof.
- revert i.
- induction n; intros [|?]; naive_solver auto with lia.
-Qed.
-Lemma replicate_S n (x : A) :
- replicate (S n) x = x :: replicate n x.
+Proof. revert i. induction n; intros [|?]; naive_solver auto with lia. Qed.
+Lemma replicate_S n x : replicate (S n) x = x :: replicate n x.
Proof. done. Qed.
-Lemma replicate_plus n m (x : A) :
+Lemma replicate_plus n m x :
replicate (n + m) x = replicate n x ++ replicate m x.
Proof. induction n; simpl; f_equal; auto. Qed.
-Lemma take_replicate n m (x : A) :
- take n (replicate m x) = replicate (min n m) x.
+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.
-Lemma take_replicate_plus n m (x : A) :
- take n (replicate (n + m) x) = replicate n x.
+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 : A) :
- drop n (replicate m x) = replicate (m - n) x.
+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.
-Lemma drop_replicate_plus n m (x : A) :
- drop n (replicate (n + m) x) = replicate m x.
+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 reverse_replicate n (x : A) :
- reverse (replicate n x) = replicate n x.
+Lemma reverse_replicate n x : reverse (replicate n x) = replicate n x.
Proof.
- induction n as [|n IH]; [done|].
- simpl. rewrite reverse_cons, IH. change [x] with (replicate 1 x).
- by rewrite <-replicate_plus, plus_comm.
+ induction n as [|n IH]; [done|]. simpl. rewrite reverse_cons, IH.
+ change [x] with (replicate 1 x). by rewrite <-replicate_plus, plus_comm.
Qed.
(** ** Properties of the [resize] function *)
-Lemma resize_spec (l : list A) 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.
-Lemma resize_0 (l : list A) x :
- resize 0 x l = [].
+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.
+Lemma resize_0 l x : resize 0 x l = [].
Proof. by destruct l. Qed.
-Lemma resize_nil n (x : A) :
- resize n x [] = replicate n x.
+Lemma resize_nil n x : resize n x [] = replicate n x.
Proof. rewrite resize_spec. rewrite take_nil. simpl. f_equal. lia. Qed.
-Lemma resize_ge (l : list A) n x :
- length l ≤ n →
- resize n x l = l ++ replicate (n - length l) x.
+Lemma resize_ge l n x :
+ length l ≤ n → resize n x l = l ++ replicate (n - length l) x.
Proof. intros. by rewrite resize_spec, take_ge. Qed.
-Lemma resize_le (l : list A) n x :
- n ≤ length l →
- resize n x l = take n l.
+Lemma resize_le l n x : n ≤ length l → resize n x l = take n l.
Proof.
intros. rewrite resize_spec, (proj2 (NPeano.Nat.sub_0_le _ _)) by done.
- simpl. by rewrite (right_id [] (++)).
+ simpl. by rewrite (right_id_L [] (++)).
Qed.
-Lemma resize_all (l : list A) x :
- resize (length l) x l = l.
+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 : list A) n x :
- n = length l →
- resize n x l = l.
+Lemma resize_all_alt l n x : n = length l → resize n x l = l.
Proof. intros. subst. by rewrite resize_all. Qed.
-Lemma resize_plus (l : list A) n m x :
+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.
- * by rewrite plus_0_r, (right_id [] (++)).
+ revert n m. induction l; intros [|?] [|?]; simpl; f_equal; auto.
+ * by rewrite plus_0_r, (right_id_L [] (++)).
* by rewrite replicate_plus.
Qed.
-Lemma resize_plus_eq (l : list A) n m x :
- length l = n →
- resize (n + m) x l = l ++ replicate m x.
+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.
+ intros. subst. by rewrite resize_plus, resize_all, drop_all, resize_nil.
Qed.
-Lemma resize_app_le (l1 l2 : list A) n x :
- n ≤ length l1 →
- resize n x (l1 ++ l2) = resize n x l1.
+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).
+ intros. by rewrite !resize_le, take_app_le by (rewrite ?app_length; lia).
Qed.
-Lemma resize_app_ge (l1 l2 : list A) n x :
- length l1 ≤ n →
- resize n x (l1 ++ l2) = l1 ++ resize (n - length l1) x l2.
+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 (++)) by done.
+ intros. rewrite !resize_spec, take_app_ge, (associative_L (++)) by done.
do 2 f_equal. rewrite app_length. lia.
Qed.
-Lemma resize_length (l : list A) n x : length (resize n x l) = n.
-Proof.
- rewrite resize_spec, app_length, replicate_length, take_length. lia.
-Qed.
-Lemma resize_replicate (x : A) n m :
- resize n x (replicate m x) = replicate n x.
+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 resize_resize (l : list A) n m x :
- n ≤ m →
- resize n x (resize m x l) = resize n x l.
+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.
Qed.
-Lemma resize_idempotent (l : list A) n x :
- resize n x (resize n x l) = resize n x l.
+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 : list A) n m x :
- n ≤ m →
- resize n x (take m l) = resize n x l.
+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.
+ revert n m. induction l; intros [|?] [|?] ?; simpl; f_equal; auto with lia.
Qed.
-Lemma resize_take_eq (l : list A) n x :
- resize n x (take n l) = resize n x l.
+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 : list A) n m x :
- take n (resize m x l) = resize (min n m) x l.
+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.
Qed.
-Lemma take_resize_le (l : list A) n m x :
- n ≤ m →
- take n (resize m x l) = resize n x l.
+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 : list A) n x :
- take n (resize n x l) = resize n x l.
+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 : list A) n x :
- length l ≤ n →
- take (length l) (resize n x l) = l.
+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 : list A) n m x :
- m = length l →
- m ≤ n →
- take m (resize n x l) = l.
+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 : list A) n m x :
- take n (resize (n + m) x l) = resize n x l.
+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 : list A) n m x :
- n ≤ m →
- drop n (resize m x l) = resize (m - n) x (drop n l).
+Lemma drop_resize_le l n m x :
+ n ≤ m → drop n (resize m x l) = resize (m - n) x (drop n l).
Proof.
revert n m. induction l; simpl.
* intros. by rewrite drop_nil, !resize_nil, drop_replicate.
* intros [|?] [|?] ?; simpl; try case_match; auto with lia.
Qed.
-Lemma drop_resize_plus (l : list A) n m x :
+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.
-(** ** Properties of the [sublist] predicate *)
-Lemma sublist_nil_l (l : list A) :
- sublist [] l.
-Proof. induction l; try constructor; auto. Qed.
-Lemma sublist_nil_r (l : list A) :
- sublist l [] ↔ l = [].
-Proof. split. by inversion 1. intros. subst. constructor. Qed.
-
-Lemma sublist_app_skip_l (k : list A) l1 l2 :
- sublist l1 l2 →
- sublist l1 (k ++ l2).
-Proof. induction k; try constructor; auto. Qed.
-Lemma sublist_app_skip_r (k : list A) l1 l2 :
- sublist l1 l2 →
- sublist l1 (l2 ++ k).
-Proof. induction 1; simpl; try constructor; auto using sublist_nil_l. Qed.
-
-Lemma sublist_cons_r (x : A) l k :
- sublist l (x :: k) ↔ sublist l k ∨ ∃ l', l = x :: l' ∧ sublist l' k.
+(** ** Properties of the [Permutation] predicate *)
+Lemma Permutation_nil l : l ≡ₚ [] ↔ l = [].
+Proof. split. by intro; apply Permutation_nil. by intro; subst. Qed.
+Lemma Permutation_singleton l x : l ≡ₚ [x] ↔ l = [x].
+Proof. split. by intro; apply Permutation_length_1_inv. by intro; subst. Qed.
+Definition Permutation_skip := @perm_skip A.
+Definition Permutation_swap := @perm_swap A.
+Definition Permutation_singleton_inj := @Permutation_length_1 A.
+
+Global Existing Instance Permutation_app'_Proper.
+Global Instance: Proper ((≡ₚ) ==> (=)) (@length A).
+Proof. induction 1; simpl; auto with lia. Qed.
+Global Instance: Commutative (≡ₚ) (@app A).
Proof.
- split.
- * inversion 1; eauto.
- * intros [?|(?&?&?)]; subst; constructor; auto.
+ intros l1. induction l1 as [|x l1 IH]; intros l2; simpl.
+ * by rewrite (right_id_L [] (++)).
+ * rewrite Permutation_middle, IH. simpl. by rewrite Permutation_middle.
Qed.
-Lemma sublist_cons_l (x : A) l k :
- sublist (x :: l) k ↔ ∃ k1 k2, k = k1 ++ x :: k2 ∧ sublist l k2.
+Global Instance: ∀ x : A, Injective (≡ₚ) (≡ₚ) (x ::).
+Proof. red. eauto using Permutation_cons_inv. Qed.
+Global Instance: ∀ k : list A, Injective (≡ₚ) (≡ₚ) (k ++).
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_app_skip_l, sublist_cons.
+ red. induction k as [|x k IH]; intros l1 l2; simpl; auto.
+ intros. by apply IH, (injective (x ::)).
Qed.
-
-Lemma sublist_app_compat (l1 l2 k1 k2 : list A) :
- sublist l1 l2 → sublist k1 k2 →
- sublist (l1 ++ k1) (l2 ++ k2).
-Proof. induction 1; simpl; try constructor; auto. Qed.
-
-Lemma sublist_app_r (l k1 k2 : list A) :
- sublist l (k1 ++ k2) ↔ ∃ l1 l2,
- l = l1 ++ l2 ∧ sublist l1 k1 ∧ sublist l2 k2.
+Global Instance: ∀ k : list A, Injective (≡ₚ) (≡ₚ) (++ k).
Proof.
- split.
- * revert l k2. induction k1 as [|y k1 IH]; intros l k2; simpl.
- { eexists [], l. by repeat constructor. }
- rewrite sublist_cons_r. intros [?|(l' & ? &?)]; subst.
- + destruct (IH l k2) as (l1&l2&?&?&?); trivial; subst.
- exists l1 l2. auto using sublist_cons_skip.
- + destruct (IH l' k2) as (l1&l2&?&?&?); trivial; subst.
- exists (y :: l1) l2. auto using sublist_cons.
- * intros (?&?&?&?&?); subst. auto using sublist_app_compat.
+ intros k l1 l2. rewrite !(commutative (++) _ k).
+ by apply (injective (k ++)).
Qed.
-Lemma sublist_app_l (l1 l2 k : list A) :
- sublist (l1 ++ l2) k ↔ ∃ k1 k2,
- k = k1 ++ k2 ∧ sublist l1 k1 ∧ sublist l2 k2.
+
+(** ** Properties of the [prefix_of] and [suffix_of] predicates *)
+Global Instance: PreOrder (@prefix_of A).
Proof.
split.
- * revert l2 k. induction l1 as [|x l1 IH]; intros l2 k; simpl.
- { eexists [], k. by repeat constructor. }
- rewrite sublist_cons_l. intros (k1 & k2 &?&?); subst.
- destruct (IH l2 k2) as (h1 & h2 &?&?&?); trivial; subst.
- exists (k1 ++ x :: h1) h2. rewrite <-(associative (++)).
- auto using sublist_app_skip_l, sublist_cons.
- * intros (?&?&?&?&?); subst. auto using sublist_app_compat.
+ * intros ?. eexists []. by rewrite (right_id_L [] (++)).
+ * intros ??? [k1 ?] [k2 ?].
+ exists (k1 ++ k2). subst. by rewrite (associative_L (++)).
Qed.
-Global Instance: PreOrder (@sublist A).
+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.
+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.
+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.
+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.
+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.
+
+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.
+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.
+Lemma prefix_of_app_l l1 l2 l3 : l1 ++ l3 `prefix_of` l2 → l1 `prefix_of` l2.
Proof.
- split.
- * intros l. induction l; constructor; auto.
- * intros l1 l2 l3 Hl12. revert l3. induction Hl12.
- + auto using sublist_nil_l.
- + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst.
- eauto using sublist_app_skip_l, sublist_cons.
- + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst.
- eauto using sublist_app_skip_l, sublist_cons_skip.
+ intros [k ?]. red. exists (l3 ++ k). subst. by rewrite <-(associative_L (++)).
Qed.
-
-Lemma sublist_length (l1 l2 : list A) :
- sublist l1 l2 → length l1 ≤ length l2.
-Proof. induction 1; simpl; auto with arith. Qed.
-
-Lemma sublist_take (l : list A) i :
- sublist (take i l) l.
-Proof. rewrite <-(take_drop i l) at 2. by apply sublist_app_skip_r. Qed.
-Lemma sublist_drop (l : list A) i :
- sublist (drop i l) l.
-Proof. rewrite <-(take_drop i l) at 2. by apply sublist_app_skip_l. Qed.
-Lemma sublist_delete (l : list A) i :
- sublist (delete i l) l.
-Proof. revert i. by induction l; intros [|?]; simpl; constructor. Qed.
-Lemma sublist_delete_list (l : list A) is :
- sublist (delete_list is l) l.
+Lemma prefix_of_app_r l1 l2 l3 : l1 `prefix_of` l2 → l1 `prefix_of` l2 ++ l3.
Proof.
- induction is as [|i is IH]; simpl; [done |].
- transitivity (delete_list is l); auto using sublist_delete.
+ intros [k ?]. exists (k ++ l3). subst. by rewrite (associative_L (++)).
Qed.
-Lemma sublist_alt (l1 l2 : list A) :
- sublist l1 l2 ↔ ∃ is, l1 = delete_list is l2.
+Lemma prefix_of_length l1 l2 : l1 `prefix_of` l2 → length l1 ≤ length l2.
+Proof. intros [??]. subst. 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 Hl12.
- cut (∀ k, ∃ is, k ++ l1 = delete_list is (k ++ l2)).
- { intros help. apply (help []). }
- induction Hl12 as [|x l1 l2 _ IH|x l1 l2 _ IH]; intros k.
- + by eexists [].
- + destruct (IH (k ++ [x])) as [is His]. exists is.
- by rewrite <-!(associative (++)) in His.
- + 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 ?. by eexists [].
+ * intros ??? [k1 ?] [k2 ?].
+ exists (k2 ++ k1). subst. by rewrite (associative_L (++)).
Qed.
-Global Instance: AntiSymmetric (@sublist A).
-Proof.
- intros l1 l2 Hl12 Hl21. apply sublist_length in Hl21.
- induction Hl12; simpl in *.
- * done.
- * f_equal. auto with arith.
- * apply sublist_length in Hl12. lia.
-Qed.
-End general_properties.
+Global Instance prefix_of_dec `{∀ x y, Decision (x = y)} : ∀ 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 _ _)
+ | x :: l1, y :: l2 =>
+ match decide_rel (=) x y with
+ | left Exy =>
+ match go l1 l2 with
+ | left Hl1l2 => left (prefix_of_cons_alt _ _ _ _ Exy Hl1l2)
+ | right Hl1l2 => right (Hl1l2 ∘ prefix_of_cons_inv_2 _ _ _ _)
+ end
+ | right Exy => right (Exy ∘ prefix_of_cons_inv_1 _ _ _ _)
+ end
+ end.
-(** ** 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).
+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)).
+ Proof.
+ revert l2. induction l1; intros [|??]; simpl;
+ repeat case_decide; simpl; 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).
+ 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.
+ 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)).
+ Proof.
+ revert l2. induction l1; intros [|??]; simpl;
+ repeat case_decide; simpl; 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.
+ Proof.
+ 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.
+ 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).
+ Proof.
+ intros [l1' ?] [l2' ?]. subst.
+ 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) →
+ k `prefix_of` l1 → k `prefix_of` l2 → k `prefix_of` k3.
+ Proof.
+ 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).
+ eapply max_prefix_of_max_alt; eauto.
+ * rewrite (max_prefix_of_fst_alt _ _ _ _ _ Hl).
+ apply prefix_of_app, prefix_of_cons, prefix_of_nil.
+ * rewrite (max_prefix_of_snd_alt _ _ _ _ _ Hl).
+ apply prefix_of_app, prefix_of_cons, prefix_of_nil.
+ Qed.
+End prefix_ops.
+
+Lemma prefix_suffix_reverse l1 l2 :
+ l1 `prefix_of` l2 ↔ reverse l1 `suffix_of` reverse l2.
+Proof.
+ split; intros [k E]; exists (reverse k).
+ * by rewrite E, reverse_app.
+ * by rewrite <-(reverse_involutive l2), E, reverse_app, reverse_involutive.
+Qed.
+Lemma suffix_prefix_reverse l1 l2 :
+ l1 `suffix_of` l2 ↔ reverse l1 `prefix_of` reverse l2.
+Proof. by rewrite prefix_suffix_reverse, !reverse_involutive. Qed.
+
+Lemma suffix_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 = [].
+Proof. by intros [[|?] ?]; simplify_list_equality. Qed.
+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.
+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.
+
+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.
+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.
+
+Lemma suffix_of_snoc_inv_1 x y l1 l2 :
+ l1 ++ [x] `suffix_of` l2 ++ [y] → x = y.
+Proof.
+ intros [k' E]. rewrite (associative_L (++)) in E. by simplify_list_equality.
+Qed.
+Lemma suffix_of_snoc_inv_2 x y l1 l2 :
+ l1 ++ [x] `suffix_of` l2 ++ [y] → l1 `suffix_of` l2.
+Proof.
+ intros [k' E]. exists k'. rewrite (associative_L (++)) in E.
+ by simplify_list_equality.
+Qed.
+Lemma suffix_of_app_inv l1 l2 k :
+ l1 ++ k `suffix_of` l2 ++ k → l1 `suffix_of` l2.
+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.
+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.
+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.
+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.
+
+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 |].
+ 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.
+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.
+ refine (cast_if (decide_rel prefix_of (reverse l1) (reverse l2)));
+ abstract (by rewrite suffix_prefix_reverse).
+Defined.
+
+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).
+ Proof.
+ rewrite <-(reverse_involutive l1) at 1.
+ rewrite (max_prefix_of_fst (reverse l1) (reverse l2)). unfold max_suffix_of.
+ destruct (max_prefix_of (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
+ by rewrite reverse_app.
+ Qed.
+ Lemma max_suffix_of_fst_alt l1 l2 k1 k2 k3 :
+ max_suffix_of l1 l2 = (k1, k2, k3) → l1 = k1 ++ k3.
+ Proof.
+ 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.
+ 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).
+ Proof.
+ rewrite <-(reverse_involutive l2) at 1.
+ 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.
+ Lemma max_suffix_of_snd_alt l1 l2 k1 k2 k3 :
+ max_suffix_of l1 l2 = (k1,k2,k3) → l2 = k2 ++ k3.
+ Proof.
+ 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.
+ 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).
+ Proof.
+ generalize (max_prefix_of_max (reverse l1) (reverse l2)).
+ rewrite !suffix_prefix_reverse. unfold max_suffix_of.
+ destruct (max_prefix_of (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
+ rewrite reverse_involutive. auto.
+ Qed.
+ Lemma max_suffix_of_max_alt l1 l2 k1 k2 k3 k :
+ max_suffix_of l1 l2 = (k1, k2, k3) →
+ k `suffix_of` l1 → k `suffix_of` l2 → k `suffix_of` k3.
+ Proof.
+ 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).
+ eapply max_suffix_of_max_alt; eauto.
+ * rewrite (max_suffix_of_fst_alt _ _ _ _ _ Hl).
+ by apply (suffix_of_app [x2]), suffix_of_app_r.
+ * rewrite (max_suffix_of_snd_alt _ _ _ _ _ Hl).
+ by apply (suffix_of_app [x2]), suffix_of_app_r.
+ Qed.
+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.
+
+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.
+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.
+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.
+Qed.
+
+Lemma sublist_app_r l k1 k2 :
+ l `sublist` k1 ++ k2 ↔
+ ∃ l1 l2, l = l1 ++ l2 ∧ l1 `sublist` k1 ∧ l2 `sublist` k2.
+Proof.
+ split.
+ * revert l k2. induction k1 as [|y k1 IH]; intros l k2; simpl.
+ { eexists [], l. by repeat constructor. }
+ rewrite sublist_cons_r. intros [?|(l' & ? &?)]; subst.
+ + destruct (IH l k2) as (l1&l2&?&?&?); trivial; subst.
+ exists l1 l2. auto using sublist_insert.
+ + destruct (IH l' k2) as (l1&l2&?&?&?); trivial; subst.
+ exists (y :: l1) l2. auto using sublist_skip.
+ * intros (?&?&?&?&?); subst. auto using sublist_app.
+Qed.
+Lemma sublist_app_l l1 l2 k :
+ l1 ++ l2 `sublist` k ↔
+ ∃ k1 k2, k = k1 ++ k2 ∧ l1 `sublist` k1 ∧ l2 `sublist` k2.
+Proof.
+ split.
+ * revert l2 k. induction l1 as [|x l1 IH]; intros l2 k; simpl.
+ { eexists [], k. by repeat constructor. }
+ rewrite sublist_cons_l. intros (k1 & k2 &?&?); subst.
+ destruct (IH l2 k2) as (h1 & h2 &?&?&?); trivial; subst.
+ exists (k1 ++ x :: h1) h2. rewrite <-(associative_L (++)).
+ auto using sublist_inserts_l, sublist_skip.
+ * intros (?&?&?&?&?); subst. auto using sublist_app.
+Qed.
+Lemma sublist_app_inv_l k l1 l2 : k ++ l1 `sublist` k ++ l2 → l1 `sublist` l2.
+Proof.
+ induction k as [|y k IH]; simpl; [done |].
+ rewrite sublist_cons_r. intros [Hl12|(?&?&?)]; [|simplify_equality; eauto].
+ rewrite sublist_cons_l in Hl12. destruct Hl12 as (k1&k2&Hk&?).
+ apply IH. rewrite Hk. eauto using sublist_inserts_l, sublist_insert.
+Qed.
+Lemma sublist_app_inv_r k l1 l2 : l1 ++ k `sublist` l2 ++ k → l1 `sublist` l2.
+Proof.
+ revert l1 l2. induction k as [|y k IH]; intros l1 l2.
+ { by rewrite !(right_id_L [] (++)). }
+ intros. feed pose proof (IH (l1 ++ [y]) (l2 ++ [y])) as Hl12.
+ { by rewrite <-!(associative_L (++)). }
+ rewrite sublist_app_l in Hl12. destruct Hl12 as (k1&k2&E&?&Hk2).
+ destruct k2 as [|z k2] using rev_ind; [inversion Hk2|].
+ rewrite (associative_L (++)) in E. simplify_list_equality.
+ eauto using sublist_inserts_r.
+Qed.
+
+Global Instance: PartialOrder (@sublist A).
+Proof.
+ split; [split|].
+ * intros l. induction l; constructor; auto.
+ * intros l1 l2 l3 Hl12. revert l3. induction Hl12.
+ + auto using sublist_nil_l.
+ + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst.
+ eauto using sublist_inserts_l, sublist_skip.
+ + intros ?. rewrite sublist_cons_l. intros (?&?&?&?); subst.
+ eauto using sublist_inserts_l, sublist_insert.
+ * intros l1 l2 Hl12 Hl21. apply sublist_length in Hl21.
+ induction Hl12; simpl in *; 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.
+Proof. rewrite <-(take_drop i l) at 2. by apply sublist_inserts_l. Qed.
+Lemma sublist_delete l i : delete i l `sublist` l.
+Proof. revert i. by induction l; intros [|?]; simpl; constructor. Qed.
+Lemma sublist_delete_list l is : delete_list is l `sublist` l.
+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.
+ * intros Hl12. cut (∀ k, ∃ is, k ++ l1 = delete_list is (k ++ l2)).
+ { intros help. apply (help []). }
+ induction Hl12 as [|x l1 l2 _ IH|x l1 l2 _ IH]; intros k.
+ + by eexists [].
+ + destruct (IH (k ++ [x])) as [is His]. exists is.
+ by rewrite <-!(associative_L (++)) in His.
+ + 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.
+Qed.
+
+Lemma Permutation_sublist l1 l2 l3 :
+ l1 ≡ₚ l2 → l2 `sublist` l3 → ∃ l4, l1 `sublist` l4 ∧ l4 ≡ₚ l3.
+Proof.
+ intros Hl1l2. revert l3.
+ induction Hl1l2 as [|x l1 l2 ? IH|x y l1|l1 l1' l2 ? IH1 ? IH2].
+ * intros l3. by exists l3.
+ * intros l3. rewrite sublist_cons_l. intros (l3'&l3''&?&?); subst.
+ destruct (IH l3'') as (l4&?&Hl4); auto. exists (l3' ++ x :: l4).
+ split. by apply sublist_inserts_l, sublist_skip. by rewrite Hl4.
+ * intros l3. rewrite sublist_cons_l. intros (l3'&l3''&?& Hl3); subst.
+ rewrite sublist_cons_l in Hl3. destruct Hl3 as (l5'&l5''&?& Hl5); subst.
+ exists (l3' ++ y :: l5' ++ x :: l5''). split.
+ - by do 2 apply sublist_inserts_l, sublist_skip.
+ - by rewrite !Permutation_middle, Permutation_swap.
+ * intros l3 ?. destruct (IH2 l3) as (l3'&?&?); trivial.
+ destruct (IH1 l3') as (l3'' &?&?); trivial. exists l3''.
+ split. done. etransitivity; eauto.
+Qed.
+Lemma sublist_Permutation l1 l2 l3 :
+ l1 `sublist` l2 → l2 ≡ₚ l3 → ∃ l4, l1 ≡ₚ l4 ∧ l4 `sublist` l3.
+Proof.
+ intros Hl1l2 Hl2l3. revert l1 Hl1l2.
+ induction Hl2l3 as [|x l2 l3 ? IH|x y l2|l2 l2' l3 ? IH1 ? IH2].
+ * intros l1. by exists l1.
+ * intros l1. rewrite sublist_cons_r. intros [?|(l1'&l1''&?)]; subst.
+ { destruct (IH l1) as (l4&?&?); trivial.
+ exists l4. split. done. by constructor. }
+ destruct (IH l1') as (l4&?&Hl4); auto. exists (x :: l4).
+ split. by constructor. by constructor.
+ * intros l1. rewrite sublist_cons_r. intros [Hl1|(l1'&l1''&Hl1)]; subst.
+ { exists l1. split; [done|]. rewrite sublist_cons_r in Hl1.
+ destruct Hl1 as [?|(l1'&?&?)]; subst; by repeat constructor. }
+ rewrite sublist_cons_r in Hl1. destruct Hl1 as [?|(l1''&?&?)]; subst.
+ + exists (y :: l1'). by repeat constructor.
+ + exists (x :: y :: l1''). by repeat constructor.
+ * intros l1 ?. destruct (IH1 l1) as (l3'&?&?); trivial.
+ destruct (IH2 l3') as (l3'' &?&?); trivial. exists l3''.
+ split; [|done]. etransitivity; eauto.
+Qed.
+
+(** Properties of the [contains] predicate *)
+Lemma contains_length l1 l2 : l1 `contains` l2 → length l1 ≤ length l2.
+Proof. induction 1; simpl; auto with lia. Qed.
+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].
+ 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.
+Proof. induction 1; constructor; auto. Qed.
+Lemma contains_Permutation_alt l1 l2 :
+ length l2 ≤ length l1 → l1 `contains` l2 → l1 ≡ₚ l2.
+Proof.
+ intros Hl21 Hl12. revert Hl21. elim Hl12; clear l1 l2 Hl12; simpl.
+ * constructor.
+ * constructor; auto with lia.
+ * constructor; auto with lia.
+ * intros x l1 l2 ? IH ?. feed specialize IH; [lia|].
+ apply Permutation_length in IH. lia.
+ * intros l1 l2 l3 Hl12 ? Hl23 ?.
+ apply contains_length in Hl12. apply contains_length in Hl23.
+ transitivity l2; auto with lia.
+Qed.
+Lemma contains_Permutation l1 l2 :
+ length l2 = length l1 → l1 `contains` l2 → l1 ≡ₚ l2.
+Proof. intro. apply contains_Permutation_alt. lia. Qed.
+
+Global Instance: Proper ((≡ₚ) ==> (≡ₚ) ==> iff) (@contains A).
+Proof.
+ intros l1 l2 ? k1 k2 ?. split; intros.
+ * transitivity l1. by apply Permutation_contains.
+ transitivity k1. done. by apply Permutation_contains.
+ * transitivity l2. by apply Permutation_contains.
+ transitivity k2. done. by apply Permutation_contains.
+Qed.
+Global Instance: AntiSymmetric (≡ₚ) (@contains A).
+Proof. red. auto using contains_Permutation_alt, 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.
+Proof. auto using sublist_drop, sublist_contains. Qed.
+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.
+ split.
+ { intros Hl13. elim Hl13; clear l1 l3 Hl13.
+ * by eexists [].
+ * intros x l1 l3 ? (l2&?&?). exists (x :: l2). by repeat constructor.
+ * intros x y l. exists (y :: x :: l). by repeat constructor.
+ * intros x l1 l3 ? (l2&?&?). exists (x :: l2). by repeat constructor.
+ * intros l1 l3 l5 ? (l2&?&?) ? (l4&?&?).
+ destruct (Permutation_sublist l2 l3 l4) as (l3'&?&?); trivial.
+ exists l3'. split; etransitivity; eauto. }
+ intros (l2&?&?).
+ transitivity l2; auto using sublist_contains, Permutation_contains.
+Qed.
+Lemma contains_sublist_r l1 l3 :
+ l1 `contains` l3 ↔ ∃ l2, l1 ≡ₚ l2 ∧ l2 `sublist` l3.
+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.
+Proof. rewrite (commutative (++)). apply contains_inserts_l. Qed.
+Lemma contains_skips_l k l1 l2 : l1 `contains` l2 → k ++ l1 `contains` k ++ l2.
+Proof. induction k; try constructor; auto. Qed.
+Lemma contains_skips_r k l1 l2 : l1 `contains` l2 → l1 ++ k `contains` l2 ++ k.
+Proof. rewrite !(commutative (++) _ k). apply contains_skips_l. Qed.
+Lemma contains_app l1 l2 k1 k2 :
+ l1 `contains` l2 → k1 `contains` k2 → l1 ++ k1 `contains` l2 ++ 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.
+ split.
+ * rewrite contains_sublist_r. intros (l'&E&Hl').
+ rewrite sublist_cons_r in Hl'. destruct Hl' as [?|(?&?&?)]; subst.
+ + left. rewrite E. eauto using sublist_contains.
+ + right. eauto using sublist_contains.
+ * intros [?|(?&E&?)]; [|rewrite E]; by constructor.
+Qed.
+Lemma contains_cons_l x l k :
+ x :: l `contains` k ↔ ∃ k', k ≡ₚ x :: k' ∧ l `contains` k'.
+Proof.
+ split.
+ * rewrite contains_sublist_l. intros (l'&Hl'&E).
+ rewrite sublist_cons_l in Hl'. destruct Hl' as (k1&k2&?&?); subst.
+ exists (k1 ++ k2). split; eauto using contains_inserts_l, sublist_contains.
+ by rewrite Permutation_middle.
+ * intros (?&E&?). rewrite E. by constructor.
+Qed.
+Lemma contains_app_r l k1 k2 :
+ l `contains` k1 ++ k2 ↔ ∃ l1 l2,
+ l ≡ₚ l1 ++ l2 ∧ l1 `contains` k1 ∧ l2 `contains` k2.
+Proof.
+ split.
+ * rewrite contains_sublist_r. intros (l'&E&Hl').
+ rewrite sublist_app_r in Hl'. destruct Hl' as (l1&l2&?&?&?); subst.
+ exists l1 l2. eauto using sublist_contains.
+ * intros (?&?&E&?&?). rewrite E. eauto using contains_app.
+Qed.
+Lemma contains_app_l l1 l2 k :
+ l1 ++ l2 `contains` k ↔ ∃ k1 k2,
+ k ≡ₚ k1 ++ k2 ∧ l1 `contains` k1 ∧ l2 `contains` k2.
+Proof.
+ split.
+ * rewrite contains_sublist_l. intros (l'&Hl'&E).
+ rewrite sublist_app_l in Hl'. destruct Hl' as (k1&k2&?&?&?); subst.
+ exists k1 k2. split. done. eauto using sublist_contains.
+ * intros (?&?&E&?&?). rewrite E. eauto using contains_app.
+Qed.
+Lemma contains_app_inv_l l1 l2 k :
+ k ++ l1 `contains` k ++ l2 → l1 `contains` l2.
+Proof.
+ induction k as [|y k IH]; simpl; [done |].
+ rewrite contains_cons_l. intros (?&E&?).
+ apply Permutation_cons_inv in E. apply IH. by rewrite E.
+Qed.
+Lemma contains_app_inv_r l1 l2 k :
+ l1 ++ k `contains` l2 ++ k → l1 `contains` l2.
+Proof.
+ revert l1 l2. induction k as [|y k IH]; intros l1 l2.
+ { by rewrite !(right_id_L [] (++)). }
+ intros. feed pose proof (IH (l1 ++ [y]) (l2 ++ [y])) as Hl12.
+ { by rewrite <-!(associative_L (++)). }
+ rewrite contains_app_l in Hl12. destruct Hl12 as (k1&k2&E1&?&Hk2).
+ rewrite contains_cons_l in Hk2. destruct Hk2 as (k2'&E2&?).
+ rewrite E2, (Permutation_cons_append k2'), (associative_L (++)) in E1.
+ apply Permutation_app_inv_r in E1. rewrite E1. eauto using contains_inserts_r.
+Qed.
+Lemma contains_cons_middle x l k1 k2 :
+ l `contains` k1 ++ k2 → x :: l `contains` k1 ++ x :: k2.
+Proof. rewrite <-Permutation_middle. by apply contains_skip. Qed.
+Lemma contains_app_middle l1 l2 k1 k2 :
+ l2 `contains` k1 ++ k2 → l1 ++ l2 `contains` k1 ++ l1 ++ k2.
+Proof.
+ rewrite !(associative (++)), (commutative (++) k1 l1), <-(associative_L (++)).
+ by apply contains_skips_l.
+Qed.
+Lemma contains_middle l k1 k2 : l `contains` k1 ++ l ++ k2.
+Proof. by apply contains_inserts_l, contains_inserts_r. Qed.
+
+Lemma Permutation_alt l1 l2 :
+ l1 ≡ₚ l2 ↔ length l1 = length l2 ∧ l1 `contains` l2.
+Proof.
+ split.
+ * intros Hl. by rewrite Hl.
+ * intros [??]. auto using contains_Permutation.
+Qed.
+
+Section contains_dec.
+ Context `{∀ x y, Decision (x = y)}.
+
+ Lemma list_remove_Permutation l1 l2 k1 x :
+ l1 ≡ₚ l2 → list_remove x l1 = Some k1 →
+ ∃ k2, list_remove x l2 = Some k2 ∧ k1 ≡ₚ k2.
+ Proof.
+ intros Hl. revert k1.
+ induction Hl as [|y l1 l2 ? IH|y1 y2 l|l1 l2 l3 ? IH1 ? IH2];
+ simpl; intros k1 Hk1.
+ * done.
+ * 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.
+ * 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.
+ Qed.
+ Lemma list_remove_Some_inv l k x :
+ l ≡ₚ x :: k → ∃ k', list_remove x l = Some k' ∧ k ≡ₚ k'.
+ Proof.
+ intros. destruct (list_remove_Permutation (x :: k) l k x) as (k'&?&?).
+ * done.
+ * 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.
+ rewrite is_Some_alt. split.
+ * revert l2. induction l1 as [|x l1 IH]; simpl.
+ { intros l2 _. by exists l2. }
+ intros l2. rewrite contains_cons_l. intros (k&Hk&?).
+ destruct (list_remove_Some_inv l2 k x) as (k2&?&Hk2); trivial.
+ simplify_option_equality. apply IH. by rewrite <-Hk2.
+ * intros [k Hk]. revert l2 k Hk.
+ induction l1 as [|x l1 IH]; simpl; intros l2 k.
+ { intros. apply contains_nil_l. }
+ 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))));
+ abstract (rewrite list_remove_list_contains; tauto).
+ Defined.
+ Global Instance Permutation_dec l1 l2 : Decision (l1 ≡ₚ l2).
+ Proof.
+ refine (cast_if_and
+ (decide (length l1 = length l2)) (decide (l1 `contains` l2)));
+ abstract (rewrite Permutation_alt; tauto).
+ Defined.
+End contains_dec.
+End 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.
Section same_length.
Context {A B : Type}.
+ Implicit Types l : list A. Implicit Types k : list B.
- Lemma same_length_length_1 (l : list A) (k : list B) :
- same_length l k → length l = length k.
+ 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 : list A) (k : list B) :
- length l = length k → same_length l k.
+ 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 : list A) (k : list B) :
- same_length l k ↔ length l = length k.
+ 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 : list A) (k : list B) i :
- same_length l k → is_Some (l !! i) → is_Some (k !! i).
+ Lemma same_length_lookup l k i :
+ l `same_length` k → is_Some (l !! i) → is_Some (k !! i).
Proof.
- rewrite same_length_length.
- setoid_rewrite lookup_lt_length.
+ rewrite same_length_length. setoid_rewrite lookup_lt_length.
intros E. by rewrite E.
Qed.
- Lemma same_length_take (l1 : list A) (l2 : list B) n :
- same_length l1 l2 →
- same_length (take n l1) (take n l2).
+ 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 [|n]; constructor; auto.
+ intros Hl. revert n; induction Hl; intros [|]; simpl; try constructor; auto.
Qed.
- Lemma same_length_drop (l1 : list A) (l2 : list B) n :
- same_length l1 l2 →
- same_length (drop n l1) (drop n l2).
- Proof.
- intros Hl.
- revert n; induction Hl; intros [|n]; simpl; try constructor; auto.
- Qed.
- Lemma same_length_resize (l1 : list A) (l2 : list B) x1 x2 n :
- same_length (resize n x1 l1) (resize n x2 l2).
+ 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.
End same_length.
@@ -1165,8 +1678,10 @@ End same_length.
Section Forall_Exists.
Context {A} (P : A → Prop).
- Lemma Forall_forall l :
- Forall P l ↔ ∀ x, x ∈ l → P x.
+ 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.
@@ -1200,46 +1715,42 @@ Section Forall_Exists.
Proof. split; subst; induction 1; constructor; firstorder. Qed.
Lemma Forall_iff l (Q : A → Prop) :
- (∀ x, P x ↔ Q x) →
- Forall P l ↔ Forall Q l.
+ (∀ 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.
Proof.
- intros H. revert i.
- by induction H; intros [|i]; try constructor.
- Qed.
- Lemma Forall_lookup l :
- Forall P l ↔ ∀ i x, l !! i = Some x → P x.
- Proof.
- rewrite Forall_forall. setoid_rewrite elem_of_list_lookup.
- naive_solver.
+ rewrite Forall_forall. setoid_rewrite elem_of_list_lookup. naive_solver.
Qed.
- Lemma Forall_lookup_1 l i x :
- Forall P l → l !! i = Some x → P x.
+ Lemma Forall_lookup_1 l i x : Forall P l → l !! i = Some x → P x.
Proof. rewrite Forall_lookup. eauto. Qed.
- Lemma Forall_lookup_2 l :
- (∀ i x, l !! i = Some x → P x) → Forall P l.
+ 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 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.
+ intros Hl. revert i. induction Hl; simpl; intros [|i]; constructor; auto.
Qed.
- Lemma Forall_replicate n x :
- P x → Forall P (replicate n x).
+ 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 Exists_exists l :
- Exists P l ↔ ∃ x, x ∈ l ∧ P x.
+ Lemma Forall_take n l : Forall P l → Forall P (take n l).
+ Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+ Lemma Forall_drop n l : Forall P l → Forall P (drop n l).
+ Proof. intros Hl. revert n. induction Hl; intros [|?]; simpl; auto. Qed.
+ Lemma Forall_resize n x l : P x → Forall P l → Forall P (resize n x l).
+ Proof.
+ intros ? Hl. revert n.
+ induction Hl; intros [|?]; simpl; auto using Forall_replicate.
+ Qed.
+ Lemma Exists_exists l : Exists P l ↔ ∃ x, x ∈ l ∧ P x.
Proof.
split.
* induction 1 as [x|y ?? IH].
@@ -1255,9 +1766,7 @@ Section Forall_Exists.
Proof.
split.
* induction l1; inversion 1; intuition.
- * intros [H|H].
- + induction H; simpl; intuition.
- + induction l1; simpl; intuition.
+ * intros [H|H]; [induction H | induction l1]; simpl; intuition.
Qed.
Global Instance Exists_proper:
@@ -1308,39 +1817,34 @@ Section Forall_Exists.
end.
End Forall_Exists.
+Lemma Forall_swap {A B} (Q : A → B → Prop) l1 l2 :
+ Forall (λ y, Forall (Q y) l1) l2 ↔ Forall (λ x, Forall (flip Q x) l2) l1.
+Proof. repeat setoid_rewrite Forall_forall. simpl. split; eauto. Qed.
+
(** ** Properties of the [Forall2] predicate *)
Section Forall2.
Context {A B} (P : A → B → Prop).
- Lemma Forall2_nil_inv_l k :
- Forall2 P [] k → k = [].
+ 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 k : Forall2 P k [] → k = [].
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.
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.
+ Forall2 P (x1 :: l1) k → ∃ x2 l2, P x1 x2 ∧ Forall2 P l1 l2 ∧ k = x2 :: l2.
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.
+ Forall2 P k (x2 :: l2) → ∃ x1 l1, P x1 x2 ∧ Forall2 P l1 l2 ∧ k = x1 :: l1.
Proof. inversion 1; subst; eauto. Qed.
- Lemma Forall2_cons_nil_inv l1 x1 :
- Forall2 P (x1 :: l1) [] → False.
+ Lemma Forall2_cons_nil_inv l1 x1 : Forall2 P (x1 :: l1) [] → False.
Proof. by inversion 1. Qed.
- Lemma Forall2_nil_cons_inv l2 x2 :
- Forall2 P [] (x2 :: l2) → False.
+ Lemma Forall2_nil_cons_inv l2 x2 : Forall2 P [] (x2 :: l2) → False.
Proof. by inversion 1. Qed.
-
Lemma Forall2_app_inv l1 l2 k1 k2 :
- same_length l1 k1 →
- Forall2 P (l1 ++ l2) (k1 ++ k2) →
- Forall2 P l1 k1 ∧ Forall2 P l2 k2.
+ l1 `same_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.
Lemma Forall2_app_inv_l l1 l2 k :
Forall2 P (l1 ++ l2) k →
@@ -1351,71 +1855,51 @@ Section Forall2.
∃ 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.
+ Lemma Forall2_length l1 l2 : Forall2 P l1 l2 → length l1 = length l2.
Proof. induction 1; simpl; auto. Qed.
- Lemma Forall2_same_length l1 l2 :
- Forall2 P l1 l2 →
- same_length l1 l2.
+ 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.
+ Lemma Forall2_flip l1 l2 : Forall2 P l1 l2 ↔ Forall2 (flip P) l2 l1.
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.
Proof. intros H ?. induction H; auto. Defined.
-
Lemma Forall2_unique l k1 k2 :
- Forall2 P l k1 →
- Forall2 P l k2 →
- (∀ x y1 y2, P x y1 → P x y2 → y1 = y2) →
- k1 = k2.
+ Forall2 P l k1 → Forall2 P l k2 →
+ (∀ x y1 y2, P x y1 → P x y2 → y1 = y2) → k1 = k2.
Proof.
- intros H. revert k2.
- induction H; inversion_clear 1; intros; f_equal; eauto.
+ 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.
+ 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.
+ 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.
+ Forall2 P l1 l2 → l1 !! i = Some x → l2 !! i = Some y → P x y.
Proof.
- intros H. revert i. induction H.
- * discriminate.
- * intros [|?] ??; simpl in *; simplify_equality; eauto.
+ intros H. revert i. induction H; [done|].
+ intros [|?] ??; simpl in *; 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.
+ Forall2 P l1 l2 → l1 !! i = Some x → ∃ y, l2 !! i = Some y ∧ P x y.
Proof.
- intros H. revert i. induction H.
- * discriminate.
- * intros [|?] ?; simpl in *; simplify_equality; eauto.
+ intros H. revert i. induction H; [done|].
+ intros [|?] ?; simpl in *; 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.
+ Forall2 P l1 l2 → l2 !! i = Some y → ∃ x, l1 !! i = Some x ∧ P x y.
Proof.
- intros H. revert i. induction H.
- * discriminate.
- * intros [|?] ?; simpl in *; simplify_equality; eauto.
+ intros H. revert i. induction H; [done|].
+ intros [|?] ?; simpl in *; simplify_equality; eauto.
Qed.
-
Lemma Forall2_lookup_2 l1 l2 :
- same_length l1 l2 →
- (∀ i x y, l1 !! i = Some x → l2 !! i = Some y → P x y) →
- Forall2 P 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.
@@ -1423,99 +1907,70 @@ Section Forall2.
* apply IH. intros i. apply (Hlookup (S i)).
Qed.
Lemma Forall2_lookup l1 l2 :
- Forall2 P l1 l2 ↔ same_length 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,
+ 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.
+ 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,
+ 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.
+ 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,
+ 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.
+ 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).
+ Forall2 P l1 l2 → Forall2 P (delete i l1) (delete i l2).
Proof.
- intros Hl12. revert i.
- induction Hl12; intros [|i]; simpl; intuition.
+ 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.
+ 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).
+ 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).
+ P x1 x2 → Forall2 P (replicate n x1) (replicate n x2).
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.
+ 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.
+ 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).
+ 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.
auto using Forall2_app, Forall2_take, Forall2_replicate.
Qed.
Lemma Forall2_resize_ge_l l1 l2 x1 x2 n m :
- (∀ x, P x x2) →
- n ≤ m →
- Forall2 P (resize n x1 l1) l2 →
- Forall2 P (resize m x1 l1) (resize m x2 l2).
+ 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).
Proof.
intros. assert (n = length l2).
{ by rewrite <-(Forall2_length (resize n x1 l1) l2), resize_length. }
@@ -1523,13 +1978,11 @@ Section Forall2.
rewrite !resize_plus, resize_all, drop_all, resize_nil.
apply Forall2_app; [done |].
apply Forall2_replicate_r; [| by rewrite resize_length].
- by apply Forall_true.
+ eauto using Forall_resize, Forall_drop.
Qed.
Lemma Forall2_resize_ge_r l1 l2 x1 x2 n m :
- (∀ x3, P x1 x3) →
- n ≤ m →
- Forall2 P l1 (resize n x2 l2) →
- Forall2 P (resize m x1 l1) (resize m x2 l2).
+ 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).
Proof.
intros. assert (n = length l1).
{ by rewrite (Forall2_length l1 (resize n x2 l2)), resize_length. }
@@ -1537,17 +1990,14 @@ Section Forall2.
rewrite !resize_plus, resize_all, drop_all, resize_nil.
apply Forall2_app; [done |].
apply Forall2_replicate_l; [| by rewrite resize_length].
- by apply Forall_true.
+ eauto using Forall_resize, Forall_drop.
Qed.
- Lemma Forall2_trans {C} (Q : B → C → Prop) (R : A → C → Prop) l1 l2 l3 :
+ 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.
+ Forall2 P l1 l2 → Forall2 Q l2 l3 → Forall2 R l1 l3.
Proof.
- intros ? Hl1l2. revert l3.
- induction Hl1l2; inversion_clear 1; eauto.
+ intros ? Hl1l2. revert l3. induction Hl1l2; inversion_clear 1; eauto.
Qed.
Lemma Forall2_Forall (Q : A → A → Prop) l :
@@ -1575,19 +2025,37 @@ Section Forall2_order.
Global Instance: Symmetric R → Symmetric (Forall2 R).
Proof. intros. induction 1; constructor; auto. Qed.
Global Instance: Transitive R → Transitive (Forall2 R).
- Proof. intros ????. apply Forall2_trans. apply transitivity. Qed.
+ Proof. intros ????. apply Forall2_transitive. apply transitivity. Qed.
+ Global Instance: Equivalence R → Equivalence (Forall2 R).
+ Proof. split; apply _. Qed.
Global Instance: PreOrder R → PreOrder (Forall2 R).
Proof. split; apply _. Qed.
- Global Instance: AntiSymmetric R → AntiSymmetric (Forall2 R).
+ 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) (++).
+ Proof. repeat intro. eauto using Forall2_app. Qed.
+ Global Instance: Proper (Forall2 R ==> Forall2 R) (delete i).
+ Proof. repeat intro. eauto using Forall2_delete. Qed.
+ Global Instance: Proper (R ==> Forall2 R) (replicate n).
+ Proof. repeat intro. eauto using Forall2_replicate. Qed.
+ Global Instance: Proper (Forall2 R ==> Forall2 R) (take n).
+ Proof. repeat intro. eauto using Forall2_take. Qed.
+ Global Instance: Proper (Forall2 R ==> Forall2 R) (drop n).
+ 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.
(** * Properties of the monadic operations *)
Section fmap.
Context {A B : Type} (f : A → B).
- Lemma list_fmap_compose {C} (g : B → C) l :
- g ∘ f <$> l = g <$> f <$> l.
+ Lemma list_fmap_compose {C} (g : B → C) l : g ∘ f <$> l = g <$> f <$> l.
Proof. induction l; simpl; f_equal; auto. Qed.
Lemma list_fmap_ext (g : A → B) (l : list A) :
@@ -1603,22 +2071,13 @@ Section fmap.
Lemma fmap_app l1 l2 : f <$> l1 ++ l2 = (f <$> l1) ++ (f <$> l2).
Proof. induction l1; simpl; by f_equal. Qed.
- Lemma fmap_nil_inv k :
- f <$> k = [] → k = [].
+ Lemma fmap_nil_inv k : f <$> k = [] → k = [].
Proof. by destruct k. Qed.
Lemma fmap_cons_inv y l k :
- f <$> l = y :: k →
- ∃ x l',
- y = f x ∧
- k = f <$> l' ∧
- l = x :: l'.
+ f <$> l = y :: k → ∃ x l', y = f x ∧ k = f <$> l' ∧ l = x :: l'.
Proof. intros. destruct l; simpl; simplify_equality; eauto. Qed.
Lemma fmap_app_inv l k1 k2 :
- f <$> l = k1 ++ k2 →
- ∃ l1 l2,
- k1 = f <$> l1 ∧
- k2 = f <$> l2 ∧
- l = l1 ++ l2.
+ 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.
@@ -1631,11 +2090,9 @@ Section fmap.
Proof. induction l; simpl; by 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; simpl; [done |]. by rewrite !reverse_cons, fmap_app, IHl.
Qed.
- Lemma fmap_replicate n x :
- f <$> replicate n x = replicate n (f x).
+ Lemma fmap_replicate n x : f <$> replicate n x = replicate n (f x).
Proof. induction n; simpl; f_equal; auto. Qed.
Lemma list_lookup_fmap l i : (f <$> l) !! i = f <$> (l !! i).
@@ -1648,11 +2105,9 @@ Section fmap.
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).
+ 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.
+ intros Hl. revert i. induction Hl; intros [|i]; simpl; f_equal; auto.
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.
@@ -1669,25 +2124,24 @@ Section fmap.
firstorder eauto using elem_of_list_fmap_1_alt, elem_of_list_fmap_2.
Qed.
- Lemma NoDup_fmap_1 (l : list A) :
- NoDup (f <$> l) → NoDup l.
+ Lemma NoDup_fmap_1 l : NoDup (f <$> l) → NoDup l.
Proof.
induction l; simpl; inversion_clear 1; constructor; auto.
rewrite elem_of_list_fmap in *. naive_solver.
Qed.
- Lemma NoDup_fmap_2 `{!Injective (=) (=) f} (l : list A) :
- NoDup l → NoDup (f <$> l).
+ Lemma NoDup_fmap_2 `{!Injective (=) (=) f} l : NoDup l → NoDup (f <$> l).
Proof.
- induction 1; simpl; constructor; trivial.
- rewrite elem_of_list_fmap. intros [y [Hxy ?]].
- apply (injective f) in Hxy. by subst.
+ induction 1; simpl; constructor; trivial. rewrite elem_of_list_fmap.
+ intros [y [Hxy ?]]. apply (injective f) in Hxy. by subst.
Qed.
- Lemma NoDup_fmap `{!Injective (=) (=) f} (l : list A) :
- NoDup (f <$> l) ↔ NoDup l.
+ Lemma NoDup_fmap `{!Injective (=) (=) f} l : NoDup (f <$> l) ↔ NoDup l.
Proof. split; auto using NoDup_fmap_1, NoDup_fmap_2. Qed.
- Global Instance fmap_Permutation_proper:
- Proper (Permutation ==> Permutation) (fmap f).
+ 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 (g : A → B) (l : list A) :
@@ -1697,11 +2151,8 @@ Section fmap.
* induction 1; simpl; f_equal; auto.
* induction l; simpl; constructor; simplify_equality; auto.
Qed.
- Lemma Forall_fmap (l : list A) (P : B → Prop) :
- Forall P (f <$> l) ↔ Forall (P ∘ f) l.
- Proof.
- split; induction l; inversion_clear 1; constructor; 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 Forall2_fmap_l {C} (P : B → C → Prop) l1 l2 :
Forall2 P (f <$> l1) l2 ↔ Forall2 (P ∘ f) l1 l2.
@@ -1714,26 +2165,20 @@ Section fmap.
split; revert l1; induction l2; inversion_clear 1; constructor; auto.
Qed.
Lemma Forall2_fmap_1 {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.
+ Forall2 P (f <$> l1) (g <$> l2) → Forall2 (λ x1 x2, P (f x1) (g x2)) l1 l2.
Proof. revert l2; induction l1; intros [|??]; inversion_clear 1; auto. Qed.
Lemma Forall2_fmap_2 {C D} (g : C → D) (P : B → D → Prop) l1 l2 :
- Forall2 (λ x1 x2, P (f x1) (g x2)) l1 l2 →
- Forall2 P (f <$> l1) (g <$> l2).
+ Forall2 (λ x1 x2, P (f x1) (g x2)) l1 l2 → Forall2 P (f <$> l1) (g <$> l2).
Proof. induction 1; simpl; auto. Qed.
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.
+ 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 mapM_fmap_Some (g : B → option A) (l : list A) :
- (∀ x, g (f x) = Some x) →
- mapM g (f <$> l) = Some l.
+ (∀ x, g (f x) = Some x) → mapM g (f <$> l) = Some l.
Proof. intros. by induction l; simpl; simplify_option_equality. Qed.
Lemma mapM_fmap_Some_inv (g : B → option A) (l : list A) (k : list B) :
- (∀ x y, g y = Some x → y = f x) →
- mapM g k = Some l →
- k = f <$> l.
+ (∀ x y, g y = Some x → y = f x) → mapM g k = Some l → k = f <$> l.
Proof.
intros Hgf. revert l; induction k as [|??]; intros [|??] ?;
simplify_option_equality; f_equiv; eauto.
@@ -1741,12 +2186,9 @@ Section fmap.
End fmap.
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).
+ (∀ x y1 y2, (x,y1) ∈ l → (x,y2) ∈ l → y1 = y2) → NoDup l → NoDup (fst <$> l).
Proof.
- intros Hunique.
- induction 1 as [|[x1 y1] l Hin Hnodup IH]; simpl; constructor.
+ intros Hunique. induction 1 as [|[x1 y1] l Hin Hnodup IH]; simpl; constructor.
* rewrite elem_of_list_fmap.
intros [[x2 y2] [??]]; simpl in *; subst. destruct Hin.
rewrite (Hunique x2 y1 y2); rewrite ?elem_of_cons; auto.
@@ -1757,24 +2199,43 @@ Qed.
Section bind.
Context {A B : Type} (f : A → list B).
- Lemma bind_app (l1 l2 : list A) :
- (l1 ++ l2) ≫= f = (l1 ≫= f) ++ (l2 ≫= f).
+ Global Instance mbind_sublist: Proper (sublist ==> sublist) (mbind f).
+ Proof.
+ induction 1; simpl; auto.
+ * done.
+ * by apply sublist_app.
+ * by apply sublist_inserts_l.
+ Qed.
+ Global Instance mbind_contains: Proper (contains ==> contains) (mbind f).
+ Proof.
+ induction 1; simpl; auto.
+ * done.
+ * by apply contains_app.
+ * by rewrite !(associative_L (++)), (commutative (++) (f _)).
+ * by apply contains_inserts_l.
+ * etransitivity; eauto.
+ Qed.
+ Global Instance mbind_Permutation: Proper ((≡ₚ) ==> (≡ₚ)) (mbind f).
+ Proof.
+ induction 1; simpl; auto.
+ * by f_equiv.
+ * 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 (++)), IHl1.
+ induction l1; simpl; [done|]. by rewrite <-(associative_L (++)), IHl1.
Qed.
Lemma elem_of_list_bind (x : B) (l : list A) :
x ∈ l ≫= f ↔ ∃ y, x ∈ f y ∧ y ∈ l.
Proof.
split.
- * induction l as [|y l IH]; simpl.
- { inversion 1. }
+ * induction l as [|y l IH]; simpl; [inversion 1|].
rewrite elem_of_app. intros [?|?].
+ exists y. split; [done | by left].
- + destruct IH as [z [??]]. done.
- exists z. split; [done | by right].
- * intros [y [Hx Hy]].
- induction Hy; simpl; rewrite elem_of_app; intuition.
+ + 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 :
@@ -1786,420 +2247,189 @@ End bind.
Section ret_join.
Context {A : Type}.
- Lemma list_join_bind (ls : list (list A)) :
- mjoin ls = ls ≫= id.
+ Lemma list_join_bind (ls : list (list A)) : mjoin ls = ls ≫= id.
Proof. induction ls; simpl; f_equal; auto. Qed.
- Lemma elem_of_list_ret (x y : A) :
- x ∈ @mret list _ A y ↔ x = y.
+ 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.
+ Lemma join_nil (ls : list (list A)) : mjoin ls = [] ↔ Forall (= []) ls.
Proof.
split.
* by induction ls as [|[|??] ?]; constructor; auto.
* by induction 1 as [|[|??] ?].
Qed.
- Lemma join_nil_1 (ls : list (list A)) :
- mjoin ls = [] → Forall (= []) ls.
+ 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 = [].
+ 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.
+ Forall (λ l, length l = n) ls → length (mjoin ls) = length ls * n.
Proof. rewrite join_length. by induction 1; simpl; f_equal. Qed.
Lemma lookup_join_same_length (ls : list (list A)) n i :
- n ≠0 →
- Forall (λ l, length l = n) ls →
+ 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].
+ intros Hn Hls. revert i. induction Hls as [|l ls ? Hls IH]; simpl; [done |].
+ intros i. destruct (decide (i < n)) as [Hin|Hin].
* rewrite <-(NPeano.Nat.div_unique i n 0 i) by lia.
rewrite <-(NPeano.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 NPeano.Nat.div_add, NPeano.Nat.mod_add by done.
replace (i - n + 1 * n) with i by lia.
- rewrite (plus_comm _ 1), lookup_app_r_alt, IH by lia.
- by subst.
+ rewrite (plus_comm _ 1), lookup_app_r_alt, IH by lia. by subst.
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 →
+ 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].
+ intros Hn Hls. revert i. induction Hls as [|l ls ? Hls IH]; simpl; [done |].
+ intros i. destruct (decide (i < n)) as [Hin|Hin].
* rewrite <-(NPeano.Nat.div_unique i n 0 i) by lia.
rewrite <-(NPeano.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 NPeano.Nat.div_add, NPeano.Nat.mod_add by done.
replace (i - n + 1 * n) with i by lia.
- rewrite (plus_comm _ 1), alter_app_r_alt, IH by lia.
- by subst.
+ rewrite (plus_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 →
+ 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).
+ Forall2 (Forall2 P) ls1 ls2 → Forall2 P (mjoin ls1) (mjoin ls2).
Proof. induction 1; simpl; auto using Forall2_app. Qed.
End ret_join.
-(** ** Properties of the [prefix_of] and [suffix_of] predicates *)
-Section prefix_postfix.
+(** ** Properties of the [permutations] function *)
+Section permutations.
Context {A : Type}.
+ Implicit Types x y z : A.
+ Implicit Types l : list A.
- Global Instance: PreOrder (@prefix_of A).
- Proof.
- split.
- * intros ?. eexists []. by rewrite (right_id [] (++)).
- * intros ??? [k1 ?] [k2 ?].
- exists (k1 ++ k2). subst. by rewrite (associative (++)).
- Qed.
-
- Lemma prefix_of_nil (l : list A) : prefix_of [] l.
- Proof. by exists l. Qed.
- Lemma prefix_of_nil_not x (l : list A) : ¬prefix_of (x :: l) [].
- Proof. by intros [k E]. Qed.
- Lemma prefix_of_cons x (l1 l2 : list A) :
- prefix_of l1 l2 → prefix_of (x :: l1) (x :: l2).
- Proof. intros [k E]. exists k. by subst. Qed.
- Lemma prefix_of_cons_alt x y (l1 l2 : list A) :
- x = y → prefix_of l1 l2 → prefix_of (x :: l1) (y :: l2).
- Proof. intro. subst. apply prefix_of_cons. Qed.
- Lemma prefix_of_cons_inv_1 x y (l1 l2 : list A) :
- prefix_of (x :: l1) (y :: l2) → x = y.
- Proof. intros [k E]. by injection E. Qed.
- Lemma prefix_of_cons_inv_2 x y (l1 l2 : list A) :
- prefix_of (x :: l1) (y :: l2) → prefix_of l1 l2.
- Proof. intros [k E]. exists k. by injection E. Qed.
-
- Lemma prefix_of_app k (l1 l2 : list A) :
- prefix_of l1 l2 → prefix_of (k ++ l1) (k ++ l2).
- Proof. intros [k' ?]. subst. exists k'. by rewrite (associative (++)). Qed.
- Lemma prefix_of_app_alt k1 k2 (l1 l2 : list A) :
- k1 = k2 → prefix_of l1 l2 → prefix_of (k1 ++ l1) (k2 ++ l2).
- Proof. intro. subst. apply prefix_of_app. Qed.
- Lemma prefix_of_app_l (l1 l2 l3 : list A) :
- prefix_of (l1 ++ l3) l2 → prefix_of l1 l2.
- Proof.
- intros [k ?]. red. exists (l3 ++ k). subst.
- by rewrite <-(associative (++)).
- Qed.
- Lemma prefix_of_app_r (l1 l2 l3 : list A) :
- prefix_of l1 l2 → prefix_of l1 (l2 ++ l3).
- Proof.
- intros [k ?]. exists (k ++ l3). subst.
- by rewrite (associative (++)).
- Qed.
-
- Lemma prefix_of_length (l1 l2 : list A) :
- prefix_of l1 l2 → length l1 ≤ length l2.
- Proof. intros [??]. subst. rewrite app_length. lia. Qed.
- Lemma prefix_of_snoc_not (l : list A) x : ¬prefix_of (l ++ [x]) l.
- Proof. intros [??]. discriminate_list_equality. Qed.
-
- Global Instance: PreOrder (@suffix_of A).
+ Lemma interleave_cons x l : x :: l ∈ interleave x l.
+ Proof. destruct l; simpl; rewrite elem_of_cons; auto. Qed.
+ Lemma interleave_Permutation x l l' : l' ∈ interleave x l → l' ≡ₚ x :: l.
Proof.
- split.
- * intros ?. by eexists [].
- * intros ??? [k1 ?] [k2 ?].
- exists (k2 ++ k1). subst. by rewrite (associative (++)).
+ 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.
Qed.
- Global Instance prefix_of_dec `{∀ x y : A, Decision (x = y)} :
- ∀ l1 l2 : list A, Decision (prefix_of l1 l2) :=
- fix go l1 l2 :=
- match l1, l2 return { prefix_of l1 l2 } + { ¬prefix_of l1 l2 } with
- | [], _ => left (prefix_of_nil _)
- | _, [] => right (prefix_of_nil_not _ _)
- | x :: l1, y :: l2 =>
- match decide_rel (=) x y with
- | left Exy =>
- match go l1 l2 with
- | left Hl1l2 => left (prefix_of_cons_alt _ _ _ _ Exy Hl1l2)
- | right Hl1l2 => right (Hl1l2 ∘ prefix_of_cons_inv_2 _ _ _ _)
- end
- | right Exy => right (Exy ∘ prefix_of_cons_inv_1 _ _ _ _)
- end
- end.
+ Lemma permutations_refl l : l ∈ permutations l.
+ Proof.
+ induction l; simpl.
+ * by apply elem_of_list_singleton.
+ * apply elem_of_list_bind. eauto using interleave_cons.
+ Qed.
+ Lemma permutations_skip x l l' :
+ l ∈ permutations l' → x :: l ∈ permutations (x :: l').
+ Proof.
+ intros Hl. simpl. apply elem_of_list_bind. eauto using interleave_cons.
+ Qed.
+ Lemma permutations_swap x y l : y :: x :: l ∈ permutations (x :: y :: l).
+ Proof.
+ simpl. apply elem_of_list_bind. exists (y :: l). split; simpl.
+ * destruct l; simpl; rewrite !elem_of_cons; auto.
+ * apply elem_of_list_bind. simpl.
+ eauto using interleave_cons, permutations_refl.
+ Qed.
+ Lemma permutations_nil l : l ∈ permutations [] ↔ l = [].
+ Proof. simpl. by rewrite elem_of_list_singleton. Qed.
- Section prefix_ops.
- Context `{∀ x y : A, Decision (x = y)}.
-
- Lemma max_prefix_of_fst (l1 l2 : list A) :
- l1 = snd (max_prefix_of l1 l2) ++ fst (fst (max_prefix_of l1 l2)).
- Proof.
- revert l2. induction l1; intros [|??]; simpl;
- repeat case_decide; simpl; f_equal; auto.
- Qed.
- Lemma max_prefix_of_fst_alt (l1 l2 : list A) k1 k2 k3 :
- max_prefix_of l1 l2 = (k1,k2,k3) → l1 = k3 ++ k1.
- Proof.
- intro. 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 : list A) :
- prefix_of (snd (max_prefix_of l1 l2)) l1.
- Proof. eexists. apply max_prefix_of_fst. Qed.
- Lemma max_prefix_of_fst_prefix_alt (l1 l2 : list A) k1 k2 k3 :
- max_prefix_of l1 l2 = (k1,k2,k3) → prefix_of k3 l1.
- Proof. eexists. eauto using max_prefix_of_fst_alt. Qed.
-
- Lemma max_prefix_of_snd (l1 l2 : list A) :
- l2 = snd (max_prefix_of l1 l2) ++ snd (fst (max_prefix_of l1 l2)).
- Proof.
- revert l2. induction l1; intros [|??]; simpl;
- repeat case_decide; simpl; f_equal; auto.
- Qed.
- Lemma max_prefix_of_snd_alt (l1 l2 : list A) k1 k2 k3 :
- max_prefix_of l1 l2 = (k1,k2,k3) → l2 = k3 ++ k2.
- Proof.
- 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 : list A) :
- prefix_of (snd (max_prefix_of l1 l2)) l2.
- Proof. eexists. apply max_prefix_of_snd. Qed.
- Lemma max_prefix_of_snd_prefix_alt (l1 l2 : list A) k1 k2 k3 :
- max_prefix_of l1 l2 = (k1,k2,k3) → prefix_of k3 l2.
- Proof. eexists. eauto using max_prefix_of_snd_alt. Qed.
-
- Lemma max_prefix_of_max (l1 l2 : list A) k :
- prefix_of k l1 →
- prefix_of k l2 →
- prefix_of k (snd (max_prefix_of l1 l2)).
- Proof.
- intros [l1' ?] [l2' ?]. subst.
- 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 : list A) k1 k2 k3 k :
- max_prefix_of l1 l2 = (k1,k2,k3) →
- prefix_of k l1 →
- prefix_of k l2 →
- prefix_of k k3.
- Proof.
- 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 : list A) 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).
- eapply max_prefix_of_max_alt; eauto.
- * rewrite (max_prefix_of_fst_alt _ _ _ _ _ Hl).
- apply prefix_of_app, prefix_of_cons, prefix_of_nil.
- * rewrite (max_prefix_of_snd_alt _ _ _ _ _ Hl).
- apply prefix_of_app, prefix_of_cons, prefix_of_nil.
- Qed.
- End prefix_ops.
-
- Lemma prefix_suffix_reverse (l1 l2 : list A) :
- prefix_of l1 l2 ↔ suffix_of (reverse l1) (reverse l2).
- Proof.
- split; intros [k E]; exists (reverse k).
- * by rewrite E, reverse_app.
- * by rewrite <-(reverse_involutive l2), E, reverse_app, reverse_involutive.
- Qed.
- Lemma suffix_prefix_reverse (l1 l2 : list A) :
- suffix_of l1 l2 ↔ prefix_of (reverse l1) (reverse l2).
- Proof. by rewrite prefix_suffix_reverse, !reverse_involutive. Qed.
-
- Lemma suffix_of_nil (l : list A) : suffix_of [] l.
- Proof. exists l. by rewrite (right_id [] (++)). Qed.
- Lemma suffix_of_nil_inv (l : list A) : suffix_of l [] → l = [].
- Proof. by intros [[|?] ?]; simplify_list_equality. Qed.
- Lemma suffix_of_cons_nil_inv x (l : list A) : ¬suffix_of (x :: l) [].
- Proof. by intros [[] ?]. Qed.
- Lemma suffix_of_snoc (l1 l2 : list A) x :
- suffix_of l1 l2 → suffix_of (l1 ++ [x]) (l2 ++ [x]).
- Proof. intros [k E]. exists k. subst. by rewrite (associative (++)). Qed.
- Lemma suffix_of_snoc_alt x y (l1 l2 : list A) :
- x = y → suffix_of l1 l2 → suffix_of (l1 ++ [x]) (l2 ++ [y]).
- Proof. intro. subst. apply suffix_of_snoc. Qed.
-
- Lemma suffix_of_app (l1 l2 k : list A) :
- suffix_of l1 l2 → suffix_of (l1 ++ k) (l2 ++ k).
- Proof. intros [k' E]. exists k'. subst. by rewrite (associative (++)). Qed.
- Lemma suffix_of_app_alt (l1 l2 k1 k2 : list A) :
- k1 = k2 → suffix_of l1 l2 → suffix_of (l1 ++ k1) (l2 ++ k2).
- Proof. intro. subst. apply suffix_of_app. Qed.
-
- Lemma suffix_of_snoc_inv_1 x y (l1 l2 : list A) :
- suffix_of (l1 ++ [x]) (l2 ++ [y]) → x = y.
- Proof.
- rewrite suffix_prefix_reverse, !reverse_snoc.
- by apply prefix_of_cons_inv_1.
- Qed.
- Lemma suffix_of_snoc_inv_2 x y (l1 l2 : list A) :
- suffix_of (l1 ++ [x]) (l2 ++ [y]) → suffix_of l1 l2.
- Proof.
- rewrite !suffix_prefix_reverse, !reverse_snoc.
- by apply prefix_of_cons_inv_2.
- Qed.
-
- Lemma suffix_of_cons_l (l1 l2 : list A) x :
- suffix_of (x :: l1) l2 → suffix_of l1 l2.
- Proof.
- intros [k ?]. exists (k ++ [x]). subst.
- by rewrite <-(associative (++)).
- Qed.
- Lemma suffix_of_app_l (l1 l2 l3 : list A) :
- suffix_of (l3 ++ l1) l2 → suffix_of l1 l2.
- Proof.
- intros [k ?]. exists (k ++ l3). subst.
- by rewrite <-(associative (++)).
- Qed.
- Lemma suffix_of_cons_r (l1 l2 : list A) x :
- suffix_of l1 l2 → suffix_of l1 (x :: l2).
- Proof. intros [k ?]. exists (x :: k). by subst. Qed.
- Lemma suffix_of_app_r (l1 l2 l3 : list A) :
- suffix_of l1 l2 → suffix_of l1 (l3 ++ l2).
- Proof.
- intros [k ?]. exists (l3 ++ k). subst.
- by rewrite (associative (++)).
- Qed.
-
- Lemma suffix_of_cons_inv (l1 l2 : list A) x y :
- suffix_of (x :: l1) (y :: l2) →
- x :: l1 = y :: l2 ∨ suffix_of (x :: l1) l2.
- Proof.
- intros [[|? k] E].
- * by left.
- * right. simplify_equality. by apply suffix_of_app_r.
- Qed.
-
- Lemma suffix_of_length (l1 l2 : list A) :
- suffix_of l1 l2 → length l1 ≤ length l2.
- Proof. intros [??]. subst. rewrite app_length. lia. Qed.
- Lemma suffix_of_cons_not x (l : list A) : ¬suffix_of (x :: l) l.
- Proof. intros [??]. discriminate_list_equality. Qed.
-
- Global Instance suffix_of_dec `{∀ x y : A, Decision (x = y)}
- (l1 l2 : list A) : Decision (suffix_of l1 l2).
- Proof.
- refine (cast_if (decide_rel prefix_of (reverse l1) (reverse l2)));
- abstract (by rewrite suffix_prefix_reverse).
- Defined.
+ 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_cons, elem_of_list_fmap.
+ intros Hl1 [? | [l2' [??]]]; subst; simpl in *.
+ * 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.
+ + exists (x1 :: y :: l3). simpl. rewrite !elem_of_cons. tauto.
+ + exists l4. simpl. rewrite elem_of_cons. auto using interleave_cons.
+ * rewrite elem_of_cons, elem_of_list_fmap in Hl1.
+ destruct Hl1 as [? | [l1' [??]]]; subst.
+ + exists (x1 :: y :: l3). simpl.
+ rewrite !elem_of_cons, !elem_of_list_fmap.
+ split; [| by auto]. right. right. exists (y :: l2').
+ rewrite elem_of_list_fmap. naive_solver.
+ + destruct (IH l1' l2') as [l4 [??]]; auto. exists (y :: l4). simpl.
+ rewrite !elem_of_cons, !elem_of_list_fmap. naive_solver.
+ Qed.
+ Lemma permutations_interleave_toggle x l1 l2 l3 :
+ l1 ∈ permutations l2 → l2 ∈ interleave x l3 → ∃ l4,
+ l1 ∈ interleave x l4 ∧ l4 ∈ permutations l3.
+ Proof.
+ revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl.
+ { 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_cons, elem_of_list_fmap.
+ intros Hl1 [? | [l2' [? Hl2']]]; subst; simpl in *.
+ * rewrite elem_of_list_bind in Hl1.
+ destruct Hl1 as [l1' [??]]. by exists l1'.
+ * rewrite elem_of_list_bind in Hl1. setoid_rewrite elem_of_list_bind.
+ destruct Hl1 as [l1' [??]]. destruct (IH l1' l2') as (l1''&?&?); auto.
+ destruct (interleave_interleave_toggle y x l1 l1' l1'') as (?&?&?); eauto.
+ Qed.
+ Lemma permutations_trans l1 l2 l3 :
+ l1 ∈ permutations l2 → l2 ∈ permutations l3 → l1 ∈ permutations l3.
+ Proof.
+ revert l1 l2. induction l3 as [|x l3 IH]; intros l1 l2; simpl.
+ * intros Hl1 Hl2. rewrite elem_of_list_singleton in Hl2.
+ by rewrite Hl2 in Hl1.
+ * rewrite !elem_of_list_bind. intros Hl1 [l2' [Hl2 Hl2']].
+ destruct (permutations_interleave_toggle x l1 l2 l2') as [? [??]]; eauto.
+ Qed.
- Section max_suffix_of.
- Context `{∀ x y : A, Decision (x = y)}.
-
- Lemma max_suffix_of_fst (l1 l2 : list A) :
- l1 = fst (fst (max_suffix_of l1 l2)) ++ snd (max_suffix_of l1 l2).
- Proof.
- rewrite <-(reverse_involutive l1) at 1.
- rewrite (max_prefix_of_fst (reverse l1) (reverse l2)).
- unfold max_suffix_of.
- destruct (max_prefix_of (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
- by rewrite reverse_app.
- Qed.
- Lemma max_suffix_of_fst_alt (l1 l2 : list A) k1 k2 k3 :
- max_suffix_of l1 l2 = (k1,k2,k3) → l1 = k1 ++ k3.
- Proof.
- 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 : list A) :
- suffix_of (snd (max_suffix_of l1 l2)) l1.
- Proof. eexists. apply max_suffix_of_fst. Qed.
- Lemma max_suffix_of_fst_suffix_alt (l1 l2 : list A) k1 k2 k3 :
- max_suffix_of l1 l2 = (k1,k2,k3) → suffix_of k3 l1.
- Proof. eexists. eauto using max_suffix_of_fst_alt. Qed.
-
- Lemma max_suffix_of_snd (l1 l2 : list A) :
- l2 = snd (fst (max_suffix_of l1 l2)) ++ snd (max_suffix_of l1 l2).
- Proof.
- rewrite <-(reverse_involutive l2) at 1.
- 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.
- Lemma max_suffix_of_snd_alt (l1 l2 : list A) k1 k2 k3 :
- max_suffix_of l1 l2 = (k1,k2,k3) → l2 = k2 ++ k3.
- Proof.
- 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 : list A) :
- suffix_of (snd (max_suffix_of l1 l2)) l2.
- Proof. eexists. apply max_suffix_of_snd. Qed.
- Lemma max_suffix_of_snd_suffix_alt (l1 l2 : list A) k1 k2 k3 :
- max_suffix_of l1 l2 = (k1,k2,k3) → suffix_of k3 l2.
- Proof. eexists. eauto using max_suffix_of_snd_alt. Qed.
-
- Lemma max_suffix_of_max (l1 l2 : list A) k :
- suffix_of k l1 →
- suffix_of k l2 →
- suffix_of k (snd (max_suffix_of l1 l2)).
- Proof.
- generalize (max_prefix_of_max (reverse l1) (reverse l2)).
- rewrite !suffix_prefix_reverse. unfold max_suffix_of.
- destruct (max_prefix_of (reverse l1) (reverse l2)) as ((?&?)&?); simpl.
- rewrite reverse_involutive. auto.
- Qed.
- Lemma max_suffix_of_max_alt (l1 l2 : list A) k1 k2 k3 k :
- max_suffix_of l1 l2 = (k1,k2,k3) →
- suffix_of k l1 →
- suffix_of k l2 →
- suffix_of k k3.
- Proof.
- 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 : list A) 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).
- eapply max_suffix_of_max_alt; eauto.
- * rewrite (max_suffix_of_fst_alt _ _ _ _ _ Hl).
- by apply (suffix_of_app [x2]), suffix_of_app_r.
- * rewrite (max_suffix_of_snd_alt _ _ _ _ _ Hl).
- by apply (suffix_of_app [x2]), suffix_of_app_r.
- Qed.
- End max_suffix_of.
-End prefix_postfix.
+ 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_bind. intros [l' [Hl'' ?]].
+ rewrite (interleave_Permutation _ _ _ Hl''). constructor; auto.
+ * induction 1; eauto using permutations_refl,
+ permutations_skip, permutations_swap, permutations_trans.
+ Qed.
+End permutations.
(** ** Properties of the folding functions *)
-Notation foldr_app := fold_right_app.
+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 (Permutation ==> R) (foldr f b).
+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.
@@ -2208,12 +2438,9 @@ Proof.
* etransitivity; eauto.
Qed.
-Lemma ifoldr_app {A B} (f : nat → B → A → A) (a : nat → A)
- (l1 l2 : list B) n :
+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 as [| b l1 IH ]; intros; simpl; f_equal; auto.
-Qed.
+Proof. revert n a. induction l1; intros; simpl; f_equal; auto. Qed.
(** ** Properties of the [zip_with] and [zip] functions *)
Section zip_with.
@@ -2224,129 +2451,87 @@ Section zip_with.
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; simpl; simplify_equality; repeat eexists.
- Qed.
+ ∃ 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; simpl; 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''.
+ ∃ 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] ?; simpl; simplify_equality.
- destruct (IH l1 l2) as (l1' & l1'' & l2' & l2'' &?&?&?&?);
- subst; [done |].
+ 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) →
- same_length l1 l2 →
- same_length k1 k2 →
- zip_with f l1 l2 = zip_with f k1 k2 →
- l1 = k1 ∧ l2 = k2.
+ 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 ?? [] ?; simpl;
+ intros ? Hl. revert k1 k2. induction Hl; intros ?? [] ?; simpl;
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.
+ 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 →
+ (∀ 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 →
+ (∀ 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) →
- same_length l1 l2 →
- g <$> zip_with f l1 l2 = l1.
+ (∀ 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) →
- same_length l1 l2 →
- g <$> zip_with f l1 l2 = 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 P l1 → Forall (λ y, ∀ x, P x → Q (f x y)) l2 →
Forall Q (zip_with f l1 l2).
- Proof.
- intros Hl1. revert l2.
- induction Hl1; destruct 1; simpl in *; auto.
- Qed.
+ 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 (λ x, ∀ y, P y → Q (f x y)) l1 → Forall P l2 →
Forall Q (zip_with f l1 l2).
- Proof.
- intros Hl1. revert l2.
- induction Hl1; destruct 1; simpl in *; auto.
- Qed.
+ Proof. intros Hl. revert l2. induction Hl; destruct 1; simpl in *; auto. Qed.
End zip_with.
Section zip.
Context {A B : Type}.
Lemma zip_length (l1 : list A) (l2 : list B) :
- length l1 ≤ length l2 →
- length (zip l1 l2) = length l1.
+ length l1 ≤ length l2 → length (zip l1 l2) = length l1.
Proof. by apply zip_with_length. Qed.
Lemma zip_fmap_fst_le (l1 : list A) (l2 : list B) :
- length l1 ≤ length l2 →
- fst <$> zip l1 l2 = l1.
+ length l1 ≤ length l2 → fst <$> zip l1 l2 = l1.
Proof. by apply zip_with_fmap_fst_le. Qed.
Lemma zip_fmap_snd (l1 : list A) (l2 : list B) :
- length l2 ≤ length l1 →
- snd <$> zip l1 l2 = l2.
+ length l2 ≤ length l1 → snd <$> zip l1 l2 = l2.
Proof. by apply zip_with_fmap_snd_le. Qed.
Lemma zip_fst (l1 : list A) (l2 : list B) :
- same_length l1 l2 →
- fst <$> zip l1 l2 = l1.
+ l1 `same_length` l2 → fst <$> zip l1 l2 = l1.
Proof. by apply zip_with_fmap_fst. Qed.
Lemma zip_snd (l1 : list A) (l2 : list B) :
- same_length l1 l2 → snd <$> zip l1 l2 = l2.
+ l1 `same_length` l2 → snd <$> zip l1 l2 = l2.
Proof. by apply zip_with_fmap_snd. Qed.
End zip.
-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.
-
Lemma elem_of_zipped_map {A B} (f : list A → list A → A → B) l k x :
x ∈ zipped_map f l k ↔
∃ k' k'' y, k = k' ++ [y] ++ k'' ∧ x = f (reverse k' ++ l) k'' y.
@@ -2356,17 +2541,15 @@ Proof.
+ 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 (++)).
+ 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 (++)).
+ revert l. induction k' as [|z k' IH]; intros l; [by left|].
+ 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 []).
- Context (Pcons : ∀ l k x, P (x :: l) k → P l (x :: k)).
+ 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
@@ -2375,236 +2558,117 @@ Section zipped_list_ind.
end.
End zipped_list_ind.
-Inductive zipped_Forall {A} (P : list A → list A → A → Prop) :
- list A → list A → Prop :=
- | zipped_Forall_nil l : zipped_Forall P l []
- | zipped_Forall_cons l k x :
- P l k x →
- zipped_Forall P (x :: l) k →
- zipped_Forall P l (x :: k).
-Arguments zipped_Forall_nil {_ _} _.
-Arguments zipped_Forall_cons {_ _} _ _ _ _ _.
-
Lemma zipped_Forall_app {A} (P : list A → list A → A → Prop) l k k' :
zipped_Forall P l (k ++ k') → zipped_Forall P (reverse k ++ l) k'.
Proof.
revert l. induction k as [|x k IH]; simpl; [done |].
- inversion_clear 1. rewrite reverse_cons, <-(associative (++)).
- by apply IH.
+ inversion_clear 1. rewrite reverse_cons, <-(associative_L (++)). by apply IH.
Qed.
-(** ** Permutations *)
-Section permutations.
- Context {A : Type}.
-
- Lemma interleave_cons (x : A) (l : list A) :
- x :: l ∈ interleave x l.
- Proof. destruct l; simpl; rewrite elem_of_cons; auto. Qed.
- Lemma interleave_Permutation (x : A) (l l' : list A) :
- l' ∈ interleave x l → Permutation 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.
- Qed.
-
- Lemma permutations_refl (l : list A) :
- l ∈ permutations l.
- Proof.
- induction l; simpl.
- * by apply elem_of_list_singleton.
- * apply elem_of_list_bind. eauto using interleave_cons.
- Qed.
- Lemma permutations_skip (x : A) (l l' : list A) :
- l ∈ permutations l' →
- x :: l ∈ permutations (x :: l').
- Proof.
- intros Hl. simpl. apply elem_of_list_bind.
- eauto using interleave_cons.
- Qed.
- Lemma permutations_swap (x y : A) (l : list A) :
- y :: x :: l ∈ permutations (x :: y :: l).
- Proof.
- simpl. apply elem_of_list_bind.
- exists (y :: l). split; simpl.
- * destruct l; simpl; rewrite !elem_of_cons; auto.
- * apply elem_of_list_bind. simpl.
- eauto using interleave_cons, permutations_refl.
- Qed.
- Lemma permutations_nil (l : list A) :
- l ∈ permutations [] ↔ l = [].
- Proof. simpl. by rewrite elem_of_list_singleton. Qed.
-
- Lemma interleave_interleave_toggle (x1 x2 : A) (l1 l2 l3 : list A) :
- 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_cons, elem_of_list_fmap.
- intros Hl1 [? | [l2' [??]]]; subst; simpl in *.
- * 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.
- + exists (x1 :: y :: l3). simpl. rewrite !elem_of_cons. tauto.
- + exists l4. simpl. rewrite elem_of_cons. auto using interleave_cons.
- * rewrite elem_of_cons, elem_of_list_fmap in Hl1.
- destruct Hl1 as [? | [l1' [??]]]; subst.
- + exists (x1 :: y :: l3). simpl.
- rewrite !elem_of_cons, !elem_of_list_fmap.
- split; [| by auto]. right. right. exists (y :: l2').
- rewrite elem_of_list_fmap. naive_solver.
- + destruct (IH l1' l2') as [l4 [??]]; auto.
- exists (y :: l4). simpl.
- rewrite !elem_of_cons, !elem_of_list_fmap. naive_solver.
- Qed.
- Lemma permutations_interleave_toggle (x : A) (l1 l2 l3 : list A) :
- l1 ∈ permutations l2 →
- l2 ∈ interleave x l3 → ∃ l4,
- l1 ∈ interleave x l4 ∧ l4 ∈ permutations l3.
- Proof.
- revert l1 l2. induction l3 as [|y l3 IH]; intros l1 l2; simpl.
- { 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_cons, elem_of_list_fmap.
- intros Hl1 [? | [l2' [? Hl2']]]; subst; simpl in *.
- * rewrite elem_of_list_bind in Hl1.
- destruct Hl1 as [l1' [??]]. by exists l1'.
- * rewrite elem_of_list_bind in Hl1.
- setoid_rewrite elem_of_list_bind.
- destruct Hl1 as [l1' [??]].
- destruct (IH l1' l2') as [l1'' [??]]; auto.
- destruct (interleave_interleave_toggle y x l1 l1' l1'') as [? [??]]; eauto.
- Qed.
- Lemma permutations_trans (l1 l2 l3 : list A) :
- 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_bind. intros Hl1 [l2' [Hl2 Hl2']].
- destruct (permutations_interleave_toggle x l1 l2 l2') as [? [??]]; eauto.
- Qed.
-
- Lemma permutations_Permutation (l l' : list A) :
- l' ∈ permutations l ↔ Permutation l l'.
- Proof.
- split.
- * revert l'. induction l; simpl; intros l''.
- + rewrite elem_of_list_singleton.
- intros. subst. constructor.
- + rewrite elem_of_list_bind. intros [l' [Hl'' ?]].
- rewrite (interleave_Permutation _ _ _ Hl'').
- constructor; auto.
- * induction 1; eauto using permutations_refl,
- permutations_skip, permutations_swap, permutations_trans.
- Qed.
-
- Global Instance Permutation_dec `{∀ x y : A, Decision (x = y)}
- (l1 l2 : list A) : Decision (Permutation l1 l2).
- Proof.
- refine (cast_if (decide (l2 ∈ permutations l1)));
- by rewrite <-permutations_Permutation.
- Defined.
-End permutations.
+(** * Relection over lists *)
+(** We define a simple data structure [rlist] to capture a syntactic
+representation of lists consisting of constants, applications and the nil list.
+Note that we represent [(x ::)] as [rapp (rnode [x])]. For now, we abstract
+over the type of constants, but later we use [nat]s and a list representing
+a corresponding environment. *)
+Inductive rlist (A : Type) :=
+ | rnil : rlist A
+ | rnode : A → rlist A
+ | rapp : rlist A → rlist A → rlist A.
+Arguments rnil {_}.
+Arguments rnode {_} _.
+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
+ end.
-(** * Set operations on lists *)
-Section list_set_operations.
- Context {A} {dec : ∀ x y : A, Decision (x = y)}.
+Notation env A := (list (list A)) (only parsing).
+Definition eval {A} (E : env A) : rlist nat → list A :=
+ fix go t :=
+ match t with
+ | rnil => []
+ | rnode i => from_option [] (E !! i)
+ | rapp t1 t2 => go t1 ++ go t2
+ end.
- Fixpoint list_difference (l k : list A) : list A :=
- match l with
- | [] => []
- | x :: l =>
- if decide_rel (∈) x k
- then list_difference l k
- else x :: list_difference l k
- end.
- Lemma elem_of_list_difference l k x :
- x ∈ list_difference l k ↔ x ∈ l ∧ x ∉ k.
- Proof.
- split; induction l; simpl; try case_decide;
- rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
- Qed.
- Lemma list_difference_nodup l k :
- NoDup l → NoDup (list_difference l k).
- Proof.
- induction 1; simpl; try case_decide.
- * constructor.
+(** A simple quoting mechanism using type classes. [QuoteLookup E1 E2 x i]
+means: starting in environment [E1], look up the index [i] corresponding to the
+constant [x]. In case [x] has a corresponding index [i] in [E1], the original
+environment is given back as [E2]. Otherwise, the environment [E2] is extended
+with a binding [i] for [x]. *)
+Section quote_lookup.
+ Context {A : Type}.
+ Class QuoteLookup (E1 E2 : list A) (x : A) (i : nat) := {}.
+ Global Instance quote_lookup_here E x : QuoteLookup (x :: E) (x :: E) x 0.
+ Global Instance quote_lookup_end x : QuoteLookup [] [x] x 0.
+ Global Instance quote_lookup_further E1 E2 x i y :
+ QuoteLookup E1 E2 x i → QuoteLookup (y :: E1) (y :: E2) x (S i) | 1000.
+End quote_lookup.
+
+Section quote.
+ Context {A : Type}.
+ Class Quote (E1 E2 : env A) (l : list A) (t : rlist nat) := {}.
+ Global Instance quote_nil: Quote E1 E1 [] rnil.
+ Global Instance quote_node E1 E2 l i:
+ QuoteLookup E1 E2 l i → Quote E1 E2 l (rnode i) | 1000.
+ Global Instance quote_cons E1 E2 E3 x l i t :
+ QuoteLookup E1 E2 [x] i →
+ Quote E2 E3 l t → Quote E1 E3 (x :: l) (rapp (rnode i) t).
+ Global Instance quote_app E1 E2 E3 l1 l2 t1 t2 :
+ Quote E1 E2 l1 t1 → Quote E2 E3 l2 t2 → Quote E1 E3 (l1 ++ l2) (rapp t1 t2).
+End quote.
+
+Section eval.
+ Context {A} (E : env A).
+
+ Lemma eval_alt t : eval E t = to_list t ≫= from_option [] ∘ (E !!).
+ Proof.
+ induction t; simpl.
* done.
- * constructor. rewrite elem_of_list_difference; intuition. done.
- Qed.
+ * by rewrite (right_id_L [] (++)).
+ * rewrite bind_app. by f_equal.
+ Qed.
+ Lemma eval_eq t1 t2 : to_list t1 = to_list t2 → eval E t1 = eval E t2.
+ Proof. intros Ht. by rewrite !eval_alt, Ht. Qed.
+ Lemma eval_Permutation t1 t2 :
+ to_list t1 ≡ₚ to_list t2 → eval E t1 ≡ₚ eval E t2.
+ Proof. intros Ht. by rewrite !eval_alt, Ht. Qed.
+ Lemma eval_contains t1 t2 :
+ to_list t1 `contains` to_list t2 → eval E t1 `contains` eval E t2.
+ Proof. intros Ht. by rewrite !eval_alt, Ht. Qed.
+End eval.
+End rlist.
- Fixpoint list_intersection (l k : list A) : list A :=
- match l with
- | [] => []
- | x :: l =>
- if decide_rel (∈) x k
- then x :: list_intersection l k
- else list_intersection l k
- end.
- Lemma elem_of_list_intersection l k x :
- x ∈ list_intersection l k ↔ x ∈ l ∧ x ∈ k.
- Proof.
- split; induction l; simpl; repeat case_decide;
- rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
- Qed.
- Lemma list_intersection_nodup l k :
- NoDup l → NoDup (list_intersection l k).
- Proof.
- induction 1; simpl; try case_decide.
- * constructor.
- * constructor. rewrite elem_of_list_intersection; intuition. done.
- * done.
- Qed.
+(** * Tactics *)
+Ltac quote_Permutation :=
+ match goal with
+ | |- ?l1 ≡ₚ ?l2 =>
+ match type of (_ : rlist.Quote [] _ l1 _) with rlist.Quote _ ?E2 _ ?t1 =>
+ match type of (_ : rlist.Quote E2 _ l2 _) with rlist.Quote _ ?E3 _ ?t2 =>
+ change (rlist.eval E3 t1 ≡ₚ rlist.eval E3 t2)
+ end end
+ end.
+Ltac solve_Permutation :=
+ quote_Permutation; apply rlist.eval_Permutation;
+ apply (bool_decide_unpack _); by vm_compute.
- Definition list_intersection_with (f : A → A → option A) :
- list A → list A → list A :=
- fix go l k :=
- match l with
- | [] => []
- | x :: l => foldr (λ y,
- match f x y with None => id | Some z => (z ::) end) (go l k) k
- end.
- 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.
- + generalize (list_intersection_with f l k).
- induction Hx2; simpl; [by rewrite Hx; left |].
- case_match; simpl; try setoid_rewrite elem_of_cons; auto.
- + generalize (IH Hx). clear Hx IH Hx2.
- generalize (list_intersection_with f l k).
- induction k; simpl; intros; [done |].
- case_match; simpl; rewrite ?elem_of_cons; auto.
- Qed.
-End list_set_operations.
+Ltac quote_contains :=
+ match goal with
+ | |- ?l1 `contains` ?l2 =>
+ match type of (_ : rlist.Quote [] _ l1 _) with rlist.Quote _ ?E2 _ ?t1 =>
+ match type of (_ : rlist.Quote E2 _ l2 _) with rlist.Quote _ ?E3 _ ?t2 =>
+ change (rlist.eval E3 t1 `contains` rlist.eval E3 t2)
+ end end
+ end.
+Ltac solve_contains :=
+ quote_contains; apply rlist.eval_contains;
+ apply (bool_decide_unpack _); by vm_compute.
-(** * Tactics *)
Ltac decompose_elem_of_list := repeat
match goal with
| H : ?x ∈ [] |- _ => by destruct (not_elem_of_nil x)
@@ -2618,25 +2682,22 @@ Ltac simplify_list_fmap_equality := repeat
| H : _ <$> _ = [] |- _ => apply fmap_nil_inv in H
| H : [] = _ <$> _ |- _ => symmetry in H; apply fmap_nil_inv in H
| H : _ <$> _ = _ :: _ |- _ =>
- apply fmap_cons_inv in H; destruct H as (?&?&?&?&?)
+ apply fmap_cons_inv in H; destruct H as (?&?&?&?&?)
| H : _ :: _ = _ <$> _ |- _ => symmetry in H
| H : _ <$> _ = _ ++ _ |- _ =>
- apply fmap_app_inv in H; destruct H as (?&?&?&?&?)
+ apply fmap_app_inv in H; destruct H as (?&?&?&?&?)
| H : _ ++ _ = _ <$> _ |- _ => symmetry in H
end.
-
Ltac simplify_zip_equality := repeat
match goal with
| _ => progress simplify_equality
- | H : zip_with _ _ _ = [] |- _ =>
- apply zip_with_nil_inv in H; destruct H
- | H : [] = zip_with _ _ _ |- _ =>
- symmetry in H
+ | H : zip_with _ _ _ = [] |- _ => apply zip_with_nil_inv in H; destruct H
+ | H : [] = zip_with _ _ _ |- _ => symmetry in H
| H : zip_with _ _ _ = _ :: _ |- _ =>
apply zip_with_cons_inv in H; destruct H as (?&?&?&?&?&?&?&?)
| H : _ :: _ = zip_with _ _ _ |- _ => symmetry in H
| H : zip_with _ _ _ = _ ++ _ |- _ =>
- apply zip_with_app_inv in H; destruct H as (?&?&?&?&?&?&?&?)
+ apply zip_with_app_inv in H; destruct H as (?&?&?&?&?&?&?&?)
| H : _ ++ _ = zip_with _ _ _ |- _ => symmetry in H
end.
@@ -2652,33 +2713,31 @@ Ltac decompose_Forall_hyps := repeat
| H : Forall2 _ [] ?l |- _ => apply Forall2_nil_inv_l in H; subst l
| H : Forall2 _ ?l [] |- _ => apply Forall2_nil_inv_r in H; subst l
| H : Forall2 _ (_ :: _) (_ :: _) |- _ =>
- apply Forall2_cons_inv in H; destruct H
+ apply Forall2_cons_inv in H; destruct H
| H : Forall2 _ (_ :: _) ?l |- _ =>
- apply Forall2_cons_inv_l in H; destruct H as (? & ? & ? & ? & ?); subst l
+ apply Forall2_cons_inv_l in H; destruct H as (? & ? & ? & ? & ?); subst l
| H : Forall2 _ ?l (_ :: _) |- _ =>
apply Forall2_cons_inv_r in H; destruct H as (? & ? & ? & ? & ?); subst l
| H : Forall2 _ (_ ++ _) (_ ++ _) |- _ =>
- destruct (Forall2_app_inv _ _ _ _ _ H); [eauto using Forall2_same_length |]
+ 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
+ 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_r in H; destruct H as (? & ? & ? & ? & ?); subst l
| 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
- | _ =>
+ assert (P x) as E by (apply (Forall_lookup_1 P _ _ _ H H1)); lazy beta in E
+ | H : Forall2 ?P ?l1 ?l2 |- _ =>
lazymatch goal with
- | H : Forall2 ?P ?l1 ?l2, H1 : ?l1 !! ?i = Some ?x,
- H2 : ?l2 !! ?i = Some ?y |- _ =>
+ | 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));
- lazy beta in E
- | H : Forall2 ?P ?l1 _, H1 : ?l1 !! _ = Some ?x |- _ =>
+ lazy beta in E
+ | H1 : l1 !! _ = Some ?x |- _ =>
destruct (Forall2_lookup_l P _ _ _ _ H H1) as (?&?&?)
- | H : Forall2 ?P _ ?l2, H2 : ?l2 !! _ = Some ?y |- _ =>
+ | H2 : l2 !! _ = Some ?y |- _ =>
destruct (Forall2_lookup_r P _ _ _ _ H H2) as (?&?&?)
end
end.
@@ -2699,8 +2758,7 @@ Ltac decompose_Forall := repeat
| |- Forall2 _ _ (_ <$> _) => apply Forall2_fmap_r
| _ => progress decompose_Forall_hyps
| |- Forall _ _ =>
- apply Forall_lookup_2;
- intros ???; progress decompose_Forall_hyps
+ apply Forall_lookup_2; intros ???; progress decompose_Forall_hyps
| |- Forall2 _ _ _ =>
apply Forall2_lookup_2; [by eauto using Forall2_same_length|];
intros ?????; progress decompose_Forall_hyps
@@ -2711,10 +2769,9 @@ tautologies, and simplifies [suffix_of] hypotheses involving [(::)] and
[(++)]. *)
Ltac simplify_suffix_of := repeat
match goal with
- | H : suffix_of (_ :: _) _ |- _ =>
- destruct (suffix_of_cons_not _ _ H)
- | H : suffix_of (_ :: _) [] |- _ =>
- apply suffix_of_nil_inv in H
+ | H : suffix_of (_ :: _) _ |- _ => destruct (suffix_of_cons_not _ _ H)
+ | H : suffix_of (_ :: _) [] |- _ => apply suffix_of_nil_inv in H
+ | H : suffix_of (_ ++ _) (_ ++ _) |- _ => apply suffix_of_app_inv in H
| H : suffix_of (_ :: _) (_ :: _) |- _ =>
destruct (suffix_of_cons_inv _ _ _ _ H); clear H
| H : suffix_of ?x ?x |- _ => clear H
@@ -2726,7 +2783,7 @@ Ltac simplify_suffix_of := repeat
(** The [solve_suffix_of] tactic tries to solve goals involving [suffix_of]. It
uses [simplify_suffix_of] to simplify hypotheses and tries to solve [suffix_of]
conclusions. This tactic either fails or proves the goal. *)
-Ltac solve_suffix_of := solve [intuition (repeat
+Ltac solve_suffix_of := by intuition (repeat
match goal with
| _ => done
| _ => progress simplify_suffix_of
@@ -2735,6 +2792,6 @@ Ltac solve_suffix_of := solve [intuition (repeat
| |- suffix_of _ (_ :: _) => apply suffix_of_cons_r
| |- suffix_of _ (_ ++ _) => apply suffix_of_app_r
| H : suffix_of _ _ → False |- _ => destruct H
- end)].
+ end).
Hint Extern 0 (PropHolds (suffix_of _ _)) =>
unfold PropHolds; solve_suffix_of : typeclass_instances.
diff --git a/theories/listset.v b/theories/listset.v
index 7738d9e9..6592895b 100644
--- a/theories/listset.v
+++ b/theories/listset.v
@@ -4,25 +4,18 @@
removed. This implementation forms a monad. *)
Require Export base decidable collections list.
-Record listset A := Listset {
- listset_car: list A
-}.
+Record listset A := Listset { listset_car: list A }.
Arguments listset_car {_} _.
Arguments Listset {_} _.
Section listset.
Context {A : Type}.
-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_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.
+ match l, k with Listset l', Listset k' => Listset (l' ++ k') end.
Global Instance: SimpleCollection A (listset A).
Proof.
@@ -47,9 +40,7 @@ Instance listset_intersection_with: IntersectionWith A (listset A) := λ f l k,
| Listset l', Listset k' => Listset (list_intersection_with f l' k')
end.
Instance listset_filter: Filter A (listset A) := λ P _ l,
- match l with
- | Listset l' => Listset (filter P l')
- end.
+ match l with Listset l' => Listset (filter P l') end.
Instance: Collection A (listset A).
Proof.
@@ -59,8 +50,7 @@ Proof.
* intros [?] [?]. apply elem_of_list_difference.
Qed.
-Instance listset_elems: Elements A (listset A) :=
- remove_dups ∘ listset_car.
+Instance listset_elems: Elements A (listset A) := remove_dups ∘ listset_car.
Global Instance: FinCollection A (listset A).
Proof.
@@ -100,16 +90,11 @@ Hint Extern 1 (Elements _ (listset _)) =>
Hint Extern 1 (Filter _ (listset _)) =>
eapply @listset_filter : typeclass_instances.
-Instance listset_ret: MRet listset := λ A x,
- {[ x ]}.
+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.
+ match l with Listset l' => Listset (f <$> l') end.
Instance listset_bind: MBind listset := λ A B f l,
- match l with
- | Listset l' => Listset (mbind (listset_car ∘ f) l')
- end.
+ match l with Listset l' => Listset (mbind (listset_car ∘ f) l') end.
Instance listset_join: MJoin listset := λ A, mbind id.
Instance: CollectionMonad listset.
@@ -119,7 +104,6 @@ Proof.
* intros ??? [?] ?. apply elem_of_list_bind.
* intros. apply elem_of_list_ret.
* intros ??? [?]. apply elem_of_list_fmap.
- * intros ? [?] ?.
- unfold mjoin, listset_join, elem_of, listset_elem_of.
+ * intros ? [?] ?. unfold mjoin, listset_join, elem_of, listset_elem_of.
simpl. by rewrite elem_of_list_bind.
Qed.
diff --git a/theories/listset_nodup.v b/theories/listset_nodup.v
index 86b91d5b..42c15949 100644
--- a/theories/listset_nodup.v
+++ b/theories/listset_nodup.v
@@ -19,10 +19,8 @@ Context {A : Type} `{∀ x y : A, Decision (x = y)}.
Notation C := (listset_nodup A).
Notation LS := ListsetNoDup.
-Instance listset_nodup_elem_of: ElemOf A C := λ x l,
- x ∈ listset_nodup_car l.
-Instance listset_nodup_empty: Empty C :=
- LS [] (@NoDup_nil_2 _).
+Instance listset_nodup_elem_of: ElemOf A C := λ x l, x ∈ listset_nodup_car l.
+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,
@@ -85,8 +83,7 @@ Proof.
* apply _.
* intros. unfold intersection_with, listset_nodup_intersection_with,
elem_of, listset_nodup_elem_of. simpl.
- rewrite elem_of_remove_dups.
- by apply elem_of_list_intersection_with.
+ rewrite elem_of_remove_dups. by apply elem_of_list_intersection_with.
* intros. apply elem_of_list_filter.
Qed.
End list_collection.
diff --git a/theories/mapset.v b/theories/mapset.v
index 6c2bd438..21e2f7b6 100644
--- a/theories/mapset.v
+++ b/theories/mapset.v
@@ -3,12 +3,9 @@
(** This files gives an implementation of finite sets using finite maps with
elements of the unit type. Since maps enjoy extensional equality, the
constructed finite sets do so as well. *)
-
Require Export fin_map_dom.
-Record mapset (M : Type → Type) := Mapset {
- mapset_car: M unit
-}.
+Record mapset (M : Type → Type) := Mapset { mapset_car: M unit }.
Arguments Mapset {_} _.
Arguments mapset_car {_} _.
@@ -17,46 +14,33 @@ Context `{FinMap K M}.
Instance mapset_elem_of: ElemOf K (mapset M) := λ x X,
mapset_car X !! x = Some ().
-Instance mapset_empty: Empty (mapset M) :=
- Mapset ∅.
-Instance mapset_singleton: Singleton K (mapset M) := λ x,
- Mapset {[ (x,()) ]}.
+Instance mapset_empty: Empty (mapset M) := Mapset ∅.
+Instance mapset_singleton: Singleton K (mapset M) := λ x, Mapset {[ (x,()) ]}.
Instance mapset_union: Union (mapset M) := λ X1 X2,
- match X1, X2 with
- | Mapset m1, Mapset m2 => Mapset (m1 ∪ m2)
- end.
+ match X1, X2 with Mapset m1, Mapset m2 => Mapset (m1 ∪ m2) end.
Instance mapset_intersection: Intersection (mapset M) := λ X1 X2,
- match X1, X2 with
- | Mapset m1, Mapset m2 => Mapset (m1 ∩ m2)
- end.
+ match X1, X2 with Mapset m1, Mapset m2 => Mapset (m1 ∩ m2) end.
Instance mapset_difference: Difference (mapset M) := λ X1 X2,
- match X1, X2 with
- | Mapset m1, Mapset m2 => Mapset (m1 ∖ m2)
- end.
+ match X1, X2 with Mapset m1, Mapset m2 => Mapset (m1 ∖ m2) end.
Instance mapset_elems: Elements K (mapset M) := λ X,
- match X with
- | Mapset m => fst <$> map_to_list m
- end.
+ match X with Mapset m => fst <$> map_to_list m end.
Lemma mapset_eq (X1 X2 : mapset M) : X1 = X2 ↔ ∀ x, x ∈ X1 ↔ x ∈ X2.
Proof.
split.
* intros. by subst.
* destruct X1 as [m1], X2 as [m2]. simpl. intros E.
- f_equal. apply map_eq. intros i.
- apply option_eq. intros []. by apply E.
+ f_equal. apply map_eq. intros i. apply option_eq. intros []. by apply E.
Qed.
Global Instance mapset_eq_dec `{∀ m1 m2 : M unit, Decision (m1 = m2)}
(X1 X2 : mapset M) : Decision (X1 = X2) | 1.
Proof.
refine
- match X1, X2 with
- | Mapset m1, Mapset m2 => cast_if (decide (m1 = m2))
- end; abstract congruence.
+ match X1, X2 with Mapset m1, Mapset m2 => cast_if (decide (m1 = m2)) end;
+ abstract congruence.
Defined.
-Global Instance mapset_elem_of_dec x (X : mapset M) :
- Decision (x ∈ X) | 1.
+Global Instance mapset_elem_of_dec x (X : mapset M) : Decision (x ∈ X) | 1.
Proof. solve_decision. Defined.
Instance: Collection K (mapset M).
@@ -78,11 +62,8 @@ Proof.
destruct (m2 !! x) as [[]|]; intuition congruence.
Qed.
-Global Instance: PartialOrder (mapset M).
-Proof.
- split; try apply _.
- intros ????. apply mapset_eq. intuition.
-Qed.
+Global Instance: PartialOrder (@subseteq (mapset M) _).
+Proof. split; try apply _. intros ????. apply mapset_eq. intuition. Qed.
Global Instance: FinCollection K (mapset M).
Proof.
@@ -123,14 +104,12 @@ Lemma elem_of_mapset_dom_with `(f : A → bool) m i :
i ∈ mapset_dom_with f m ↔ ∃ x, m !! i = Some x ∧ f x.
Proof.
unfold mapset_dom_with, elem_of, mapset_elem_of.
- simpl. rewrite lookup_merge by done.
- destruct (m !! i) as [a|].
+ simpl. rewrite lookup_merge by done. destruct (m !! i) as [a|].
* destruct (Is_true_reflect (f a)); naive_solver.
* naive_solver.
Qed.
-Instance mapset_dom {A} : Dom (M A) (mapset M) :=
- mapset_dom_with (λ _, true).
+Instance mapset_dom {A} : Dom (M A) (mapset M) := mapset_dom_with (λ _, true).
Instance mapset_dom_spec: FinMapDom K M (mapset M).
Proof.
split; try apply _. intros. unfold dom, mapset_dom.
diff --git a/theories/natmap.v b/theories/natmap.v
index de543be9..40a65f6f 100644
--- a/theories/natmap.v
+++ b/theories/natmap.v
@@ -1,15 +1,13 @@
(* Copyright (c) 2012-2013, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
-(** This files implements finite maps whose keys range over Coq's data type of
-unary natural numbers [nat]. *)
-Require Import fin_maps.
+(** This files implements a type [natmap A] of finite maps whose keys range
+over Coq's data type of unary natural numbers [nat]. The implementation equips
+a list with a proof of canonicity. *)
+Require Import fin_maps mapset.
Notation natmap_raw A := (list (option A)).
Definition natmap_wf {A} (l : natmap_raw A) :=
- match last l with
- | None => True
- | Some x => is_Some x
- end.
+ match last l with None => True | Some x => is_Some x end.
Instance natmap_wf_pi {A} (l : natmap_raw A) : ProofIrrel (natmap_wf l).
Proof. unfold natmap_wf. case_match; apply _. Qed.
@@ -31,7 +29,7 @@ Definition natmap (A : Type) : Type := sig (@natmap_wf A).
Instance natmap_empty {A} : Empty (natmap A) := [] ↾ I.
Instance natmap_lookup {A} : Lookup nat A (natmap A) :=
- λ i m, mjoin (`m !! i).
+ λ 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
@@ -91,7 +89,7 @@ Proof.
eauto using natmap_singleton_wf, natmap_cons_canon_wf, natmap_wf_inv.
Qed.
Instance natmap_alter {A} : PartialAlter nat A (natmap A) := λ f i m,
- natmap_alter_raw f i (`m)↾natmap_alter_wf _ _ _ (proj2_sig m).
+ match m with exist l Hl => _↾natmap_alter_wf f i l Hl end.
Lemma natmap_lookup_alter_raw {A} (f : option A → option A) i l :
mjoin (natmap_alter_raw f i l !! i) = f (mjoin (l !! i)).
Proof.
@@ -138,15 +136,18 @@ Proof.
revert l2. induction l1; intros [|??]; simpl;
eauto using natmap_merge_aux_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 →
+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.
Qed.
Instance natmap_merge: Merge natmap := λ A B C f m1 m2,
- natmap_merge_raw f _ _ ↾ natmap_merge_wf _ _ _ (proj2_sig m1) (proj2_sig m2).
+ match m1, m2 with
+ | exist l1 Hl1, exist l2 Hl2 =>
+ natmap_merge_raw f _ _ ↾ natmap_merge_wf _ _ _ Hl1 Hl2
+ end.
Fixpoint natmap_to_list_raw {A} (i : nat) (l : natmap_raw A) : list (nat * A) :=
match l with
@@ -186,7 +187,7 @@ Proof.
rewrite natmap_elem_of_to_list_raw_aux. intros (?&?&?). lia.
Qed.
Instance natmap_to_list {A} : FinMapToList nat A (natmap A) := λ m,
- natmap_to_list_raw 0 (`m).
+ match m with exist l _ => natmap_to_list_raw 0 l end.
Definition natmap_map_raw {A B} (f : A → B) : natmap_raw A → natmap_raw B :=
fmap (fmap f).
@@ -199,7 +200,9 @@ Proof.
Qed.
Lemma natmap_lookup_map_raw {A B} (f : A → B) i l :
mjoin (natmap_map_raw f l !! i) = f <$> mjoin (l !! i).
-Proof. unfold natmap_map_raw. rewrite list_lookup_fmap. by destruct (l !! i). Qed.
+Proof.
+ unfold natmap_map_raw. rewrite list_lookup_fmap. by destruct (l !! i).
+Qed.
Instance natmap_map: FMap natmap := λ A B f m,
natmap_map_raw f _ ↾ natmap_map_wf _ _ (proj2_sig m).
@@ -228,3 +231,37 @@ Proof.
* intros ? [??] ??. by apply natmap_elem_of_to_list_raw.
* intros ????? [??] [??] ?. by apply natmap_lookup_merge_raw.
Qed.
+
+(** Finally, we can construct sets of [nat]s satisfying extensional equality. *)
+Notation natset := (mapset natmap).
+Instance natmap_dom {A} : Dom (natmap A) natset := mapset_dom.
+Instance: FinMapDom nat natmap natset := mapset_dom_spec.
+
+(** A [natmap A] forms a stack with elements of type [A] and possible holes *)
+Definition natmap_push {A} (o : option A) (m : natmap A) : natmap A :=
+ match m with exist l Hl => _↾natmap_cons_canon_wf o l Hl end.
+
+Definition natmap_pop_raw {A} (l : natmap_raw A) : natmap_raw A := tail l.
+Lemma natmap_pop_wf {A} (l : natmap_raw A) :
+ natmap_wf l → natmap_wf (natmap_pop_raw l).
+Proof. destruct l; simpl; eauto using natmap_wf_inv. Qed.
+Definition natmap_pop {A} (m : natmap A) : natmap A :=
+ match m with exist l Hl => _↾natmap_pop_wf _ Hl end.
+
+Lemma lookup_natmap_push_O {A} o (m : natmap A) : natmap_push o m !! 0 = o.
+Proof. by destruct o, m as [[|??]]. Qed.
+Lemma lookup_natmap_push_S {A} o (m : natmap A) i :
+ natmap_push o m !! S i = m !! i.
+Proof. by destruct o, m as [[|??]]. Qed.
+Lemma lookup_natmap_pop {A} (m : natmap A) i : natmap_pop m !! i = m !! S i.
+Proof. by destruct m as [[|??]]. Qed.
+
+Lemma natmap_push_pop {A} (m : natmap A) :
+ natmap_push (m !! 0) (natmap_pop m) = m.
+Proof.
+ apply map_eq. intros i. destruct i.
+ * by rewrite lookup_natmap_push_O.
+ * by rewrite lookup_natmap_push_S, lookup_natmap_pop.
+Qed.
+Lemma natmap_pop_push {A} o (m : natmap A) : natmap_pop (natmap_push o m) = m.
+Proof. apply (sig_eq_pi _). by destruct o, m as [[|??]]. Qed.
diff --git a/theories/nmap.v b/theories/nmap.v
index a2abeeaf..4a79107e 100644
--- a/theories/nmap.v
+++ b/theories/nmap.v
@@ -2,7 +2,7 @@
(* This file is distributed under the terms of the BSD license. *)
(** This files extends the implementation of finite over [positive] to finite
maps whose keys range over Coq's data type of binary naturals [N]. *)
-Require Import pmap.
+Require Import pmap mapset.
Require Export prelude fin_maps.
Local Open Scope N_scope.
@@ -17,8 +17,7 @@ Instance Nmap_eq_dec `{∀ x y : A, Decision (x = y)} (t1 t2 : Nmap A) :
Proof.
refine
match t1, t2 with
- | NMap x t1, NMap y t2 =>
- cast_if_and (decide (x = y)) (decide (t1 = t2))
+ | NMap x t1, NMap y t2 => cast_if_and (decide (x = y)) (decide (t1 = t2))
end; abstract congruence.
Defined.
@@ -35,17 +34,14 @@ 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 => option_case (λ x, [(0,x)]) [] o ++
- (fst_map Npos <$> map_to_list t)
+ | NMap o t => default [] o (λ x, [(0,x)]) ++ (fst_map Npos <$> map_to_list 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 (fmap f o) (fmap f t) end.
Instance: FinMap N Nmap.
Proof.
@@ -54,9 +50,8 @@ Proof.
+ 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.
@@ -80,7 +75,11 @@ 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 ? [o1 t1] [o2 t2] [|?]; simpl; [done|].
+ apply (lookup_merge f t1 t2).
Qed.
+
+(** Finally, we can construct sets of [N]s satisfying extensional equality. *)
+Notation Nset := (mapset Nmap).
+Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom.
+Instance: FinMapDom N Nmap Nset := mapset_dom_spec.
diff --git a/theories/numbers.v b/theories/numbers.v
index 2315710c..d0e2c74b 100644
--- a/theories/numbers.v
+++ b/theories/numbers.v
@@ -3,7 +3,7 @@
(** This file collects some trivial facts on the Coq types [nat] and [N] for
natural numbers, and the type [Z] for integers. It also declares some useful
notations. *)
-Require Export PArith NArith ZArith.
+Require Export Eqdep PArith NArith ZArith.
Require Import Qcanon.
Require Export base decidable.
Open Scope nat_scope.
@@ -32,6 +32,21 @@ Instance nat_le_dec: ∀ x y : nat, Decision (x ≤ y) := le_dec.
Instance nat_lt_dec: ∀ x y : nat, Decision (x < y) := lt_dec.
Instance nat_inhabited: Inhabited nat := populate 0%nat.
+Instance nat_le_pi: ∀ x y : nat, ProofIrrel (x ≤ y).
+Proof.
+ assert (∀ x y (p : x ≤ y) y' (q : x ≤ y'),
+ y = y' → eq_dep nat (le x) y p y' q) as aux.
+ { fix 3. intros x ? [|y p] ? [|y' q].
+ * done.
+ * clear nat_le_pi. omega.
+ * clear nat_le_pi. omega.
+ * injection 1. intros Hy. by case (nat_le_pi x y p y' q Hy). }
+ intros x y p q.
+ by apply (eq_dep_eq_dec (λ x y, decide (x = y))), aux.
+Qed.
+Instance nat_lt_pi: ∀ x y : nat, ProofIrrel (x < y).
+Proof. apply _. Qed.
+
Lemma lt_n_SS n : n < S (S n).
Proof. auto with arith. Qed.
Lemma lt_n_SSS n : n < S (S (S n)).
@@ -45,6 +60,14 @@ Definition sum_list_with {A} (f : A → nat) : list A → nat :=
end.
Notation sum_list := (sum_list_with id).
+Lemma mult_split_eq n x1 x2 y1 y2 :
+ x2 < n → y2 < n → x1 * n + x2 = y1 * n + y2 → x1 = y1 ∧ x2 = y2.
+Proof.
+ intros Hx2 Hy2 E.
+ cut (x1 = y1); [intros; subst;lia |].
+ revert y1 E. induction x1; simpl; intros [|?]; simpl; auto with lia.
+Qed.
+
(** * Notations and properties of [positive] *)
Open Scope positive_scope.
@@ -185,6 +208,16 @@ Arguments Z.modulo _ _ : simpl never.
Arguments Z.quot _ _ : simpl never.
Arguments Z.rem _ _ : simpl never.
+Lemma Zmod_pos a b : (0 < b)%Z → (0 ≤ a `mod` b)%Z.
+Proof. apply Z.mod_pos_bound. Qed.
+
+Hint Resolve Z.lt_le_incl : zpos.
+Hint Resolve Z.add_nonneg_pos Z.add_pos_nonneg Z.add_nonneg_nonneg : zpos.
+Hint Resolve Z.mul_nonneg_nonneg Z.mul_pos_pos : zpos.
+Hint Resolve Z.pow_pos_nonneg : zpos.
+Hint Resolve Zmod_pos Z.div_pos : zpos.
+Hint Extern 1000 => lia : zpos.
+
(** * Notations and properties of [Qc] *)
Notation "2" := (1+1)%Qc : Qc_scope.
Infix "≤" := Qcle : Qc_scope.
@@ -213,8 +246,7 @@ Proof. split; auto using Qcle_not_lt, Qcnot_lt_le. Qed.
Lemma Qclt_nge (x y : Qc) : (x < y ↔ ¬y ≤ x)%Qc.
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)%Qc.
+Lemma Qcplus_le_mono_l (x y z : Qc) : (x ≤ y ↔ z + x ≤ z + y)%Qc.
Proof.
split; intros.
* by apply Qcplus_le_compat.
@@ -222,17 +254,20 @@ Proof.
replace y with ((0 - z) + (z + y))%Qc by ring.
by apply Qcplus_le_compat.
Qed.
-Lemma Qcplus_le_mono_r (x y z : Qc) :
- (x ≤ y ↔ x + z ≤ y + z)%Qc.
+Lemma Qcplus_le_mono_r (x y z : Qc) : (x ≤ y ↔ x + z ≤ y + z)%Qc.
Proof. rewrite !(Qcplus_comm _ z). apply Qcplus_le_mono_l. Qed.
-Lemma Qcplus_lt_mono_l (x y z : Qc) :
- (x < y ↔ z + x < z + y)%Qc.
+Lemma Qcplus_lt_mono_l (x y z : Qc) : (x < y ↔ z + x < z + y)%Qc.
Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_l. Qed.
-Lemma Qcplus_lt_mono_r (x y z : Qc) :
- (x < y ↔ x + z < y + z)%Qc.
+Lemma Qcplus_lt_mono_r (x y z : Qc) : (x < y ↔ x + z < y + z)%Qc.
Proof. by rewrite !Qclt_nge, <-Qcplus_le_mono_r. Qed.
(** * Conversions *)
+Lemma Z_to_nat_nonpos x : (x ≤ 0)%Z → Z.to_nat x = 0.
+Proof.
+ destruct x; simpl; auto using Z2Nat.inj_neg.
+ by intros [].
+Qed.
+
(** The function [Z_to_option_N] converts an integer [x] into a natural number
by giving [None] in case [x] is negative. *)
Definition Z_to_option_N (x : Z) : option N :=
@@ -277,8 +312,7 @@ Proof.
rewrite Z_to_option_nat_Some.
split; intros [??]; subst; auto using Nat2Z.id, Z2Nat.id, eq_sym.
Qed.
-Lemma Z_to_option_of_nat x :
- Z_to_option_nat (Z.of_nat x) = Some x.
+Lemma Z_to_option_of_nat x : Z_to_option_nat (Z.of_nat x) = Some x.
Proof. apply Z_to_option_nat_Some_alt. auto using Nat2Z.is_nonneg. Qed.
(** The function [Z_of_sumbool] converts a sumbool [P] into an integer
@@ -308,11 +342,9 @@ Proof.
Qed.
(* We have [x `mod` 0 = 0] on [nat], and [x `mod` 0 = x] on [N]. *)
Lemma N_to_nat_mod x y :
- y ≠0%N →
- N.to_nat (x `mod` y) = N.to_nat x `mod` N.to_nat y.
+ y ≠0%N → N.to_nat (x `mod` y) = N.to_nat x `mod` N.to_nat y.
Proof.
- intros.
- apply NPeano.Nat.mod_unique with (N.to_nat (x `div` y)).
+ intros. apply NPeano.Nat.mod_unique with (N.to_nat (x `div` y)).
{ by apply N_to_nat_lt, N.mod_lt. }
rewrite (N.div_unique_exact (x * y) y x), N.div_mul by lia.
by rewrite <-N2Nat.inj_mul, <-N2Nat.inj_add, <-N.div_mod.
diff --git a/theories/option.v b/theories/option.v
index fc9d1377..8f280e90 100644
--- a/theories/option.v
+++ b/theories/option.v
@@ -16,28 +16,20 @@ Instance Some_inj {A} : Injective (=) (=) (@Some A).
Proof. congruence. Qed.
(** The non dependent elimination principle on the option type. *)
-Definition option_case {A B} (f : A → B) (b : B) (x : option A) : B :=
- match x with
- | None => b
- | Some a => f a
- end.
+Definition default {A B} (b : B) (x : option A) (f : A → B) : B :=
+ match x with None => b | Some a => f a end.
(** The [from_option] function allows us to get the value out of the option
type by specifying a default value. *)
Definition from_option {A} (a : A) (x : option A) : A :=
- match x with
- | None => a
- | Some b => b
- end.
+ match x with None => a | Some b => b end.
(** An alternative, but equivalent, definition of equality on the option
data type. This theorem is useful to prove that two options are the same. *)
Lemma option_eq {A} (x y : option A) :
x = y ↔ ∀ a, x = Some a ↔ y = Some a.
Proof.
- split.
- { intros. by subst. }
- intros E. destruct x, y.
+ split; [by intros; by subst |]. intros E. destruct x, y.
+ by apply E.
+ symmetry. by apply E.
+ by apply E.
@@ -45,24 +37,19 @@ Proof.
Qed.
Inductive is_Some {A} : option A → Prop :=
- make_is_Some x : is_Some (Some x).
+ mk_is_Some x : is_Some (Some x).
Instance is_Some_pi {A} (x : option A) : ProofIrrel (is_Some x).
Proof.
intros [?] p2. by refine
match p2 in is_Some o return
- match o with
- | Some y => (make_is_Some y =)
- | _ => λ _, False
- end p2
- with
- | make_is_Some y => _
- end.
+ match o with Some y => (mk_is_Some y =) | _ => λ _, False end p2
+ with mk_is_Some y => _ end.
Qed.
-Lemma make_is_Some_alt `(x : option A) a : x = Some a → is_Some x.
+Lemma mk_is_Some_alt `(x : option A) a : x = Some a → is_Some x.
Proof. intros. by subst. Qed.
-Hint Resolve make_is_Some_alt.
+Hint Resolve mk_is_Some_alt.
Lemma is_Some_None {A} : ¬is_Some (@None A).
Proof. by inversion 1. Qed.
Hint Resolve is_Some_None.
@@ -71,9 +58,7 @@ Lemma is_Some_alt `(x : option A) : is_Some x ↔ ∃ y, x = Some y.
Proof. split. inversion 1; eauto. intros [??]. by subst. Qed.
Ltac inv_is_Some := repeat
- match goal with
- | H : is_Some _ |- _ => inversion H; clear H; subst
- end.
+ match goal with H : is_Some _ |- _ => inversion H; clear H; subst end.
Definition is_Some_proj `{x : option A} : is_Some x → A :=
match x with
@@ -87,7 +72,7 @@ Definition Some_dec `(x : option A) : { a | x = Some a } + { x = None } :=
end.
Instance is_Some_dec `(x : option A) : Decision (is_Some x) :=
match x with
- | Some x => left (make_is_Some x)
+ | Some x => left (mk_is_Some x)
| None => right is_Some_None
end.
Instance None_dec `(x : option A) : Decision (x = None) :=
@@ -101,7 +86,7 @@ Proof. split. by destruct 2. destruct x. by intros []. done. Qed.
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.
-Lemma make_eq_Some {A} (x : option A) a :
+Lemma mk_eq_Some {A} (x : option A) a :
is_Some x → (∀ b, x = Some b → b = a) → x = Some a.
Proof. destruct 1. intros. f_equal. auto. Qed.
@@ -122,18 +107,12 @@ Instance option_eq_dec `{dec : ∀ x y : A, Decision (x = y)}
(** * Monadic operations *)
Instance option_ret: MRet option := @Some.
Instance option_bind: MBind option := λ A B f x,
- match x with
- | Some a => f a
- | None => None
- end.
+ match x with Some a => f a | None => None end.
Instance option_join: MJoin option := λ A x,
- match x with
- | Some x => x
- | None => None
- end.
+ match x with Some x => x | None => None end.
Instance option_fmap: FMap option := @option_map.
Instance option_guard: MGuard option := λ P dec A x,
- if dec then x else None.
+ match dec with left H => x H | _ => None end.
Definition mapM `{!MBind M} `{!MRet M} {A B}
(f : A → M B) : list A → M (list B) :=
@@ -153,60 +132,49 @@ Lemma fmap_None {A B} (f : A → B) (x : option A) :
f <$> x = None ↔ x = None.
Proof. unfold fmap, option_fmap. by destruct x. Qed.
-Lemma option_fmap_id {A} (x : option A) :
- id <$> x = x.
+Lemma option_fmap_id {A} (x : option A) : id <$> x = x.
Proof. by destruct x. Qed.
Lemma option_bind_assoc {A B C} (f : A → option B)
(g : B → option C) (x : option A) : (x ≫= f) ≫= g = x ≫= (mbind g ∘ f).
Proof. by destruct x; simpl. Qed.
Lemma option_bind_ext {A B} (f g : A → option B) x y :
- (∀ a, f a = g a) →
- x = y →
- x ≫= f = y ≫= g.
+ (∀ a, f a = g a) → x = y → x ≫= f = y ≫= g.
Proof. intros. destruct x, y; simplify_equality; simpl; auto. Qed.
Lemma option_bind_ext_fun {A B} (f g : A → option B) x :
- (∀ a, f a = g a) →
- x ≫= f = x ≫= g.
+ (∀ a, f a = g a) → x ≫= f = x ≫= g.
Proof. intros. by apply option_bind_ext. Qed.
Section mapM.
Context {A B : Type} (f : A → option B).
- Lemma mapM_ext (g : A → option B) l :
- (∀ x, f x = g x) → mapM f l = mapM g l.
+ Lemma mapM_ext (g : A → option B) l : (∀ x, f x = g x) → mapM f l = mapM g l.
Proof. intros Hfg. by induction l; simpl; rewrite ?Hfg, ?IHl. Qed.
Lemma Forall2_mapM_ext (g : A → option B) l k :
Forall2 (λ x y, f x = g y) l k → mapM f l = mapM g k.
- Proof.
- induction 1 as [|???? Hfg ? IH]; simpl. done. by rewrite Hfg, IH.
- Qed.
+ Proof. induction 1 as [|???? Hfg ? IH]; simpl. done. by rewrite Hfg, IH. Qed.
Lemma Forall_mapM_ext (g : A → option B) l :
Forall (λ x, f x = g x) l → mapM f l = mapM g l.
- Proof.
- induction 1 as [|?? Hfg ? IH]; simpl. done. by rewrite Hfg, IH.
- Qed.
+ 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.
+ Lemma mapM_Some_1 l k : mapM f l = Some k → Forall2 (λ x y, f x = Some y) l k.
Proof.
revert k. induction l as [|x l]; intros [|y k]; simpl; try done.
* destruct (f x); simpl; [|discriminate]. by destruct (mapM f l).
* destruct (f x) eqn:?; simpl; [|discriminate].
destruct (mapM f l); intros; simplify_equality. constructor; auto.
Qed.
- Lemma mapM_Some_2 l k :
- Forall2 (λ x y, f x = Some y) l k → mapM f l = Some k.
+ Lemma mapM_Some_2 l k : Forall2 (λ x y, f x = Some y) l k → mapM f l = Some k.
Proof.
induction 1 as [|???? Hf ? IH]; simpl; [done |].
rewrite Hf. simpl. by rewrite IH.
Qed.
- Lemma mapM_Some l k :
- mapM f l = Some k ↔ Forall2 (λ x y, f x = Some y) l k.
+ Lemma mapM_Some l k : mapM f l = Some k ↔ Forall2 (λ x y, f x = Some y) l k.
Proof. split; auto using mapM_Some_1, mapM_Some_2. Qed.
End mapM.
Tactic Notation "simplify_option_equality" "by" tactic3(tac) := repeat
match goal with
+ | _ => progress (unfold default in *)
| _ => first [progress simpl in * | progress simplify_equality]
| H : context [mbind (M:=option) (A:=?A) ?f ?o] |- _ =>
let Hx := fresh in
@@ -279,10 +247,10 @@ Tactic Notation "simplify_option_equality" "by" tactic3(tac) := repeat
rewrite Hx; clear Hx
end
| H : context C [@mguard option _ ?P ?dec _ ?x] |- _ =>
- let X := context C [ if dec then x else None ] in
+ let X := context C [ match dec with left H => x H | _ => None end ] in
change X in H; destruct_decide dec
| |- context C [@mguard option _ ?P ?dec _ ?x] =>
- let X := context C [ if dec then x else None ] in
+ let X := context C [ match dec with left H => x H | _ => None end ] in
change X; destruct_decide dec
| H1 : ?o = Some ?x, H2 : ?o = Some ?y |- _ =>
assert (y = x) by congruence; clear H2
@@ -304,14 +272,9 @@ Instance option_union_with {A} : UnionWith A (option A) := λ f x y,
| None, Some b => Some b
| None, None => None
end.
-Instance option_intersection_with {A} :
- IntersectionWith A (option A) := λ f x y,
- match x, y with
- | Some a, Some b => f a b
- | _, _ => None
- end.
-Instance option_difference_with {A} :
- DifferenceWith A (option A) := λ f x y,
+Instance option_intersection_with {A} : IntersectionWith A (option A) :=
+ λ f x y, match x, y with Some a, Some b => f a b | _, _ => None end.
+Instance option_difference_with {A} : DifferenceWith A (option A) := λ f x y,
match x, y with
| Some a, Some b => f a b
| Some a, None => Some a
diff --git a/theories/orders.v b/theories/orders.v
index b3ba0df3..7c7790de 100644
--- a/theories/orders.v
+++ b/theories/orders.v
@@ -2,7 +2,6 @@
(* This file is distributed under the terms of the BSD license. *)
(** This file collects common properties of pre-orders and semi lattices. This
theory will mainly be used for the theory on collections and finite maps. *)
-Require Import SetoidList.
Require Export base decidable tactics list.
(** * Pre-orders *)
@@ -15,9 +14,9 @@ Section preorder.
Instance preorder_equivalence: @Equivalence A (≡).
Proof.
split.
- * firstorder.
- * firstorder.
- * intros x y z; split; transitivity y; firstorder.
+ * done.
+ * by intros ?? [??].
+ * by intros x y z [??] [??]; split; transitivity y.
Qed.
Global Instance: Proper ((≡) ==> (≡) ==> iff) (⊆).
@@ -40,13 +39,13 @@ Section preorder.
Lemma subset_subseteq X Y : X ⊂ Y → X ⊆ Y.
Proof. by intros [? _]. Qed.
- Lemma subset_trans_l X Y Z : X ⊂ Y → Y ⊆ Z → X ⊂ Z.
+ Lemma subset_transitive_l X Y Z : X ⊂ Y → Y ⊆ Z → X ⊂ Z.
Proof.
intros [? HXY] ?. split.
* by transitivity Y.
* contradict HXY. by transitivity Z.
Qed.
- Lemma subset_trans_r X Y Z : X ⊆ Y → Y ⊂ Z → X ⊂ Z.
+ Lemma subset_transitive_r X Y Z : X ⊆ Y → Y ⊂ Z → X ⊂ Z.
Proof.
intros ? [? HYZ]. split.
* by transitivity Y.
@@ -57,7 +56,7 @@ Section preorder.
Proof.
split.
* firstorder.
- * eauto using subset_trans_r, subset_subseteq.
+ * eauto using subset_transitive_r, subset_subseteq.
Qed.
Global Instance: Proper ((≡) ==> (≡) ==> iff) (⊂).
Proof. unfold subset, preorder_subset. solve_proper. Qed.
@@ -98,7 +97,7 @@ Hint Extern 0 (@Equivalence _ (≡)) =>
(** * Partial orders *)
Section partialorder.
- Context `{PartialOrder A}.
+ Context `{SubsetEq A} `{!PartialOrder (⊆)}.
Global Instance: LeibnizEquiv A.
Proof.
@@ -121,26 +120,20 @@ Section bounded_join_sl.
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_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.
Proof. by apply union_least. Qed.
- Lemma union_comm_1 x y : x ∪ y ⊆ y ∪ x.
+ Lemma union_commutative_1 x y : x ∪ y ⊆ y ∪ x.
Proof. auto. Qed.
- Lemma union_assoc_1 x y z : (x ∪ y) ∪ z ⊆ x ∪ (y ∪ z).
+ Lemma union_associative_1 x y z : (x ∪ y) ∪ z ⊆ x ∪ (y ∪ z).
Proof. auto. Qed.
- Lemma union_assoc_2 x y z : x ∪ (y ∪ z) ⊆ (x ∪ y) ∪ z.
+ Lemma union_associative_2 x y z : x ∪ (y ∪ z) ⊆ (x ∪ y) ∪ z.
Proof. auto. Qed.
Global Instance union_proper: Proper ((≡) ==> (≡) ==> (≡)) (∪).
@@ -155,9 +148,9 @@ Section bounded_join_sl.
Global Instance: RightId (≡) ∅ (∪).
Proof. split; eauto. Qed.
Global Instance: Commutative (≡) (∪).
- Proof. split; apply union_comm_1. Qed.
+ Proof. split; apply union_commutative_1. Qed.
Global Instance: Associative (≡) (∪).
- Proof. split. apply union_assoc_2. apply union_assoc_1. Qed.
+ Proof. split. apply union_associative_2. apply union_associative_1. Qed.
Lemma subseteq_union X Y : X ⊆ Y ↔ X ∪ Y ≡ Y.
Proof. repeat split; eauto. intros E. rewrite <-E. auto. Qed.
@@ -169,8 +162,7 @@ Section bounded_join_sl.
Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅.
Proof. split; eauto. Qed.
- Global Instance union_list_proper:
- Proper (eqlistA (≡) ==> (≡)) union_list.
+ Global Instance union_list_proper: Proper (Forall2 (≡) ==> (≡)) union_list.
Proof.
induction 1; simpl.
* done.
@@ -189,17 +181,13 @@ Section bounded_join_sl.
* by rewrite (left_id ∅ _).
* by rewrite IH, (associative _).
Qed.
- Lemma union_list_reverse (Xs : list A) :
- ⋃ (reverse Xs) ≡ ⋃ Xs.
+ Lemma union_list_reverse (Xs : list A) : ⋃ (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) :
- Forall2 (⊆) Xs Ys →
- ⋃ Xs ⊆ ⋃ Ys.
+ Lemma union_list_preserving (Xs Ys : list A) : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
Proof. induction 1; simpl; auto using union_preserving. Qed.
Lemma empty_union X Y : X ∪ Y ≡ ∅ ↔ X ≡ ∅ ∧ Y ≡ ∅.
@@ -282,24 +270,19 @@ Section meet_sl.
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.
+ 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.
+ 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.
+ x1 ⊆ x2 → y1 ⊆ y2 → x1 ∩ y1 ⊆ x2 ∩ y2.
Proof. auto. Qed.
- Lemma intersection_comm_1 x y : x ∩ y ⊆ y ∩ x.
+ Lemma intersection_commutative_1 x y : x ∩ y ⊆ y ∩ x.
Proof. auto. Qed.
- Lemma intersection_assoc_1 x y z : (x ∩ y) ∩ z ⊆ x ∩ (y ∩ z).
+ Lemma intersection_associative_1 x y z : (x ∩ y) ∩ z ⊆ x ∩ (y ∩ z).
Proof. auto. Qed.
- Lemma intersection_assoc_2 x y z : x ∩ (y ∩ z) ⊆ (x ∩ y) ∩ z.
+ Lemma intersection_associative_2 x y z : x ∩ (y ∩ z) ⊆ (x ∩ y) ∩ z.
Proof. auto. Qed.
Global Instance: Proper ((≡) ==> (≡) ==> (≡)) (∩).
@@ -310,9 +293,11 @@ Section meet_sl.
Global Instance: Idempotent (≡) (∩).
Proof. split; eauto. Qed.
Global Instance: Commutative (≡) (∩).
- Proof. split; apply intersection_comm_1. Qed.
+ Proof. split; apply intersection_commutative_1. Qed.
Global Instance: Associative (≡) (∩).
- Proof. split. apply intersection_assoc_2. apply intersection_assoc_1. Qed.
+ Proof.
+ split. apply intersection_associative_2. apply intersection_associative_1.
+ Qed.
Lemma subseteq_intersection X Y : X ⊆ Y ↔ X ∩ Y ≡ X.
Proof. repeat split; eauto. intros E. rewrite <-E. auto. Qed.
diff --git a/theories/pmap.v b/theories/pmap.v
index 9b1ec6eb..f09b7ff9 100644
--- a/theories/pmap.v
+++ b/theories/pmap.v
@@ -7,7 +7,7 @@ trees (uncompressed Patricia trees) and guarantees logarithmic-time operations.
However, we extend Leroy's implementation by packing the trees into a Sigma
type such that canonicity of representation is ensured. This is necesarry for
Leibniz equality to become extensional. *)
-Require Import PArith.
+Require Import PArith mapset.
Require Export prelude fin_maps.
Local Open Scope positive_scope.
@@ -108,7 +108,7 @@ Lemma Pmap_wf_eq_get {A} (t1 t2 : Pmap_raw A) :
Pmap_wf t1 → Pmap_wf t2 → (∀ i, t1 !! i = t2 !! i) → t1 = t2.
Proof.
intros t1wf. revert t2.
- induction t1wf as [| ? x ? ? IHl ? IHr | l r ? IHl ? IHr Hne1 ].
+ induction t1wf as [| ? x ? ? IHl ? IHr | l r ? IHl ? IHr Hne1].
* destruct 1 as [| | ???? [?|?]]; intros Hget.
+ done.
+ discriminate (Hget 1).
@@ -125,11 +125,11 @@ Proof.
+ specialize (Hget 1). simpl in *. congruence.
* destruct 1; intros Hget.
+ destruct Hne1.
- destruct (Pmap_ne_lookup l) as [i [??]]; trivial.
- - specialize (Hget (i~0)). simpl in *. congruence.
+ - destruct (Pmap_ne_lookup l) as [i [??]]; trivial.
+ specialize (Hget (i~0)); simpl in *. congruence.
- destruct (Pmap_ne_lookup r) as [i [??]]; trivial.
- specialize (Hget (i~1)). simpl in *. congruence.
- + specialize (Hget 1). simpl in *. congruence.
+ specialize (Hget (i~1)); simpl in *. congruence.
+ + specialize (Hget 1); simpl in *. congruence.
+ f_equal.
- apply IHl; trivial. intros i. apply (Hget (i~0)).
- apply IHr; trivial. intros i. apply (Hget (i~1)).
@@ -176,8 +176,7 @@ Lemma Pnode_canon_lookup_xI `(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_xH || rewrite Pnode_canon_lookup_xO ||
rewrite Pnode_canon_lookup_xI).
Instance Ppartial_alter_raw {A} : PartialAlter positive A (Pmap_raw A) :=
@@ -262,7 +261,7 @@ Fixpoint Pto_list_raw {A} (j : positive) (t : Pmap_raw A) :
list (positive * A) :=
match t with
| Pleaf => []
- | Pnode l o r => option_case (λ x, [(Preverse j, x)]) [] o ++
+ | Pnode l o r => default [] o (λ x, [(Preverse j, x)]) ++
Pto_list_raw (j~0) l ++ Pto_list_raw (j~1) r
end%list.
@@ -273,30 +272,30 @@ Proof.
* revert j. induction t as [|? IHl [?|] ? IHr]; intros j; simpl.
+ by rewrite ?elem_of_nil.
+ rewrite elem_of_cons, !elem_of_app. intros [?|[?|?]].
- - simplify_equality. exists 1. by rewrite (left_id 1 (++))%positive.
+ - simplify_equality. exists 1. by rewrite (left_id_L 1 (++))%positive.
- destruct (IHl (j~0)) as (i' &?&?); trivial; subst.
- exists (i' ~ 0). by rewrite Preverse_xO, (associative _).
+ exists (i' ~ 0). by rewrite Preverse_xO, (associative_L _).
- destruct (IHr (j~1)) as (i' &?&?); trivial; subst.
- exists (i' ~ 1). by rewrite Preverse_xI, (associative _).
+ exists (i' ~ 1). by rewrite Preverse_xI, (associative_L _).
+ rewrite !elem_of_app. intros [?|?].
- destruct (IHl (j~0)) as (i' &?&?); trivial; subst.
- exists (i' ~ 0). by rewrite Preverse_xO, (associative _).
+ exists (i' ~ 0). by rewrite Preverse_xO, (associative_L _).
- destruct (IHr (j~1)) as (i' &?&?); trivial; subst.
- exists (i' ~ 1). by rewrite Preverse_xI, (associative _).
+ exists (i' ~ 1). by rewrite Preverse_xI, (associative_L _).
* intros (i' & ?& Hi'); subst. revert i' j Hi'.
induction t as [|? IHl [?|] ? IHr]; intros i j; simpl.
+ done.
+ rewrite elem_of_cons, elem_of_app. destruct i as [i|i|]; simpl in *.
- right. right. specialize (IHr i (j~1)).
- rewrite Preverse_xI, (associative_eq _) in IHr. auto.
+ rewrite Preverse_xI, (associative_L _) in IHr. auto.
- right. left. specialize (IHl i (j~0)).
- rewrite Preverse_xO, (associative_eq _) in IHl. auto.
- - left. simplify_equality. by rewrite (left_id_eq 1 (++))%positive.
+ rewrite Preverse_xO, (associative_L _) in IHl. auto.
+ - left. simplify_equality. by rewrite (left_id_L 1 (++))%positive.
+ rewrite elem_of_app. destruct i as [i|i|]; simpl in *.
- right. specialize (IHr i (j~1)).
- rewrite Preverse_xI, (associative_eq _) in IHr. auto.
+ rewrite Preverse_xI, (associative_L _) in IHr. auto.
- left. specialize (IHl i (j~0)).
- rewrite Preverse_xO, (associative_eq _) in IHl. auto.
+ rewrite Preverse_xO, (associative_L _) in IHl. auto.
- done.
Qed.
Lemma Pelem_of_to_list_raw {A} (t : Pmap_raw A) i x :
@@ -320,12 +319,12 @@ Proof.
rewrite !Papp_length in Hi. simpl in Hi. lia.
+ intros [??]. rewrite !Pelem_of_to_list_raw_aux.
intros (i1&?&?) (i2&Hi&?); subst.
- rewrite Preverse_xO, Preverse_xI, !(associative_eq _) in Hi.
+ rewrite Preverse_xO, Preverse_xI, !(associative_L _) in Hi.
by apply (injective (++ _)) in Hi.
* intros. rewrite NoDup_app. split_ands; trivial.
intros [??]. rewrite !Pelem_of_to_list_raw_aux.
intros (i1&?&?) (i2&Hi&?); subst.
- rewrite Preverse_xO, Preverse_xI, !(associative_eq _) in Hi.
+ rewrite Preverse_xO, Preverse_xI, !(associative_L _) in Hi.
by apply (injective (++ _)) in Hi.
Qed.
@@ -394,3 +393,8 @@ Proof.
* intros ? [??]. apply Pelem_of_to_list_raw.
* intros ??? ?? [??] [??] ?. by apply Pmerge_raw_spec.
Qed.
+
+(** Finally, we can construct sets of [positive]s satisfying extensional equality. *)
+Notation Pset := (mapset Pmap).
+Instance Pmap_dom {A} : Dom (Pmap A) Pset := mapset_dom.
+Instance: FinMapDom positive Pmap Pset := mapset_dom_spec.
diff --git a/theories/tactics.v b/theories/tactics.v
index a16cb293..150d32d0 100644
--- a/theories/tactics.v
+++ b/theories/tactics.v
@@ -24,26 +24,21 @@ unfolding setoid equalities. Note that this tactic performs much better than
Coq's [easy] tactic as it does not perform [inversion]. *)
Ltac done :=
trivial; intros; solve
- [ repeat first
- [ solve [trivial]
- | solve [symmetry; trivial]
- | reflexivity
- | discriminate
- | contradiction
- | solve [apply not_symmetry; trivial]
- | split ]
- | match goal with
- H : ¬_ |- _ => solve [destruct H; trivial]
- end ].
+ [ repeat first
+ [ solve [trivial]
+ | solve [symmetry; trivial]
+ | reflexivity
+ | discriminate
+ | contradiction
+ | solve [apply not_symmetry; trivial]
+ | split ]
+ | match goal with H : ¬_ |- _ => solve [destruct H; trivial] end ].
Tactic Notation "by" tactic(tac) :=
tac; done.
(** Whereas the [split] tactic splits any inductive with one constructor, the
tactic [split_and] only splits a conjunction. *)
-Ltac split_and :=
- match goal with
- | |- _ ∧ _ => split
- end.
+Ltac split_and := match goal with |- _ ∧ _ => split end.
Ltac split_ands := repeat split_and.
(** The tactic [case_match] destructs an arbitrary match in the conclusion or
@@ -144,16 +139,12 @@ is already blocked, it will not be blocked again. The tactic [unblock_hyps]
removes [blocked] everywhere. *)
Ltac block_hyps := repeat_on_hyps (fun H =>
- match type of H with
- | block _ => idtac
- | ?T => change (block T) in H
- end).
+ match type of H with block _ => idtac | ?T => change (block T) in H end).
Ltac unblock_hyps := unfold block in * |-.
(** The tactic [injection' H] is a variant of injection that introduces the
generated equalities. *)
-Ltac injection' H :=
- block_goal; injection H; clear H; intros; unblock_goal.
+Ltac injection' H := block_goal; injection H; clear H; intros; unblock_goal.
(** The tactic [simplify_equality] repeatedly substitutes, discriminates,
and injects equalities, and tries to contradict impossible inequalities. *)
@@ -165,6 +156,7 @@ Ltac simplify_equality := repeat
| H : _ = ?x |- _ => subst x
| H : _ = _ |- _ => discriminate H
| H : ?f _ = ?f _ |- _ => apply (injective f) in H
+ | H : ?f _ _ = ?f _ _ |- _ => apply (injective2 f) in H; destruct H
(* before [injection'] to circumvent bug #2939 in some situations *)
| H : _ = _ |- _ => injection' H
| H : ?x = ?x |- _ => clear H
@@ -174,18 +166,14 @@ Ltac simplify_equality := repeat
equality. The following tactic extends [remember] to do so. *)
Tactic Notation "remember" constr(t) "as" "(" ident(x) "," ident(E) ")" :=
remember t as x;
- match goal with
- | E' : x = _ |- _ => rename E' into E
- end.
+ match goal with E' : x = _ |- _ => rename E' into E end.
(** 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
suceed for any element of the generated list, the whole tactic wil fail. *)
Tactic Notation "iter" tactic(tac) tactic(l) :=
let rec go l :=
- match l with
- | ?x :: ?l => tac x || go l
- end in go l.
+ match l with ?x :: ?l => tac x || go l end in go l.
(** Given H : [A_1 → ... → A_n → B] (where each [A_i] is non-dependent), the
tactic [feed tac H tac_by] creates a subgoal for each [A_i] and calls [tac p]
diff --git a/theories/vector.v b/theories/vector.v
index a7dd52ee..8c726a5d 100644
--- a/theories/vector.v
+++ b/theories/vector.v
@@ -21,16 +21,11 @@ Notation FS := Fin.FS.
Delimit Scope fin_scope with fin.
Arguments Fin.FS _ _%fin.
-Notation "0" := Fin.F1 : fin_scope.
-Notation "1" := (FS 0) : fin_scope.
-Notation "2" := (FS 1) : fin_scope.
-Notation "3" := (FS 2) : fin_scope.
-Notation "4" := (FS 3) : fin_scope.
-Notation "5" := (FS 4) : fin_scope.
-Notation "6" := (FS 5) : fin_scope.
-Notation "7" := (FS 6) : fin_scope.
-Notation "8" := (FS 7) : fin_scope.
-Notation "9" := (FS 8) : fin_scope.
+Notation "0" := Fin.F1 : fin_scope. Notation "1" := (FS 0) : fin_scope.
+Notation "2" := (FS 1) : fin_scope. Notation "3" := (FS 2) : fin_scope.
+Notation "4" := (FS 3) : fin_scope. Notation "5" := (FS 4) : fin_scope.
+Notation "6" := (FS 5) : fin_scope. Notation "7" := (FS 6) : fin_scope.
+Notation "8" := (FS 7) : fin_scope. Notation "9" := (FS 8) : fin_scope.
Notation "10" := (FS 9) : fin_scope.
Fixpoint fin_to_nat {n} (i : fin n) : nat :=
@@ -76,14 +71,10 @@ 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
+ 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
+ match goal with |- ∀ i, @?P i => apply (fin_S_inv P) end
end.
(** * Vectors *)
@@ -117,13 +108,10 @@ Ltac vec_double_ind v1 v2 :=
match type of v1 with
| vec _ ?n =>
repeat match goal with
- | H' : context [ n ] |- _ =>
- var_neq v1 H'; var_neq v2 H'; revert H'
+ | H' : context [ n ] |- _ => var_neq v1 H'; var_neq v2 H'; revert H'
end;
revert n v1 v2;
- match goal with
- | |- ∀ n v1 v2, @?P n v1 v2 => apply (vec_rect2 P)
- end
+ match goal with |- ∀ n v1 v2, @?P n v1 v2 => apply (vec_rect2 P) end
end.
Notation vcons_inj := VectorSpec.cons_inj.
@@ -132,8 +120,7 @@ Proof. apply vcons_inj. Qed.
Lemma vcons_inj_2 {A n} x y (v w : vec A n) : x ::: v = y ::: w → v = w.
Proof. apply vcons_inj. Qed.
-Lemma vec_eq {A n} (v w : vec A n) :
- (∀ i, v !!! i = w !!! i) → v = w.
+Lemma vec_eq {A n} (v w : vec A n) : (∀ i, v !!! i = w !!! i) → v = w.
Proof.
vec_double_ind v w; [done|]. intros n v w IH x y Hi. f_equal.
* apply (Hi 0%fin).
@@ -168,14 +155,10 @@ 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
+ 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
+ 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
@@ -213,7 +196,7 @@ Proof. by induction l; simpl; 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) :
- same_length v w.
+ v `same_length` w.
Proof. apply same_length_length. by rewrite !vec_to_list_length. Qed.
Lemma vec_to_list_inj1 {A n m} (v : vec A n) (w : vec A m) :
@@ -253,12 +236,10 @@ 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.
+ rewrite <-(take_drop i v) at 1. f_equal. apply vec_to_list_drop_lookup.
Qed.
Lemma elem_of_vlookup {A n} (v : vec A n) x :
@@ -273,31 +254,21 @@ Proof.
+ by left.
+ right. apply IHv.
Qed.
-
Lemma Forall_vlookup {A} (P : A → Prop) {n} (v : vec A n) :
Forall P (vec_to_list v) ↔ ∀ i, P (v !!! i).
-Proof.
- rewrite Forall_forall.
- setoid_rewrite elem_of_vlookup. naive_solver.
-Qed.
+Proof. rewrite Forall_forall. setoid_rewrite elem_of_vlookup. naive_solver. Qed.
Lemma Forall_vlookup_1 {A} (P : A → Prop) {n} (v : vec A n) i :
Forall P (vec_to_list v) → P (v !!! i).
Proof. by rewrite Forall_vlookup. Qed.
Lemma Forall_vlookup_2 {A} (P : A → Prop) {n} (v : vec A n) :
(∀ i, P (v !!! i)) → Forall P (vec_to_list v).
Proof. by rewrite Forall_vlookup. Qed.
-
Lemma Exists_vlookup {A} (P : A → Prop) {n} (v : vec A n) :
Exists P (vec_to_list v) ↔ ∃ i, P (v !!! i).
-Proof.
- rewrite Exists_exists.
- setoid_rewrite elem_of_vlookup. naive_solver.
-Qed.
-
-Lemma Forall2_vlookup {A B} (P : A → B → Prop)
- {n} (v1 : vec A n) (v2 : vec B n) :
- Forall2 P (vec_to_list v1) (vec_to_list v2) ↔
- ∀ i, P (v1 !!! i) (v2 !!! i).
+Proof. rewrite Exists_exists. setoid_rewrite elem_of_vlookup. naive_solver. Qed.
+Lemma Forall2_vlookup {A B} (P : A → B → Prop) {n}
+ (v1 : vec A n) (v2 : vec B n) :
+ Forall2 P (vec_to_list v1) (vec_to_list v2) ↔ ∀ i, P (v1 !!! i) (v2 !!! i).
Proof.
split.
* vec_double_ind v1 v2.
@@ -310,13 +281,12 @@ Proof.
constructor. apply (H 0%fin). apply IH, (λ i, H (FS i)).
Qed.
-(** The function [vmap f v] applies a funlocks (mem_unlock (⋃ Ωs) (⋃ ms)) ≡ ∅ction [f] element wise to [v]. *)
+(** The function [vmap f v] applies a function [f] element wise to [v]. *)
Notation vmap := Vector.map.
Lemma vlookup_map `(f : A → B) {n} (v : vec A n) i :
vmap f v !!! i = f (v !!! i).
Proof. by apply Vector.nth_map. Qed.
-
Lemma vec_to_list_map `(f : A → B) {n} (v : vec A n) :
vec_to_list (vmap f v) = f <$> vec_to_list v.
Proof. induction v; simpl. done. by rewrite IHv. Qed.
@@ -328,15 +298,12 @@ Notation vzip_with := Vector.map2.
Lemma vlookup_zip_with `(f : A → B → C) {n} (v1 : vec A n) (v2 : vec B n) i :
vzip_with f v1 v2 !!! i = f (v1 !!! i) (v2 !!! i).
Proof. by apply Vector.nth_map2. Qed.
-
-Lemma vec_to_list_zip_with `(f : A → B → C) {n}
- (v1 : vec A n) (v2 : vec B n) :
+Lemma vec_to_list_zip_with `(f : A → B → C) {n} (v1 : vec A n) (v2 : vec B n) :
vec_to_list (vzip_with f v1 v2) =
zip_with f (vec_to_list v1) (vec_to_list v2).
Proof.
- revert v2. induction v1; intros v2; inv_vec v2; intros; simpl.
- * done.
- * by rewrite IHv1.
+ revert v2. induction v1; intros v2; inv_vec v2; intros; simpl; [done|].
+ by rewrite IHv1.
Qed.
(** Similar to vlookup, we cannot define [vinsert] as an instance of the
@@ -350,13 +317,13 @@ Fixpoint vinsert {A n} (i : fin n) (x : A) : vec A n → vec A n :=
Lemma vec_to_list_insert {A n} i x (v : vec A n) :
vec_to_list (vinsert i x v) = insert (fin_to_nat i) x (vec_to_list v).
Proof. induction v; inv_fin i. done. simpl. intros. by rewrite IHv. Qed.
-
Lemma vlookup_insert {A n} i x (v : vec A n) : vinsert i x v !!! i = x.
Proof. by induction i; inv_vec v. Qed.
-
Lemma vlookup_insert_ne {A n} i j x (v : vec A n) :
i ≠j → vinsert i x v !!! j = v !!! j.
Proof.
induction i; inv_fin j; inv_vec v; simpl; try done.
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.
--
GitLab