diff --git a/theories/base.v b/theories/base.v
index 886543243b65101fd634494e27fdd800dbbfa33a..10c91ff0296ab8cafb1ff9a863b6de712c82fc5b 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 7d4c52dbd32858473e49a9f7ccc557269c90a4db..754efa114f759c49e0477da4f3b01f1331f80073 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 ecce3512505be6a5fba14e48fd9b85a4d51307ee..25de0bf4e960f60669d3d54e53688950739a887c 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 469696128a9750806f3c1ce484ff934889ca8363..1cfb0a473b717b7cdf51cc8563041758b4f5a273 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 2ca9a5836e1127e08d14b8d0fe0276fb0b3c2725..78ee121d325006c5861d64de53500526d9cdbcd2 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 5c4acc4e76632214cc8a0647fe4cb1a056f6acbe..0eb686e509247168962924302a09962807b371a9 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 84f0ec2c669bad6ba68dee21bacc8ddbfcef5e57..1e8c5d85d525c74dded4b577c32f0201421cf02d 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 4aa9139452f6f33d1e65ef14e9ef0a958c356be9..d874ece4d315886b1540e9abe03caa839d27cbff 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 7738d9e90fd0b264876800c64af1be14a2f9238e..6592895b0915893b19c71a35ab136ca1397f035d 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 86b91d5b06efb8c8aa53e9ec41a4429ef657d56d..42c15949fbaf09a7e73d52ab0cbc7aade940471b 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 6c2bd438e1281e862883ac0967e2c04c13d80b7b..21e2f7b6b343b9875864c2f4664cd794932720d7 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 de543be9739d60d65ee3714c7faa6eabd60e2071..40a65f6fb2dc172ffe9b9add071523d132edbc0d 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 a2abeeaf683b422493defa55cce955a55886be8a..4a79107e320af9acae3ef248c92ae9151497cb2b 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 2315710ceded039e2f9f613a3f85943f19b24cee..d0e2c74bdbccb64a6b49694ce034c40418e617f6 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 fc9d13771288a801798d9f37c295a0a395b33777..8f280e906fc3e7837ffbed36087537322ffe1d04 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 b3ba0df3620d9e9dd2158af4df905215492f71cf..7c7790de3a13377d9431ed33e3e890f9ec0210ca 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 9b1ec6eb0c5c72ec79fcf7741a1f88054cd8d58f..f09b7ff94179f0ffebe13c00fce6d123cf5151cb 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 a16cb29377dfee4a3e60641cd1ab807799501636..150d32d05fb0afc0a45edce8192cecc17fa2bfbe 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 a7dd52ee60f51c35147e95f09e3b6071a094a300..8c726a5daf8e79d8cced00547f52201d8c858d17 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.