Commit 1c177c39 authored by Robbert Krebbers's avatar Robbert Krebbers

Misc updates to the prelude.

parent 1f545953
......@@ -170,8 +170,7 @@ Hint Extern 5 (subrelation _ (tc _)) =>
eapply @tc_once_subrel : typeclass_instances.
Hint Resolve
rtc_once rtc_r
tc_r
rtc_once rtc_r tc_r
bsteps_once bsteps_r bsteps_refl bsteps_trans : ars.
(** * Theorems on sub relations *)
......
......@@ -6,7 +6,7 @@ abstract interfaces for ordered structures, collections, and various other data
structures. *)
Global Generalizable All Variables.
Global Set Automatic Coercions Import.
Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid NArith.
Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid.
(** * General *)
(** The following coercion allows us to use Booleans as propositions. *)
......@@ -17,6 +17,7 @@ applied. *)
Arguments id _ _/.
Arguments compose _ _ _ _ _ _ /.
Arguments flip _ _ _ _ _ _/.
Typeclasses Transparent id compose flip.
(** Change [True] and [False] into notations in order to enable overloading.
We will use this in the file [assertions] to give [True] and [False] a
......@@ -415,10 +416,6 @@ Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
fold_right delete m l.
Instance: Params (@delete_list) 3.
Definition insert_consecutive `{Insert nat A M} (i : nat) (l : list A)
(m : M) : M := fold_right (λ x f i, <[i:=x]>(f (S i))) (λ _, m) l i.
Instance: Params (@insert_consecutive) 3.
(** The function [union_with f m1 m2] is supposed to yield the union of [m1]
and [m2] using the function [f] to combine values of members that are in
both [m1] and [m2]. *)
......@@ -451,6 +448,10 @@ Class Injective {A B} (R : relation A) (S : relation B) (f : A → B) : Prop :=
Class Injective2 {A B C} (R1 : relation A) (R2 : relation B)
(S : relation C) (f : A B C) : Prop :=
injective2: x1 x2 y1 y2, S (f x1 x2) (f y1 y2) R1 x1 y1 R2 x2 y2.
Class Cancel {A B} (S : relation B) (f : A B) (g : B A) : Prop :=
cancel: x, S (f (g x)) x.
Class Surjective {A B} (R : relation B) (f : A B) :=
surjective : y, x, R (f x) y.
Class Idempotent {A} (R : relation A) (f : A A A) : Prop :=
idempotent: x, R (f x x) x.
Class Commutative {A B} (R : relation A) (f : B B A) : Prop :=
......@@ -475,6 +476,8 @@ Class AntiSymmetric {A} (R S : relation A) : Prop :=
Arguments irreflexivity {_} _ {_} _ _.
Arguments injective {_ _ _ _} _ {_} _ _ _.
Arguments injective2 {_ _ _ _ _ _} _ {_} _ _ _ _ _.
Arguments cancel {_ _ _} _ _ {_} _.
Arguments surjective {_ _ _} _ {_} _.
Arguments idempotent {_ _} _ {_} _.
Arguments commutative {_ _ _} _ {_} _ _.
Arguments left_id {_ _} _ _ {_} _.
......@@ -486,55 +489,6 @@ Arguments left_distr {_ _} _ _ {_} _ _ _.
Arguments right_distr {_ _} _ _ {_} _ _ _.
Arguments anti_symmetric {_ _} _ {_} _ _ _ _.
Lemma impl_transitive (P Q R : Prop) : (P Q) (Q R) (P R).
Proof. tauto. Qed.
Instance: Commutative () (@eq A).
Proof. red. intuition. Qed.
Instance: Commutative () (λ x y, @eq A y x).
Proof. red. intuition. Qed.
Instance: Commutative () ().
Proof. red. intuition. Qed.
Instance: Commutative () ().
Proof. red. intuition. Qed.
Instance: Associative () ().
Proof. red. intuition. Qed.
Instance: Idempotent () ().
Proof. red. intuition. Qed.
Instance: Commutative () ().
Proof. red. intuition. Qed.
Instance: Associative () ().
Proof. red. intuition. Qed.
Instance: Idempotent () ().
Proof. red. intuition. Qed.
Instance: LeftId () True ().
Proof. red. intuition. Qed.
Instance: RightId () True ().
Proof. red. intuition. Qed.
Instance: LeftAbsorb () False ().
Proof. red. intuition. Qed.
Instance: RightAbsorb () False ().
Proof. red. intuition. Qed.
Instance: LeftId () False ().
Proof. red. intuition. Qed.
Instance: RightId () False ().
Proof. red. intuition. Qed.
Instance: LeftAbsorb () True ().
Proof. red. intuition. Qed.
Instance: RightAbsorb () True ().
Proof. red. intuition. Qed.
Instance: LeftId () True impl.
Proof. unfold impl. red. intuition. Qed.
Instance: RightAbsorb () True impl.
Proof. unfold impl. red. intuition. Qed.
Instance: LeftDistr () () ().
Proof. red. intuition. Qed.
Instance: RightDistr () () ().
Proof. red. intuition. Qed.
Instance: LeftDistr () () ().
Proof. red. intuition. Qed.
Instance: RightDistr () () ().
Proof. red. intuition. Qed.
(** The following lemmas are specific versions of the projections of the above
type classes for Leibniz equality. These lemmas allow us to enforce Coq not to
use the setoid rewriting mechanism. *)
......@@ -696,11 +650,9 @@ Notation "x .½" := (half x) (at level 20, format "x .½") : C_scope.
Lemma proj1_sig_inj {A} (P : A Prop) x (Px : P x) y (Py : P y) :
xPx = yPy x = y.
Proof. injection 1; trivial. Qed.
Lemma not_symmetry `{R : relation A} `{!Symmetric R} (x y : A) :
¬R x y ¬R y x.
Lemma not_symmetry `{R : relation A} `{!Symmetric R} x y : ¬R x y ¬R y x.
Proof. intuition. Qed.
Lemma symmetry_iff `(R : relation A) `{!Symmetric R} (x y : A) :
R x y R y x.
Lemma symmetry_iff `(R : relation A) `{!Symmetric R} x y : R x y R y x.
Proof. intuition. Qed.
(** ** Pointwise relations *)
......@@ -765,11 +717,15 @@ Section prod_relation.
End prod_relation.
(** ** Other *)
Definition proj_relation {A B} (R : relation A)
(f : B A) : relation B := λ x y, R (f x) (f y).
Definition proj_relation_equivalence {A B} (R : relation A) (f : B A) :
Equivalence R Equivalence (proj_relation R f).
Proof. unfold proj_relation. firstorder auto. Qed.
Definition proj_eq {A B} (f : B A) : relation B := λ x y, f x = f y.
Global Instance proj_eq_equivalence `(f : B A) : Equivalence (proj_eq f).
Proof. unfold proj_eq. repeat split; red; intuition congruence. Qed.
Notation "x ~{ f } y" := (proj_eq f x y)
(at level 70, format "x ~{ f } y") : C_scope.
Notation "(~{ f } )" := (proj_eq f) (f at level 10, only parsing) : C_scope.
Hint Extern 0 (_ ~{_} _) => reflexivity.
Hint Extern 0 (_ ~{_} _) => symmetry; assumption.
Instance: A B (x : B), Commutative (=) (λ _ _ : A, x).
Proof. red. trivial. Qed.
......@@ -799,3 +755,96 @@ Proof. red. trivial. Qed.
Instance idem_propholds {A} (R : relation A) f :
Idempotent R f x, PropHolds (R (f x x) x).
Proof. red. trivial. Qed.
Lemma injective_iff {A B} {R : relation A} {S : relation B} (f : A B)
`{!Injective R S f} `{!Proper (R ==> S) f} x y : S (f x) (f y) R x y.
Proof. firstorder. Qed.
Instance: Injective (=) (=) (@inl A B).
Proof. injection 1; auto. Qed.
Instance: Injective (=) (=) (@inr A B).
Proof. injection 1; auto. Qed.
Instance: Injective2 (=) (=) (=) (@pair A B).
Proof. injection 1; auto. Qed.
Instance: `{Injective2 A B C R1 R2 R3 f} y, Injective R1 R3 (λ x, f x y).
Proof. repeat intro; edestruct (injective2 f); eauto. Qed.
Instance: `{Injective2 A B C R1 R2 R3 f} x, Injective R2 R3 (f x).
Proof. repeat intro; edestruct (injective2 f); eauto. Qed.
Lemma cancel_injective `{Cancel A B R1 f g}
`{!Equivalence R1} `{!Proper (R2 ==> R1) f} : Injective R1 R2 g.
Proof.
intros x y E. rewrite <-(cancel f g x), <-(cancel f g y), E. reflexivity.
Qed.
Lemma cancel_surjective `{Cancel A B R1 f g} : Surjective R1 f.
Proof. intros y. exists (g y). auto. Qed.
Lemma impl_transitive (P Q R : Prop) : (P Q) (Q R) (P R).
Proof. tauto. Qed.
Instance: Commutative () (@eq A).
Proof. red. intuition. Qed.
Instance: Commutative () (λ x y, @eq A y x).
Proof. red. intuition. Qed.
Instance: Commutative () ().
Proof. red. intuition. Qed.
Instance: Commutative () ().
Proof. red. intuition. Qed.
Instance: Associative () ().
Proof. red. intuition. Qed.
Instance: Idempotent () ().
Proof. red. intuition. Qed.
Instance: Commutative () ().
Proof. red. intuition. Qed.
Instance: Associative () ().
Proof. red. intuition. Qed.
Instance: Idempotent () ().
Proof. red. intuition. Qed.
Instance: LeftId () True ().
Proof. red. intuition. Qed.
Instance: RightId () True ().
Proof. red. intuition. Qed.
Instance: LeftAbsorb () False ().
Proof. red. intuition. Qed.
Instance: RightAbsorb () False ().
Proof. red. intuition. Qed.
Instance: LeftId () False ().
Proof. red. intuition. Qed.
Instance: RightId () False ().
Proof. red. intuition. Qed.
Instance: LeftAbsorb () True ().
Proof. red. intuition. Qed.
Instance: RightAbsorb () True ().
Proof. red. intuition. Qed.
Instance: LeftId () True impl.
Proof. unfold impl. red. intuition. Qed.
Instance: RightAbsorb () True impl.
Proof. unfold impl. red. intuition. Qed.
Instance: LeftDistr () () ().
Proof. red. intuition. Qed.
Instance: RightDistr () () ().
Proof. red. intuition. Qed.
Instance: LeftDistr () () ().
Proof. red. intuition. Qed.
Instance: RightDistr () () ().
Proof. red. intuition. Qed.
Lemma not_injective `{Injective A B R R' f} x y : ¬R x y ¬R' (f x) (f y).
Proof. intuition. Qed.
Instance injective_compose {A B C} R1 R2 R3 (f : A B) (g : B C) :
Injective R1 R2 f Injective R2 R3 g Injective R1 R3 (g f).
Proof. red; intuition. Qed.
Instance surjective_compose {A B C} R (f : A B) (g : B C) :
Surjective (=) f Surjective R g Surjective R (g f).
Proof.
intros ?? x. unfold compose. destruct (surjective g x) as [y ?].
destruct (surjective f y) as [z ?]. exists z. congruence.
Qed.
Section sig_map.
Context `{P : A Prop} `{Q : B Prop} (f : A B) (Hf : x, P x Q (f x)).
Definition sig_map (x : sig P) : sig Q := f (`x) Hf _ (proj2_sig x).
Global Instance sig_map_injective:
( x, ProofIrrel (P x)) Injective (=) (=) f Injective (=) (=) sig_map.
Proof.
intros ?? [x Hx] [y Hy]. injection 1. intros Hxy.
apply (injective f) in Hxy; subst. rewrite (proof_irrel _ Hy). auto.
Qed.
End sig_map.
......@@ -489,7 +489,7 @@ Section collection_monad.
* revert l. induction k; esolve_elem_of.
* induction 1; esolve_elem_of.
Qed.
Lemma mapM_length {A B} (f : A M B) l k :
Lemma collection_mapM_length {A B} (f : A M B) l k :
l mapM f k length l = length k.
Proof. revert l; induction k; esolve_elem_of. Qed.
......
......@@ -3,10 +3,11 @@
(** This file collects definitions and theorems on finite collections. Most
importantly, it implements a fold and size function and some useful induction
principles on finite collections . *)
Require Import Permutation ars.
Require Export collections numbers listset.
Require Import Permutation ars listset.
Require Export numbers collections.
Definition choose `{Elements A C} (X : C) : option A := head (elements X).
Definition collection_choose `{Elements A C} (X : C) : option A :=
head (elements X).
Instance collection_size `{Elements A C} : Size C := length elements.
Definition collection_fold `{Elements A C} {B}
(f : A B B) (b : B) : C B := foldr f b elements.
......@@ -56,23 +57,27 @@ Proof.
rewrite (nil_length l), !elem_of_list_singleton by done. congruence.
Qed.
Lemma choose_Some X x : choose X = Some x x X.
Lemma collection_choose_Some X x : collection_choose X = Some x x X.
Proof.
unfold choose. destruct (elements X) eqn:E; intros; simplify_equality.
rewrite elements_spec, E. by left.
unfold collection_choose. destruct (elements X) eqn:E; intros;
simplify_equality. rewrite elements_spec, E. by left.
Qed.
Lemma choose_None X : choose X = None X .
Lemma collection_choose_None X : collection_choose X = None X .
Proof.
unfold choose. destruct (elements X) eqn:E; intros; simplify_equality.
unfold collection_choose.
destruct (elements X) eqn:E; intros; simplify_equality.
apply equiv_empty. intros x. by rewrite elements_spec, E, elem_of_nil.
Qed.
Lemma elem_of_or_empty X : ( x, x X) X .
Proof. destruct (choose X) eqn:?; eauto using choose_Some, choose_None. Qed.
Lemma choose_is_Some X : X is_Some (choose X).
Proof.
destruct (choose X) eqn:?.
* rewrite elem_of_equiv_empty. split; eauto using choose_Some.
* split. intros []; eauto using choose_None. by intros [??].
destruct (collection_choose X) eqn:?;
eauto using collection_choose_Some, collection_choose_None.
Qed.
Lemma collection_choose_is_Some X : X is_Some (collection_choose X).
Proof.
destruct (collection_choose X) eqn:?.
* rewrite elem_of_equiv_empty. split; eauto using collection_choose_Some.
* split. intros []; eauto using collection_choose_None. by intros [??].
Qed.
Lemma not_elem_of_equiv_empty X : X ( x, x X).
Proof.
......@@ -156,8 +161,7 @@ Qed.
Lemma collection_fold_ind {B} (P : B C Prop) (f : A B B) (b : B) :
Proper ((=) ==> () ==> iff) P
P b
( x X r, x X P r X P (f x r) ({[ x ]} X))
P b ( x X r, x X P r X P (f x r) ({[ x ]} X))
X, P (collection_fold f b X) X.
Proof.
intros ? Hemp Hadd.
......@@ -184,7 +188,6 @@ Proof.
abstract (unfold set_Forall; setoid_rewrite elements_spec;
by rewrite <-Forall_forall).
Defined.
Global Instance set_Exists_dec `(P : A Prop) `{ x, Decision (P x)} X :
Decision (set_Exists P X) | 100.
Proof.
......@@ -192,7 +195,6 @@ Proof.
abstract (unfold set_Exists; setoid_rewrite elements_spec;
by rewrite <-Exists_exists).
Defined.
Global Instance rel_elem_of_dec `{ x y, Decision (R x y)} x X :
Decision (elem_of_upto R x X) | 100 := decide (set_Exists (R x) X).
End fin_collection.
......@@ -135,14 +135,21 @@ Lemma map_subset_empty {A} (m : M A) : m ⊄ ∅.
Proof. intros [? []]. intros i x. by rewrite lookup_empty. Qed.
(** ** Properties of the [partial_alter] operation *)
Lemma partial_alter_compose {A} (m : M A) i f g :
Lemma partial_alter_ext {A} (f g : option A option A) (m : M A) i :
( x, m !! i = x f x = g x) partial_alter f i m = partial_alter g i m.
Proof.
intros Hfg. apply map_eq. intros j. destruct (decide (i = j)); subst.
* rewrite !lookup_partial_alter. by apply Hfg.
* by rewrite !lookup_partial_alter_ne.
Qed.
Lemma partial_alter_compose {A} f g (m : M A) i:
partial_alter (f g) i m = partial_alter f i (partial_alter g i m).
Proof.
intros. apply map_eq. intros ii. case (decide (i = ii)).
* intros. subst. by rewrite !lookup_partial_alter.
* intros. by rewrite !lookup_partial_alter_ne.
Qed.
Lemma partial_alter_commute {A} (m : M A) i j f g :
Lemma partial_alter_commute {A} f g (m : M A) i j :
i j partial_alter f i (partial_alter g j m) =
partial_alter g j (partial_alter f i m).
Proof.
......@@ -164,10 +171,10 @@ Qed.
Lemma partial_alter_self {A} (m : M A) i : partial_alter (λ _, m !! i) i m = m.
Proof. by apply partial_alter_self_alt. Qed.
Lemma partial_alter_subseteq {A} (m : M A) i f :
Lemma partial_alter_subseteq {A} f (m : M A) i :
m !! i = None m partial_alter f i m.
Proof. intros Hi j x Hj. rewrite lookup_partial_alter_ne; congruence. Qed.
Lemma partial_alter_subset {A} (m : M A) i f :
Lemma partial_alter_subset {A} f (m : M A) i :
m !! i = None is_Some (f (m !! i)) m partial_alter f i m.
Proof.
intros Hi Hfi. split.
......@@ -178,11 +185,26 @@ Proof.
Qed.
(** ** Properties of the [alter] operation *)
Lemma alter_ext {A} (f g : A A) (m : M A) i :
( x, m !! i = Some x f x = g x) alter f i m = alter g i m.
Proof. intro. apply partial_alter_ext. intros [x|] ?; simpl; f_equal; auto. Qed.
Lemma lookup_alter {A} (f : A A) m i : alter f i m !! i = f <$> m !! i.
Proof. apply lookup_partial_alter. Qed.
Lemma lookup_alter_ne {A} (f : A A) m i j : i j alter f i m !! j = m !! j.
Proof. apply lookup_partial_alter_ne. Qed.
Lemma alter_compose {A} (f g : A A) (m : M A) i:
alter (f g) i m = alter f i (alter g i m).
Proof.
unfold alter, map_alter. rewrite <-partial_alter_compose.
apply partial_alter_ext. by intros [?|].
Qed.
Lemma alter_commute {A} (f g : A A) (m : M A) i j :
i j alter f i (alter g j m) = alter g j (alter f i m).
Proof. apply partial_alter_commute. Qed.
Lemma lookup_alter_Some {A} (f : A A) m i j y :
alter f i m !! j = Some y
(i = j x, m !! j = Some x y = f x) (i j m !! j = Some y).
......@@ -456,7 +478,7 @@ Lemma map_of_list_inj {A} (l1 l2 : list (K * A)) :
NoDup (fst <$> l1) NoDup (fst <$> l2)
map_of_list l1 = map_of_list l2 l1 l2.
Proof.
intros ?? Hl1l2. apply NoDup_Permutation; auto using (NoDup_fmap_1 fst).
intros ?? Hl1l2. apply NoDup_Permutation; auto using (fmap_nodup_1 fst).
intros [i x]. by rewrite !elem_of_map_of_list, Hl1l2.
Qed.
Lemma map_of_to_list {A} (m : M A) : map_of_list (map_to_list m) = m.
......
......@@ -53,6 +53,10 @@ Instance list_alter {A} (f : A → A) : AlterD nat A (list A) f :=
| x :: l => match i with 0 => f x :: l | S i => x :: @alter _ _ _ f go i l end
end.
(** The operation [<[i:=x]> l] overwrites the element at position [i] with the
value [x]. In case [i] is out of bounds, the list is returned unchanged. *)
Instance list_insert {A} : Insert nat A (list A) := λ i x, alter (λ _, x) i.
(** The operation [delete i l] removes the [i]th element of [l] and moves
all consecutive elements one position ahead. In case [i] is out of bounds,
the list is returned unchanged. *)
......@@ -63,10 +67,6 @@ Instance list_delete {A} : Delete nat (list A) :=
| x :: l => match i with 0 => l | S i => x :: @delete _ _ go i l end
end.
(** The operation [<[i:=x]> l] overwrites the element at position [i] with the
value [x]. In case [i] is out of bounds, the list is returned unchanged. *)
Instance list_insert {A} : Insert nat A (list A) := λ i x, alter (λ _, x) i.
(** The function [option_list o] converts an element [Some x] into the
singleton list [[x]], and [None] into the empty list [[]]. *)
Definition option_list {A} : option A list A := option_rect _ (λ x, [x]) [].
......@@ -82,6 +82,21 @@ Instance list_filter {A} : Filter A (list A) :=
then x :: @filter _ _ (@go) _ _ l
else @filter _ _ (@go) _ _ l
end.
Fixpoint filter_Some {A} (l : list (option A)) : list A :=
match l with
| [] => []
| Some x :: l => x :: filter_Some l
| None :: l => filter_Some l
end.
(** The function [list_find P l] returns the first index [i] whose element
satisfies the predicate [P]. *)
Definition list_find {A} P `{ x, Decision (P x)} : list A option nat :=
fix go l :=
match l with
| [] => None
| x :: l => if decide (P x) then Some 0 else S <$> go l
end.
(** The function [replicate n x] generates a list with length [n] of elements
with value [x]. *)
......@@ -106,6 +121,11 @@ Fixpoint resize {A} (n : nat) (y : A) (l : list A) : list A :=
end.
Arguments resize {_} !_ _ !_.
Definition sublist_lookup {A} (i n : nat) (l : list A) : option (list A) :=
guard (i + n length l); Some $ take n $ drop i l.
Definition sublist_insert {A} (i : nat) (k l : list A) : list A :=
take i l ++ take (length l - i) k ++ drop (i + length k) l.
(** Functions to fold over a list. We redefine [foldl] with the arguments in
the same order as in Haskell. *)
Notation foldr := fold_right.
......@@ -128,6 +148,13 @@ Instance list_bind {A B} (f : A → list B) : MBindD list f :=
Instance list_join: MJoin list :=
fix go A (ls : list (list A)) : list A :=
match ls with [] => [] | l :: ls => l ++ @mjoin _ go _ ls end.
Definition mapM `{!MBind M} `{!MRet M} {A B}
(f : A M B) : list A M (list B) :=
fix go l :=
match l with
| [] => mret []
| x :: l => y f x; k go l; mret (y :: k)
end.
(** We define stronger variants of map and fold that allow the mapped
function to use the index of the elements. *)
......@@ -199,12 +226,12 @@ Section prefix_suffix_ops.
Definition strip_suffix (l1 l2 : list A) := snd $ fst $ max_suffix_of l1 l2.
End prefix_suffix_ops.
(** A list [l1] is a sub list of [l2] if [l2] is obtained by removing elements
(** A list [l1] is a sublist of [l2] if [l2] is obtained by removing elements
from [l1] without changing the order. *)
Inductive sublist {A} : relation (list A) :=
| sublist_nil : sublist [] []
| 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).
| sublist_cons 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
......@@ -213,7 +240,7 @@ 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_cons 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.
......@@ -312,6 +339,8 @@ Ltac simplify_list_equality :=
destruct i; [change (Some x = Some y) in H | discriminate]
end;
try discriminate_list_equality.
Ltac simplify_list_equality' :=
repeat (progress simpl in * || simplify_list_equality).
(** * General theorems *)
Section general_properties.
......@@ -321,10 +350,6 @@ Implicit Types l k : list A.
Global Instance: Injective2 (=) (=) (=) (@cons A).
Proof. by injection 1. Qed.
Global Instance: x, Injective (=) (=) (x ::).
Proof. by injection 1. Qed.
Global Instance: l, Injective (=) (=) (:: l).
Proof. by injection 1. Qed.
Global Instance: k, Injective (=) (=) (k ++).
Proof. intros ???. apply app_inv_head. Qed.
Global Instance: k, Injective (=) (=) (++ k).
......@@ -375,15 +400,13 @@ Proof. by destruct l. Qed.
Lemma lookup_lt_Some l i x : l !! i = Some x i < length l.
Proof.
revert i. induction l; intros [|?] ?;
simpl in *; simplify_equality; simpl; auto with arith.
revert i. induction l; intros [|?] ?; simplify_equality'; auto with arith.
Qed.
Lemma lookup_lt_is_Some_1 l i : is_Some (l !! i) i < length l.
Proof. intros [??]; eauto using lookup_lt_Some. Qed.
Lemma lookup_lt_is_Some_2 l i : i < length l is_Some (l !! i).
Proof.
revert i. induction l; intros [|?] ?;
simpl in *; simplify_equality; simpl; eauto with lia.
revert i. induction l; intros [|?] ?; simplify_equality'; eauto with lia.
Qed.
Lemma lookup_lt_is_Some l i : is_Some (l !! i) i < length l.
Proof. split; auto using lookup_lt_is_Some_1, lookup_lt_is_Some_2. Qed.
......@@ -410,27 +433,22 @@ Lemma lookup_app_l l1 l2 i : i < length l1 → (l1 ++ l2) !! i = l1 !! i.
Proof. revert i. induction l1; intros [|?]; simpl; auto with lia. Qed.
Lemma lookup_app_l_Some l1 l2 i x : l1 !! i = Some x (l1 ++ l2) !! i = Some x.
Proof. intros. rewrite lookup_app_l; eauto using lookup_lt_Some. Qed.
Lemma lookup_app_r l1 l2 i : (l1 ++ l2) !! (length l1 + i) = l2 !! i.
Proof.
revert i. induction l1; intros [|i]; simpl in *; simplify_equality; auto.
Qed.
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.
Proof. revert i. induction l1; intros [|i]; simplify_equality'; auto. Qed.
Lemma lookup_app_r_alt l1 l2 i j :
j = length l1 (l1 ++ l2) !! (j + i) = l2 !! i.
Proof. intros ->. by apply lookup_app_r. Qed.
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 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_minus_r l1 l2 i :
length l1 i (l1 ++ l2) !! i = l2 !! (i - length l1).
Proof. intros. rewrite <-(lookup_app_r l1 l2). f_equal. lia. Qed.
Lemma lookup_app_inv l1 l2 i x :
(l1 ++ l2) !! i = Some x l1 !! i = Some x l2 !! (i - length l1) = Some x.
Proof.
revert i. induction l1; intros [|i] ?; simpl in *; simplify_equality; auto.
Qed.
Proof. revert i. induction l1; intros [|i] ?; simplify_equality'; auto. Qed.
Lemma list_lookup_middle l1 l2 x : (l1 ++ x :: l2) !! length l1 = Some x.
Proof. by induction l1; simpl. Qed.
......@@ -457,7 +475,7 @@ Proof. apply list_lookup_alter_ne. Qed.
Lemma list_lookup_other l i x :
length l 1 l !! i = Some x j y, j i l !! j = Some y.
Proof.
intros. destruct i, l as [|x0 [|x1 l]]; simpl in *; simplify_equality.
intros. destruct i, l as [|x0 [|x1 l]]; simplify_equality'.
* by exists 1 x1.
* by exists 0 x0.
Qed.
......@@ -476,6 +494,18 @@ Proof.
intros. assert (i = length l1 + (i - length l1)) as Hi by lia.
rewrite Hi at 1. by apply alter_app_r.
Qed.
Lemma list_alter_ext f g l i :
( x, l !! i = Some x f x = g x) alter f i l = alter g i l.
Proof. revert i. induction l; intros [|?] ?; simpl; f_equal; auto. Qed.
Lemma list_alter_compose f g l i :
alter (f g) i l = alter f i (alter g i l).
Proof. revert i. induction l; intros [|?]; simpl; f_equal; auto. Qed.
Lemma list_alter_commute f g l i j :
i j alter f i (alter g j l) = alter g j (alter f i l).
Proof.
revert i j.
induction l; intros [|?] [|?]; simpl; auto with f_equal congruence.
Qed.
Lemma insert_app_l l1 l2 i x :
i < length l1 <[i:=x]>(l1 ++ l2) = <[i:=x]>l1 ++ l2.
......@@ -486,10 +516,6 @@ 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 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 x : delete (length l1) (l1 ++ x :: l2) = l1 ++ l2.
Proof. induction l1; simpl; f_equal; auto. Qed.
......@@ -536,8 +562,7 @@ Proof.