diff --git a/.github/workflows/docker-action.yml b/.github/workflows/docker-action.yml index 62e3acb..14954b6 100644 --- a/.github/workflows/docker-action.yml +++ b/.github/workflows/docker-action.yml @@ -18,8 +18,7 @@ jobs: strategy: matrix: image: - - 'mathcomp/mathcomp:2.4.0-rocq-prover-9.0' - - 'mathcomp/mathcomp:2.5.0-rocq-prover-9.1' + - 'mathcomp/mathcomp:2.6.0-rocq-prover-9.2' - 'mathcomp/mathcomp-dev:rocq-prover-dev' fail-fast: false steps: diff --git a/Makefile b/Makefile index 19c7e0b..4332ff0 100644 --- a/Makefile +++ b/Makefile @@ -7,7 +7,7 @@ KNOWNFILES := Makefile _CoqProject .DEFAULT_GOAL := invoke-coqmakefile CoqMakefile: Makefile _CoqProject - $(COQBIN)coq_makefile -f _CoqProject -o CoqMakefile + $(COQBIN)rocq makefile -f _CoqProject -o CoqMakefile invoke-coqmakefile: CoqMakefile $(MAKE) --no-print-directory -f CoqMakefile $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) diff --git a/README.md b/README.md index 2d4d47a..d116a86 100644 --- a/README.md +++ b/README.md @@ -29,9 +29,11 @@ This library relies on propositional and functional extentionality axioms. - Anton Trunov - Alexander Gryzlov - License: [Apache-2.0](LICENSE) -- Compatible Rocq/Coq versions: 9.0 or later +- Compatible Rocq/Coq versions: none - Additional dependencies: - - [MathComp ssreflect 2.4 or later](https://math-comp.github.io) + - Rocq Core compiler engine + - Rocq Standard Library components + - [MathComp ssreflect 2.6 or later](https://math-comp.github.io) - [Hierarchy Builder 1.7.0 or later](https://github.com/math-comp/hierarchy-builder) - [MathComp algebra](https://math-comp.github.io) - Rocq/Coq namespace: `pcm` diff --git a/_CoqProject b/_CoqProject index 99fca64..81d2633 100644 --- a/_CoqProject +++ b/_CoqProject @@ -2,11 +2,8 @@ -arg -w -arg -notation-overridden -arg -w -arg -redundant-canonical-projection -arg -w -arg -HB.no-new-instance --arg -w -arg -notation-for-abbreviation -# release-specific args --arg -w -arg -notation-incompatible-prefix # specific to coq8.20.0 --arg -w -arg -deprecated-from-Coq # specific to coq8.21 --arg -w -arg -deprecated-dirpath-Coq # specific to coq8.21 +-arg -w -arg -ambiguous-paths +-arg -w -arg -rewrite-rw core/options.v core/axioms.v @@ -28,6 +25,7 @@ pcm/autopcm.v pcm/morphism.v pcm/invertible.v pcm/unionmap.v +pcm/nmodmap.v pcm/natmap.v pcm/automap.v pcm/heap.v diff --git a/coq-fcsl-pcm.opam b/coq-fcsl-pcm.opam index 9a17310..c81ee0e 100644 --- a/coq-fcsl-pcm.opam +++ b/coq-fcsl-pcm.opam @@ -10,7 +10,7 @@ dev-repo: "git+https://github.com/imdea-software/fcsl-pcm.git" bug-reports: "https://github.com/imdea-software/fcsl-pcm/issues" license: "Apache-2.0" -synopsis: "Coq library of Partial Commutative Monoids" +synopsis: "Rocq library of Partial Commutative Monoids" description: """ The PCM library provides a formalisation of Partial Commutative Monoids (PCMs), a common algebraic structure used in separation logic for verification of @@ -25,10 +25,11 @@ This library relies on propositional and functional extentionality axioms.""" build: [make "-j%{jobs}%"] install: [make "install"] depends: [ - "coq" { (>= "9.0" & < "9.2~") | (= "dev") } - "coq-mathcomp-ssreflect" { (>= "2.4.0" & < "2.6~") | (= "dev") } - "coq-hierarchy-builder" { (>= "1.7.0" & < "1.11~") | (= "dev") } - "coq-mathcomp-algebra" + "rocq-core" { (>= "9.2" & < "9.3~") | (= "dev") } + "rocq-stdlib" + "rocq-mathcomp-ssreflect" { (>= "2.6.0" & < "2.7~") | (= "dev") } + "rocq-hierarchy-builder" { (>= "1.7.0" & < "1.11~") | (= "dev") } + "rocq-mathcomp-algebra" ] tags: [ diff --git a/core/autouniq.v b/core/autouniq.v index 5c08fa0..48d02e4 100644 --- a/core/autouniq.v +++ b/core/autouniq.v @@ -14,7 +14,8 @@ limitations under the License. From HB Require Import structures. From Stdlib Require Import ssreflect ssrbool ssrfun. From mathcomp Require Import ssrnat seq eqtype. -From pcm Require Import options prelude auto. +From pcm Require Import options prelude. +From pcm Require Export auto. (**********************************************************) (**********************************************************) @@ -378,8 +379,8 @@ Module UniqX. Section UniqX. Variable A : eqType. Implicit Types (j : ctx A) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. Structure packed_map (m : seq A) := Pack {unpack : seq A}. Canonical equate (m : seq A) := Pack m m. @@ -412,8 +413,8 @@ Canonical start. Section Exports. Variable A : eqType. Implicit Types (j : ctx A) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* main lemma *) (* boolean component of rform is set to true *) @@ -442,8 +443,8 @@ Module NeqX. Section NeqX. Variable A : eqType. Implicit Types (j : ctx A) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. Structure packed_elem (x : A) := Pack {unpack : A}. Canonical equate m := Pack m m. @@ -485,8 +486,8 @@ Canonical start. Section Exports. Variable A : eqType. Implicit Types (j : ctx A) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* main lemma *) Lemma neqO n m i keys2 ts1 (f : form (empx A) i ts1) @@ -523,8 +524,8 @@ Module NotinX. Section NotinX. Variable A : eqType. Implicit Types (j : ctx A) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. Structure packed_map (x : seq A) := Pack {unpack : seq A}. Canonical equate m := Pack m m. @@ -563,8 +564,8 @@ Canonical start. Section Exports. Variable A : eqType. Implicit Types (j : ctx A) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* main lemma *) Lemma notinO n m i keys2 ts1 (f : form (empx A) i ts1) @@ -602,11 +603,11 @@ Lemma uniqX' (A : eqType) i ts1 (f1 : Syntactify.form (empx A) i ts1) : uniq (UniqX.unpack (UniqX.pivot g))) * (forall n keys2 (x : xfind (keyx i) keys2 n), ((forall m (y : NeqX.rform (Context keys2 (varx i)) ts1 n m true), - xuntag x == NeqX.unpack (NeqX.pivot y) = false) * + (xuntag x == NeqX.unpack (NeqX.pivot y)) = false) * (forall m (y : NotinX.rform (Context keys2 (varx i)) ts1 n m true), - xuntag x \in NotinX.unpack (NotinX.pivot y) = false))). + (xuntag x \in NotinX.unpack (NotinX.pivot y)) = false))). Proof. -by move=>U; split; [|split]=>*; first by [apply: uniqO U]; +by move=>U; split; [|split]; move=>*; first by [apply: uniqO U]; apply/negbTE; [apply: neqO U|apply: notinO U]. Qed. @@ -616,3 +617,8 @@ Definition uniqX {A i ts1 f1} U := (mem_rcons, mem_cat, inE, negb_or, rcons_uniq, cat_uniq, andbT, orbF, @uniqX' A i ts1 f1 U). +Lemma test (A : eqType) (s1 s2 : seq A) (x : A) : + uniq (rcons s1 x ++ s2) -> + x \in s1 -> + false. +Proof. by move=>U; rewrite (uniqX U). Abort. diff --git a/core/axioms.v b/core/axioms.v index a5ca0a6..56a64e1 100644 --- a/core/axioms.v +++ b/core/axioms.v @@ -21,7 +21,8 @@ limitations under the License. (* Jonh Major equality via equality cast. *) (******************************************************************************) -From Stdlib Require Import ssreflect ssrfun Eqdep ClassicalFacts. +From Corelib Require Import ssreflect ssrfun. +From Stdlib Require Import Eqdep ClassicalFacts. From mathcomp Require Import eqtype. From pcm Require Import options. @@ -40,7 +41,7 @@ Axiom fext : forall A (B : A -> Type) (f1 f2 : forall x, B x), Lemma pf_irr (P : Prop) (p1 p2 : P) : p1 = p2. Proof. by apply/ext_prop_dep_proof_irrel_cic/@pext. Qed. -Lemma sval_inj A P : injective (@sval A P). +Lemma inj_sval A P : injective (@sval A P). Proof. move=>[x Hx][y Hy] /= H; move: Hx Hy; rewrite H=>*. congr exist; apply: pf_irr. @@ -55,50 +56,31 @@ Proof. by apply: fext. Qed. Lemma comp1f A B (f : A -> B) : f = id \o f. Proof. by apply: fext. Qed. -(*****************************************) -(* Cast and John Major Equality via cast *) -(*****************************************) +(********) +(* Cast *) +(********) (* depends on StreicherK axiom *) Section Cast. Variable (T : Type) (interp : T -> Type). -Definition cast A B (pf : A = B) (v : interp B) : interp A := - ecast _ _ (esym pf) v. +Definition cast A B (pf : A = B) (v : interp A) : interp B := + ecast _ _ pf v. Lemma eqc A (pf : A = A) (v : interp A) : cast pf v = v. Proof. by move: pf; apply: Streicher_K. Qed. -Definition jmeq A B (v : interp A) (w : interp B) := exists pf, v = cast pf w. - -Lemma jm_refl A (v : interp A) : jmeq v v. -Proof. by exists (erefl _); rewrite eqc. Qed. - -Lemma jm_sym A B (v : interp A) (w : interp B) : jmeq v w -> jmeq w v. -Proof. by case=>? ->; subst B; rewrite eqc; apply: jm_refl. Qed. - -Lemma jm_trans A B C (u : interp A) (v : interp B) (w : interp C) : - jmeq u v -> jmeq v w -> jmeq u w. -Proof. by case=>? -> [? ->]; subst B C; rewrite !eqc; apply: jm_refl. Qed. - -Lemma jmE A (v w : interp A) : jmeq v w <-> v = w. -Proof. by split=>[[?]|] ->; [rewrite eqc | apply: jm_refl]. Qed. - -Lemma castE A B (pf1 pf2 : A = B) (v1 v2 : interp B) : +Lemma castE A B (pf1 pf2 : A = B) (v1 v2 : interp A) : v1 = v2 <-> cast pf1 v1 = cast pf2 v2. Proof. by subst B; rewrite !eqc. Qed. End Cast. Arguments cast {T} interp [A][B] pf v. -Arguments jmeq {T} interp [A][B] v w. - -#[export] Hint Resolve jm_refl : core. (* special notation for the common case when interp = id *) -Notation icast pf v := (@cast _ id _ _ pf v). -Notation ijmeq v w := (@jmeq _ id _ _ v w). +Abbreviation icast pf v := (@cast _ id _ _ pf v). (* in case of eqTypes StreicherK not needed *) Section EqTypeCast. @@ -107,7 +89,6 @@ Lemma eqd a (pf : a = a) (v : interp a) : cast interp pf v = v. Proof. by rewrite eq_axiomK. Qed. End EqTypeCast. - (* type dynamic is sigT *) Section Dynamic. @@ -116,20 +97,36 @@ Variables (A : Type) (P : A -> Type). (** eta expand definitions to prevent universe inconsistencies when using the injectivity of constructors of datatypes depending on [[dynamic]] *) -Definition dynamic := sigT P. +Definition dynamic := sigT [eta P]. Definition dyn := existT P. Definition dyn_tp := @projT1 _ P. Definition dyn_val := @projT2 _ P. Definition dyn_eta := @sigT_eta _ P. -Definition dyn_injT := @eq_sigT_fst _ P. -Definition dyn_inj := @inj_pair2 _ P. - +Definition inj_dynT := @eq_sigT_fst _ P. +Definition inj_dyn := @inj_pair2 _ P. End Dynamic. -Prenex Implicits dyn_tp dyn_val dyn_injT dyn_inj. +Prenex Implicits dyn_tp dyn_val inj_dynT inj_dyn. Arguments dyn {T} interp {A} _ : rename. -Notation idyn v := (@dyn _ id _ v). +Abbreviation idyn v := (@dyn _ id _ v). + +(* Tagging *) + +Abbreviation Tag := (@existT _ _). +Definition inj_tagT := @eq_sigT_fst. +Definition inj_tagK := @inj_pair2. +Prenex Implicits inj_tagT inj_tagK. + +(* Because of a bug in inversion and injection tactics *) +(* we occasionally have to destruct pairs by hand, else we *) +(* lose the second equation. *) +Lemma inj_pair A B (a1 a2 : A) (b1 b2 : B) : + (a1, b1) = (a2, b2) -> + (a1 = a2) * (b1 = b2). +Proof. by case. Qed. + +Arguments inj_pair {A B a1 a2 b1 b2}. + +Definition inj_some := @Some_inj. +Prenex Implicits inj_some. -Lemma dynE (A B : Type) interp (v : interp A) (w : interp B) : - jmeq interp v w <-> dyn interp v = dyn interp w. -Proof. by split=>[[pf ->]|[pf]]; subst B; [rewrite !eqc | move/dyn_inj=>->]. Qed. diff --git a/core/finmap.v b/core/finmap.v index aa18aba..7598082 100644 --- a/core/finmap.v +++ b/core/finmap.v @@ -22,9 +22,6 @@ From mathcomp Require Import ssrnat eqtype seq path. From pcm Require Export ordtype seqperm. From pcm Require Import options. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - Section Def. Variables (K : ordType) (V : Type). @@ -49,11 +46,11 @@ Prenex Implicits key value predk predCk seq_of. Section Ops. Variables (K : ordType) (V : Type). -Notation fmap := (finMap K V). -Notation key := (@key K V). -Notation value := (@value K V). -Notation predk := (@predk K V). -Notation predCk := (@predCk K V). +Abbreviation fmap := (finMap K V). +Abbreviation key := (@key K V). +Abbreviation value := (@value K V). +Abbreviation predk := (@predk K V). +Abbreviation predCk := (@predCk K V). Lemma fmapE (s1 s2 : fmap) : s1 = s2 <-> seq_of s1 = seq_of s2. @@ -122,8 +119,8 @@ Prenex Implicits fnd ins rem supp nil. Section Laws. Variables (K : ordType) (V : Type). -Notation fmap := (finMap K V). -Notation nil := (@nil K V). +Abbreviation fmap := (finMap K V). +Abbreviation nil := (@nil K V). (* `path_le` specialized to `transitive ord` *) Lemma ord_path (x y : K) s : @@ -222,8 +219,8 @@ by move=>x; case: ifP=>H /=; [|case: eqP=>//->]; rewrite ?(eqP H) ?andbN ?H. Qed. Variant supp_spec x (s : fmap) : bool -> Type := -| supp_spec_some v of fnd x s = Some v : supp_spec x s true -| supp_spec_none of fnd x s = None : supp_spec x s false. +| supp_spec_some v & fnd x s = Some v : supp_spec x s true +| supp_spec_none & fnd x s = None : supp_spec x s false. Lemma suppP x (s : fmap) : supp_spec x s (x \in supp s). Proof. @@ -419,7 +416,7 @@ case: (ordP k2 k3)=>H2 /=. - rewrite eq_sym H1 /=. case: (ordP k3 k1)=>H3 /=; case: (ordP k2 k3) (H2)=>//=. rewrite -(eqP H3) in H1 *. - rewrite -IH //; last by apply: path_sorted H. + rewrite -IH //; first by apply: path_sorted H. rewrite last_ins' /= 1?eq_sym ?H1 //. by apply: ord_path H. - by move: H1; rewrite (eqP H2) /= eq_sym => -> /=; rewrite irr eq_refl. @@ -474,8 +471,8 @@ End Laws. Section Append. Variable (K : ordType) (V : Type). -Notation fmap := (finMap K V). -Notation nil := (@nil K V). +Abbreviation fmap := (finMap K V). +Abbreviation nil := (@nil K V). Lemma seqof_ins k v (s : fmap) : path ord k (supp s) -> seq_of (ins k v s) = (k, v) :: seq_of s. @@ -523,9 +520,9 @@ Lemma fmap_ind' (P : fmap -> Prop) : forall s, P s. Proof. move=>H1 H2; case; elim=>[|[k v] s IH] /= H. -- by rewrite (_ : FinMap _ = nil); last by rewrite fmapE. +- by rewrite (_ : FinMap _ = nil); first by rewrite fmapE. have S: sorted ord (map key s) by apply: path_sorted H. -rewrite (_ : FinMap _ = ins k v (FinMap S)); last first. +rewrite (_ : FinMap _ = ins k v (FinMap S)). - by rewrite fmapE /= last_ins'. by apply: H2. Qed. @@ -537,7 +534,7 @@ Lemma fmap_ind'' (P : fmap -> Prop) : forall s, P s. Proof. move=>H1 H2; case; elim/last_ind=>[|s [k v] IH] /= H. -- by rewrite (_ : FinMap _ = nil); last by rewrite fmapE. +- by rewrite (_ : FinMap _ = nil); first by rewrite fmapE. have Sb: subseq (map key s) (map key (rcons s (k, v))). - by elim: s {IH H}=>[|x s IH] //=; rewrite eq_refl. have S : sorted ord (map key s). @@ -547,7 +544,7 @@ have T : forall x : K, x \in map key s -> ord x k. rewrite inE; case/orP; last by apply: IH; apply: path_sorted L. move/eqP=>->; elim: s {IH} L=>[|[x1 w1] s IH] /=; first by rewrite andbT. by case/andP=>O /(ord_path O) /IH. -rewrite (_ : FinMap _ = ins k v (FinMap S)); last first. +rewrite (_ : FinMap _ = ins k v (FinMap S)). - by rewrite fmapE /= first_ins'. by apply: H2 (IH _)=>x /T. Qed. @@ -558,7 +555,8 @@ Fixpoint fcat' (s1 : fmap) (s2 : seq (K * V)) {struct s2} : fmap := Definition fcat s1 s2 := fcat' s1 (seq_of s2). Lemma fcat_ins' k v s1 s2 : - k \notin (map key s2) -> fcat' (ins k v s1) s2 = ins k v (fcat' s1 s2). + k \notin (map key s2) -> + fcat' (ins k v s1) s2 = ins k v (fcat' s1 s2). Proof. move=>H; elim: s2 k v s1 H=>[|[k2 v2] s2 IH] k1 v1 s1 //=. rewrite inE negb_or; case/andP=>H1 H2. @@ -650,8 +648,8 @@ End Append. Section FMapInd. Variables (K : ordType) (V : Type). -Notation fmap := (finMap K V). -Notation nil := (@nil K V). +Abbreviation fmap := (finMap K V). +Abbreviation nil := (@nil K V). Lemma supp_eq_ins (s1 s2 : fmap) k1 k2 v1 v2 : path ord k1 (supp s1) -> path ord k2 (supp s2) -> @@ -687,8 +685,8 @@ End FMapInd. Section Filtering. Variables (K : ordType) (V : Type). -Notation fmap := (finMap K V). -Notation nil := (@nil K V). +Abbreviation fmap := (finMap K V). +Abbreviation nil := (@nil K V). Definition kfilter' (p : pred K) (s : fmap) := filter (fun kv => p kv.1) (seq_of s). @@ -791,16 +789,16 @@ End Filtering. Section DisjointUnion. Variable (K : ordType) (V : Type). -Notation fmap := (finMap K V). -Notation nil := (@nil K V). +Abbreviation fmap := (finMap K V). +Abbreviation nil := (@nil K V). Definition disj (s1 s2 : fmap) := all (predC (fun x => x \in supp s2)) (supp s1). Variant disj_spec (s1 s2 : fmap) : bool -> Type := -| disj_true of (forall x, x \in supp s1 -> x \notin supp s2) : +| disj_true & (forall x, x \in supp s1 -> x \notin supp s2) : disj_spec s1 s2 true -| disj_false x of x \in supp s1 & x \in supp s2 : +| disj_false x & x \in supp s1 & x \in supp s2 : disj_spec s1 s2 false. Lemma disjP s1 s2 : disj_spec s1 s2 (disj s1 s2). @@ -988,9 +986,8 @@ Lemma sorted_map_key (m : seq (K * U)) : sorted ord (map key m) -> sorted ord (map key (mapf' m)). Proof. elim: m=>[|[k v] m IH] //= H. -rewrite path_min_sorted; first by apply: IH; apply: path_sorted H. -rewrite map_key_mapf. -by apply/(order_path_min _ H);apply/trans. +rewrite path_min_sorted; last by apply: IH; apply: path_sorted H. +by rewrite map_key_mapf; apply/(order_path_min _ H)/trans. Qed. Definition mapf (m : finMap K U) : finMap K V := @@ -1102,7 +1099,7 @@ Lemma mapk_comp m: Proof. elim/fmap_ind': m =>//= k v s P IH. rewrite [mapk (g \o f) _]mapk_ins //. -rewrite mapk_ins // mapk_ins //; first by rewrite IH. +rewrite mapk_ins // mapk_ins //; last by rewrite IH. exact: (path_mapk Hf P). Qed. End KeyMap. diff --git a/core/ordtype.v b/core/ordtype.v index 8c7ed7a..ad0dfb5 100644 --- a/core/ordtype.v +++ b/core/ordtype.v @@ -99,11 +99,11 @@ Polymorphic Definition pack_ := fun (m : Equality.mixin_of T) End PolymorphicClonePack. Local Arguments phant_clone : clear implicits. -Notation clone X2 X1 := (phant_clone X2 X1 _ id_phant id_phant). +Abbreviation clone X2 X1 := (phant_clone X2 X1 _ id_phant id_phant). Local Arguments pack_ : clear implicits. Module Exports. -Notation ordType := Ordered.type. +Abbreviation ordType := Ordered.type. #[reversible] Coercion sort : Ordered.type >-> Sortclass. (* Polymorphic annotation added *) @@ -143,9 +143,9 @@ Definition phant_on_ : forall T : ordType, phant T -> axioms_ T := fun T : ordType => fun=> class T. Local Arguments phant_on_ : clear implicits. -Notation on_ X1 := ( phant_on_ _ (Phant X1)). -Notation copy X2 X1 := ( phant_on_ _ (Phant X1) : axioms_ X2). -Notation on X1 := ( phant_on_ _ (Phant _) : axioms_ X1). +Abbreviation on_ X1 := ( phant_on_ _ (Phant X1)). +Abbreviation copy X2 X1 := ( phant_on_ _ (Phant X1) : axioms_ X2). +Abbreviation on X1 := ( phant_on_ _ (Phant _) : axioms_ X1). Module EtaAndMixinExports. Section hb_instance_91. @@ -196,7 +196,7 @@ Definition ordtype_subproof : forall s : ordType, ordtype_axiom ord := Local Arguments ordtype_subproof : clear implicits. Global Arguments ordtype_subproof {_}. -Notation Ordered X1 := (Ordered.axioms_ X1). +Abbreviation Ordered X1 := (Ordered.axioms_ X1). (* end of generated and changed code *) diff --git a/core/pred.v b/core/pred.v index bce6035..704dd80 100644 --- a/core/pred.v +++ b/core/pred.v @@ -16,14 +16,12 @@ limitations under the License. (******************************************************************************) From Stdlib Require Import ssreflect ssrbool ssrfun Setoid Basics. -From mathcomp Require Import ssrnat seq eqtype bigop. +From mathcomp Require Import ssrnat seq eqtype fintype bigop. From pcm Require Import options. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (* First some basic propositional equalities *) + Lemma andTp p : True /\ p <-> p. Proof. by intuition. Qed. Lemma andpT p : p /\ True <-> p. Proof. by intuition. Qed. Lemma andFp p : False /\ p <-> False. Proof. by intuition. Qed. @@ -61,14 +59,14 @@ Identity Coercion Fun_Of_Pred : Pred >-> Funclass. Definition SubPred T (p1 p2 : Pred T) := forall x : T, p1 x -> p2 x. -Notation xPred0 := (fun _ => False). -Notation xPred1 := (fun x => eq^~ x). -Notation xPredT := (fun _ => True). -Notation xPredI := (fun (p1 p2 : Pred _) x => p1 x /\ p2 x). -Notation xPredU := (fun (p1 p2 : Pred _) x => p1 x \/ p2 x). -Notation xPredC := (fun (p : Pred _) x => ~ p x). -Notation xPredD := (fun (p1 p2 : Pred _) x => ~ p2 x /\ p1 x). -Notation xPreim := (fun f (p : Pred _) x => p (f x)). +Abbreviation xPred0 := (fun _ => False). +Abbreviation xPred1 := (fun x => eq^~ x). +Abbreviation xPredT := (fun _ => True). +Abbreviation xPredI := (fun (p1 p2 : Pred _) x => p1 x /\ p2 x). +Abbreviation xPredU := (fun (p1 p2 : Pred _) x => p1 x \/ p2 x). +Abbreviation xPredC := (fun (p : Pred _) x => ~ p x). +Abbreviation xPredD := (fun (p1 p2 : Pred _) x => ~ p2 x /\ p1 x). +Abbreviation xPreim := (fun f (p : Pred _) x => p (f x)). (* The packed class interface for pred-like types. *) @@ -137,7 +135,7 @@ Notation "[ 'Pred' x : T | E1 & E2 ]" := [Pred x : T | E1 /\ E2 ] Module PredOfSimpl. Definition Coerce T (sp : Simpl_Pred T) : Pred T := fun_of_simpl sp. End PredOfSimpl. -Notation Pred_Of_Simpl := PredOfSimpl.Coerce. +Abbreviation Pred_Of_Simpl := PredOfSimpl.Coerce. Coercion Pred_Of_Simpl : Simpl_Pred >-> Pred. Canonical SimplPredType T := PropPredType (@Pred_Of_Simpl T). @@ -189,8 +187,8 @@ Definition Simpl_Rel T := T -> Simpl_Pred T. Coercion Rel_Of_Simpl T (sr : Simpl_Rel T) : Rel T := fun x : T => sr x. Arguments Rel_Of_Simpl {T} sr x /. -Notation xRelU := (fun (r1 r2 : Rel _) x y => r1 x y \/ r2 x y). -Notation xRelPre := (fun f (r : Rel _) x y => r (f x) (f y)). +Abbreviation xRelU := (fun (r1 r2 : Rel _) x y => r1 x y \/ r2 x y). +Abbreviation xRelPre := (fun f (r : Rel _) x y => r (f x) (f y)). Definition PropSimplRel {T} (r : Rel T) : Simpl_Rel T := fun x => PropSimplPred (r x). @@ -382,24 +380,41 @@ Arguments Has_Quality n {T}. Lemma QualifE n T p x : (x \In @PropQualifier n T p) = p x. Proof. by []. Qed. -Notation "x \Is A" := (x \In Has_Quality 0 A) - (at level 0, only parsing) : function_scope. -Notation "x \Is A" := (x \In Has_Quality 0 A) - (at level 0, only printing) : function_scope. -Notation "x \Is 'a' A" := (x \In Has_Quality 1 A) - (at level 0, only parsing) : function_scope. -Notation "x \Is 'a' A" := (x \In Has_Quality 1 A) - (at level 0, only printing) : function_scope. -Notation "x \Is 'an' A" := (x \In Has_Quality 2 A) - (at level 0, only parsing) : function_scope. -Notation "x \Is 'an' A" := (x \In Has_Quality 2 A) - (at level 0, only printing) : function_scope. -Notation "x \Isn't A" := (x \Notin Has_Quality 0 A) - (at level 0) : function_scope. -Notation "x \Isn't 'a' A" := (x \Notin Has_Quality 1 A) - (at level 0) : function_scope. -Notation "x \Isn't 'an' A" := (x \Notin Has_Quality 2 A) - (at level 0) : function_scope. +Reserved Notation "x \Is A" (at level 70, no associativity, + format "'[hv' x '/ ' \Is A ']'"). +Reserved Notation "x \Isn't A" (at level 70, no associativity, + format "'[hv' x '/ ' \Isn't A ']'"). +Reserved Notation "x \Is 'a' A" (at level 70, no associativity, + format "'[hv' x '/ ' \Is 'a' A ']'"). +Reserved Notation "x \Isn't 'a' A" (at level 70, no associativity, + format "'[hv' x '/ ' \Isn't 'a' A ']'"). +Reserved Notation "x \Is 'an' A" (at level 70, no associativity, + format "'[hv' x '/ ' \Is 'an' A ']'"). +Reserved Notation "x \Isn't 'an' A" (at level 70, no associativity, + format "'[hv' x '/ ' \Isn't 'an' A ']'"). +Reserved Notation "[ 'Qualify' x | P ]" (at level 0, x at level 99, + format "'[hv' [ 'Qualify' x | '/ ' P ] ']'"). +Reserved Notation "[ 'Qualify' x : T | P ]" (at level 0, x at level 99, + format "'[hv' [ 'Qualify' x : T | '/ ' P ] ']'"). +Reserved Notation "[ 'Qualify' 'a' x | P ]" (at level 0, x at level 99, + format "'[hv' [ 'Qualify' 'a' x | '/ ' P ] ']'"). +Reserved Notation "[ 'Qualify' 'a' x : T | P ]" (at level 0, x at level 99, + format "'[hv' [ 'Qualify' 'a' x : T | '/ ' P ] ']'"). +Reserved Notation "[ 'Qualify' 'an' x | P ]" (at level 0, x at level 99, + format "'[hv' [ 'Qualify' 'an' x | '/ ' P ] ']'"). +Reserved Notation "[ 'Qualify' 'an' x : T | P ]" (at level 0, x at level 99, + format "'[hv' [ 'Qualify' 'an' x : T | '/ ' P ] ']'"). + +Notation "x \Is A" := (x \In Has_Quality 0 A) (only parsing) : function_scope. +Notation "x \Is A" := (x \In Has_Quality 0 A) (only printing) : function_scope. +Notation "x \Is 'a' A" := (x \In Has_Quality 1 A) (only parsing) : function_scope. +Notation "x \Is 'a' A" := (x \In Has_Quality 1 A) (only printing) : function_scope. +Notation "x \Is 'an' A" := (x \In Has_Quality 2 A) (only parsing) : function_scope. +Notation "x \Is 'an' A" := (x \In Has_Quality 2 A) (only printing) : function_scope. +Notation "x \Isn't A" := (x \Notin Has_Quality 0 A) : function_scope. +Notation "x \Isn't 'a' A" := (x \Notin Has_Quality 1 A) : function_scope. +Notation "x \Isn't 'an' A" := (x \Notin Has_Quality 2 A) : function_scope. + Notation "[ 'Qualify' x | P ]" := (PropQualifier 0 (fun x => P)) : form_scope. Notation "[ 'Qualify' x : T | P ]" := (PropQualifier 0 (fun x : T => P)) (only parsing) : form_scope. @@ -436,7 +451,7 @@ Canonical Leyed_Mem_Simpl := End KeyPred. -Local Notation In_Unkey x S := (x \In @Unkey_Pred _ S _ _) (only parsing). +Local Abbreviation In_Unkey x S := (x \In @Unkey_Pred _ S _ _) (only parsing). Notation "x \In S" := (In_Unkey x S) (only printing) : function_scope. Section KeyedQualifier. @@ -630,14 +645,14 @@ Add Parametric Morphism T : (@PredU T) with signature @Eq_Pred T _ ==> @Eq_Pred T _ ==> @Eq_Pred T _ as predU_morph. Proof. move=>r1 s1 H1 r2 h2 H2 x; split; -by case; [move/H1 | move/H2]=>/=; auto. +by case=>[/H1|/H2]=>/=; auto. Qed. Add Parametric Morphism T : (@PredI T) with signature @Eq_Pred _ _ ==> @Eq_Pred _ _ ==> @Eq_Pred _ _ as predI_morph. Proof. move=>r1 s1 H1 r2 s2 H2 x; split; -by case; move/H1=>T1; move/H2=>T2. +by case=>/H1 T1 /H2 T2. Qed. Add Parametric Morphism T : (@PredC T) with signature @@ -688,11 +703,8 @@ Lemma or0r r : Pred0 \+p r <~> r. Proof. by rewrite orrC orr0. Qed. Lemma orrCA r1 r2 r3 : - r1 \+p r2 \+p r3 <~> r2 \+p r1 \+p r3. -Proof. - simpl. - by move=>x /=; intuition. -Qed. + r1 \+p r2 \+p r3 <~> r2 \+p r1 \+p r3. +Proof. by move=>x /=; intuition. Qed. Lemma orrAC r1 r2 r3 : (r1 \+p r2) \+p r3 <~> (r1 \+p r3) \+p r2. @@ -790,15 +802,11 @@ Definition InE := (Mem_Seq1, In_cons, (In_Applicative, In_Simpl, Simpl_PredE)). -Lemma Mem_cat x : forall s1 s2, (x \In s1 ++ s2) <-> x \In s1 \/ x \In s2. +Lemma In_cat (s1 s2 : seq T) x : + x \In s1 ++ s2 <-> x \In s1 \/ x \In s2. Proof. -elim=>[|y s1 IH] s2 /=; first by split; [right | case]. -rewrite !InE /=. -split. -- case=>[->|/IH]; first by left; left. - by case; [left; right | right]. -case; first by case; [left | move=>H; right; apply/IH; left]. -by move=>H; right; apply/IH; right. +elim: s1=>[|a s1 IH] //=; first by split; [right|case]. +by rewrite !InE IH; intuition. Qed. Lemma In_split x s : x \In s -> exists s1 s2, s = s1 ++ x :: s2. @@ -808,9 +816,34 @@ case=>[<-|]; first by exists [::], s. by case/IH=>s1 [s2 ->]; exists (y :: s1), s2. Qed. +Lemma In_rcons y s x : x \In rcons s y <-> x \In s \/ x = y. +Proof. +rewrite or_comm; elim: s y x=>[|a s IH] y x //. +rewrite rcons_cons !InE IH; tauto. +Qed. + +Lemma In_rev x s : x \In rev s <-> x \In s. +Proof. +elim: s=>[|y s IH] //=. +by rewrite rev_cons In_rcons or_comm InE IH. +Qed. + +Lemma In_filter (p : pred T) (x : T) s : + x \In filter p s <-> x \In s /\ p x. +Proof. +elim: s=>[|a s IH] /=; first by split=>//; case. +case: ifP=>P; last first. +- rewrite IH InE; split; first by case=>H1 H2; split=>//; right. + by case; case=>[->|//]; rewrite P. +rewrite !InE IH; split; last first. +- by case; case=>H1 H2; [left|right]. +case=>[->|]; first by split=>//; left. +by case=>H1 H2; split=>//; right. +Qed. + End ListMembership. -Prenex Implicits In_split. +Prenex Implicits In_split In_rcons In_rev. (* for equality types, membership predicates coincide *) Lemma mem_seqP (A : eqType) x (s : seq A) : reflect (x \In s) (x \in s). @@ -837,20 +870,48 @@ Qed. Prenex Implicits Mem_map_inv. -Lemma MapP T1 T2 (f : T1 -> T2) (s : seq T1) (y : T2) : - y \In map f s <-> exists2 x, x \In s & y = f x. +Lemma In_map T1 T2 (f : T1 -> T2) (s : seq T1) (y : T2) : + y \In map f s <-> exists2 x, y = f x & x \In s. Proof. elim: s => [|x s IHs] /=; first by split=>//; case. rewrite In_cons; split. - case=>[->|]; first by exists x=>//; apply/In_cons; left. - by case/IHs=>k H ->; exists k=>//; apply/In_cons; right. -case=>k /In_cons [->|H E]; first by left. + by case/IHs=>k -> H; exists k=>//; apply/In_cons; right. +case=>k=>E /In_cons [<-|H]; first by left. by right; apply/IHs; exists k. Qed. Lemma mapPP T1 (T2 : eqType) (f : T1 -> T2) (s : seq T1) y : - reflect (exists2 x, x \In s & y = f x) (y \in map f s). -Proof. by apply: (iffP idP)=>[/mem_seqP/MapP|/MapP/mem_seqP]. Qed. + reflect (exists2 x, y = f x & x \In s) (y \in map f s). +Proof. by apply: (iffP idP)=>[/mem_seqP/In_map|/In_map/mem_seqP]. Qed. + +(* pmap *) + +Lemma pmap_none T (s : seq T) : pmap (fun => @None T) s = [::]. +Proof. by elim: s. Qed. + +Lemma In_pmap T1 T2 (f : T1 -> option T2) (s : seq T1) (y : T2) : + y \In pmap f s <-> exists2 x, f x = Some y & x \In s. +Proof. +elim: s=>[|x s IHs] /=; first by split=>//; case. +case F: (f x)=>[a|] /=; last first. +- rewrite IHs; split=>[[z H1 H2]|[z]]; first by exists z=>//; right. + by rewrite InE=>/[swap] -[->{z}|Z]; [rewrite F|exists z]. +rewrite InE IHs; split=>[X|[z]]. +- case: X F=>[<-{a}|[z H1 H2]] F; first by exists x=>//; left. + by exists z=>//; right. +rewrite InE=>/[swap] -[->{z}|H1 H2]; last by right; exists z. +by rewrite F; case; left. +Qed. + +Lemma pmapPP T1 (T2 : eqType) (f : T1 -> option T2) (s : seq T1) (y : T2) : + reflect (exists2 x, f x = Some y & x \In s) (y \in pmap f s). +Proof. by apply: (iffP idP); [move/mem_seqP/In_pmap|move/In_pmap/mem_seqP]. Qed. + +Lemma map_pmap T1 T2 (f : T1 -> T2) : map f =1 pmap (Some \o f). +Proof. by elim. Qed. + +(* filter *) Lemma Mem_filter (T : Type) (a : pred T) (x : T) (s : seq T) : x \In filter a s <-> a x /\ x \In s. @@ -872,7 +933,7 @@ Lemma eq_In_filter (T : Type) a1 a2 (s : seq T) : filter a1 s = filter a2 s. Proof. elim: s => //= x s IHs eq_a. -rewrite eq_a; last by rewrite InE; left. +rewrite eq_a; first by rewrite InE; left. rewrite IHs // => y s_y; apply: eq_a. by rewrite InE; right. Qed. @@ -886,6 +947,15 @@ elim: s=>[|x s IH] //=; split=>[H|[H1 /IH H2 k]]. by rewrite InE; case=>[->|/H2]. Qed. +Lemma eq_In_pmap S T (f g : S -> option T) (s : seq S) : + (forall x, x \In s -> f x = g x) -> + pmap f s = pmap g s. +Proof. +elim: s=>[|x s IH] //= H; rewrite /oapp -H; first by left. +suff /IH -> : forall y, y \In s -> f y = g y by []. +by move=>y X; apply: H; right. +Qed. + (* Big \In equivalences for all and has *) @@ -958,8 +1028,8 @@ Lemma All_cat (s1 s2 : seq T) : All (s1 ++ s2) <-> All s1 /\ All s2. Proof. split. -- by move/AllP=>H; split; apply/AllP=>x Hx; apply/H/Mem_cat; [left|right]. -by case=>/AllP H1 /AllP H2; apply/AllP=>x /Mem_cat; case=>Hx; [apply: H1| apply: H2]. +- by move/AllP=>H; split; apply/AllP=>x Hx; apply/H/In_cat; [left|right]. +by case=>/AllP H1 /AllP H2; apply/AllP=>x /In_cat; case=>Hx; [apply: H1| apply: H2]. Qed. Fixpoint Has xs := if xs is x :: xs then P x \/ Has xs else False. @@ -978,8 +1048,8 @@ Lemma Has_cat (s1 s2 : seq T) : Has (s1 ++ s2) <-> Has s1 \/ Has s2. Proof. split. -- by move/HasP=>[x] /Mem_cat; case=>Hx Px; [left|right]; apply/HasP; exists x. -by case=>/HasP [x Hx Px]; apply/HasP; exists x=>//; apply/Mem_cat; [left|right]. +- by move/HasP=>[x] /In_cat; case=>Hx Px; [left|right]; apply/HasP; exists x. +by case=>/HasP [x Hx Px]; apply/HasP; exists x=>//; apply/In_cat; [left|right]. Qed. End AllHasP. @@ -1007,12 +1077,77 @@ case: andP=>H; constructor. by case=>/mem_seqP H1 /IH H2; elim: H. Qed. -Lemma map_Uniq T1 (T2 : eqType) (f : T1 -> T2) (s : seq T1) : - uniq [seq f i | i <- s] -> Uniq s. +Lemma filter_Uniq T (a : pred T) s : + Uniq s -> + Uniq (filter a s). +Proof. +elim: s=>[|x s IH] //= [Uq /IH Uq']. +case: ifP=>//= A; split=>//. +by case/In_filter=>/Uq. +Qed. + +Lemma map_Uniq T1 T2 (f : T1 -> T2) (s : seq T1) : + Uniq [seq f i | i <- s] -> Uniq s. Proof. -elim: s=>//= x s IH /andP [nsfx /IH H]; split=>//. -apply: contraNnot nsfx=>Hx. -by apply/mapPP; exists x. +elim: s=>//= x s IH [nsfx /IH H]; split=>//. +by move=>Hx; apply/nsfx/In_map; exists x. +Qed. + +Lemma map_inj_In_Uniq T1 T2 (f : T1 -> T2) (s : seq T1) : + (forall x y, x \In s -> y \In s -> + f x = f y -> x = y) -> + Uniq [seq f i | i <- s] <-> Uniq s. +Proof. +elim: s=>[|x s IH] I //=; split; case=>X /IH J; split. +- by move=>Z; apply/X/In_map; exists x. +- by apply: J=>x' y X' Y; apply: I; right. +- by case/In_map=>z E Z; apply/X; move/I: E=>-> //; [left|right]. +by apply: J=>x' y X' Y; apply: I; right. +Qed. + +Lemma cat_Uniq T (s1 s2 : seq T) : + Uniq (s1 ++ s2) <-> + [/\ Uniq s1, ~ Has [Mem s1] s2 & Uniq s2]. +Proof. +elim: s1 s2=>[|x s1 IH] s2 /=. +- by split=>[U2|[//]]; split=>// /HasP []. +split. +- case=>H /IH [H1 H2 H3]; split=>//. + - by split=>// Z; apply/H/In_cat; left. + case/HasP=>z Z1 /= Z2; apply/H2/HasP; exists z=>//=. + rewrite InE in Z2; case: Z2 Z1=>// -> {z} Z1; suff : False by []. + by apply/H/In_cat; right. +case; case=>H1 H2 H3 H4; split. +- case/In_cat=>Z; first by apply: H1. + by apply/H3/HasP; exists x=>//=; left. +rewrite IH; split=>//; case/HasP=>z Z2 /= Z1. +by apply/H3/HasP; exists z=>//=; right. +Qed. + +Lemma pmap_Uniq T1 T2 (f : T1 -> option T2) (g : T2 -> T1) : + ocancel f g -> + forall s, Uniq s -> Uniq (pmap f s). +Proof. +move=>O; elim=>[|x s IH] //= [H Uq]. +case D: (f x)=>[a|] //=; last by apply: IH. +split; last by apply: IH. +case/In_pmap=>z E Z; apply: H. +by move: D E (O x) (O z)=>->-> /= ->->. +Qed. + +Lemma pmap_filter_Uniq T1 T2 (f : T1 -> option T2) (s : seq T1) : + (forall x y z, x \In s -> y \In s -> + f x = Some z -> f y = Some z -> x = y) -> + Uniq (filter f s) -> + Uniq (pmap f s). +Proof. +move=>H Uq; rewrite (_ : Uniq (pmap f s) <-> Uniq (map Some (pmap f s))). +- by rewrite map_inj_In_Uniq //; move=>x y _ _ []. +rewrite (@pmapS_filter _ _ f s) map_inj_In_Uniq //. +move=>x y /In_filter [H1 H2] /In_filter [H3 H4] E. +case Dx: (f x) H2 E=>[zx|//] _ E. +case Dy: (f y) H4 E Dx=>[zy|//] _ [->] Dx. +by apply: H H1 H3 Dx Dy. Qed. (* \In and big operators *) @@ -1060,7 +1195,6 @@ Lemma eq_bigR R (idx : R) (op : R -> R -> R) (I : eqType) (r : seq I) \big[op/idx]_(i <- r | P i) F1 i = \big[op/idx]_(i <- r | P i) F2 i. Proof. by move=>eqF12; apply: eq_Bigr=>i /mem_seqP/eqF12. Qed. - (***********************************) (* Image of a collective predicate *) (***********************************) @@ -1075,7 +1209,7 @@ Definition Image' : Pred B := image_spec. End Image. (* swap to make the notation consider P before E; helps inference *) -Notation Image f P := (Image' P f). +Abbreviation Image f P := (Image' P f). Notation "[ 'Image' E | i <- s ]" := (Image (fun i => E) s) (at level 0, E at level 99, i name, @@ -1755,14 +1889,14 @@ Qed. Local Notation "{ 'All1' P }" := (forall x, P x : Prop) (at level 0). Local Notation "{ 'All2' P }" := (forall x y, P x y : Prop) (at level 0). Local Notation "{ 'All3' P }" := (forall x y z, P x y z: Prop) (at level 0). -Local Notation ph := (phantom _). +Local Abbreviation ph := (phantom _). Section LocalProperties. Variables T1 T2 T3 : Type. Variables (d1 : T1 -> Prop) (d2 : T2 -> Prop) (d3 : T3 -> Prop). -Local Notation ph := (phantom Prop). +Local Abbreviation ph := (phantom Prop). Definition Prop_in1 P & ph {All1 P} := forall x, d1 x -> P x. @@ -1836,7 +1970,7 @@ Variables (d1 d1' : T1 -> Prop). Local Notation "{ 'All1' P }" := (forall x, P x : Prop) (at level 0). Local Notation "{ 'All2' P }" := (forall x y, P x y : Prop) (at level 0). Local Notation "{ 'All3' P }" := (forall x y z, P x y z: Prop) (at level 0). -Local Notation ph := (phantom _). +Local Abbreviation ph := (phantom _). Lemma In1W : {All1 P1} -> {In D1, {All1 P1}}. Proof. by move=> ? ?. Qed. diff --git a/core/prelude.v b/core/prelude.v index 1f50c32..76671f3 100644 --- a/core/prelude.v +++ b/core/prelude.v @@ -17,15 +17,11 @@ limitations under the License. (******************************************************************************) From HB Require Import structures. -From Stdlib Require Import Eqdep. From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat seq eqtype choice. From mathcomp Require Import path fintype finset finfun tuple perm fingroup. From mathcomp Require Import ssralg. From pcm Require Import options axioms. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (***********) (* Prelude *) (***********) @@ -33,29 +29,20 @@ Set SsrOldRewriteGoalsOrder. (* often used notation definitions and lemmas that are *) (* not included in the other libraries *) -(* export inj_pair without exporting the whole Eqdep library *) -Definition inj_pair2 := @inj_pair2. -Arguments inj_pair2 {U P p x y}. - -(* Because of a bug in inversion and injection tactics *) -(* we occasionally have to destruct pair by hand, else we *) -(* lose the second equation. *) -Lemma inj_pair A B (a1 a2 : A) (b1 b2 : B) : - (a1, b1) = (a2, b2) -> - (a1 = a2) * (b1 = b2). -Proof. by case. Qed. - -Arguments inj_pair {A B a1 a2 b1 b2}. +Prenex Implicits Logic.eq_sym. (* eta laws for pairs and units *) -Notation prod_eta := surjective_pairing. +Abbreviation prod_eta := surjective_pairing. (* eta law often used with injection *) -Lemma prod_inj A B (x y : A * B) : +Lemma inj_prod A B (x y : A * B) : x = y <-> (x.1, x.2) = (y.1, y.2). Proof. by case: x y=>x1 x2 []. Qed. +Definition inj_rcons := @rcons_inj. +Prenex Implicits inj_rcons. + Lemma idfunE (U : Type) (x : U) : idfun x = x. Proof. by []. Qed. @@ -673,7 +660,7 @@ Inductive is_some_spec A x : option A -> Prop := Hint Resolve is_some_case : core. -Notation is_some x := (is_some_spec x x). +Abbreviation is_some x := (is_some_spec x x). Lemma is_someP A (x : option A) : reflect (is_some x) (isSome x). Proof. by case: x=>[a|]; constructor=>//; case. Qed. @@ -703,7 +690,14 @@ Proof. by elim: n. Qed. Lemma subn_eq0P m n : reflect (m - n = 0) (m <= n). Proof. by rewrite -subn_eq0; apply/eqP. Qed. - + +(************) +(* Ordinals *) +(************) + +Lemma ord_neq n (i : 'I_n) : n != i. +Proof. by rewrite neq_ltn widen_ord_proof // orbT. Qed. + (**************************************) (* Inhabited (non-empty) finite types *) (**************************************) @@ -742,7 +736,7 @@ Lemma ith_indx {T : finType} (i : T) (pf : indx i < #|T|) : ith (indx i) pf = i. Proof. by rewrite /ith/indx nth_index // mem_enum. Qed. -Lemma indx_inj {T} : injective (@indx T). +Lemma inj_indx {T} : injective (@indx T). Proof. rewrite /indx=>x1 x2. have [] : x1 \in enum T /\ x2 \in enum T by rewrite !mem_enum. @@ -751,7 +745,7 @@ case: (x1 =P x)=>[<-|] _ /=; first by case: (x2 =P x1). by case: (x2 =P x)=>//= _ X1 X2 []; apply: IH X1 X2. Qed. -Lemma ith_inj {T : finType} i1 i2 (pf1 : i1 < #|T|) (pf2 : i2 < #|T|) : +Lemma inj_ith {T : finType} i1 i2 (pf1 : i1 < #|T|) (pf2 : i2 < #|T|) : ith i1 pf1 = ith i2 pf2 -> i1 = i2. Proof. @@ -764,7 +758,7 @@ case=>[|i1][|i2] //= pf1 pf2 o1 o2. by move=>H /andP [_ U]; rewrite (IH _ _ pf1 pf2 o1 o2). Qed. -Lemma indx_injE {T : finType} s i (pf : i < #|T|) : +Lemma inj_indxE {T : finType} s i (pf : i < #|T|) : (s == ith i pf) = (indx s == i). Proof. apply/eqP/eqP=>[->|E]; first by rewrite indx_ith. @@ -778,16 +772,16 @@ elim: (enum T) (enum_uniq T)=>[|x xs IH] //. set f := index^~(x :: xs)=>/= /andP [H1 H2]. rewrite {1}/f /= eqxx; congr (0 :: _). case: (eq_in_map f (fun x=>(index x xs).+1) xs)=>E _. -rewrite E; last first. +rewrite E. - by move=>z R; rewrite /f /=; case: (x =P z) R H1=>//= ->->. by rewrite -add1n iotaDl -IH // -map_comp. Qed. Lemma take_enum {T : finType} x i : - x \in take i (enum T) = (indx x < i). + (x \in take i (enum T)) = (indx x < i). Proof. pose f x := indx x. -rewrite -(mem_map indx_inj) map_take map_indx take_iota. +rewrite -(mem_map inj_indx) map_take map_indx take_iota. case: (leqP i #|T|)=>H; rewrite mem_iota /=; first by rewrite add0n. rewrite add0n cardE index_mem mem_enum inE /=; apply: sym_eq. apply: (@ltn_trans #|T|) H. @@ -795,10 +789,10 @@ by rewrite cardE index_mem mem_enum. Qed. Lemma drop_enum {T : finType} x i : - x \in drop i (enum T) = (i <= indx x). + (x \in drop i (enum T)) = (i <= indx x). Proof. pose f x := index x (enum T). -rewrite -(mem_map indx_inj) map_drop map_indx drop_iota mem_iota add0n. +rewrite -(mem_map inj_indx) map_drop map_indx drop_iota mem_iota add0n. case H : (i <= indx x)=>//=; rewrite subnKC ?indx_card //. by apply/(leq_trans H)/ltnW/indx_card. Qed. @@ -807,7 +801,7 @@ Lemma take_enum_filter {T : finType} k : filter (preim indx [pred x | x < k]) (enum T) = take k (enum T). Proof. -apply: (inj_map indx_inj). +apply: (inj_map inj_indx). rewrite map_take map_indx -filter_map map_indx. apply: (sorted_eq leq_trans anti_leq). - by apply/(sorted_filter leq_trans)/iota_sorted. @@ -826,7 +820,7 @@ Lemma drop_enum_filter {T : finType} k : filter (preim indx [pred x | x >= k]) (enum T) = drop k (enum T). Proof. -apply: (inj_map indx_inj). +apply: (inj_map inj_indx). rewrite map_drop map_indx -filter_map map_indx. apply: (sorted_eq leq_trans anti_leq). - by apply/(sorted_filter leq_trans)/iota_sorted. @@ -973,6 +967,24 @@ Lemma pmap_pcomp {S T U} (f : T -> option U) (g : S -> option T) s : pmap (pcomp f g) s = pmap f (pmap g s). Proof. by elim: s=>//= x s ->; rewrite /pcomp; case: (g x). Qed. +Lemma pmap_comp {S T U} (f : T -> option U) (g : S -> T) s : + pmap (f \o g) s = pmap f (map g s). +Proof. by elim: s=>//= x s ->. Qed. + +Lemma pmap_map {S T} (f : S -> option T) (s : seq S) : + pmap f s = pmap id (map f s). +Proof. by rewrite -pmap_comp. Qed. + +Lemma pmap_none {S} (s : seq S) : pmap (fun=>@None S) s = [::]. +Proof. by elim: s. Qed. + +Lemma pmap_some {S} (s : seq S) : pmap some s = s. +Proof. by elim: s=>//= x s ->. Qed. + +Lemma filter_pmapE {S} p (xs : seq S) : + filter p xs = pmap (fun x => if p x then Some x else None) xs. +Proof. by elim: xs=>[|x xs IH] //=; case: ifP=>P; rewrite IH. Qed. + (* sequence prefixes *) (* Two helper concepts for searching in sequences: *) @@ -1051,6 +1063,16 @@ Lemma Prefix_cons' x y s1 s2 : Prefix (x :: s1) (y :: s2) -> x = y /\ Prefix s1 s2. Proof. by move=>H; case: (H 0 x (erefl _)) (H)=>-> /Prefix_cons. Qed. +Lemma Prefix_consE s1 a s2 : + Prefix s1 (a :: s2) <-> + s1 = [::] \/ exists s1', s1 = a :: s1' /\ Prefix s1' s2. +Proof. +split; last first. +- by case=>[->|] // [s1'][->{s1}] /Prefix_cons; apply. +case: s1=>[|_ s1 /Prefix_cons' [->]]; first by left. +by right; exists s1. +Qed. + Lemma Prefix_rcons x s : Prefix s (rcons s x). Proof. by elim: s=>//= y ys IH; apply/Prefix_cons; apply: IH. Qed. @@ -1061,10 +1083,28 @@ rewrite -cat_rcons; apply: Prefix_trans (IH _). by apply: Prefix_rcons. Qed. -Lemma Prefix_size s1 s2 : Prefix s1 s2 -> size s1 <= size s2. +Lemma PrefixE s1 s2 : + Prefix s1 s2 <-> exists s3, s2 = s1 ++ s3. Proof. -elim: s1 s2=>[//|a s1 IH] [|b s2] H; first by move: (H 0 a (erefl _)). -by rewrite ltnS; apply: (IH _ (proj2 (Prefix_cons' H))). +split; last by case=>s3 ->; apply: Prefix_cat. +elim: s1 s2=>[|x xs IH] s2; first by exists s2. +case: s2=>[/(_ 0 x erefl)//|y ys /Prefix_cons' [?]]. +by subst y=>/IH [s3 ->]; exists s3. +Qed. + +Lemma Prefix_size s1 s2 : + Prefix s1 s2 -> + size s1 <= size s2. +Proof. by case/PrefixE=>s3 ->; rewrite size_cat leq_addr. Qed. + +Lemma Prefix_size' s1 s2 : + Prefix s1 s2 -> + size s1 = size s2 -> + s1 = s2. +Proof. +case/PrefixE=>s3 -> /Logic.eq_sym/eqP. +rewrite size_cat -{2}(addn0 (size s1)) eqn_add2l. +by move/eqP/size0nil=>->; rewrite cats0. Qed. Lemma Prefix_onth s t x : @@ -1075,12 +1115,80 @@ elim:s t x =>[//|a s IH] [|b t] x H1 H2; first by move: (H2 0 a (erefl _)). by case/Prefix_cons': H2=><- H2; case: x H1=>[|n] //= H1; apply: IH. Qed. -Lemma PrefixE s1 s2 : Prefix s1 s2 <-> exists s3, s2 = s1 ++ s3. +Lemma Prefix_catE (xs ys1 ys2 : seq A) : + Prefix xs (ys1 ++ ys2) <-> + if size xs < size ys1 then Prefix xs ys1 + else ys1 = take (size ys1) xs /\ Prefix (drop (size ys1) xs) ys2. Proof. -split; last by case=>s3 ->; apply: Prefix_cat. -elim: s1 s2=>[|x xs IH] s2; first by exists s2. -case: s2=>[/(_ 0 x erefl)//|y ys /Prefix_cons' [?]]. -by subst y=>/IH [s3 ->]; exists s3. +rewrite PrefixE; split=>[[xs2 H]|]; last first. +- case: ltnP=>[N|N [->]] /PrefixE [xs2 ->]. + - by exists (xs2 ++ ys2); rewrite catA. + by exists xs2; rewrite catA size_takel ?cat_take_drop. +case: ltnP=>N; rewrite PrefixE. +- exists (drop (size xs) ys1). + rewrite {1}(_ : xs = take (size xs) (ys1 ++ ys2)). + - by rewrite H takel_cat // take_size. + by rewrite take_cat N cat_take_drop. +split. +- rewrite {1}(_ : ys1 = take (size ys1) (xs ++ xs2)). + - by rewrite -H takel_cat // take_size. + by rewrite takel_cat. +exists xs2. +rewrite (_ : ys2 = drop (size ys1) (xs ++ xs2)). +- by rewrite -H drop_size_cat. +rewrite drop_cat; case: ltngtP N=>// -> _. +by rewrite subnn drop0 drop_size. +Qed. + +Lemma Prefix_catLE (xs ys1 ys2 : seq A) : + Prefix xs (ys1 ++ ys2) <-> + if size xs <= size ys1 then Prefix xs ys1 + else ys1 = take (size ys1) xs /\ + Prefix (drop (size ys1) xs) ys2. +Proof. +rewrite Prefix_catE; case: ltngtP=>// E. +rewrite -E take_size drop_size. +by split=>[[-> _]|/Prefix_size'/(_ E)]. +Qed. + +Lemma Prefix_catP (xs ys1 ys2 : seq A) : + Prefix xs (ys1 ++ ys2) <-> + Prefix xs ys1 \/ + exists2 xs2, xs = ys1 ++ xs2 & Prefix xs2 ys2. +Proof. +split. +- move/Prefix_catLE; case: leqP=>N; first by left. + case=>H1 H2; right; exists (drop (size ys1) xs)=>//. + by rewrite {1}H1 cat_take_drop. +case=>[|[xs2] ->] H; first by apply/Prefix_trans/Prefix_cat. +by elim: ys1=>[|y ys1 IH] //=; rewrite Prefix_cons. +Qed. + +Lemma Prefix0s s : Prefix [::] s. +Proof. by []. Qed. + +(* enumerations of 0,1,2 prefixes *) + +Lemma Prefixs0 s : Prefix s [::] <-> s = [::]. +Proof. by split=>[|->] //; rewrite PrefixE; case=>s'; case: s. Qed. + +Lemma Prefixs1 s a : Prefix s [:: a] <-> s = [::] \/ s = [:: a]. +Proof. +rewrite Prefix_consE; split. +- by case=>[->|[x][->] /Prefixs0 ->]; [left|right]. +by case=>->; [left=>//|right]; exists [::]. +Qed. + +Lemma Prefixs2 s a b : + Prefix s [:: a; b] <-> + [\/ s = [::], s = [:: a] | s = [:: a; b]]. +Proof. +rewrite Prefix_consE; split. +- case=>[->|[x][->] /Prefixs1 [] ->]; + by [apply: Or31|apply: Or32|apply: Or33]. +case=>->; [left=>//|right|right]. +- by exists [::]. +by exists [:: b]; split. Qed. End SeqPrefix. @@ -1191,14 +1299,21 @@ Lemma fin_eta f : f = finfun (sel^~ f). Proof. by apply/ffinP=>t; rewrite sel_fin. Qed. (* function *) +(* this could be defined as *) +(* if tg =P x is Reflect pf then cast Us pf v *) +(* else sel x f *) +(* but the definition below is better in practice *) +(* as it automatically reduces when it can determine *) +(* that tg = x or tg != x, say because tx and x *) +(* are some concrete values of type T *) Definition splice tg f (v : Us tg) : {dffun _} := finfun (fun x => - if decP (x =P tg) is left pf then cast Us pf v + if decP (tg =P x) is left pf then cast Us pf v else sel x f). Lemma sel_splice t f x (v : Us x) : sel t (splice f v) = - if decP (t =P x) is left pf then cast Us pf v + if decP (x =P t) is left pf then cast Us pf v else sel t f. Proof. by rewrite sel_fin. Qed. @@ -1206,7 +1321,7 @@ Lemma sel_spliceE t f v : sel t (splice f v) = v. Proof. by rewrite sel_fin; case: eqP=>//= pf; rewrite eqd. Qed. Lemma sel_spliceN t x f (w : Us x) : - t <> x -> sel t (splice f w) = sel t f. + x <> t -> sel t (splice f w) = sel t f. Proof. by move=>N; rewrite sel_fin; case: eqP. Qed. Lemma splice_eta t f : splice f (sel t f) = f. @@ -1240,7 +1355,7 @@ Variant dfun_delta : Type := DFunDelta t of Us t. (* for iteration that starts with function ends with function *) Definition dapp_fdelta df (f : forall t, Us t) z := let: DFunDelta t v := df in - if decP (z =P t) is left pf then cast Us pf v + if decP (t =P z) is left pf then cast Us pf v else f z. (* for iteration that starts with finfun ends with function *) @@ -1395,34 +1510,155 @@ move=>H; apply/set_ordT=>x; rewrite ltnNge. by apply/contraR/H. Qed. -(* Tagging *) - -Notation Tag := (@existT _ _). - -Lemma Tag_inj T Us (t1 t2 : T) i1 i2 : - Tag t1 i1 = Tag t2 i2 -> - t1 = t2 /\ jmeq Us i1 i2. -Proof. by case=>?; subst t2=>/inj_pair2 ->. Qed. -Arguments Tag_inj {T Us t1 t2 i1 i2}. +(**************************) +(* Heterogeneous equality *) +(**************************) + +(* when tags are equality type, inj_tag doesn't require StreicherK *) + +Lemma inj_tag {T : eqType} (interp : T -> Type) A (x1 x2 : interp A) : + Tag A x1 = Tag A x2 -> x1 = x2. +Proof. by move/(@eq_from_Tagged T interp). Qed. + +Prenex Implicits inj_tag. + +(* proposition of heterogeneous (John Major) equality can be defined as *) +(* jmeq T (interp : T -> Type) (A1 A2 : T) *) +(* (x1 : interp A1) (x2 : interp A2) := *) +(* exists pf : A1 = A2, x2 = cast interp pf x1 *) +(* or equivalently, using tagged (dependent) pairs as *) +(* jmeq T (interp : T -> Type) (A1 A2 : T) *) +(* (x1 : interp A1) (x2 : interp A2) := *) +(* Tag A1 x1 = Tag A2 x2 *) +(* or as an inductive type (eg. in Coq Stdlib, where it's called eq_dep) *) +(* Inductive eq_dep T (interp : T -> Type) A (x : interp A) : *) +(* forall B, interp B -> Prop := *) +(* jmeq_refl of eq_dep A x A x *) + +(* We work with tagged pairs directly, and thus don't define jmeq explicitly. *) +(* On occasion, however, it's useful to have a jmeq structure that's *) +(* formulated to *embed* x1 and x2, rather than simply equate them. *) +(* This is carried out below. *) + +Section JMeq. +Context {T : Type} (interp : T -> Type). +Implicit Types A : T. + +Definition jmeq_axiom {A1 A2} (x1 : interp A1) (x2 : interp A2) := + exists pf : A1 = A2, x2 = cast interp pf x1. + +Structure isJMeq A1 A2 x1 x2 := jmeqMix {_ : @jmeq_axiom A1 A2 x1 x2}. + +Structure jmeq A1 A2 := + JMeqPack {the : interp A1; emit : interp A2; _ : isJMeq the emit}. + +(* The only instance of jmeq that's ever declared *) +(* is jmeq_refl, ensuring that heterogenous equality *) +(* reduces to plain (homogenous) equality, *) +(* hence it's John Major nature *) +Lemma refl_is_jmeq A x : @jmeq_axiom A A x x. +Proof. by exists erefl. Qed. + +Canonical jmeq_refl A x := + Eval hnf in JMeqPack (jmeqMix (@refl_is_jmeq A x)). + +Lemma jmeqP A1 A2 (jm : jmeq A1 A2) : + exists pf : A1 = A2, emit jm = cast interp pf (the jm). +Proof. by case: jm=>x1 x2 []. Qed. + +(* the following lemma isn't very useful as the *) +(* only instance of jm encountered in practice is jmeq_refl *) +(* and emit (jmeq_refl x) = the (jmeq_refl x) = x *) +(* definitionally, i.e., by plain simplification *) +(* NOTE: the proof requires eqc/StreicherK *) +Lemma jmK_silly A (jm : jmeq A A) : emit jm = the jm. +Proof. by case: (jmeqP jm)=>pf; rewrite eqc. Abort. +End JMeq. + +Abbreviation ijmeq A1 A2 := (@jmeq _ id A1 A2). + +(* One potential use of jmeq canonical structure is to *) +(* separate the equality of tags from equality of tagged values *) +(* when the values happen to have the same type, that is: *) +(* interp tg1 = interp tg2 :> Type *) + +(* NOTE: proof uses eqc and inj_tag, both consequences of StreicherK *) +Lemma injm_tagK A B (interp : A -> Type) (tg1 tg2 : A) + (s1 : ijmeq (interp tg1) B) (s2 : ijmeq (interp tg2) B) : + (Tag tg1 (the s1) = Tag tg2 (the s2)) -> + (tg1 = tg2) /\ (emit s1 = emit s2). +Proof. +case=>?; subst tg2=>/inj_tagK. +case: s1=>s1 es1 [/=]/[swap] ->{s1}. +case=>?; subst B=>/= ->{es1}. +by case: s2=>s2 _ [/=][pf ->]; rewrite eqc. +Qed. + +Prenex Implicits injm_tagK. + +(* The eqType variant also rewrites by eqc *) +(* in order to equate the tagged values. *) +(* Thus it also depends on StreicherK. *) +Lemma jmEK (A B : eqType) (interp : A -> eqType) (tg1 tg2 : A) + (s1 : ijmeq (interp tg1) B) (s2 : ijmeq (interp tg2) B) : + (Tag tg1 (the s1) == Tag tg2 (the s2)) = + (tg1 == tg2) && (emit s1 == emit s2). +Proof. +rewrite -tag_eqE /tag_eq /=. +case: (tg1 =P tg2)=>// ?; subst tg2=>/=. +rewrite tagged_asE {2}/eq_op. +case: B s1 s2=>B [[/= eq_op eqPs]]. +case=>s1 e1 [/=][?]; subst B=>->{e1}. +case=>s2 _ [/=][pf ->]; rewrite {pf}eqc. +by case: eqPs=>[->|]; [rewrite eqxx|case: eqP]. +Qed. -(* tagged union of equality types is equality type *) +(* slight generalization *) +Lemma jmEK' (A B : eqType) (interp : A -> eqType) (tg2 : A) + (u : {tg & interp tg}) (s2 : ijmeq (interp tg2) (interp (tag u))) : + (u == Tag tg2 (the s2)) = + (tag u == tg2) && (tagged u == emit s2). +Proof. by case: u s2=>tg1 s1 s2; rewrite jmEK. Qed. + +(* if there's no need to equate tagged values *) +(* (e.g., because B = unit), then StreicherK isn't required *) +Lemma jmE1 (A : eqType) (interp : A -> eqType) (tg1 tg2 : A) + (s1 : ijmeq (interp tg1) unit) (s2 : ijmeq (interp tg2) unit) : + (Tag tg1 (the s1) == Tag tg2 (the s2)) = (tg1 == tg2). +Proof. +rewrite -tag_eqE /tag_eq /=. +case: (tg1 =P tg2)=>// ?; subst tg2=>/=. +rewrite tagged_asE; apply/eqP. +case: s1=>s1 [][/=][pf1 _]. +case: s2=>s2 [][/= _]. +rewrite pf1 in s1 s2 *. +by case: s1; case: s2. +Qed. -Section TaggedEq. -Variables (T : eqType) (Us : T -> eqType). +(* We can restate jmEK for non-trivial interp without using StreicherK *) +(* but this isn't useful, as the lemma is just overcomplicated way *) +(* of stating eq_Tagged *) +Lemma jmE_silly (T : eqType) (interp : T -> eqType) (tg1 tg2 : T) tg + (s1 : jmeq interp tg1 tg) (s2 : jmeq interp tg2 tg) : + (Tag tg1 (the s1) == Tag tg2 (the s2)) = + (tg1 == tg2) && (emit s1 == emit s2). +Proof. +rewrite -tag_eqE /tag_eq /=. +case: (tg1 =P tg2)=>// ?; subst tg2=>/=. +rewrite tagged_asE. +case: s1=>s1 e1 [[pf1 H1]] /=; subst tg e1=>/=. +by case: s2=>s2 e2 [[pf2 H2]] /=; rewrite {e2}H2 eq_axiomK. +Abort. -Definition tag_eq : sigT Us -> sigT Us -> bool := - fun '(Tag tx opx) '(Tag ty opy) => - if decP (tx =P ty) is left pf then opx == cast Us pf opy - else false. +(* above lemma is better phrased as follows *) +Lemma inj_tagE (T : eqType) (interp : T -> eqType) + (u : {tg & interp tg}) (x : interp (tag u)) : + (u == Tag (tag u) x) = (tagged u == x). +Proof. exact: eq_Tagged. Qed. -Lemma tag_eqP : Equality.axiom tag_eq. -Proof. -case=>tx opx [ty opy] /=; case: (tx =P ty)=>pf; last first. -- by constructor; case=>/pf. -subst ty; rewrite /= eqc; case: eqP=>pf; constructor; -by [rewrite pf|case=>/inj_pair2/pf]. -Qed. +(* collecting non-StreicherK jm rewrites *) +Definition jmE := (jmE1, inj_tagE). -HB.instance Definition _ := hasDecEq.Build (sigT Us) tag_eqP. -End TaggedEq. +(* collecting all jm rewrites *) +Definition jmK := (jmE, jmEK). diff --git a/core/seqext.v b/core/seqext.v index 8e26b1f..19f3b87 100644 --- a/core/seqext.v +++ b/core/seqext.v @@ -15,15 +15,32 @@ From Stdlib Require Import ssreflect ssrbool ssrfun. From mathcomp Require Import ssrnat seq eqtype path choice fintype bigop perm. From pcm Require Import options prelude pred seqperm. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (*********************) (* Extensions to seq *) (*********************) (* TODO upstream to mathcomp *) +Lemma inj_cons {A} {a1 a2} {s1 s2 : seq A} : + cons a1 s1 = cons a2 s2 -> + a1 = a2 /\ s1 = s2. +Proof. by case. Qed. + +Lemma inj_consE {A : eqType} {x1 x2} {xs1 xs2 : seq A} : + (x1 :: xs1 == x2 :: xs2) = (x1 == x2) && (xs1 == xs2). +Proof. by []. Qed. + +Lemma revE {A} {s1 s2 : seq A} : + rev s1 = s2 <-> s1 = rev s2. +Proof. by split=>[<-|->]; rewrite revK. Qed. + +Lemma rev_eqseq {A : eqType} {s1 s2 : seq A} : + (rev s1 == s2) = (s1 == rev s2). +Proof. by apply/idP/idP=>/eqP/revE/eqP. Qed. + +Lemma inj_rev {A} : injective (@rev A). +Proof. by move=>s1 s2 /revE; rewrite revK. Qed. + Lemma head_rcons {A} (s : seq A) (x y : A) : head x (rcons s y) = head y s. Proof. by rewrite headI. Qed. @@ -48,7 +65,6 @@ Lemma filter_swap {A} (s : seq A) p1 p2 : filter p1 (filter p2 s) = filter p2 (filter p1 s). Proof. by rewrite -!filter_predI filter_predIC. Qed. -(* TODO contribute to mathcomp? *) Lemma map_nilp {A B} (f : A -> B) (s : seq A) : nilp (map f s) = nilp s. Proof. by rewrite /nilp; case: s. Qed. @@ -86,9 +102,8 @@ Lemma drop_take_mask {A} (s : seq A) x y : drop x (take y s) = mask (nseq x false ++ nseq (y-x) true) s. Proof. case: (ltnP x (size s))=>Hx; last first. -- rewrite drop_oversize; last by rewrite size_take_min geq_min Hx orbT. - rewrite -{1}(subnKC Hx) nseqD -catA -{3}(cats0 s) mask_cat; - last by rewrite size_nseq. +- rewrite drop_oversize; first by rewrite size_take_min geq_min Hx orbT. + rewrite -{1}(subnKC Hx) nseqD -catA -{3}(cats0 s) mask_cat; first by rewrite size_nseq. by rewrite mask0 mask_false. have Hx': size (nseq x false) = size (take x s). - by rewrite size_nseq size_take_min; symmetry; apply/minn_idPl/ltnW. @@ -98,13 +113,142 @@ move: (Hxy); rewrite -subn_eq0=>/eqP->; rewrite add0n drop_take_id. by rewrite drop_oversize // size_take_min geq_min Hxy. Qed. +Lemma catl_cancel {A} {x1 y1 x2 y2 : seq A} : + size x1 = size y1 -> + x1 ++ x2 = y1 ++ y2 -> + x1 = y1 /\ x2 = y2. +Proof. +move=>S /[dup] /(f_equal (take (size x1))). +rewrite {2}S !take_size_cat // => ->. +by move/(f_equal (drop (size y1))); rewrite !drop_size_cat. +Qed. + +Lemma catr_cancel {A} {x1 y1 x2 y2 : seq A} : + size x2 = size y2 -> + x1 ++ x2 = y1 ++ y2 -> + x1 = y1 /\ x2 = y2. +Proof. +move=>S /(f_equal rev); rewrite !rev_cat. +case/catl_cancel=>[|/inj_rev -> /inj_rev//]. +by rewrite !size_rev. +Qed. + +Lemma hasN_count {A} {f : {pred A}} {xs} : + reflect (count f xs = 0) (~~ has f xs). +Proof. by rewrite has_count -leqNgt leqn0; apply: eqP. Qed. + +Lemma hasN_filter {A} {f : {pred A}} {xs} : + reflect (filter f xs = [::]) (~~ has f xs). +Proof. by rewrite -filter_nilp; apply: (iffP nilP). Qed. + +Lemma count_filter0 {A} {f : {pred A}} {xs} : + count f xs = 0 <-> filter f xs = [::]. +Proof. by rewrite -size_filter; split=>[/size0nil|->]. Qed. + +Lemma count_pmap0 {A B} {f : A -> option B} {xs} : + count f xs = 0 <-> pmap f xs = [::]. +Proof. by elim: xs=>[|x xs IH] //=; rewrite /oapp; case: (f x). Qed. + +Lemma hasN_pmap {A B} {f : A -> option B} {xs} : + reflect (pmap f xs = [::]) (~~ has f xs). +Proof. by apply: (iffP hasN_count)=>/count_pmap0. Qed. + +Lemma count_rcons A (f : {pred A}) x (xs : seq A) : + count f (rcons xs x) = (count f xs + f x)%N. +Proof. by rewrite -count_rev rev_rcons /= addnC count_rev. Qed. + +Lemma has_first_split A (f : {pred A}) (xs : seq A) : + has f xs -> + exists x p1 p2, + [/\ xs = rcons p1 x ++ p2, f x & ~~ has f p1]. +Proof. +elim: xs=>[|x xs IH] //=. +case F : (f x); first by exists x, [::], xs. +case/IH=>x0 [p1][p2][-> H H1]. +by exists x0, (x :: p1), p2; rewrite /= F H1. +Qed. + +Lemma has_last_split A (f : {pred A}) (xs : seq A) : + has f xs -> + exists x p1 p2, + [/\ xs = rcons p1 x ++ p2, f x & ~~ has f p2]. +Proof. +rewrite -has_rev=>/has_first_split [x][p1][p2][/revE E H1 H2]. +exists x, (rev p2), (rev p1). +by rewrite E rev_cat rev_rcons cat_rcons has_rev. +Qed. + +Lemma count1_split A (f : {pred A}) (xs : seq A) : + count f xs = 1 -> + exists x p1 p2, + [/\ xs = rcons p1 x ++ p2, f x, ~~ has f p1 & ~~ has f p2]. +Proof. +move=>C; have H : has f xs by rewrite has_count C. +case/has_first_split: H C=>x [p1][p2][->{xs} H1 H2]. +rewrite count_cat count_rcons H1 (hasN_count H2) add0n add1n. +by case=>/hasN_count; exists x, p1, p2. +Qed. + +Lemma count_splitE A (f : {pred A}) (x1 x2 : A) p1 p2 q1 q2 : + ~~ has f p1 -> + ~~ has f q1 -> + f x1 -> + f x2 -> + p1 ++ x1 :: q1 = + p2 ++ x2 :: q2 -> + [/\ p1 = p2, x1 = x2 & q1 = q2]. +Proof. +elim: p1 x1 q1 p2 x2 q2=>[|a1 p1 IH] x1 q1 p2 x2 q2 Hp Hq F1 F2 /= E. +- case: p2 E Hq=>[|a2 p2] /=; first by case. + by case=>->->; rewrite has_cat /= F2 orbT. +case: p2 E Hp=>[|a2 p2] /=; first by case=>->; rewrite F2. +case=><-{a2} E; rewrite negb_or=>/andP [_ Hp]. +by case/(IH _ _ _ _ _ Hp Hq F1 F2): E=>->. +Qed. + +Lemma pmap_rcons {A B} {f : A -> option B} {xs x} : + pmap f (rcons xs x) = + if f x is Some y then rcons (pmap f xs) y else pmap f xs. +Proof. +by elim: xs x=>[|y ys IH] x //=; rewrite /oapp IH; case: (f x); case: (f y). +Qed. + +Lemma pmap_rev {A B} {f : A -> option B} {xs} : + pmap f (rev xs) = rev (pmap f xs). +Proof. +elim: xs=>[|x xs IH] //=; rewrite /oapp rev_cons pmap_rcons IH. +by case: (f x)=>[a|//]; rewrite rev_cons. +Qed. + +Lemma sorted_cat {A} (ord : rel A) (xs1 xs2 : seq A) : + transitive ord -> + sorted ord (xs1 ++ xs2) -> + forall k, k \In xs1 -> all (ord k) xs2. +Proof. +move=>Tr S k K; case/In_split: K S=>s1 [s2 ->]. +rewrite -catA sorted_cat_cons /=; case/andP=>_ /(order_path_min Tr). +by rewrite all_cat; case/andP. +Qed. + +Lemma iotaDr m1 m2 n : iota (m1 + m2) n = map (addn^~ m1) (iota m2 n). +Proof. by rewrite iotaDl; apply: eq_map=>x; rewrite addnC. Qed. + Section LemmasEq. -Variables A : eqType. +Context {A : eqType}. Implicit Type xs : seq A. Lemma eqnil xs : xs =i [::] -> xs = [::]. Proof. by case: xs=>// x xs /(_ x); rewrite inE eqxx. Qed. +Lemma revA xs1 xs2 : rev xs1 == xs2 -> all [mem xs1] xs2. +Proof. +elim: xs2 xs1=>[|x2 xs2 IH] //=. +case/lastP=>[|xs1 x1] //=. +rewrite rev_rcons=>/eqP [->{x1}] /eqP /IH /allP X. +rewrite mem_rcons inE eqxx /=. +by apply/allP=>z /X /= Z; rewrite mem_rcons inE Z orbT. +Qed. + (* With A : Type, we have the In_split lemma. *) (* With A : eqType, the lemma can be strenghtened to *) (* not only return the split of xs, but the split of xs *) @@ -153,6 +297,59 @@ split=>[/perm_undup/perm1P ->//|]. by move/perm1P/perm_mem=>H z; rewrite -mem_undup H. Qed. +Lemma permeq_filterC p (s : seq A) : + perm_eq s (filter p s ++ filter (predC p) s). +Proof. by rewrite perm_sym; apply/permEl/perm_filterC. Qed. + +Lemma filter_subseq_in (s1 s2 : seq A) : + uniq s2 -> + subseq s1 s2 -> + filter [in s1] s2 = s1. +Proof. +elim: s2 s1=>[|x s2 IH] s1 /= U; first by move/eqP=>->. +case: s1=>[_|y s1] /=; first by rewrite filter_pred0. +case/andP: U=>N U; case: ifPn=>[/eqP ->{y}|Nyx S]. +- rewrite inE eqxx /= => /(IH _ U) {2}<-. + congr cons; apply: eq_in_filter=>z Z; rewrite inE. + by case: eqP Z N=>//= ->->. +have Nx : x \notin s1. +- by apply: contra N=>N; rewrite (mem_subseq S) // inE N orbT. +by rewrite inE eq_sym (negbTE Nyx) (negbTE Nx) (IH _ U S). +Qed. + +Lemma perm_subseq (r1 r2 r s : seq A) : + uniq r -> + perm_eq r (r1 ++ r2) -> + subseq s r -> + exists s1 s2, + [/\ perm_eq s (s1 ++ s2), + subseq s1 r1 & + subseq s2 r2]. +Proof. +move=>U P S; set s1 := filter (mem s) r1; set s2 := filter (mem s) r2. +exists s1, s2; split; try by apply: filter_subseq. +by rewrite -filter_cat -{1}(filter_subseq_in _ S) // perm_filter. +Qed. + +Lemma rcons_subseq (s : seq A) (x : A) : + subseq [:: x] (rcons s x). +Proof. +elim: s=>[|a s IH] // /=; case: (x =P a)=>[->|//]. +by apply: sub0seq. +Qed. + +Lemma split_subseq x (s1 s2 : seq A) : + subseq (x :: s1) s2 <-> + exists a1 a2, [/\ s2 = a1 ++ x :: a2 & subseq s1 a2]. +Proof. +split; last first. +- case=>a1 [a2][->{s2} S]. + by rewrite -[x :: s1]cat0s cat_subseq ?sub0seq //= eqxx. +elim: s2 s1 x=>[|y s2 IH] s1 x //=. +case: ifPn=>[/eqP <-{y}|_]; first by exists [::], s2. +by case/IH=>a1 [a2][E1 E2]; exists (y :: a1), a2; rewrite /= -E1. +Qed. + Lemma undup_uniq_eq1 (x : A) xs : uniq xs -> xs =i [:: x] <-> xs = [:: x]. @@ -217,11 +414,11 @@ move=>X z; rewrite !inE; case/orP=>[|/X] -> //. by rewrite orbT. Qed. -Lemma subset_catL (s1 s2 s : seq A) : +Lemma subset_catL (s1 s2 : seq A) : {subset s1 <= s1 ++ s2}. Proof. by move=>x S; rewrite mem_cat S. Qed. -Lemma subset_catR (s1 s2 s : seq A) : +Lemma subset_catR (s1 s2 : seq A) : {subset s2 <= s1 ++ s2}. Proof. by move=>x S; rewrite mem_cat S orbT. Qed. @@ -332,7 +529,20 @@ Lemma filter_mem_sym (s1 s2 : seq A) : filter (mem s1) s2 =i filter (mem s2) s1. Proof. by move=>x; rewrite !mem_filter andbC. Qed. -Lemma index_inj xs x y : +Lemma has_filterI (p q : pred A) (s : seq A) : + has p (filter q s) = has (predI p q) s. +Proof. by rewrite has_filter -filter_predI -has_filter. Qed. + +Lemma filter_sub p (s : seq A) : + {subset s <= p} -> + filter p s = s. +Proof. by move=>S; rewrite -[RHS]filter_predT; apply: eq_in_filter. Qed. + +Lemma filter_in (s : seq A) : + filter [in s] s = s. +Proof. by apply: filter_sub. Qed. + +Lemma inj_index xs x y : x \in xs -> index x xs = index y xs -> x = y. @@ -365,14 +575,14 @@ Lemma head_dflt (x1 x2 x : A) xs : head x1 xs = head x2 xs. Proof. by case: xs. Qed. -Lemma mem_head (x : A) xs : head x xs \in x :: xs. +Lemma head_mem (x : A) xs : head x xs \in x :: xs. Proof. by case: xs=>[|y ys]; rewrite !inE //= eqxx orbT. Qed. (* a common pattern of using mem_head that avoids forward reasoning *) Lemma mem_headI (x : A) xs a : a = head x xs -> a \in x :: xs. -Proof. by move=>->; apply: mem_head. Qed. +Proof. by move=>->; apply: head_mem. Qed. Lemma head_nilp (x : A) xs : x \notin xs -> @@ -396,14 +606,14 @@ Qed. (* TODO upstream to mathcomp *) Lemma in_mask_count x m xs : count_mem x xs <= 1 -> - x \in mask m xs = (x \in xs) && nth false m (index x xs). + (x \in mask m xs) = (x \in xs) && nth false m (index x xs). Proof. elim: xs m => [|y xs IHs] m /=; first by rewrite mask0 in_nil. case: m=>/=[|b m]; first by rewrite in_nil nth_nil andbF. case: b; rewrite !inE eq_sym; case: eqP=>//= _. - by rewrite add0n; apply: IHs. - rewrite -{2}(addn0 1%N) leq_add2l leqn0 => /eqP Hc. - rewrite IHs; last by rewrite Hc. + rewrite IHs; first by rewrite Hc. by move/count_memPn/negbTE: Hc=>->. by rewrite add0n; apply: IHs. Qed. @@ -416,7 +626,7 @@ by rewrite inE negb_or eq_sym H. Qed. Lemma prefix_drop_sub (s1 s2 : seq A) : - seq.prefix s1 s2 -> + prefix s1 s2 -> forall n, {subset (drop n s1) <= drop n s2}. Proof. case/seq.prefixP=>s0 {s2}-> n x H. @@ -435,8 +645,96 @@ case: s2=>[|y' s2] /= /andP [/eqP ->]. by rewrite eqxx=>/IH [|/= ->]; [left|right]. Qed. +Lemma prefix_sub (s1 s2 : seq A) : + prefix s1 s2 -> + {subset s1 <= s2}. +Proof. by case/prefixP=>s2' ->; apply: subset_catL. Qed. + +Lemma prefix_subT (s1 s2 s3 : seq A) : + prefix s1 s2 -> + {subset s2 <= s3} -> + {subset s1 <= s3}. +Proof. by move/prefix_sub=>H1 H2 x /H1/H2. Qed. + +Lemma prefix_cat (xs ys1 ys2 : seq A) : + prefix xs (ys1 ++ ys2) = + if size xs < size ys1 then prefix xs ys1 + else (ys1 == take (size ys1) xs) && + prefix (drop (size ys1) xs) ys2. +Proof. +rewrite !prefixE take_cat size_drop; case: ltnP=>// N. +by rewrite -{2}(cat_take_drop (size ys1) xs) eqseq_cat // size_takel. +Qed. + +Lemma prefix_catl (xs ys1 ys2 : seq A) : + prefix xs (ys1 ++ ys2) = + if size xs <= size ys1 then prefix xs ys1 + else (ys1 == take (size ys1) xs) && + prefix (drop (size ys1) xs) ys2. +Proof. +rewrite prefix_cat prefixE; case: ltngtP=>// E. +by rewrite -E {3}E !take_size drop_size prefix0s andbT. +Qed. + +Lemma prefix_catP (xs ys1 ys2 : seq A) : + reflect (prefix xs ys1 \/ + exists2 xs2, xs = ys1 ++ xs2 & prefix xs2 ys2) + (prefix xs (ys1 ++ ys2)). +Proof. +rewrite prefix_catl; case: leqP=>N. +- case D: (prefix xs ys1); constructor; first by left. + case=>//; case=>xs2 E; move: E N D=>->. + rewrite size_cat -leq_subRL // subnn leqn0. + by move/eqP/size0nil=>->; rewrite cats0 prefix_refl. +case: andP=>[[/eqP H1 H2]|H]; constructor. +- right; exists (drop (size ys1) xs)=>//. + by rewrite {1}H1 cat_take_drop. +case=>[/size_prefix|[xs2 E P]]; first by case: ltngtP N. +by apply: H; rewrite E take_size_cat // drop_size_cat. +Qed. + +Lemma suffix_cat (xs ys1 ys2 : seq A) : + suffix xs (ys1 ++ ys2) = + if (size xs < size ys2)%N then suffix xs ys2 + else (ys2 == drop (size xs - size ys2) xs) && + suffix (take (size xs - size ys2) xs) ys1. +Proof. +rewrite /suffix rev_cat prefix_cat !size_rev; case: ltnP=>// N. +by rewrite rev_eqseq !rev_take size_rev revK subKn. +Qed. + +Lemma suffix_catl (xs ys1 ys2 : seq A) : + suffix xs (ys1 ++ ys2) = + if (size xs <= size ys2)%N then suffix xs ys2 + else (ys2 == drop (size xs - size ys2) xs) && + suffix (take (size xs - size ys2) xs) ys1. +Proof. +rewrite suffix_cat; case: ltngtP=>// E; rewrite [RHS]suffixE {}E. +by rewrite subnn !drop0 take0 suffix0s andbT. +Qed. + +Lemma suffix_catP (xs ys1 ys2 : seq A) : + reflect (suffix xs ys2 \/ + exists2 xs1, xs = xs1 ++ ys2 & suffix xs1 ys1) + (suffix xs (ys1 ++ ys2)). +Proof. +rewrite /suffix rev_cat; apply: (iffP (prefix_catP _ _ _)). +- case=>[|[xs2] /revE ->]; first by left. + by right; exists (rev xs2); rewrite ?rev_cat 1?revK. +case=>[|[xs1 ->]]; first by left. +by right; exists (rev xs1)=>//; rewrite rev_cat. +Qed. + +Lemma suffix_sub (s1 s2 : seq A) : + suffix s1 s2 -> + {subset s1 <= s2}. +Proof. by move/prefix_sub=>S x; rewrite -mem_rev=>/S; rewrite mem_rev. Qed. + End LemmasEq. + + + (* lemmas about prev and next should generally by proved using *) (* prev_nth and next_nth, but sometimes we can also prove them *) (* directly by setting up the right induction *) @@ -516,6 +814,16 @@ apply/idP/idP=>/allP S; apply/allP=>x X; by apply/negP=>/S; rewrite X. Qed. +Lemma disjointPR {A : eqType} (s1 s2 : seq A) : + reflect {in s2, forall x, x \notin s1} + (disjoint s1 s2). +Proof. by apply/(iffP allP). Qed. + +Lemma disjointPL {A : eqType} (s1 s2 : seq A) : + reflect {in s1, forall x, x \notin s2} + (disjoint s1 s2). +Proof. by rewrite disjointC; apply/disjointPR. Qed. + Lemma disjoint_catR {A : eqType} (s s1 s2 : seq A) : disjoint s (s1 ++ s2) = disjoint s s1 && disjoint s s2. @@ -644,6 +952,12 @@ apply: (iffP disj_filt_subL)=>/subsetC S x X; apply: S; by rewrite !inE /= negbK. Qed. +Lemma prefix_disjT {A : eqType} (s1 s2 s3 : seq A) : + prefix s1 s2 -> + disjoint s2 s3 -> + disjoint s1 s3. +Proof. by move/prefix_sub/disjoint_subR; apply. Qed. + Lemma cycle_head_uniq {A : eqType} (r : rel A) x (xs : seq A) : x \in xs -> cycle r xs -> @@ -653,6 +967,68 @@ case/splitPr=>p1 p2; rewrite cycle_catC /= rcons_path; case/andP. by case/shortenP=>p' P U _ R; exists p'; rewrite rcons_path P R. Qed. +Lemma subseq_permD {A : eqType} (r1 r2 r : seq A) : + subseq r1 r -> + subseq r2 r -> + disjoint r1 r2 -> + exists2 r', perm_eq r' (r1 ++ r2) & subseq r' r. +Proof. +elim: r r1 r2=>[|x r IH] r1 r2. +- by move/eqP=>-> /eqP ->; exists [::]. +case: r1=>[|a1 r1]; case: r2=>[|a2 r2] //=; first by exists [::]. +- case: ifPn=>[/eqP ->{a2}|N] _ S. + - by exists (x :: r2)=>//; rewrite eqxx. + by exists (a2 :: r2)=>//; rewrite (negbTE N). +- rewrite cats0; case: ifPn=>[/eqP ->{a1}|N] S _. + - by exists (x :: r1)=>//; rewrite eqxx. + by exists (a1 :: r1)=>//; rewrite (negbTE N). +case: ifPn=>[/eqP ->{a1}|N1] S1. +- rewrite disjoint_consL inE (eq_sym x). + case: (a2 =P x)=>//= _ S2 /andP [_] /(IH _ _ S1 S2) [r' P R]. + by exists (x :: r'); [rewrite perm_cons|rewrite eqxx]. +case: ifPn=>[/eqP ->{a2}|N2] S2. +- rewrite disjoint_consR inE (eq_sym x) (negbTE N1) /=. + case/andP=>_ /(IH _ _ S1 S2) [r'] P R. + exists (x :: r'); last by rewrite eqxx. + rewrite -cat_cons -(cat1s x r') -(cat1s x r2). + apply/perm_trans/permPl/perm_catCA. + by rewrite perm_cat2l. +case/(IH _ _ S1 S2)=>r' P R. +exists r'; first by rewrite -cat1s catA cat1s. +by case: r' P R=>[//|a r'] P; case: (a =P x)=>// -> /cons_subseq. +Qed. + +Lemma map_subseq_inj {A B : eqType} (f : A -> B) (s1 s2 : seq A) : + injective f -> + subseq (map f s1) (map f s2) = subseq s1 s2. +Proof. +elim: s2 s1=>[|x s2 IH][|y s1] //= I. +case: (y =P x)=>[->|N]; first by rewrite eqxx IH. +by case: eqP; [move/I/N|rewrite -IH]. +Qed. + +Lemma map_image_subseq {A B : eqType} (f : A -> B) s1 s2 : + subseq s1 (map f s2) -> + exists2 s, s1 = map f s & subseq s s2. +Proof. +elim: s2 s1=>[|x s2 IH][|y s1] //=; try by exists [::]. +case: ifPn=>[/eqP ->{y}|N] /IH [s -> S]. +- by exists (x :: s)=>//; rewrite eqxx. +exists s=>//; case: s S=>[//|z s] S. +by case: eqP S=>// -> /cons_subseq. +Qed. + +Lemma pmap_subseq {A B : eqType} (f : A -> option B) (s1 s2 : seq A) : + subseq s1 s2 -> + subseq (pmap f s1) (pmap f s2). +Proof. +move=>S; suff : subseq (map Some (pmap f s1)) (map Some (pmap f s2)). +- by rewrite map_subseq_inj //; move=>x y []. +rewrite !pmapS_filter; apply: map_subseq; rewrite subseq_filter. +apply/andP; split; first by apply/allP=>z; rewrite mem_filter=>/andP []. +by apply: subseq_trans S; apply/filter_subseq. +Qed. + (* finding last occurrence of element in a sequence *) Section FindLast. @@ -675,8 +1051,8 @@ rewrite /findlast_aux; elim: s oi0=>/= [|x s IH] [o0 i0] /=. rewrite IH /= rev_cons -cats1 find_cat /= has_find. move: (find_size p (rev s)); rewrite size_rev; case: ltngtP=>// H _. - case: eqP=>[E|_]; first by rewrite E ltnNge leqnSn in H. - apply: injective_projections=>/=; [congr Some | rewrite addSnnS]=>//. - by rewrite !predn_sub /= -predn_sub addSnnS prednK // subn_gt0. + apply: injective_projections=>/=; [congr Some|rewrite addSnnS=>//]. + by rewrite !predn_sub /= -predn_sub addSnnS prednK // subn_gt0. case: ifP=>_; rewrite addSnnS; last by rewrite addn1 eqxx. by rewrite addn0 eqn_leq leqnSn /= ltnn subSnn addn0. Qed. @@ -731,8 +1107,8 @@ case/boolP: (has p s2)=>H2; last first. by rewrite addnC subnDl. have H2' : find p (rev s2) < size s2. - by rewrite -size_rev -has_find has_rev. -rewrite /= orbT andbF -addnBA; last by apply: ltnW. -rewrite -!subn1 -subnDA -addnBA; last by rewrite subn_gt0. +rewrite /= orbT andbF -addnBA; first by apply: ltnW. +rewrite -!subn1 -subnDA -addnBA; first by rewrite subn_gt0. by rewrite subnDA. Qed. @@ -760,7 +1136,7 @@ Lemma nth_findlast x0 p s : p (nth x0 s (findlast p s)). Proof. rewrite findlastE=>/[dup] E ->; rewrite -has_rev in E. -rewrite -subnS -nth_rev; last by rewrite -size_rev -has_find. +rewrite -subnS -nth_rev; first by rewrite -size_rev -has_find. by apply: nth_find. Qed. @@ -774,7 +1150,7 @@ have Hh: 0 < size s - find p (rev s). rewrite -size_rev; move/(has_take (size s - i)): (E). rewrite take_rev -subnS size_rev. case/boolP: (i < size s)=>[Hi|]. -- rewrite subnA //; last by apply: ltnW. +- rewrite subnA //; first by apply: ltnW. rewrite subnn add0n has_rev=>->. rewrite ltn_subRL addnC -ltn_subRL subnS. by case: (size s - find p (rev s)) Hh. @@ -802,7 +1178,7 @@ elim: s=>//= h s IH. rewrite rev_cons -cats1 find_cat has_rev size_rev /=. case/orP; first by move=>->. move=>/[dup] H ->; case: ifP=>_ //. -rewrite subSn /=; last first. +rewrite subSn /=. - by rewrite -size_rev; apply: find_size. apply: (leq_ltn_trans (IH H)); rewrite ltn_predL subn_gt0. by rewrite -size_rev -has_find has_rev. @@ -817,7 +1193,7 @@ Lemma split_findlast_nth x0 p s (i := findlast p s) : split_findlast_nth_spec p s (take i s) (drop i.+1 s) (nth x0 s i). Proof. move=> p_s; rewrite -[X in split_findlast_nth_spec _ X](cat_take_drop i s). -rewrite (drop_nth x0 _); last by rewrite -has_findlast. +rewrite (drop_nth x0 _); first by rewrite -has_findlast. rewrite -cat_rcons; constructor; first by apply: nth_findlast. by rewrite has_drop // ltnn. Qed. @@ -835,6 +1211,7 @@ Qed. End FindLast. + Section FindLastEq. Variables T : eqType. Implicit Type s : seq T. @@ -1007,11 +1384,11 @@ Lemma findall_cat p s1 s2 : findall p (s1 ++ s2) = findall p s1 ++ map (fun n => size s1 + n) (findall p s2). Proof. -rewrite !findallE size_cat iotaD add0n zip_cat; last by rewrite size_iota. +rewrite !findallE size_cat iotaD add0n zip_cat; first by rewrite size_iota. rewrite filter_cat {1}/unzip1 map_cat; congr (_ ++ _). set n := size s1. rewrite -{1}(addn0 n) iotaDl zip_mapl filter_map -!map_comp. -rewrite (eq_filter (a2:=(p \o snd))); last by case. +rewrite (eq_filter (a2:=(p \o snd))); first by case. by apply: eq_map; case. Qed. @@ -1257,12 +1634,12 @@ move=>Px; elim: ks=>[|k ks IH] //=; case P : (p k)=>/=; by case: ifP Px; case: ifP=>// _ /eqP <-; rewrite P. Qed. -Lemma filter_sub (p1 p2 : pred A) (s : seq A) : +Lemma filter_subset (p1 p2 : pred A) (s : seq A) : subpred p1 p2 -> {subset filter p1 s <= filter p2 s}. Proof. -move=>S; rewrite (_ : filter p1 s = filter p1 (filter p2 s)). -- by apply: mem_subseq; apply: filter_subseq. +move=>S; rewrite (_ : filter p1 s = filter p1 (filter p2 s)); + last by apply: mem_subseq; apply: filter_subseq. rewrite -filter_predI; apply: eq_in_filter=>x X /=. by case E : (p1 x)=>//=; rewrite (S _ E). Qed. @@ -1498,72 +1875,50 @@ End FilterLastIndex. Section IndexPmap. Variables A B : eqType. -Lemma index_pmap_inj (s : seq A) (f : A -> option B) a1 a2 b1 b2 : - injective f -> - f a1 = Some b1 -> - f a2 = Some b2 -> - index b1 (pmap f s) < index b2 (pmap f s) <-> index a1 s < index a2 s. -Proof. -move=>Inj E1 E2; elim: s=>[|k s IH] //=; rewrite /oapp. -case: eqP=>[->{k}|]. -- rewrite E1 /= eqxx. - case: (a1 =P a2) E1 E2=>[-> -> [/eqP ->] //|]. - by case: (b1 =P b2)=>[-> Na <- /Inj /esym/Na|]. -case: eqP=>[->{k} Na|N2 N1]; first by rewrite E2 /= eqxx !ltn0. -case E : (f k)=>[b|] //=. -case: eqP E1 E=>[-><- /Inj/N1 //|_ _]. -by case: eqP E2=>[-><- /Inj/N2 //|_ _ _]; rewrite IH. -Qed. - -Lemma index_pmap_inj_mem (s : seq A) (f : A -> option B) a1 a2 b1 b2 : - {in s &, injective f} -> - a1 \in s -> - a2 \in s -> - f a1 = Some b1 -> - f a2 = Some b2 -> - index b1 (pmap f s) < index b2 (pmap f s) <-> index a1 s < index a2 s. -Proof. -move=>Inj A1 A2 E1 E2. -elim: s Inj A1 A2=>[|k s IH] //= Inj; rewrite /oapp !inE !(eq_sym k). -case: eqP Inj=>[<-{k} /= Inj _|]. -- rewrite E1 /= !eqxx eq_sym. - case: eqP E1 E2=>[->-> [->]|]; first by rewrite eqxx. - case: eqP=>[-> Na <- E /= A2|//]. - by move/Inj: E Na=>-> //; rewrite inE ?(eqxx,A2,orbT). -case eqP=>[<-{k} Na Inj /= A1 _|]; first by rewrite E2 /= eqxx !ltn0. -move=>N2 N1 Inj /= A1 A2. -have Inj1 : {in s &, injective f}. -- by move=>x y X Y; apply: Inj; rewrite inE ?X ?Y ?orbT. -case E : (f k)=>[b|] /=; last by rewrite IH. -case: eqP E1 E=>[-> <- E|_ _]. -- by move/Inj: E N1=>-> //; rewrite inE ?(eqxx,A1,orbT). -case: eqP E2=>[-><- E|_ _ _]; last by rewrite IH. -by move/Inj: E N2=>-> //; rewrite inE ?(eqxx,A2,orbT). -Qed. - -(* we can relax the previous lemma a bit *) -(* the relaxation will be more commonly used than the previous lemma *) -(* because the option type gives us the implication that the second *) -(* element is in the map *) -Lemma index_pmap_inj_in (s : seq A) (f : A -> option B) a1 a2 b1 b2 : - {in s & predT, injective f} -> - f a1 = Some b1 -> - f a2 = Some b2 -> - index b1 (pmap f s) < index b2 (pmap f s) <-> index a1 s < index a2 s. -Proof. -move=>Inj E1 E2. -case A1 : (a1 \in s); last first. -- move/negbT/index_sizeE: (A1)=>->. - suff /index_sizeE -> : b1 \notin pmap f s by rewrite !ltnNge !index_size. - rewrite mem_pmap; apply/mapP; case=>x X /esym; rewrite -E1=>E. - by move/(Inj _ _ X): E A1=><- //; rewrite X. -case A2 : (a2 \in s). -- by apply: index_pmap_inj_mem=>// x y X _; apply: Inj. -move/negbT/index_sizeE: (A2)=>->. -suff /index_sizeE -> : b2 \notin pmap f s. -- by rewrite !index_mem /= A1 mem_pmap; split=>// _; apply/mapP; exists a1. -rewrite mem_pmap; apply/mapP; case=>x X /esym; rewrite -E2=>E. -by move/(Inj _ _ X): E A2=><- //; rewrite X. +Lemma index_pmap (f : A -> option B) s x' y' y : + f y = Some y' -> + index x' (pmap f s) < index y' (pmap f s) -> + exists2 x, f x = Some x' & index x s < index y s. +Proof. +move=>Y N; case Dy : (y \in s); last first. +- have : x' \in pmap f s by rewrite -index_mem (leq_trans N) // index_size. + case/pmapPP=>x H1 /mem_seqP D1; exists x=>//. + by move/negbT/index_memN: Dy=>->; rewrite index_mem. +elim: s Dy Y N=>[|k ks IH] //=; rewrite inE /oapp eq_sym =>Dy Y. +case: (k =P y) Dy=>[->{k} _|Nk /= H]. +- by rewrite Y /= eqxx; case: ifP. +case D: (f k)=>[k'|] /=; last first. +- by case/(IH H Y)=>x X N; exists x=>//; case: ifP. +case: ifPn D=>[/eqP ->|Nk1]; first by exists k=>//; rewrite eqxx. +case: ifPn=>// Nk2 D /(IH H Y) [x] X N; exists x=>//. +by case: ifP. +Qed. + +Lemma index_pmap_inj (f : A -> option B) s x y x' y' : + {in s, forall x, f x = Some y' -> x = y} -> + index x s < index y s -> + f x = Some x' -> + f y = Some y' -> + index x' (pmap f s) < index y' (pmap f s). +Proof. +move=>H N X Y; case Dy : (y \in s); last first. +- have Ny : y' \notin pmap f s. + - apply/pmapPP; case=>z E /mem_seqP Z. + by move/(H _ Z): E (Z) Dy=>->->. + rewrite (memNindex Ny) index_mem. + apply/pmapPP; exists x=>//; apply/mem_seqP. + by rewrite -index_mem (leq_trans N) // index_size. +elim: s Dy H N=>[|k s IH] //=; rewrite inE /oapp eq_sym. +case: (k =P y)=>[->{k}|] //=. +case: (k =P x)=>[->{k} Nxy Dy H _|/eqP Nkx Nky Dy H]. +- by rewrite X /= eqxx; case: ifP X Nxy=>// /eqP -> /H -> //; rewrite inE eqxx. +have H' : {in s, forall x, f x = Some y' -> x = y}. +- by move=>z Dz /H -> //; rewrite inE Dz orbT. +move/(IH Dy H'); case Dk: (f k)=>[k'|] //=. +case: ifPn Dk=>[/eqP ->{k'} Dk|]. +- by case: ifPn=>// /eqP ->; rewrite ltnn. +case: ifPn=>// /eqP ->{k'} N K. +by move/H: K Nky=>-> //; rewrite inE eqxx. Qed. End IndexPmap. @@ -1645,18 +2000,14 @@ case; case=>[|i][] /=; first by rewrite Ne. by rewrite ltnS=>H1 H2 H3; exists i; split=>// j; rewrite -ltnS; apply: H3. Qed. -Section SeqRel. -Variable A : eqType. -Implicit Type ltT leT : rel A. - (* ordering with path, seq and last *) -Lemma eq_last (s : seq A) x y : +Lemma eq_last (A : eqType) (s : seq A) x y : x \in s -> last y s = last x s. Proof. by elim: s x y=>[|w s IH]. Qed. -Lemma seq_last_in (s : seq A) x : +Lemma seq_last_in (A : eqType) (s : seq A) x : last x s \notin s -> s = [::]. Proof. @@ -1664,7 +2015,7 @@ case: (lastP s)=>{s} // s y; case: negP=>//; elim; rewrite last_rcons. by elim: s=>[|y' s IH]; rewrite /= inE // IH orbT. Qed. -Lemma path_last (s : seq A) leT x : +Lemma path_last (A : eqType) (s : seq A) leT x : transitive leT -> path leT x s -> (x == last x s) || leT x (last x s). @@ -1674,14 +2025,14 @@ move=>T /(order_path_min T) /allP; case: s=>[|a s] H /=. by rewrite (H (last a s)) ?orbT // mem_last. Qed. -Lemma path_lastR (s : seq A) leT x : +Lemma path_lastR (A : eqType) (s : seq A) leT x : reflexive leT -> transitive leT -> path leT x s -> leT x (last x s). Proof. by move=>R T P; case: eqP (path_last T P)=>// <- _; apply: R. Qed. -Lemma path_prev leT s a x : +Lemma path_prev (A : eqType) (leT : rel A) s a x : x \in s -> path leT a s -> exists y, y \in belast a s /\ leT y x. @@ -1690,7 +2041,7 @@ case/splitPr=>p1 p2; rewrite cat_path /= =>/and3P []. by exists (last a p1); rewrite belast_cat /= mem_cat inE eqxx orbT. Qed. -Lemma path_next leT s a x b : +Lemma path_next (A : eqType) (leT : rel A) s a x b : x \in a :: s -> path leT a (rcons s b) -> exists y, y \in rcons s b /\ leT x y. @@ -1702,7 +2053,7 @@ case/andP: H2=>H2 _; exists y; split=>//. by rewrite mem_cat inE eqxx orbT. Qed. -Lemma path_uniq leT a s : +Lemma path_uniq (A : eqType) (leT : rel A) a s : (forall x y, leT x y -> y != a) -> (forall a b x, leT a x -> leT b x -> a = b) -> path leT a s -> @@ -1720,7 +2071,7 @@ Qed. (* in a sorted list, the last element is maximal *) (* and the maximal element is last *) -Lemma sorted_last_key_max (s : seq A) leT x y : +Lemma sorted_last_key_max (A : eqType) (s : seq A) leT x y : transitive leT -> sorted leT s -> x \in s -> @@ -1731,7 +2082,7 @@ case: eqP=>[->|] /= _; first by apply: path_last. by apply: IH (path_sorted H). Qed. -Lemma sorted_last_key_maxR (s : seq A) leT x y : +Lemma sorted_last_key_maxR (A : eqType) (s : seq A) leT x y : reflexive leT -> transitive leT -> sorted leT s -> @@ -1742,7 +2093,7 @@ move=>R T S X; case/orP: (sorted_last_key_max y T S X)=>// /eqP <-. by apply: R. Qed. -Lemma sorted_max_key_last (s : seq A) leT x y : +Lemma sorted_max_key_last (A : eqType) (s : seq A) leT x y : transitive leT -> antisymmetric leT -> sorted leT s -> @@ -1758,7 +2109,7 @@ case/orP: (path_last T H1)=>[/eqP //|] X. by apply: S; rewrite X H2 ?mem_last. Qed. -Lemma max_key_last_notin (s : seq A) (leT : rel A) x y : +Lemma max_key_last_notin (A : eqType) (s : seq A) (leT : rel A) x y : leT y x -> (forall z, z \in s -> leT z x) -> leT (last y s) x. @@ -1768,7 +2119,7 @@ elim: s x y=>[|w s IH] //= x y H1 H2; apply: IH. by move=>z D; apply: H2; rewrite inE D orbT. Qed. -Lemma seq_last_mono (s1 s2 : seq A) leT x : +Lemma seq_last_mono (A : eqType) (s1 s2 : seq A) leT x : transitive leT -> path leT x s1 -> path leT x s2 -> @@ -1778,10 +2129,10 @@ Proof. move=>T; case: s1=>/= [_ H1 _|a s]; first by apply: path_last H1. case/andP=>H1 H2 H3 H; apply: sorted_last_key_max (path_sorted H3) _=>//. apply: {x s2 H1 H3} H; rewrite inE orbC -implyNb. -by case E: (_ \notin _) (@seq_last_in s a)=>//= ->. +by case E: (_ \notin _) (@seq_last_in A s a)=>//= ->. Qed. -Lemma seq_last_monoR (s1 s2 : seq A) leT x : +Lemma seq_last_monoR (A : eqType) (s1 s2 : seq A) leT x : reflexive leT -> transitive leT -> path leT x s1 -> @@ -1790,7 +2141,7 @@ Lemma seq_last_monoR (s1 s2 : seq A) leT x : leT (last x s1) (last x s2). Proof. by move=>R T P1 P2 S; case: eqP (seq_last_mono T P1 P2 S)=>[->|]. Qed. -Lemma ord_path (s : seq A) leT (x y : A) : +Lemma ord_path A (s : seq A) leT (x y : A) : transitive leT -> leT x y -> path leT y s -> @@ -1800,7 +2151,7 @@ move=>T; elim: s x y=>[|k s IH] x y //= H1 /andP [H2 ->]. by rewrite (T _ _ _ H1 H2). Qed. -Lemma path_mem (s : seq A) leT x y : +Lemma path_mem (A : eqType) (s : seq A) leT x y : transitive leT -> path leT x s -> y \in s -> @@ -1811,7 +2162,7 @@ rewrite inE; case/orP=>[/eqP -> //|]. by apply: IH; apply: ord_path O P. Qed. -Lemma path_mem_irr (s : seq A) ltT x : +Lemma path_mem_irr (A : eqType) (s : seq A) ltT x : irreflexive ltT -> transitive ltT -> path ltT x s -> @@ -1821,7 +2172,7 @@ move=>I T P; apply: contraFT (I x). by rewrite negbK; apply: path_mem T P. Qed. -Lemma sorted_rcons (s : seq A) leT (y : A) : +Lemma sorted_rcons (A : eqType) (s : seq A) leT (y : A) : sorted leT s -> (forall x, x \in s -> leT x y) -> sorted leT (rcons s y). @@ -1830,7 +2181,7 @@ elim: s=>[|a s IH] //= P H; rewrite rcons_path P /=. by apply: H (mem_last _ _). Qed. -Lemma sorted_rconsE (leT : rel A) xs x : +Lemma sorted_rconsE A (leT : rel A) xs x : transitive leT -> sorted leT (rcons xs x) = all (leT^~ x) xs && sorted leT xs. @@ -1839,12 +2190,12 @@ move/rev_trans=>Ht; rewrite -(revK (rcons _ _)) rev_rcons rev_sorted /=. by rewrite path_sortedE // all_rev rev_sorted. Qed. -Lemma sorted1 (r : rel A) xs : +Lemma sorted1 A (r : rel A) xs : size xs == 1 -> sorted r xs. Proof. by case: xs=>// x; case. Qed. -Lemma sorted_subset_subseq (s1 s2 : seq A) ltT : +Lemma sorted_subset_subseq_irr (A : eqType) (s1 s2 : seq A) ltT : irreflexive ltT -> transitive ltT -> sorted ltT s1 -> @@ -1858,7 +2209,27 @@ apply: irr_sorted_eq S1 _ _=>//; first by rewrite sorted_filter. by move=>k; rewrite mem_filter; case S : (_ \in _)=>//; rewrite (H _ S). Qed. -Lemma sorted_ord_index (s : seq A) ltT x y : +Lemma sorted_subset_subseq_asym (A : eqType) (s1 s2 : seq A) leT : + uniq s1 -> + uniq s2 -> + transitive leT -> + antisymmetric leT -> + sorted leT s1 -> + sorted leT s2 -> + {subset s1 <= s2} -> + subseq s1 s2. +Proof. +move=>U1 U2 T An S1 S2 H. +suff -> : s1 = filter (fun x => x \in s1) s2 by apply: filter_subseq. +apply: (sorted_eq (leT:=leT))=>//; first by rewrite sorted_filter. +rewrite {1}(_ : s1 = undup s1); first by rewrite undup_id. +rewrite (_ : [seq x <- s2 | x \in s1] = + undup [seq x <- s2 | x \in s1]); first by rewrite undup_id ?filter_uniq. +apply: perm_undup=>z; rewrite mem_filter. +by case D : (z \in s1)=>//=; rewrite H. +Qed. + +Lemma sorted_ord_index (A : eqType) (s : seq A) ltT x y : irreflexive ltT -> transitive ltT -> sorted ltT s -> @@ -1873,7 +2244,7 @@ case: eqP H P=>[<-{z} H|_ H]; last first. by move/(path_mem T)/(_ X)=>/(T _ _ _ H); rewrite I. Qed. -Lemma path_ord_index_leq (s : seq A) leT x y : +Lemma path_ord_index_leq (A : eqType) (s : seq A) leT x y : transitive leT -> antisymmetric leT -> leT x y -> @@ -1888,7 +2259,7 @@ case: eqP Lya Pal As=>[<-{a} Lyx _ As _|Nxa Lya Pal /= As' X]. by move/Nxa: (IH x a As' (T _ _ _ Lxy Lya) Pal X). Qed. -Lemma sorted_ord_index_leq (s : seq A) leT x y : +Lemma sorted_ord_index_leq (A : eqType) (s : seq A) leT x y : transitive leT -> antisymmetric leT -> sorted leT s -> @@ -1904,7 +2275,7 @@ case: eqP Nxz P=>[<-{z} Nxy P|Nyz Nxz P]. by apply: IH X=>//; apply: path_sorted P. Qed. -Lemma sorted_index_ord (s : seq A) leT x y : +Lemma sorted_index_ord (A : eqType) (s : seq A) leT x y : transitive leT -> sorted leT s -> y \in s -> @@ -1918,7 +2289,7 @@ Qed. (* sorted, uniq, filter *) -Lemma lt_sorted_uniq_le (s : seq A) ltT : +Lemma lt_sorted_uniq_le (A : eqType) (s : seq A) ltT : irreflexive ltT -> antisymmetric ltT -> transitive ltT -> @@ -1939,7 +2310,7 @@ rewrite eq_sym (negbTE Nm) /= =>lTmn. by rewrite (As m n) ?eqxx // lTnm lTmn in Nm. Qed. -Lemma sort_sorted_in_lt (s : seq A) ltT : +Lemma sort_sorted_in_lt (A : eqType) (s : seq A) ltT : irreflexive ltT -> antisymmetric ltT -> transitive ltT -> @@ -1952,7 +2323,7 @@ by rewrite sort_uniq U (sort_sorted_in Tot _). Qed. (* filtering and consecutive elements in an order *) -Lemma filterCN (ltT : rel A) f t1 t2 : +Lemma filterCN (A : eqType) (ltT : rel A) f t1 t2 : t1 \notin f -> {in f, forall z, ltT z t2 = (z == t1) || ltT z t1} -> filter (ltT^~ t2) f = filter (ltT^~ t1) f. @@ -1961,7 +2332,7 @@ move=>N C; apply: eq_in_filter=>x T; rewrite C ?inE ?orbT //. by case: eqP N T=>// -> /negbTE ->. Qed. -Lemma filterCE (ltT : rel A) f t1 t2 : +Lemma filterCE (A : eqType) (ltT : rel A) f t1 t2 : irreflexive ltT -> transitive ltT -> sorted ltT f -> @@ -1984,7 +2355,7 @@ Qed. (* frequently we have nested filtering and sorting *) (* for which the following forms of the lemmas is more effective *) -Lemma filter2CN (ltT : rel A) p f t1 t2 : +Lemma filter2CN (A : eqType) (ltT : rel A) p f t1 t2 : t1 \notin p -> {in p, forall z, ltT z t2 = (z == t1) || ltT z t1} -> filter (ltT^~ t2) (filter p f) = filter (ltT^~ t1) (filter p f). @@ -1993,7 +2364,7 @@ move=>N C; apply: filterCN; first by rewrite mem_filter negb_and N. by move=>z; rewrite mem_filter=>/andP [D _]; apply: C. Qed. -Lemma filter2CE (ltT : rel A) (p : pred A) f t1 t2 : +Lemma filter2CE (A : eqType) (ltT : rel A) (p : pred A) f t1 t2 : irreflexive ltT -> antisymmetric ltT -> transitive ltT -> @@ -2014,11 +2385,11 @@ Qed. (* nth *) -Lemma nth_cons (a x : A) (s : seq A) (n : nat) : +Lemma nth_cons A (a x : A) (s : seq A) (n : nat) : nth a (x :: s) n = if n == 0 then x else nth a s n.-1. Proof. by case: n. Qed. -Lemma nth_base (s : seq A) k1 k2 i : +Lemma nth_base A (s : seq A) k1 k2 i : i < size s -> nth k1 s i = nth k2 s i. Proof. @@ -2026,7 +2397,7 @@ elim: s i=>[|x xs IH] //= i K; rewrite !nth_cons. by case: eqP=>//; case: i K=>// i; rewrite ltnS=>/IH ->. Qed. -Lemma nth_path_head (s : seq A) leT x0 k i : +Lemma nth_path_head (A : eqType) (s : seq A) leT x0 k i : transitive leT -> i <= size s -> path leT k s -> @@ -2039,7 +2410,7 @@ rewrite !ltnS in IH; move: (IH (ltnW N)); rewrite H1 H2=>/(_ (erefl _)). by move/T; apply; apply/pathP. Qed. -Lemma nth_path_last (s : seq A) leT x0 k i : +Lemma nth_path_last (A : eqType) (s : seq A) leT x0 k i : transitive leT -> i < size s -> path leT k s -> (nth x0 s i == last k s) || leT (nth x0 s i) (last k s). @@ -2051,10 +2422,10 @@ move=>z; apply: sorted_last_key_max=>//. by apply: path_sorted P. Qed. -Lemma nth_consS (s : seq A) x0 k i : nth x0 s i = nth x0 (k::s) i.+1. +Lemma nth_consS A (s : seq A) x0 k i : nth x0 s i = nth x0 (k::s) i.+1. Proof. by []. Qed. -Lemma nth_leT (s : seq A) leT x0 k i : +Lemma nth_leT A (s : seq A) leT x0 k i : i < size s -> path leT k s -> leT (nth x0 (k::s) i) (nth x0 s i). @@ -2063,7 +2434,7 @@ elim: i k s=>[|i IH] k s; first by case: s=>[|x xs] //= _ /andP []. by case: s IH=>[|x xs] //= IH N /andP [P1 P2]; apply: IH. Qed. -Lemma nth_ltn_mono (s : seq A) leT x0 k i j : +Lemma nth_ltn_mono A (s : seq A) leT x0 k i j : transitive leT -> i <= size s -> j <= size s -> @@ -2077,7 +2448,7 @@ rewrite ltnS leq_eqVlt=>/orP; case=>[/eqP -> //|]. by move/(IH (ltnW S2))/T; apply. Qed. -Lemma nth_mono_ltn (s : seq A) ltT x0 k i j : +Lemma nth_mono_ltn A (s : seq A) ltT x0 k i j : irreflexive ltT -> transitive ltT -> i <= size s -> @@ -2090,7 +2461,7 @@ move=>I T S1 S2 P; case: ltngtP=>//; last by move=>->; rewrite I. by move/(nth_ltn_mono x0 T S2 S1 P)/T=>X /X; rewrite I. Qed. -Lemma nth_between (s : seq A) ltT x0 k z i : +Lemma nth_between (A : eqType) (s : seq A) ltT x0 k z i : irreflexive ltT -> transitive ltT -> path ltT k s -> @@ -2111,7 +2482,7 @@ Qed. (* how to prove that something's sorted via index? *) -Lemma index_sorted (s : seq A) (leT : rel A) : +Lemma index_sorted (A : eqType) (s : seq A) (leT : rel A) : uniq s -> (forall a b, a \in s -> b \in s -> index a s < index b s -> leT a b) -> @@ -2125,8 +2496,6 @@ apply: H; rewrite ?(inE,Xa,Xb,orbT) //. by case: eqP U=>[->|]; case: eqP=>[->|]; rewrite ?(Xa,Xb). Qed. -End SeqRel. - (* there always exists a nat not in a given list *) Lemma not_memX (ks : seq nat) : exists k, k \notin ks. Proof. @@ -2141,6 +2510,83 @@ rewrite L=>N; rewrite L; apply: leq_trans N _. by rewrite addnAC leq_addr. Qed. +(* merge, merge_sort_push, sort *) + +Lemma merge_eq T (lT1 lT2 : rel T) xs ys : + (forall x y, x \In xs ++ ys -> + y \In xs ++ ys -> + lT1 x y = lT2 x y) -> + merge lT1 xs ys = merge lT2 xs ys. +Proof. +elim: xs ys=>[|x xs IH1] ys H //=. +elim: ys IH1 H=>[|y ys IH2] IH1 H //=; rewrite H //. +- by apply/In_cat; left; left. +- by apply/In_cat; right; left. +case: ifP=>_. +- by rewrite IH1 //; move=>x0 y0 X0 Y0; apply: H=>//=; right. +congr (_ :: _); apply: IH2; first by move=>z H2; apply: IH1 H2. +move=>x0 y0 X0 Y0. +have P : perm (y :: (x :: xs) ++ ys) ((x :: xs) ++ y :: ys). +- by apply/pperm_cons_cat_consL/pperm_refl. +by apply: H; apply: (pperm_in P); right. +Qed. + +Lemma merge_sort_push_eq T (lT1 lT2 : rel T) xs yss : + (forall x y, x \In xs ++ flatten yss -> + y \In xs ++ flatten yss -> + lT1 x y = lT2 x y) -> + merge_sort_push lT1 xs yss = merge_sort_push lT2 xs yss. +Proof. +elim: yss xs=>[|ys yss IH] //= xs H. +case: ys H=>[|y ys] H //; congr (_ :: _). +rewrite (_ : merge lT1 (y :: ys) xs = merge lT2 (y :: ys) xs). +- apply: merge_eq=>x0 y0 X0 Y0. + have P : perm (flatten yss ++ (y :: ys) ++ xs) + (xs ++ (y :: ys) ++ flatten yss). + - by rewrite catA; apply/pperm_trans/pperm_catC/pperm_cat2r/pperm_catC. + by apply: H; apply: (pperm_in P); apply/In_cat; right. +apply: IH=>x0 y0 X0 Y0. +have P : perm (merge lT2 (y :: ys) xs ++ flatten yss) + (xs ++ (y :: ys) ++ flatten yss). +- rewrite catA; apply/pperm_cat2r. + by apply/pperm_trans/pperm_catC/pperm_merge. +by apply: H; apply: (pperm_in P). +Qed. + +Lemma sort_eq T (lT1 lT2 : rel T) (xs : seq T) : + (forall x y, x \In xs -> y \In xs -> + lT1 x y = lT2 x y) -> + sort lT1 xs = sort lT2 xs. +Proof. +move=>H; rewrite !sortE. +have {H} : forall x y, x \In xs ++ flatten [::] -> + y \In xs ++ flatten [::] -> lT1 x y = lT2 x y. +- by move=>x y; rewrite cats0; apply: H. +elim: xs [::]=>[|x xs IH] yss H //=. +- elim: yss [::] H =>[|ys yss IH] //= xs H; rewrite IH. + - move=>x0 y0 X0 Y0. + suff P : perm (merge lT1 ys xs ++ flatten yss) (xs ++ ys ++ flatten yss). + - by apply: H; apply: (pperm_in P). + by rewrite catA; apply/pperm_cat2r/pperm_trans/pperm_catC/pperm_merge. + congr merge_sort_pop; apply: merge_eq=>x0 y0 X0 Y0. + have P : perm (ys ++ xs ++ flatten yss) (xs ++ ys ++ flatten yss). + - by rewrite !catA; apply/pperm_cat2r/pperm_catC. + by apply: H; apply: (pperm_in P); rewrite catA; apply/In_cat; left. +have H' : forall x0 y0, x0 \In [:: x] ++ flatten yss -> + y0 \In [:: x] ++ flatten yss -> lT1 x0 y0 = lT2 x0 y0. +- move=>x0 y0 X0 Y0. + have P : perm (xs ++ [:: x] ++ flatten yss) ((x :: xs) ++ flatten yss). + - by apply/pperm_cons_catAC. + by apply: H; apply: (pperm_in P); apply/In_cat; right. +rewrite (merge_sort_push_eq H'); apply: IH=>x0 y0 X0 Y0. +have P : perm (xs ++ flatten (merge_sort_push lT2 [:: x] yss)) + ((x :: xs) ++ flatten yss). +- rewrite -(cat1s x xs) -catA. + apply/pperm_trans/pperm_catCA/pperm_cat2l. + by apply/pperm_merge_sort_push. +by apply: H; apply: (pperm_in P). +Qed. + Section BigCat. Context {A B : Type}. Implicit Types (xs : seq A) (f : A -> seq B). @@ -2171,7 +2617,7 @@ Qed. End BigCat. Lemma big_cat_mem_has A (B : eqType) xs (f : A -> seq B) b : - b \in \big[cat/[::]]_(x <- xs) f x = + (b \in \big[cat/[::]]_(x <- xs) f x) = has (fun x => b \in f x) xs. Proof. rewrite -has_pred1 has_big_cat; apply: eq_has=>x. @@ -2220,7 +2666,7 @@ apply: IH=>//. by move=>z1 z2 Hz1 Hz2 N; apply: H2=>//; right. Qed. -Lemma big_cat_uniq_pairwise A (B : eqType) xs (f : A -> seq B) x1 x2 : +Lemma big_cat_uniq_pairewriteise A (B : eqType) xs (f : A -> seq B) x1 x2 : uniq (\big[cat/[::]]_(x <- xs) f x) -> x1 \In xs -> x2 \In xs -> @@ -2333,3 +2779,421 @@ Lemma uniq_big_cat_disj (A : finType) (B : eqType) (f : A -> seq B) t1 t2 x : x \in f t2 -> t1 = t2. Proof. by case/uniq_big_cat=>_; apply. Qed. + +(****************************) +(* enumerating all prefixes *) +(****************************) + +(* useful when quantifying over partial sums *) + +Fixpoint prefixes {A} (s : seq A) := + if s is x :: xs then [::] :: map (cons x) (prefixes xs) else [:: [::]]. + +Lemma prefixes0 {A : eqType} (s : seq A) : [::] \in prefixes s. +Proof. by elim: s. Qed. + +Lemma prefixesT {A : eqType} (s : seq A) : s \in prefixes s. +Proof. +elim: s=>[|x s IH] //=; rewrite inE mem_map //=. +by move=>?? []. +Qed. + +Lemma prefixesE {A : eqType} (s : seq A) xs : + (xs \in prefixes s) = prefix xs s. +Proof. +elim: s xs=>[|x s /= IH][|y xs] //=; rewrite inE /=. +case: (y =P x)=>[->|N]; last by apply/mapP; case=>z Z [] /N. +by rewrite mem_map ?IH //; move=>?? []. +Qed. + +Lemma uniq_prefixes {A : eqType} (s : seq A) : uniq (prefixes s). +Proof. +elim: s=>[|x s IH] //=. +have I : injective (cons x) by move=>?? []. +rewrite map_inj_uniq // IH andbT. +by apply/mapP; case=>?. +Qed. + +Lemma map_f_prefix {A B : eqType} (f : A -> B) (s1 s2 : seq A) : + prefix s1 s2 -> + prefix (map f s1) (map f s2). +Proof. +elim: s2 s1=>[|x s2 /= IH][|y s1] //=. +by case: (y =P x)=>[->|] //= /IH ->; rewrite eqxx. +Qed. + +Lemma mem_map_prefix {A B : eqType} (f : A -> B) (s1 s2 : seq A) : + injective f -> + prefix (map f s1) (map f s2) = prefix s1 s2. +Proof. +elim: s2 s1=>[|x s2 /= IH][|y s1] //= I. +by case: (y =P x)=>[->|N]; [rewrite eqxx IH|case: eqP=>// /I /N]. +Qed. + +Lemma map_image_prefix {A B : eqType} (f : A -> B) s1 s2 : + prefix s1 (map f s2) -> + exists2 s, s1 = map f s & prefix s s2. +Proof. +elim: s2 s1=>[|x s2 /= IH][|y s1] //=; try by exists [::]. +case/andP=>/eqP ->{y} /IH [s ->{s1} H]. +by exists (x :: s)=>//=; rewrite eqxx. +Qed. + +(* lifting map_f_prefix, mem_map_prefix and map_image_prefix to prefixes *) + +Lemma map_f_prefixes {A B : eqType} (f : A -> B) (s : seq A) xs : + xs \in prefixes s -> + map f xs \in prefixes (map f s). +Proof. by rewrite !prefixesE; apply: map_f_prefix. Qed. + +Lemma mem_map_prefixes {A B : eqType} (f : A -> B) (s : seq A) xs : + injective f -> + (map f xs \in prefixes (map f s)) = (xs \in prefixes s). +Proof. by rewrite !prefixesE; apply: mem_map_prefix. Qed. + +(* prefixes (map f s) <= image (map f) (prefixes s) *) +Lemma map_image_prefixes {A B : eqType} (f : A -> B) (s : seq A) xs : + xs \in prefixes (map f s) -> + exists2 ys, xs = map f ys & ys \in prefixes s. +Proof. +rewrite prefixesE=>/map_image_prefix [z -> H]. +by exists z=>//; rewrite prefixesE. +Qed. + +(********************************) +(* enumerating all subsequences *) +(********************************) + +(* subsequence of s is included in s *) +(* in the given order, but not necessarily *) +(* contiguously *) + +(* enumerating all subsequences of s *) + +Fixpoint subseqs {A} (s : seq A) : seq (seq A) := + if s is y :: s' then + let: ss := subseqs s' in ss ++ map (cons y) ss + else [:: [::]]. + +Lemma subseqs0 {A : eqType} (s : seq A) : [::] \in subseqs s. +Proof. by elim: s=>[|a s IH] //=; rewrite mem_cat IH. Qed. + +Lemma subseqsE {A : eqType} (s : seq A) xs : + (xs \in subseqs s) = subseq xs s. +Proof. +elim: s xs=>[|a s IH] xs /=; first by rewrite inE. +rewrite mem_cat; case: xs=>[|y xs] /=; first by rewrite subseqs0. +case: (y =P a)=>[->{y}|N]; last first. +- rewrite IH; case: (subseq _)=>//=. + by apply/negP=>/mapP [z _ [/N]]. +rewrite mem_map ?IH 1?orbC; first by move=>?? []. +by apply/orP/idP; [case=>// /cons_subseq|left]. +Qed. + +(* useful renaming *) +Lemma subseq_f_prefix {A B : eqType} (f : A -> B) (s1 s2 : seq A) : + subseq s1 s2 -> + subseq (map f s1) (map f s2). +Proof. exact: map_subseq. Qed. + +(* lifting subseq_f_prefix, mem_map_subseq, map_image_subseq to subseqs *) + +Lemma map_subseqs {A B : eqType} (f : A -> B) (s : seq A) xs : + xs \in subseqs s -> + map f xs \in subseqs (map f s). +Proof. by rewrite !subseqsE; apply: map_subseq. Qed. + +Lemma mem_map_subseqs {A B : eqType} (f : A -> B) (s : seq A) xs : + injective f -> + (map f xs \in subseqs (map f s)) = (xs \in subseqs s). +Proof. by rewrite !subseqsE; apply: map_subseq_inj. Qed. + +Lemma map_image_subseqs {A B : eqType} (f : A -> B) (s : seq A) xs : + xs \in subseqs (map f s) -> + exists2 ys, xs = map f ys & ys \in subseqs s. +Proof. +rewrite subseqsE=>/map_image_subseq [ys ->]. +by rewrite -subseqsE; exists ys. +Qed. + +(*****************************************) +(* self-simplifying definition of suffix *) +(*****************************************) + +(* TODO: upstream to mathcomp *) + +Fixpoint suffx {T : eqType} (s1 s2 : seq T) {struct s2} : bool := + if s2 is x :: s2' then (s1 == x :: s2') || suffx s1 s2' + else s1 == [::]. + +Lemma suffxE {T : eqType} (s1 s2 : seq T) : suffx s1 s2 = suffix s1 s2. +Proof. +rewrite/suffix; elim: s2 s1=>[|x2 s2 IH] s1 /=. +- by case: (lastP s1)=>[|{}s1 x1] //=; rewrite rev_rcons; case: s1. +rewrite rev_cons; apply/idP/idP; last first. +- case/rcons_prefix; first by rewrite orbC IH=>->. + by move/revE=>->; rewrite rev_rcons revK eqxx. +case/orP=>[/eqP ->|]; first by rewrite rev_cons; apply: prefix_refl. +by rewrite IH=>H; apply: prefix_trans (prefix_rcons _ _). +Qed. + +(********************) +(* inversion lemmas *) +(********************) + +(* various list morphisms in interaction with *) +(* list constructors and basic primitives *) + +Lemma filter_cons_inv {A} {f : {pred A}} {xs y ys} : + filter f xs = y :: ys -> + exists xs1 xs2, + [/\ xs = xs1 ++ y :: xs2, + f y, + filter f xs2 = ys & + ~~ has f xs1]. +Proof. +elim: xs y ys=>[|x' xs IH] //= y ys; case: ifP=>N. +- by case=><-{y} <-; exists [::], xs. +case/IH=>xs1 [xs2][-> H1 H2 H3]. +by exists (x' :: xs1), xs2; rewrite /= N H3. +Qed. + +Lemma filter_cat_inv {A} {f : {pred A}} {xs ys1 ys2} : + filter f xs = ys1 ++ ys2 -> + exists xs1 xs2, + [/\ xs = xs1 ++ xs2, + filter f xs1 = ys1 & + filter f xs2 = ys2]. +Proof. +elim: ys1 xs ys2=>[|y ys1 IH] xs ys2 /=. +- by move=><-; exists [::], xs. +case/filter_cons_inv=>xs1 [xs2][->{xs} H1 /[swap] H2]. +case/IH=>xs3 [xs4][->{xs2} H3 H4]. +exists (xs1 ++ [:: y] ++ xs3), xs4. +by rewrite -catA filter_cat /= H1 (hasN_filter H2) H3 H4. +Qed. + +Lemma filter_rcons_inv {A} {f : {pred A}} {xs ys y} : + filter f xs = rcons ys y -> + exists xs1 xs2, + [/\ xs = xs1 ++ y :: xs2, + filter f xs1 = ys, + f y & + ~~ has f xs2]. +Proof. +move/(f_equal rev); rewrite -filter_rev rev_rcons. +case/filter_cons_inv=>xs1 [xs2][H1 H2 H3 H4]. +rewrite -(revK xs) H1 rev_cat rev_cons -cats1 -catA /=. +exists (rev xs2), (rev xs1). +by rewrite has_rev filter_rev H3 revK. +Qed. + +Lemma map_cons_inv {A B} {f : A -> B} {xs y ys} : + map f xs = y :: ys -> + exists x xs', + [/\ xs = x :: xs', + f x = y & + map f xs' = ys]. +Proof. by elim: xs y ys=>[|x' xs' IH] // _ ys [<-]; exists x', xs'. Qed. + +Lemma map_cat_inv {A B} {f : A -> B} {xs ys1 ys2} : + map f xs = ys1 ++ ys2 -> + exists xs1 xs2, + [/\ xs = xs1 ++ xs2, + map f xs1 = ys1 & + map f xs2 = ys2]. +Proof. +elim: ys1 xs ys2=>[|y1 ys1 IH] xs ys2 /=; first by exists [::], xs. +case/map_cons_inv=>x [xs'][-> H1] /IH [xs1][xs2][-> H2 H3]. +by exists (x :: xs1), xs2; rewrite /= H1 H2 H3. +Qed. + +Lemma map_rcons_inv {A B} {f : A -> B} {xs ys y} : + map f xs = rcons ys y -> + exists xs1 x, + [/\ xs = rcons xs1 x, + map f xs1 = ys & + f x = y]. +Proof. +move/(f_equal rev); rewrite -map_rev rev_rcons=>/map_cons_inv [x][xs1]. +by case=>/revE -> <- /revE <-; exists (rev xs1), x; rewrite rev_cons map_rev. +Qed. + +Lemma pmap_cons_inv {A B} {f : A -> option B} {xs y ys} : + pmap f xs = y :: ys -> + exists xs1 x xs2, + [/\ xs = xs1 ++ x :: xs2, + f x = Some y, + pmap f xs2 = ys & + ~~ has f xs1]. +Proof. +elim: xs y ys=>[|x xs IH] y ys //=; rewrite /oapp. +case D : (f x)=>[a|]; first by case=><-{y}; exists [::], x, xs. +case/IH=>xs1 [x1][xs2][-> C H1 H2]. +by exists (x :: xs1), x1, xs2; rewrite /= D C. +Qed. + +Lemma pmap_cat_inv {A B} {f : A -> option B} {xs ys1 ys2} : + pmap f xs = ys1 ++ ys2 -> + exists xs1 xs2, + [/\ xs = xs1 ++ xs2, + pmap f xs1 = ys1 & + pmap f xs2 = ys2]. +Proof. +elim: ys1 xs=>[|y1 ys1 IH] /= xs; first by exists [::], xs. +case/pmap_cons_inv=>xs1 [x][xx][->{xs} H1 /[swap] H2] +/IH [xs3][xs4][-> H3 H4]; exists (xs1 ++ x :: xs3), xs4. +by rewrite -catA pmap_cat /= /oapp H1 (hasN_pmap H2) H3. +Qed. + +Lemma pmap_rcons_inv {A B} {f : A -> option B} {xs y ys} : + pmap f xs = rcons ys y -> + exists xs1 x xs2, + [/\ xs = rcons xs1 x ++ xs2, + pmap f xs1 = ys, + f x = Some y & + ~~ has f xs2]. +Proof. +move/(f_equal rev); rewrite -pmap_rev rev_rcons=>/pmap_cons_inv [xs1][x][xs2]. +case=>/revE -> H1 /esym/revE ->; exists (rev xs2), x, (rev xs1). +by rewrite rev_cat -rev_cons pmap_rev has_rev. +Qed. + +(*********************************) +(* interleaving of two sequences *) +(*********************************) + +Fixpoint interleave A (s s1 s2 : seq A) := + match s with + nil => s1 = nil /\ s2 = nil + | x :: s' => + (exists s1', s1 = x :: s1' /\ interleave s' s1' s2) \/ + (exists s2', s2 = x :: s2' /\ interleave s' s1 s2') + end. + +Lemma Prefix_interleave A (s s1 s2 : seq A) s' : + interleave s s1 s2 -> + Prefix s' s -> + exists s1' s2', + [/\ interleave s' s1' s2', + Prefix s1' s1 & Prefix s2' s2]. +Proof. +elim: s s' s1 s2=>[|x s IH] /= s' s1 s2. +- by case=>->-> /Prefixs0 ->; exists [::], [::]. +case=>[[+][->{s1}]|[+][->{s2}]]; +[move=>s1|move=>s2]; move=>M /Prefix_consE. +case=>[->|[+][->{s'}]]; first by exists [::], [::]. +- move=>s' /(IH _ _ _ M) [s1'][s2'][{}M H1 H2]. + exists (x :: s1'), s2'; split=>//=. + - by left; exists s1'. + by apply/Prefix_cons. +case=>[->|[+][->{s'}]]; first by exists [::], [::]. +move=>s' /(IH _ _ _ M) [s1'][s2'][{}M H1 H2]. +exists s1', (x :: s2'); split=>//=. +- by right; exists s2'. +by apply/Prefix_cons. +Qed. + +Lemma interleave0 A (s1 s2 : seq A) : + interleave s1 s2 [::] <-> s1 = s2. +Proof. +elim: s1 s2=>[|x s1 IH] s2 /=; first by split=>//; case. +split=>[|<-]; first by case=>[[s1'][->] /IH ->|[s2'][]]. +by left; exists s1; split=>//; apply/IH. +Qed. + +Lemma interleave0E A (s1 s2 : seq A) : + interleave [::] s1 s2 -> + s1 = [::] /\ s2 = [::]. +Proof. by []. Qed. + +Lemma interleaveC A (s s1 s2 : seq A) : + interleave s s1 s2 -> + interleave s s2 s1. +Proof. +elim: s s1 s2=>[|x s IH] //= s1 s2; first by case. +by case; case=>a [->] /IH; [right|left]; exists a. +Qed. + +Lemma interleaveA A (x y s1 s2 s3 : seq A) : + interleave x s1 s2 -> + interleave y x s3 -> + exists2 z, interleave y s1 z & + interleave z s2 s3. +Proof. +elim: y x s1 s2 s3=>[|a y IH] x s1 s2 s3 /=. +- by move/[swap]; case=>->-> /= [->->]; exists [::]. +move/[swap]; case=>[[s1'][->]|[s2'][->]] /= My. +- case; case=>b [->] /IH-/(_ _ My) [z] {}My Mz. + - by exists z=>//; left; exists b. + by eexists (a :: z); [right; exists z|left; exists b]. +move/IH=>/(_ _ My) [z] {}My Mz. +by exists (a :: z); right; [exists z|exists s2']. +Qed. + +Lemma interleave_mask A (s s1 s2 : seq A) : + interleave s s1 s2 <-> + exists m, + [/\ s1 = mask m s, + s2 = mask (map negb m) s & + size s = size m]. +Proof. +elim: s s1 s2=>[|x s IH] s1 s2 /=. +- by split=>[[->->]|[m][->->]]; [exists [::]|rewrite !mask0]. +split. +- case; case=>_ [->] /IH [m][->->->]; + by [exists (true :: m)|exists (false :: m)]. +case; case=>[|a m][->-> // [S]]; case: a; +[left; exists (mask m s)|right; exists (mask (map negb m) s)]; +by split=>//; apply/IH; exists m. +Qed. + +(* arbitrary finite interleaving *) + +Fixpoint interleave_seq A s (xs : seq (seq A)) := + if xs is x :: xs then + exists2 s', interleave s x s' & interleave_seq s' xs + else s = [::]. + +Lemma interleaves0 A (s : seq A) : + interleave_seq s [::] -> s = [::]. +Proof. by elim: s. Qed. + +Lemma interleave0s A (s : seq (seq A)) : + interleave_seq [::] s <-> + (forall x, x \In s -> x = [::]). +Proof. +elim: s=>[|a s IH] //=; split. +- by case=>s' [->->] /IH H x; rewrite InE; case=>// /H. +move=>H; exists [::]. +- by split=>//; apply: H; left. +by apply/IH=>x X; apply: H; right. +Qed. + +Lemma interleave_seq_cons_cat A s x (s1 s2 : seq (seq A)) : + interleave_seq s (x :: s1 ++ s2) -> + interleave_seq s (s1 ++ x :: s2). +Proof. +elim: s1 s x s2=>[|a s1 IH] s x s2 //= [z1] S [z2] Z1 I. +case/interleaveC/(interleaveA Z1): S=>z3 I1 I2. +by exists z3=>//; apply: IH; exists z2=>//; apply/interleaveC. +Qed. + +Lemma interleave_seq_permI A (s : seq A) (xs1 xs2 : seq (seq A)) : + perm xs1 xs2 -> + interleave_seq s xs1 -> + interleave_seq s xs2. +Proof. +elim: xs1 s xs2=>[|x xs1 IH] s xs2 S /=. +- by move/interleaves0=>->; move/pperm_nil: S=>->. +case=>s' H; case: (pperm_consE S)=>s1 [s2][E] X; subst xs2. +by move/(IH s' _ X)=>Y; apply/interleave_seq_cons_cat; exists s'. +Qed. + +Lemma interleave_seq_perm A (s : seq A) (xs1 xs2 : seq (seq A)) : + perm xs1 xs2 -> + interleave_seq s xs1 <-> + interleave_seq s xs2. +Proof. +by move=>S; split; apply/interleave_seq_permI=>//; apply/pperm_sym. +Qed. diff --git a/core/seqperm.v b/core/seqperm.v index 59fe89a..87fc53d 100644 --- a/core/seqperm.v +++ b/core/seqperm.v @@ -13,7 +13,7 @@ limitations under the License. From Stdlib Require Import ssreflect ssrbool ssrfun. From mathcomp Require Import ssrnat seq path eqtype. -From pcm Require Import options pred. +From pcm Require Import options pred autouniq. (****************************************************) (* A theory of permutations over non-equality types *) @@ -139,7 +139,7 @@ suff H: apply: perm_ind; last 1 first. - move=>s2 s1 s3 H1 IH1 H2 IH2 x r1 t1 r2 t2 E1 E2. case: (@In_split _ x s2). - - by apply: pperm_in H1 _; rewrite E1 Mem_cat; right; left. + - by apply: pperm_in H1 _; rewrite E1 In_cat; right; left. move=>s4 [s5] E; apply: (@pperm_trans (s4++s5)); first by apply: IH1 E1 E. by apply: IH2 E E2. - by move=>x []. @@ -191,19 +191,42 @@ Lemma pperm_catCA s1 s2 s3 : Proof. by move=>*; rewrite !catA pperm_cat2r. Qed. Lemma pperm_cons_cat_cons x s1 s2 s : - perm (x :: s) (s1 ++ x :: s2) <-> perm s (s1 ++ s2). + perm (x :: s) (s1 ++ x :: s2) <-> + perm s (s1 ++ s2). Proof. by split; [apply: (@pperm_cat_consR [::]) | apply: pperm_cons_cat_consL]. Qed. +Lemma pperm_consE x s s' : + perm (x :: s') s -> + exists s1 s2, + s = s1 ++ x :: s2 /\ + perm s' (s1 ++ s2). +Proof. +move=>S; have : x \In s by apply/(pperm_in S); left. +case/In_split=>s1 [s2] E; move: E S=>->. +by move/pperm_cons_cat_cons; exists s1, s2. +Qed. + Lemma pperm_cat_cons x s1 s2 t1 t2 : - perm (s1 ++ x :: t1) (s2 ++ x :: t2) <-> perm (s1 ++ t1) (s2 ++ t2). + perm (s1 ++ x :: t1) (s2 ++ x :: t2) <-> + perm (s1 ++ t1) (s2 ++ t2). Proof. split=>[|H]; first by apply: pperm_cat_consR. apply: (@pperm_trans (x::s1++t1))=>//; apply: (@pperm_trans (x::s2++t2))=>//. by apply/pperm_cons. Qed. +Lemma pperm_cat_consE x t1 t2 s : + perm (t1 ++ x :: t2) s <-> + exists s1 s2, + s = s1 ++ x :: s2 /\ + perm (t1 ++ t2) (s1 ++ s2). +Proof. +split=>[|[s1][s2][->]] T; last by apply/pperm_cat_cons. +by apply/pperm_consE/pperm_trans/T/pperm_cons_cat_cons. +Qed. + Lemma pperm_rcons s1 s2 x : perm s1 s2 <-> perm (rcons s1 x) (rcons s2 x). @@ -229,6 +252,13 @@ case/In_split: X H=>s1 [s2] ->{s} /pperm_cons_cat_cons/pperm_nil. by case: s1=>//; case: s2. Qed. +Lemma pperm_rcons_cons s x : + perm (rcons s x) (x :: s). +Proof. +rewrite -(revK (x :: _)) rev_cons; apply/pperm_trans/pperm_rev. +by rewrite -(pperm_rcons _ _ x); apply/pperm_rev. +Qed. + End Permutations. #[export] Hint Resolve pperm_refl pperm_catC pperm_cons_catCA @@ -240,23 +270,233 @@ Lemma pperm_map A B (f : A -> B) (s1 s2 : seq A) : perm (map f s1) (map f s2). Proof. elim=>[//|||??? _ IH1 _ IH2]*; -by [apply/pperm_cons | apply/permutation_swap | apply/(pperm_trans IH1 IH2)]. +by [apply/pperm_cons|apply/permutation_swap|apply/(pperm_trans IH1 IH2)]. +Qed. + +Lemma pperm_pmap A B (f : A -> option B) (s1 s2 : seq A) : + perm s1 s2 -> + perm (pmap f s1) (pmap f s2). +Proof. +elim=>[//|a x1 x2 H IH|a b x1 x2 H IH|a x1 x2 H1 IH1 H2 IH2] /=; +last 1 first. +- by apply/pperm_trans/IH2/IH1. +- by case: (f a)=>[a'|] //=; apply/pperm_cons. +case: (f a)=>[a'|]; case: (f b)=>[b'|] //=; try by [apply/pperm_cons]. +by apply/permutation_swap. Qed. +(* perm and uniq *) + +Lemma pperm_Uniq A (s1 s2 : seq A) : + perm s1 s2 -> + Uniq s1 <-> Uniq s2. +Proof. +suff {s1 s2} H : forall (s1 s2 : seq A), perm s1 s2 -> Uniq s1 -> Uniq s2. +- by move=>P; split;apply/H=>//; apply/pperm_sym/P. +move=>s1 s2; elim=>[//|a x1 x2 H IH|a b x1 x2 H IH|a x1 x2 _ IH1 _ IH2] /=; +last 1 first. +- by move/IH1/IH2. +- case=>X1 X2; split; last by apply/IH. + by move=>Z; apply/X1/pperm_in/Z/pperm_sym. +case=>X1 [X2 X3]; split. +- move=>Z; apply/X1; rewrite !InE in Z *. + case: Z; first by left. + by move/pperm_sym: H=>H; move/(pperm_in H)/X2. +split; last by apply/IH. +by move/pperm_sym: H=>H; move/(pperm_in H)=>Z; apply/X1; right. +Qed. + +Lemma pperm_uniq (A : eqType) (s1 s2 : seq A) : + perm s1 s2 -> + uniq s1 = uniq s2. +Proof. by move/pperm_Uniq=>H; apply/UniqP/UniqP; rewrite H. Qed. + (* mapping to ssreflect decidable perm *) Lemma perm_eq_perm {A : eqType} (s1 s2 : seq A) : reflect (perm s1 s2) (perm_eq s1 s2). Proof. apply: (iffP idP); last first. - elim=>[|||??? _ H1 _ H2]*. - - by apply seq.perm_refl. - - by rewrite seq.perm_cons. - - by rewrite -![[:: _, _ & _]]/([::_] ++ [::_] ++ _) seq.perm_catCA; - rewrite !seq.perm_cat2l. - by apply: seq.perm_trans H1 H2. -elim: s2 s1 =>[s1 /seq.perm_size/size0nil->// | x s2 IH s1 H]. -move: (seq.perm_mem H x); rewrite mem_head=>H'; move: H' H. -move/splitPr=>[p1 p2]; rewrite -cat1s seq.perm_catCA seq.perm_cons=>/IH. + - by apply perm_refl. + - by rewrite perm_cons. + - by rewrite -![[:: _, _ & _]]/([::_] ++ [::_] ++ _) perm_catCA; + rewrite !perm_cat2l. + by apply: perm_trans H1 H2. +elim: s2 s1 =>[s1 /perm_size/size0nil->// | x s2 IH s1 H]. +move: (perm_mem H x); rewrite mem_head=>H'; move: H' H. +move/splitPr=>[p1 p2]; rewrite -cat1s perm_catCA perm_cons=>/IH. by rewrite -[_::s2]cat0s pperm_cat_cons. Qed. +Lemma pperm_merge T (leT : rel T) s1 s2 : + perm (merge leT s1 s2) (s1 ++ s2). +Proof. +elim: s1 s2=>[|x s1 IH] /=; first by elim. +elim=>[|y s2 IH2] /=; first by rewrite cats0. +case: ifP=>H. +- by apply/pperm_cons/pperm_trans/pperm_refl/IH. +rewrite -!cat_cons in IH2 *. +apply/pperm_trans/pperm_cons_catCA/pperm_cons. +by apply/pperm_trans/IH2; case: {IH2} s2. +Qed. + +Lemma pperm_merge_sort_push T (leT : rel T) xs yss : + perm (flatten (merge_sort_push leT xs yss)) + (xs ++ flatten yss). +Proof. +elim: yss xs=>[|[|y ys] yss IH] xs //=. +apply: pperm_trans (IH _) _; rewrite -cat_cons catA. +by apply/pperm_cat2r/pperm_trans/pperm_cons_cat_cons +/pperm_catC/pperm_merge. +Qed. + +Lemma pperm_sort T (leT : rel T) xs : + perm (sort leT xs) xs. +Proof. +rewrite sortE; rewrite {2}(_ : xs = flatten [::] ++ xs) //. +elim: xs [::]=>[|x xs IH] ss /=. +- elim: ss [::]=>//= s ss IH t. + apply: pperm_trans (IH (merge leT s t)) _. + apply/pperm_trans/pperm_catAC/pperm_trans/pperm_catC. + by apply/pperm_cat2l/pperm_merge. +apply: pperm_trans {IH}(IH _) _; rewrite -(cat1s x xs). +elim: {x} ss [:: x]=>[|x ss IH] ys /=; first by rewrite cats0. +move/(_ (merge leT x ys)): IH; case: x=>[|x s] IH /=. +- by rewrite catA pperm_cat2r; apply/pperm_catC. +apply: pperm_trans IH _. +rewrite -cat_cons !catA; apply/pperm_cat2r. +rewrite -cat_cons -catA; apply/pperm_trans/pperm_catCA. +by apply/pperm_cat2l/pperm_trans/pperm_refl/pperm_merge. +Qed. + +(************************************) +(* Membership lemmas for sortedness *) +(************************************) + +Lemma In_merge T (leT : rel T) s1 s2 x : + x \In merge leT s1 s2 <-> x \In s1 ++ s2. +Proof. +split; first by apply/pperm_in/pperm_merge. +by apply/pperm_in/pperm_sym/pperm_merge. +Qed. + +Lemma In_merge_sort_push T (leT : rel T) xs ys x : + x \In flatten (merge_sort_push leT xs ys) <-> + x \In xs ++ flatten ys. +Proof. +split. +- by apply/pperm_in/pperm_merge_sort_push. +by apply/pperm_in/pperm_sym/pperm_merge_sort_push. +Qed. + +Lemma In_sort T (leT : rel T) xs x : + x \In sort leT xs <-> x \In xs. +Proof. +split; first by apply/pperm_in/pperm_sort. +by apply/pperm_in/pperm_sym/pperm_sort. +Qed. + +(* decidable variants *) + +Lemma mem_merge (T : eqType) (leT : rel T) s1 s2 x : + (x \in merge leT s1 s2) = (x \in s1 ++ s2). +Proof. +apply/idP/idP; first by move/mem_seqP/In_merge/mem_seqP. +by move/mem_seqP/(In_merge leT)/mem_seqP. +Qed. + +Lemma mem_merge_sort_push (T : eqType) (leT : rel T) xs ys : + flatten (merge_sort_push leT xs ys) =i + xs ++ flatten ys. +Proof. +move=>x. +by apply/idP/idP=>/mem_seqP/(In_merge_sort_push leT)/mem_seqP. +Qed. + +(* mem_sort already exists *) + +(*************************************************) +(* Interaction of sorting with reflexive closure *) +(* of the sorting relation *) +(*************************************************) + +(* if sequence has no repetitions, sorting relation *) +(* can be irreflexive because sorting wouldn't *) +(* compare equal elements *) + + +Lemma merge_lt_le (T : eqType) (ltT : rel T) s1 s2 : + uniq (s1 ++ s2) -> + merge (fun x y => (x == y) || ltT x y) s1 s2 = + merge ltT s1 s2. +Proof. +elim: s1 s2=>[|x1 s1 IH] s2 /=; first by elim: s2. +elim: s2=>[|x2 s2 IH2] /andP [N Uq] //; rewrite [LHS]/=. +case: (x1 =P x2) N Uq=>[<-|_] N Uq; rewrite [LHS]/=. +- by rewrite mem_cat inE eqxx orbT in N. +rewrite IH //=; case: ifP=>// _; congr cons; apply: IH2. +rewrite (uniqX' Uq) andbT (contra _ N) //. +by rewrite !mem_cat inE; case/orP => ->; rewrite ?orbT. +Qed. + +Lemma merge_sort_push_lt_le (T : eqType) (ltT : rel T) xs yss : + uniq (xs ++ flatten yss) -> + merge_sort_push (fun x y => (x == y) || ltT x y) xs yss = + merge_sort_push ltT xs yss. +Proof. +elim: yss xs=>[|[|y ys] yss IH] //= xs Uq; congr cons. +rewrite merge_lt_le // ?(uniqX' Uq) //; apply: IH. +rewrite cat_uniq; set x := ~~ has _ _. +rewrite (_ : x = ~~ has [in y :: ys ++ xs] (flatten yss)). +- by apply/hasPn/hasPn=>H z /H; rewrite mem_merge. +by rewrite merge_uniq -cat_uniq !(uniqX' Uq). +Qed. + +Lemma merge_sort_push_uniq (T : eqType) (ltT : rel T) xs ys : + uniq (flatten (merge_sort_push ltT xs ys)) = + uniq (xs ++ flatten ys). +Proof. by apply/perm_uniq/perm_eq_perm/pperm_merge_sort_push. Qed. + +Lemma sort_lt_le (T : eqType) (ltT : rel T) xs : + uniq xs -> + sort (fun x y => (x == y) || ltT x y) xs = + sort ltT xs. +Proof. +rewrite !sortE {1}(_ : xs = flatten [::] ++ xs) //. +elim: xs [::]=>[|x xs IH] ss /=. +- elim: ss [::]=>[|s ss IH] xs //= Uq. + rewrite IH; last by rewrite merge_lt_le // (uniqX' Uq). + rewrite merge_lt_le ?(uniqX' Uq) // cat_uniq merge_uniq. + set x := ~~ has _ _; rewrite (_ : x = ~~ has [in flatten ss] (s ++ xs)). + - by apply/hasPn/hasPn=>H z; [rewrite -(mem_merge ltT)|rewrite mem_merge]; move=>/H. + by rewrite -cat_uniq (uniqX' Uq). +elim: ss x=>[|s ss IH2] x //= Uq; first by apply: IH. +set X1 := (X in sort_rec1 _ X); set X2 := (X in _ = sort_rec1 _ X xs). +rewrite (_ : X1 = X2). +- rewrite {}/X1{}/X2; case: s Uq=>// y s Uq; congr cons. + rewrite merge_lt_le ?merge_sort_push_lt_le ?(uniqX' Uq) //. + rewrite cat_uniq merge_uniq; set X := ~~ has _ _. + rewrite (_ : X = ~~ has [in y :: s ++ [:: x]] (flatten ss)). + - by apply/hasPn/hasPn=>H z /H; rewrite mem_merge. + by rewrite -cat_uniq (uniqX' Uq). +rewrite IH // {X1}/X2; case: s Uq=>[|a s] Uq /=; first by rewrite !(uniqX' Uq). +set j := if _ then _ else _; rewrite cat_uniq merge_sort_push_uniq. +set X := ~~ has _ _; rewrite (_ : X = ~~ has [in j ++ flatten ss] xs). +- by apply/hasPn/hasPn=>H z /H; rewrite mem_merge_sort_push. +rewrite -{X}cat_uniq /j /=; case: ifP=>_; last by rewrite (uniqX' Uq). +rewrite /= !mem_cat mem_merge -!mem_cat 2!cat_uniq merge_uniq. +set X := ~~ has _ _; rewrite (_ : X = ~~ has [in s ++ [:: x]] (flatten ss)). +- by apply/hasPn/hasPn=>H z /H; rewrite mem_merge. +rewrite -{X}cat_uniq; set X := ~~ has _ _. +rewrite (_ : X = ~~ has [in (s ++ [:: x]) ++ flatten ss] xs). +- by apply/hasPn/hasPn=>H z /H; rewrite !mem_cat mem_merge -!mem_cat. +by rewrite -{X}cat_uniq !(uniqX' Uq). +Qed. + + + + + + + + diff --git a/core/slice.v b/core/slice.v index 17c07f2..17b910f 100644 --- a/core/slice.v +++ b/core/slice.v @@ -18,9 +18,6 @@ From pcm Require Import options prelude seqext. Open Scope order_scope. Import Order.Theory. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - Section BSimp_Extension. Context disp (T : porderType disp). Implicit Types (x y : T) (b c : bool). @@ -225,14 +222,14 @@ by exact: geq_minl. Qed. Corollary slice_usize s : s = &:s `]-oo, size s[. -Proof. by rewrite itv_overR /=; [rewrite slice_uu|rewrite addn0]. Qed. +Proof. by rewrite itv_overR /=; [rewrite addn0|rewrite slice_uu]. Qed. (* slice size *) Lemma slice_size s (i : interval nat) : size (&:s i) = minn (bnd i.2 (size s)) (size s) - bnd i.1 (size s). Proof. -rewrite /slice; case: i=>[[l i|[]][r j|[]]] //=; +rewrite /slice; case: i=>[[l i|[]][r j|[]]] //=; rewrite ?take0 ?drop0 ?take_size ?drop_size ?minnn ?min0n ?subn0 //=. - by rewrite size_drop size_take_min. - by rewrite size_drop. @@ -370,7 +367,7 @@ move: (onth_size H)=>Hk; case: l; case: r=>/=; rewrite ?addn0 ?addn1. - by apply: drop_oversize; rewrite size_take Hk. - rewrite -addn1 addnC -take_drop. - rewrite (take_nth v); last by rewrite size_drop subn_gt0. + rewrite (take_nth v); first by rewrite size_drop subn_gt0. by rewrite take0 /= nth_drop addn0 nth_onth H. - by apply: drop_oversize; rewrite size_take Hk. apply: drop_oversize; rewrite size_take; case: ifP=>// /negbT. @@ -444,7 +441,7 @@ Lemma slice_xR a x s : (&:s (Interval a +oo)) (onth s x). Proof. -move=>Hax; rewrite (slice_split _ true (x:=x)) /=; last first. +move=>Hax; rewrite (slice_split _ true (x:=x)) /=. - rewrite in_itv /= lexx andbT. by case: a Hax=>/=[ax av|ax]; case: ax. rewrite slice_kk /=; case: (onth_sizeP s x)=>[|v] H; @@ -460,7 +457,7 @@ Lemma slice_xL b x s : [::] (onth s x). Proof. -move=>Hxb; rewrite (slice_split _ false (x:=x)) /=; last first. +move=>Hxb; rewrite (slice_split _ false (x:=x)) /=. - rewrite in_itv /= lexx /=. by case: b Hxb=>/=[bx bv|bx]; case: bx. rewrite slice_kk /=; case: (onth_sizeP s x)=>[|v] H; rewrite H //=. @@ -559,7 +556,7 @@ Lemma slice_cat_piecewise s1 s2 i : Proof. rewrite slice_cat; case: i=>i j /=; case: ifP. - rewrite in_itv; case/andP=>Hi Hj. - rewrite (itv_overR _ (j:=j)); last first. + rewrite (itv_overR _ (j:=j)). - case: j Hj=>[[] j|[]] //=. - by rewrite addn0; move/ltnW. by rewrite addn1 leEnat; move/(ltnW (n:=j.+1)). @@ -569,7 +566,7 @@ rewrite slice_cat; case: i=>i j /=; case: ifP. by rewrite ltnn /= subnn. rewrite in_itv=>/negbT; rewrite negb_and=>H. case: ifP=>Hj. -- rewrite (itv_underR (s:=s2)); first by rewrite cats0. +- rewrite (itv_underR (s:=s2)); last by rewrite cats0. case: {H}j Hj=>[[] j|[]] //=. - rewrite addn0 leEnat leq_eqVlt; case/orP=>[/eqP->|->] //=. by rewrite ltnn /= subnn. @@ -649,13 +646,13 @@ Implicit Type (s : seq A). (* membership *) Corollary slice_memE x s i : - x \in &:s i = + (x \in &:s i) = has (fun j => j \in i) (indexall x s). Proof. by rewrite /indexall -has_pred1; apply: slice_has. Qed. Corollary slice_memE1 x s i : (count_mem x s <= 1)%N -> - x \in &:s i = + (x \in &:s i) = (x \in s) && (bnd i.1 (size s) <= index x s < bnd i.2 (size s)). Proof. move=>H; rewrite slice_memE indexall_count1 //; case: ifP=>//= Hx; rewrite orbF. @@ -665,15 +662,15 @@ Qed. Corollary slice_uniq_memE x s i : uniq s -> - x \in &:s i = + (x \in &:s i) = (x \in s) && (bnd i.1 (size s) <= index x s < bnd i.2 (size s)). Proof. by move=>U; apply: slice_memE1; rewrite (count_uniq_mem _ U) leq_b1. Qed. (* subset *) Lemma slice_subset s i1 i2 : - i1 <= i2 -> - {subset (&:s i1) <= &:s i2}. + i1 <= i2 -> + {subset (&:s i1) <= &:s i2}. Proof. case: i1=>i1 j1; case: i2=>i2 j2. rewrite subitvE; case/andP=>Hi Hj. @@ -681,19 +678,17 @@ move=>x Hx. have Hij : i1 <= j1. - apply: contraLR Hx; rewrite -ltNge=>/ltW Hji. by rewrite itv_swapped_bnd. -rewrite (@slice_split_bnd _ _ _ i1) /=; last first. +rewrite (@slice_split_bnd _ _ _ i1) /=. - by rewrite Hi /=; apply/le_trans/Hj. rewrite mem_cat; apply/orP; right. -rewrite (@slice_split_bnd _ _ _ j1) /=; last first. +rewrite (@slice_split_bnd _ _ _ j1) /=. - by rewrite Hj andbT. by rewrite mem_cat Hx. Qed. Corollary slice_subset_full s i : {subset &:s i <= s}. -Proof. -by rewrite -{2}(slice_uu s); apply/slice_subset/itv_lex1. -Qed. +Proof. by rewrite -{2}(slice_uu s); apply/slice_subset/itv_lex1. Qed. (* slicing preserves uniqueness *) diff --git a/core/uconsec.v b/core/uconsec.v index adda24c..1b38dca 100644 --- a/core/uconsec.v +++ b/core/uconsec.v @@ -17,9 +17,6 @@ From pcm Require Import options prelude ordtype seqext slice useqord uslice. Local Open Scope order_scope. Import Order.Theory. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (* We assume the sequences are unique and most lemmas do require this *) (* condition explicitly. Should it be added to `consec` itself? *) @@ -112,7 +109,7 @@ Lemma consec_prevN (ks : seq A) x y z : z != x -> consec ks x y -> z <[ks] y -> z <[ks] x. Proof. move=>U N C /(consec_prev U C). -by rewrite sle_eqVlt; [rewrite (negbTE N)|rewrite (consec_mem C) orbT]. +by rewrite sle_eqVlt; [rewrite (consec_mem C) orbT|rewrite (negbTE N)]. Qed. Lemma consec_next (ks : seq A) x y z : @@ -163,16 +160,16 @@ case: (lastP ks) U H T=>[|xs x] /= {ks} + H. - by rewrite slt_nil. rewrite rcons_uniq slt_rcons mem_rcons inE negb_or !(eq_sym x). case/andP=>Nx Ux; case: ifP=>X; rewrite ?andbF ?andbT. -- move=>Nt; split=>//; case=>ks' /rcons_inj [??]; subst ks' x. +- move=>Nt; split=>//; case=>ks' /inj_rcons [??]; subst ks' x. by rewrite (slt_memE Nt) in Nx. move/contra: (H x)=>/(_ erefl). -rewrite eqslice_mem_uniq /=; last by rewrite rcons_uniq Nx. +rewrite eqslice_mem_uniq /=; first by rewrite rcons_uniq Nx. rewrite mem_rcons inE eqxx /= in_itv /= negb_and ltEnat /=. rewrite -!seqlt_unlock -!sleNgt !sle_rcons (negbTE Nx) X /=. rewrite eqxx /= orbF andbT (eq_sym x). case/orP=>[/negbTE->|/eqP->] /=. - by case/andP=>H1 /eqP->; split=>// _; exists xs. -rewrite eqxx /= orbF => H1; split=>//; case=>ks' /rcons_inj [_ Ex]. +rewrite eqxx /= orbF => H1; split=>//; case=>ks' /inj_rcons [_ Ex]. by rewrite Ex H1 in Nx. Qed. @@ -202,7 +199,7 @@ case=>xs E; rewrite E /consec rcons_uniq mem_rcons inE negb_or eq_sym in U T2 *. case/andP: U T2=>T1 U /andP [N T2]. rewrite slt_rcons (negbTE T2) (negbTE T1) N eq_refl /= nilp_hasPn. rewrite -all_predC; apply/allP=>x /=; apply: contraTeq=>_. -rewrite eqslice_mem_uniq; last by rewrite rcons_uniq T1. +rewrite eqslice_mem_uniq; first by rewrite rcons_uniq T1. rewrite mem_rcons inE in_itv /= ltEnat /= !negb_and negb_or. rewrite -!seqlt_unlock -!sleNgt !sle_rcons (eq_sym x) eqxx. rewrite orbF T1 (negbTE T2) (negbTE N) /= andbC orbCA orbb. @@ -343,14 +340,14 @@ case/slt_splitL: H U=>ks1 [ks2][-> Nt1t2 N1 N2] /=. rewrite cat_uniq /= negb_or -!andbA. case/and5P=>Uks1 _ /hasPn Nks2 Nt1ks2 Uks2. have H : head t2 ks2 \notin ks1. -- move: (mem_head t2 ks2); rewrite inE. +- move: (head_mem t2 ks2); rewrite inE. by case/orP=>[/eqP ->//|]; apply: Nks2. exists (head t2 ks2); split; last first. - rewrite sle_cat (negbTE H) N2 /= sle_cons (eq_sym t2) Nt1t2 /=. by rewrite sle_head orbT. apply/andP; split. - rewrite slt_cat (negbTE H) (negbTE N1) /= sltL. - case: eqP Nt1ks2 (mem_head t2 ks2)=>// -> X. + case: eqP Nt1ks2 (head_mem t2 ks2)=>// -> X. by rewrite inE (negbTE Nt1t2) (negbTE X). rewrite nilp_hasPn; apply: contra H. case/hasP=>x; case/mem_oo. @@ -684,7 +681,7 @@ apply/eqP/contraT; rewrite eq_sym=>M; exfalso. move: (last_change M)=>L. move: (E (last k1 ks)); rewrite mem_rcons inE L orbT=>/(_ erefl). rewrite slt_rcons sle_rcons (negbTE K2) L /=. -move/esym; rewrite sle_eqVlt; last by rewrite L. +move/esym; rewrite sle_eqVlt; first by rewrite L. rewrite (negbTE M) /=. by move/(sle_slt_trans (sle_last k1 U K1)); rewrite slt_irr. Qed. @@ -746,7 +743,7 @@ Lemma consec_rcons (s : seq A) a x y : Proof. rewrite /= mem_rcons inE negb_or rcons_uniq -andbA. case/and4P=>U1 U2 U3 U4. -rewrite -rcons_cons consec_rconsE; last 2 first. +rewrite -rcons_cons consec_rconsE. - by rewrite /= U2 U4. - by rewrite inE negb_or eq_sym U1 U3. case: (x =P y)=>[->{x}|/eqP N] /=. @@ -942,7 +939,7 @@ Lemma consec_sorted ks t1 t2 : {in ks, forall z, ord z t2 = oleq z t1}. Proof. move=>U S T2 /(consecP_inlt _ _ U) [T1 H] z Z. -rewrite -(slt_sortedE S Z T2) -(sle_sortedE S Z T1). +rewrite -(slt_sortedE (@irr _) (@trans _) S Z T2) -(sle_sortedE S Z T1). by apply: H Z. Qed. @@ -1062,7 +1059,7 @@ Lemma consec_nthI (A : eqType) (ks : seq A) a i : Proof. elim: ks a {3 4}a i=>[|k ks IH] a b i //=. rewrite inE negb_or -andbA; case/and4P=>U1 U2 U3 U4. -rewrite ltnS=>S; rewrite consec_consE //=; last 2 first. +rewrite ltnS=>S; rewrite consec_consE //=. - by rewrite U3 U4. - by rewrite inE negb_or U1 U2. rewrite nth_cons; case: i S=>[|i] S /=. @@ -1100,7 +1097,7 @@ case: ks U H S=>[|k ks] //= U H S; apply: H. - by rewrite inE eqxx. rewrite inE negb_or -andbA in U. case/and4P: U=>U1 U2 U3 U4. -rewrite consec_consE /=; last 2 first. +rewrite consec_consE /=. - by rewrite U3 U4. - by rewrite inE negb_or U1. by rewrite eqxx inE eqxx. diff --git a/core/useqord.v b/core/useqord.v index 2252171..ddc90be 100644 --- a/core/useqord.v +++ b/core/useqord.v @@ -13,13 +13,10 @@ limitations under the License. From Stdlib Require Import ssreflect ssrbool ssrfun. From mathcomp Require Import ssrnat eqtype seq path interval order. -From pcm Require Import options prelude ordtype seqext. +From pcm Require Import options prelude pred ordtype seqext. Local Open Scope order_scope. Import Order.Theory. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (* We assume the sequences are unique and use the first index, however most *) (* lemmas don't require this condition explicitly. The ones that do are *) (* grouped in a separate section. *) @@ -64,7 +61,7 @@ End SeqOrd. End SeqOrd. Export SeqOrd. -(* alternative rewrites *) +(* alternative rewrites that drop %N *) Lemma seqle_unlockE (A : eqType) ks (t1 t2 : A) : t1 <=[ks] t2 = (index t1 ks <= index t2 ks). Proof. exact: seqle_unlock. Qed. @@ -77,6 +74,25 @@ Section SeqLeBase. Variable (A : eqType). Implicit Type (ks : seq A). +(* relating to mathcomp's mem2 *) +Lemma sle_mem2 ks t1 t2 : + uniq ks -> + mem2 ks t1 t2 = (t1 <=[ks] t2) && (t2 \in ks). +Proof. +move=>U; apply/idP/idP. +- move=>H; rewrite (mem2r H) andbT; case/splitP2r: H U=>p1 p2. + rewrite inE cat_uniq /= negb_or -!andbA => H /and5P [U1 U2 /hasPn U3 U4 U5]. + rewrite seqle_unlock !index_cat (negbTE U2) /= eqxx eq_sym. + case: (t2 =P t1) H=>[-> _|_ H]; first by rewrite (negbTE U2). + by rewrite (negbTE (U3 _ H)) addn0 leq_addr. +case/andP=>H1 H2; case/splitPr: H2 U H1=>p1 p2. +rewrite cat_uniq /= negb_or -!andbA; case/and5P=>U1 U2 /hasPn U3 U4 U5. +rewrite seqle_unlock /mem2 /= !index_cat (negbTE U2) /= eqxx. +case: ifPn=>T1; first by rewrite drop_cat index_mem T1 mem_cat inE eqxx orbT. +case: ifPn=>N; first by rewrite drop_cat addn0 ltnn subnn /= inE eqxx. +by rewrite addn0 leqNgt -addSnnS ltn_addr. +Qed. + (****************** transitivity ****************) Lemma sle_trans ks : transitive (seq_le ks). @@ -113,7 +129,7 @@ Proof. by rewrite slt_irr. Qed. Lemma sle_antisym ks : {in ks, antisymmetric (seq_le ks)}. Proof. move=>x Hx y; rewrite !seqle_unlock. -by rewrite -eqn_leq =>/eqP /index_inj; apply. +by rewrite -eqn_leq =>/eqP /inj_index; apply. Qed. (****************** asymmetry ***************) @@ -131,7 +147,7 @@ Lemma slt_total ks x y : [|| x == y, x <[ks] y | y <[ks] x]. Proof. rewrite !seqlt_unlock=>H; case: ltngtP; rewrite ?orbT ?orbF //. -by move/index_inj=>->. +by move/inj_index=>->. Qed. (* transfer properties of sequence ordering *) @@ -144,8 +160,8 @@ Lemma sle_eqVlt ks t1 t2 : Proof. move=>H; rewrite seqlt_unlock seqle_unlock leq_eqVlt /=. case: (t1 =P t2)=>[->|N] /=; first by rewrite eq_refl. -case: eqP=>//=; case/orP: H=>H; first by move/(index_inj H)/N. -by move/esym/(index_inj H)/esym/N. +case: eqP=>//=; case/orP: H=>H; first by move/(inj_index H)/N. +by move/esym/(inj_index H)/esym/N. Qed. (****************** slt_neqAle ***************) @@ -157,8 +173,8 @@ Proof. move=>H. rewrite seqlt_unlock seqle_unlock ltn_neqAle. case: (t1 =P t2)=>[->|N] /=; first by rewrite eq_refl. -case: eqP=>//=; case/orP: H=>H; first by move/(index_inj H)/N. -by move/esym/(index_inj H)/esym/N. +case: eqP=>//=; case/orP: H=>H; first by move/(inj_index H)/N. +by move/esym/(inj_index H)/esym/N. Qed. (****************** sltNge ***************) @@ -189,7 +205,6 @@ Implicit Type (ks : seq A). Lemma sltW ks t1 t2 : t1 <[ks] t2 -> t1 <=[ks] t2. Proof. by rewrite seqlt_unlock seqle_unlock; apply: ltnW. Qed. - (* membership properties of the sequence orderings *) Lemma slt_memI x y ks : x \in ks -> y \notin ks -> x <[ks] y. @@ -347,7 +362,7 @@ Qed. Lemma sle_splitR x y ks1 ks2 : y \notin ks1 -> x <=[ks1++x::ks2] y. Proof. -move=>Y; rewrite sle_eqVlt; last first. +move=>Y; rewrite sle_eqVlt. - by apply/orP; left; rewrite mem_cat inE eq_refl orbT. by case: eqP=>[|/eqP N] //=; rewrite (slt_splitR _ _ Y) // eq_sym. Qed. @@ -440,7 +455,7 @@ Lemma sle_sorted_lt ltT ks x y : sorted ltT ks -> y \in ks -> x <=[ks] y -> (x == y) || ltT x y. Proof. -move=>T S Y; rewrite sle_eqVlt; last by rewrite Y orbT. +move=>T S Y; rewrite sle_eqVlt; first by rewrite Y orbT. by case/orP=>[->//|/(slt_sorted_lt T S Y) ->]; rewrite orbT. Qed. @@ -455,7 +470,8 @@ Lemma slt_sorted_leE leT ks x y : x <[ks] y = (x != y) && leT x y. Proof. move=>As T S X Y; apply/idP/idP. -- by case: eqP=>[->|/eqP N] /=; [apply: contraLR; rewrite slt_irr | apply: slt_sorted_lt]. +- case: eqP=>[->|/eqP N] /=; + by [apply: contraLR; rewrite slt_irr|apply: slt_sorted_lt]. by rewrite seqlt_unlock; case/andP=>H K; apply: sorted_ord_index_leq K H. Qed. @@ -467,7 +483,7 @@ Lemma sle_sorted_leE leT ks x y : x \in ks -> y \in ks -> x <=[ks] y = (x == y) || leT x y. Proof. -move=>As T S X Y; rewrite sle_eqVlt; last by rewrite X. +move=>As T S X Y; rewrite sle_eqVlt; first by rewrite X. by rewrite (slt_sorted_leE As T S X Y); case: eqP. Qed. @@ -510,7 +526,7 @@ Qed. Lemma slt_last x k ks : uniq ks -> x \in ks -> last k ks != x -> x <[ks] (last k ks). Proof. -move=>U X N; move: (sle_last k U X); rewrite sle_eqVlt; last by rewrite X. +move=>U X N; move: (sle_last k U X); rewrite sle_eqVlt; first by rewrite X. by rewrite eq_sym (negbTE N). Qed. @@ -518,64 +534,340 @@ Lemma slt_last_cons x k ks : uniq (k :: ks) -> x \in k::ks -> last k ks != x -> x <[k::ks] (last k ks). Proof. -move=>U X N; rewrite slt_neqAle; last by rewrite X. +move=>U X N; rewrite slt_neqAle; first by rewrite X. by rewrite eq_sym N sle_last_cons. Qed. +(* switching sorted between seq_lt and seq_le *) +Lemma sorted_slt_sle xs ks : + uniq ks -> + {subset xs <= ks} -> + sorted (seq_lt ks) xs = uniq xs && sorted (seq_le ks) xs. +Proof. +elim: xs=>[|x xs IH] //= Uq S. +rewrite (path_sortedE (@slt_trans A _)) (path_sortedE (@sle_trans A _)). +rewrite IH //; first by move=>z Z; rewrite S // inE Z orbT. +rewrite -andbA; apply/and3P/and4P. +- case=>/allP H ->->; split=>//. + - by apply/negP=>/H; rewrite slt_irr. + by apply/allP=>z /H/sltW. +case=>H1 -> /allP H2 ->; split=>//. +apply/allP=>z /[dup] Z /H2 X. +have Oz : z \in ks by rewrite S // inE Z orbT. +rewrite slt_neqAle ?Oz ?orbT //=. +by case: eqP Z H1=>// ->->. +Qed. + (* every list is sorted by its slt relation, assuming uniqueness *) -Lemma sorted_slt ks : uniq ks -> sorted (seq_lt ks) ks. + +Lemma sorted_slt_subseq xs ks : + uniq ks -> + {subset xs <= ks} -> + sorted (seq_lt ks) xs = subseq xs ks. Proof. -case: ks=>//= k ks; elim: ks k=>[|k1 ks IH] k2 //=. -rewrite inE negb_or -andbA=>/and4P [N1 N2 N3 N4]. -rewrite sltL eq_sym N1 /=. -have : path (seq_lt [:: k1 & ks]) k1 ks by apply: IH; rewrite N3 N4. -apply: (@sub_in_path _ (mem (k1::ks))); last by apply/allP. -move=>x y /=; rewrite !inE !slt_cons. -case/orP=>[/eqP ->{x}|X]. -- rewrite (eq_sym k1 k2) (negbTE N1) /= eq_refl andbT. - case/orP=>[/eqP ->|Y ->]; first by rewrite eq_refl. - by case: eqP Y N2=>// ->->. -case/orP=>[/eqP ->|Y]; first by rewrite eq_refl. -case: eqP Y N3=>[->|/eqP N Y N3] //=. -case: eqP X N3=>[->->|/eqP M X K1] //= H. -by rewrite H orbT andbT; case: eqP Y N2=>// ->->. +move: {-2}ks xs (subseq_refl ks); elim: ks=>[|k ks IH] ys xs //=. +- by move/eqP=>->; case: xs=>[|x xs] //= _ /(_ x (mem_head _ _)). +case: ys=>[|y ys] Sq /=; first by case: xs=>[|x xs] //= _ /(_ x (mem_head _ _)). +have {}Sq : subseq ys ks by case: eqP Sq=>// _ /cons_subseq. +case: xs=>[|x xs] //= /andP [Ny Uq] S; rewrite (path_sortedE (@slt_trans A _)). +apply/andP/idP. +- case=>/allP H Sq2. + have Nyxs : y \notin xs by apply/negP=>/H; rewrite slt_cons eqxx. + have S1 : (x == y) || (x \in ys) by apply/S/mem_head. + have {}S : {subset xs <= ys}. + - move=>z /[dup] Z; move: (S z (subset_consR x Z)) Nyxs. + by case/orP=>// /eqP -> /negbTE ->. + have Nz : {in xs, forall z, z != y}. + - by move=>z /S; case: eqP=>// ->; rewrite (negbTE Ny). + rewrite -IH //; first by case: eqP S1=>//= _ S1 z; rewrite inE=>/orP [/eqP ->|/S]. + suff : sorted (seq_lt ys) xs. + - case: eqP=>[|/eqP Nxy] //=; rewrite path_min_sorted //. + by apply/allP=>z /H; rewrite slt_cons (negbTE Nxy); case: (z =P y). + rewrite (eq_in_sorted (e':=seq_lt (y::ys)) (P:=[mem xs])) //. + by move=>z z'; rewrite !inE=>Z Z'; rewrite slt_cons (negbTE (Nz _ Z)) /= (Nz _ Z'). +move=>Sq2. +have S1 : (x == y) || (x \in ys) by apply/S/mem_head. +have {}S : {subset xs <= ys}. +- case: eqP S1 Sq2 S=>[->|/eqP N] /= S1 Sq2 S. + - by apply/mem_subseq. + by move=>z Z; apply/(mem_subseq Sq2); rewrite inE Z orbT. +have Nz : {in xs, forall z, z != y}. +- by move=>z /S; case: eqP=>// ->; rewrite (negbTE Ny). +split. +- apply/allP=>z Z; rewrite slt_cons (Nz _ Z) /=. + case: eqP S1 Sq2=>[|/eqP N] //= S1 Sq2. + case/split_subseq: {S Sq S1 Ny} Sq2 Uq=>a1 [a2][->{ys}] /mem_subseq S Uq. + rewrite slt_cat slt_cons eqxx andbT; move: Uq; rewrite cat_uniq /= negb_or -andbA. + case/and4P=>_ /negbTE -> /hasPn/(_ z (S _ Z)) /negbTE ->. + by case: eqP=>// <-; rewrite (S _ Z). +rewrite -IH // in Sq2. +- by case: eqP S1=>//= _ S1 z; rewrite inE=>/orP [/eqP ->|/S]. +have {}Sq2 : sorted (seq_lt ys) xs. +- by case: eqP Sq2=>//= _ /path_sorted. +rewrite (eq_in_sorted (e':=seq_lt ys) (P:=[mem xs])) //. +by move=>z z'; rewrite !inE=>Z Z'; rewrite slt_cons (negbTE (Nz _ Z)) (Nz _ Z'). Qed. +Lemma sorted_slt ks : uniq ks -> sorted (seq_lt ks) ks. +Proof. by move=>U; rewrite sorted_slt_subseq. Qed. + +Lemma sorted_sle_subseq xs ks : + uniq ks -> + {subset xs <= ks} -> + subseq xs ks = uniq xs && sorted (seq_le ks) xs. +Proof. by move=>U S; rewrite -sorted_slt_sle ?sorted_slt_subseq. Qed. + Lemma sorted_sle ks : uniq ks -> sorted (seq_le ks) ks. Proof. move=>U; apply: sub_sorted (sorted_slt U). by move=>x y /sltW. Qed. +Lemma slt_sorted (ord : rel A) ks x y : + transitive ord -> + sorted ord ks -> y \in ks -> x <[ks] y -> ord x y. +Proof. by move=>T; apply/slt_sorted_lt/T. Qed. + +Lemma slt_sortedI (ord : rel A) ks : + uniq ks -> + (forall x y, y \in ks -> x <[ks] y -> ord x y) -> + sorted ord ks. +Proof. +elim: ks=>[|k ks IH] //= /andP [Nk U] H. +rewrite path_min_sorted. +- apply/allP=>x X; apply: H; first by rewrite inE X orbT. + by rewrite slt_cons eqxx andbT; case: eqP X Nk=>// ->->. +apply: IH=>// x y Y N; apply: H; first by rewrite inE Y orbT. +by rewrite slt_cons N orbT andbT; case: eqP Y Nk=>// ->->. +Qed. + +Lemma slt_sortedE (ord : rel A) ks x y : + irreflexive ord -> + transitive ord -> + sorted ord ks -> + x \in ks -> y \in ks -> + x <[ks] y = ord x y. +Proof. +move=>I T S X Y; apply/idP/idP; first by apply: slt_sorted S Y. +by rewrite seqlt_unlock; apply: (sorted_ord_index I T S X). +Qed. + +Lemma subseq_eq (s1 s2 xs : seq A) : + uniq xs -> + subseq s1 xs -> + subseq s2 xs -> + s1 =i s2 -> + s1 = s2. +Proof. +move=>Uq S1 S2 E; apply: (sorted_eq (leT:=seq_lt xs)). +- by apply: slt_trans. +- by move=>x y /andP [] H /(slt_trans H); rewrite slt_irr. +- by rewrite sorted_slt_subseq //; apply/mem_subseq. +- by rewrite sorted_slt_subseq //; apply/mem_subseq. +by apply/uniq_perm/E; apply/subseq_uniq/Uq. +Qed. + End SeqLeUniq. +(* ole and sortedness under ordering on A *) + Section SeqLeOrd. Variable (A : ordType). Implicit Type (ks : seq A). -(* olt/ole and sortedness under ordering on A *) - -Lemma slt_sorted ks x y : - sorted ord ks -> y \in ks -> x <[ks] y -> ord x y. -Proof. by apply/slt_sorted_lt/trans. Qed. - Lemma sle_sorted ks x y : sorted ord ks -> y \in ks -> x <=[ks] y -> oleq x y. Proof. by rewrite oleq_eqVord; apply/sle_sorted_lt/trans. Qed. -Lemma slt_sortedE ks x y : - sorted ord ks -> - x \in ks -> y \in ks -> - x <[ks] y = ord x y. +Lemma sle_sortedI ks : + uniq ks -> + (forall x y, y \in ks -> x <=[ks] y -> oleq x y) -> + sorted ord ks. Proof. -move=>S X Y; apply/idP/idP; first by apply: slt_sorted S Y. -by rewrite seqlt_unlock; apply: (sorted_ord_index (@irr _) (@trans _)) S X. +move=>Uq H; apply: slt_sortedI=>// x y Dy N. +move: (H x y Dy (sltW N)); rewrite oleq_eqVord. +by case: eqP N=>// ->; rewrite slt_irr. Qed. Lemma sle_sortedE ks x y : sorted ord ks -> x \in ks -> y \in ks -> x <=[ks] y = oleq x y. -Proof. by move=>S X Y; rewrite oleqNord sleNgt (slt_sortedE S Y X). Qed. +Proof. +move=>S X Y; rewrite oleqNord sleNgt. +by rewrite (slt_sortedE (@irr _) (@trans _) S Y X). +Qed. End SeqLeOrd. + +(* split_findlast in terms of <[s] *) + +Lemma slt_findlast {A : eqType} (p : pred A) (s : seq A) : + uniq s -> + has p s -> + exists x, [/\ x \in s, p x & + forall z, z \in s -> x <[s] z -> ~~ p z]. +Proof. +move=>Us H. +case: {-1}s {-3}_ {-6}_ / {H} (split_findlast H) (erefl s). +move=>x s1 s2 Px /hasPn /= S2 E; exists x. +rewrite mem_cat mem_rcons inE eqxx /=; split=>//. +move=>z; rewrite mem_cat mem_rcons inE -orbA. +case/or3P=>[/eqP ->|Z|/S2//]; first by rewrite slt_irr. +rewrite slt_cat mem_rcons inE Z orbT slt_rcons Z=>/slt_memE. +rewrite E cat_uniq rcons_uniq -andbA in Us. +by case/and4P: Us=>/negbTE ->. +Qed. + +Lemma slt_filterlast {A : eqType} (p q : pred A) (s : seq A) : + uniq s -> + has p (filter q s) -> + exists x, [/\ x \in s, p x, q x & + forall z, z \in s -> x <[s] z -> q z -> ~~ p z]. +Proof. +move=>Us; rewrite has_filterI. +case/(slt_findlast Us)=>x [X] /andP [H1 H2] Y. +exists x; split=>//= z Z /(Y z Z). +by rewrite negb_and; case/orP=>// /negbTE ->. +Qed. + +Lemma has_first {A : eqType} (xs : seq A) f : + has f xs -> + exists x, [/\ x \in xs, f x & + forall x', x' <[xs] x -> ~~ f x']. +Proof. +case/has_first_split=>x [p1][p2][-> H1 H2]; exists x. +split=>[|//|y]; first by rewrite mem_cat mem_rcons inE eqxx. +by rewrite slt_cat mem_rcons inE eqxx /= =>/slt_rconsR/(hasPn H2). +Qed. + +(* prefixes is ordered monotonically *) +Lemma prefixes_mono {A : eqType} (s : seq A) xs ys : + xs \in prefixes s -> + ys <=[prefixes s] xs = prefix ys xs. +Proof. +elim: s xs ys=>[|x s IH] /= xs ys; rewrite inE. +- by move/eqP=>->; rewrite sle_cons eqxx orbF; case: ys. +case/orP=>[/eqP ->|/mapP [x0 X0 ->]]. +- by rewrite sle_cons eqxx orbF; case: ys {IH}. +rewrite sle_cons /=; case: ys=>[|y ys] //=. +have I : injective (cons x) by move=>x1 x2 []. +apply/idP/idP; last first. +- case/andP=>/eqP ->{y} P. + by rewrite seqle_unlock !index_map // -seqle_unlock IH. +rewrite seqle_unlock index_map //; move=>H. +have : y :: ys \in [seq x :: i | i <- prefixes s]. +- rewrite -!index_mem in X0 *; rewrite size_map. + by apply: leq_ltn_trans H X0. +case/mapP=>x1 X2 [??]; subst y x1; rewrite eqxx /= -IH //. +by rewrite seqle_unlock (leq_trans _ H) // index_map. +Qed. + +(* sequence orderings and map/pmap *) + +Section SeqLeLtMap. +Context {A B : ordType}. +Implicit Type ks : seq A. + +(* map *) + +Lemma slt_map (f : A -> B) ks x' y : + x' <[map f ks] (f y) -> + exists2 x, f x = x' & x <[ks] y. +Proof. +case Dy : (y \in ks); last first. +- move=>N; case/mapPP: (slt_memE N)=>x -> /mem_seqP Dx. + by exists x=>//; rewrite slt_memI // Dy. +elim: ks Dy=>[|k ks IH] //=; rewrite inE !slt_cons. +case: (y =P k)=>[<-{k}|/eqP Ny]; first by rewrite eqxx. +move=>Dy /andP [Nf] /orP [/eqP ->|]. +- by exists k=>//; rewrite slt_cons Ny eqxx. +by case/(IH Dy)=>x <- N; exists x=>//; rewrite slt_cons Ny N orbT. +Qed. + +Lemma slt_map_inj (f : A -> B) ks x y : + {in ks, forall x, f x = f y -> x = y} -> + x <[ks] y -> + (f x) <[map f ks] (f y). +Proof. +case Dy : (y \in ks); last first. +- move=>H1 H2; apply: slt_memI; apply/mapP. + - by exists x=>//; apply: (slt_memE H2). + by case=>z Z /esym N; move/(H1 _ Z): N (Z) Dy=>->->. +elim: ks Dy=>[|k ks IH] //=; rewrite inE !slt_cons. +case: (y =P k)=>[<-{k}|/eqP N] //= Dy H X; rewrite (_ : f y != f k) /=. +- by apply: contra N=>/eqP/esym/H -> //; rewrite inE eqxx. +case/orP: X N H=>[/eqP ->|Nxy] N H; first by rewrite eqxx. +by rewrite IH ?orbT // => z Z /H -> //; rewrite inE Z orbT. +Qed. + +Lemma sle_map (f : A -> B) ks x' y : + x' \in map f ks -> + x' <=[map f ks] (f y) -> + exists2 x, f x = x' & x <=[ks] y. +Proof. +move=>Dx; rewrite sle_eqVlt ?Dx //; case/orP=>[/eqP ->|]. +- by exists y=>//; rewrite sle_refl. +by case/slt_map=>x <- /sltW; exists x. +Qed. + +Lemma sle_map_inj (f : A -> B) ks x y : + {in ks, forall x, f x = f y -> x = y} -> + x <=[ks] y -> + (f x) <=[map f ks] (f y). +Proof. +move=>H; case Dy : (y \in ks); last first. +- move=>N; apply/sle_memI/mapP; case=>z Z E. + by move/esym/(H _ Z): E (Z) Dy=>->->. +rewrite sle_eqVlt ?Dy ?orbT //. +case/orP=>[/eqP ->|]; first by rewrite sle_refl. +by move/(slt_map_inj H)/sltW. +Qed. + +(* pmap *) + +Lemma slt_pmap (f : A -> option B) ks x' y' y : + f y = Some y' -> + x' <[pmap f ks] y' -> + exists2 x, f x = Some x' & x <[ks] y. +Proof. +rewrite seqlt_unlock=>H /(index_pmap H) [x]. +by exists x=>//; rewrite seqlt_unlock. +Qed. + +Lemma slt_pmap_inj (f : A -> option B) ks x y x' y' : + {in ks, forall x, f x = Some y' -> x = y} -> + x <[ks] y -> + f x = Some x' -> + f y = Some y' -> + x' <[pmap f ks] y'. +Proof. by rewrite !seqlt_unlock; apply: index_pmap_inj. Qed. + +Lemma sle_pmap (f : A -> option B) ks x' y' y : + x' \in pmap f ks -> + f y = Some y' -> + x' <=[pmap f ks] y' -> + exists2 x, f x = Some x' & x <=[ks] y. +Proof. +move=>Dx' Y; rewrite sle_eqVlt ?Dx' //. +case/orP=>[/eqP ->|]; first by exists y=>//; rewrite sle_refl. +by case/(slt_pmap Y)=>x <- /sltW; exists x. +Qed. + +Lemma sle_pmap_inj (f : A -> option B) ks x y x' y' : + {in ks, forall x, f x = Some y' -> x = y} -> + x <=[ks] y -> + f x = Some x' -> + f y = Some y' -> + x' <=[pmap f ks] y'. +Proof. +move=>H; case Dy: (y \in ks); last first. +- move=>N X Y; apply/sle_memI/pmapPP; case=>z E /mem_seqP Z. + by move/(H _ Z): E (Z) Dy=>->->. +rewrite sle_eqVlt ?Dy ?orbT //. +case/orP=>[/eqP ->-> [->]|]; first by rewrite sle_refl. +by move=>N X /(slt_pmap_inj H N X)/sltW. +Qed. + +End SeqLeLtMap. + diff --git a/core/uslice.v b/core/uslice.v index 67bf74f..8f36aa9 100644 --- a/core/uslice.v +++ b/core/uslice.v @@ -20,9 +20,6 @@ From pcm Require Import options prelude ordtype seqext slice useqord. Local Open Scope order_scope. Import Order.Theory. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (* slicing by element index *) Definition ix_bnd {A : eqType} (s : seq A) (i : itv_bound A) : itv_bound nat := @@ -192,7 +189,7 @@ Lemma eqsl_uxR t s : then rcons (&=s `]-oo, t[) t else &=s `]-oo, t[. Proof. -rewrite /eq_slice /= (@slice_split _ _ _ true (index t s)) /=; last first. +rewrite /eq_slice /= (@slice_split _ _ _ true (index t s)) /=. - by rewrite in_itv /=. rewrite slice_kk /= onth_index; case: ifP=>/= H. - by rewrite cats1. @@ -204,7 +201,7 @@ Lemma eqsl_xuL t s : then t :: &=s `]t, +oo[ else &=s `]t, +oo[. Proof. -rewrite /eq_slice /= (@slice_split _ _ _ false (index t s)) //=; last first. +rewrite /eq_slice /= (@slice_split _ _ _ false (index t s)) //=. - by rewrite in_itv /= andbT. by rewrite slice_kk /= onth_index; case: ifP. Qed. @@ -216,7 +213,7 @@ Lemma eqsl_xxL t1 t2 s : Proof. rewrite /eq_slice seqle_unlock /=. case: leqP=>I /=; last by rewrite itv_swapped_bnd. -rewrite (@slice_split _ _ _ false (index t1 s)) /=; last first. +rewrite (@slice_split _ _ _ false (index t1 s)) /=. - by rewrite in_itv /= lexx. rewrite slice_kk /= onth_index; case: ifP=>//= /negbT N1. by rewrite (memNindex N1) itv_overL //= addn1. @@ -231,7 +228,7 @@ Lemma eqsl_xxR t1 t2 s : Proof. rewrite /eq_slice seqle_unlock /=. case: leqP=>I /=; last by rewrite itv_swapped_bnd //. -rewrite (@slice_split _ _ _ true (index t2 s)) /=; last first. +rewrite (@slice_split _ _ _ true (index t2 s)) /=. - by rewrite in_itv /= lexx andbT. rewrite slice_kk /= onth_index /=; case: ifP=>/=; first by rewrite cats1. rewrite cats0 => /negbT/memNindex->. @@ -245,7 +242,7 @@ Lemma eqsl_xoL t1 t2 s : Proof. rewrite /eq_slice seqlt_unlock /=. case: ltnP=>I; last by rewrite itv_swapped_bnd. -rewrite (@slice_split _ _ _ false (index t1 s)) /=; last first. +rewrite (@slice_split _ _ _ false (index t1 s)) /=. - by rewrite in_itv /= lexx. rewrite slice_kk /= onth_index; case: ifP=>//= /negbT/memNindex E. by move: I; rewrite E ltnNge index_size. @@ -260,7 +257,7 @@ Lemma eqsl_oxR t1 t2 s : Proof. rewrite /eq_slice seqlt_unlock /=. case: ltnP=>I; last by rewrite itv_swapped_bnd. -rewrite (@slice_split _ _ _ true (index t2 s)) /=; last first. +rewrite (@slice_split _ _ _ true (index t2 s)) /=. - by rewrite in_itv /= lexx andbT. rewrite slice_kk /= onth_index /=; case: ifP=>/=; first by rewrite cats1. rewrite cats0 =>/negbT/memNindex->. @@ -273,7 +270,7 @@ Lemma eqsl_uL_notinE s b t : t \notin s -> &=s `(Interval -oo (BSide b t)) = s. Proof. -move=>N; rewrite /eq_slice /= itv_overR /=; first by exact: slice_uu. +move=>N; rewrite /eq_slice /= itv_overR /=; last by exact: slice_uu. by rewrite (memNindex N); exact: leq_addr. Qed. @@ -300,7 +297,7 @@ Lemma eqsl_uL_catE s1 s2 b t : Proof. rewrite /eq_slice slice_cat /= index_cat; case: ifP=>H1. - by rewrite index_mem H1 itv_minfR cats0. -rewrite ltnNge leq_addr /= addnC addnK itv_overR /=; first by rewrite slice_uu. +rewrite ltnNge leq_addr /= addnC addnK itv_overR /=; last by rewrite slice_uu. by rewrite -addnA addnCA; exact: leq_addr. Qed. @@ -328,12 +325,12 @@ Proof. rewrite /eq_slice slice_cat /= !index_cat. case/boolP: (t1 \in s1)=>H1; case/boolP: (t2 \in s1)=>H2. - by rewrite !index_mem H1 H2 itv_minfR cats0. -- rewrite index_mem H1 ltnNge leq_addr /= itv_overR /=; last first. +- rewrite index_mem H1 ltnNge leq_addr /= itv_overR /=. - by rewrite -addnA; exact: leq_addr. by congr (_ ++ _); rewrite addnC addnK. -- rewrite ltnNge leq_addr index_mem H2 itv_minfR cats0 itv_overL //= -addnA. +- rewrite ltnNge leq_addr /= index_mem H2 itv_minfR cats0 itv_overL //= -addnA. exact: leq_addr. -rewrite !ltnNge !leq_addr /= itv_overL /=; last first. +rewrite !ltnNge !leq_addr /= itv_overL /=. - by rewrite -addnA; exact: leq_addr. by do 2!rewrite addnC addnK. Qed. @@ -506,6 +503,27 @@ move=>N. by rewrite -(cat0s (_ :: _ :: _)); apply: eqsl_oo_split_consec. Qed. +Lemma eqsl_prefix (s1 s2 : seq A) : + uniq s2 -> + prefix s1 s2 -> + s1 = [::] \/ + exists2 t, t \in s2 & s1 = &=s2 `]-oo, t]. +Proof. +elim: s1 s2=>[|x s1 IH][|y s2] //=; try by left. +case/andP=>H1 H2 /andP [/eqP ->{x} H3]; right. +case: (IH s2 H2 H3)=>[->|]. +- exists y; first by rewrite inE eqxx. + by rewrite eqsl_uL_consE eqxx. +case=>t T E; exists t; first by rewrite inE T orbT. +by rewrite eqsl_uL_consE -E; case: eqP T H1=>// ->->. +Qed. + +Lemma prefix_eqsl (s : seq A) t : prefix &=s `]-oo, t] s. +Proof. +elim: s=>[|x xs IH] //=; rewrite eqsl_uL_consE. +by case: eqP=>_; rewrite eqxx ?prefix0s ?IH. +Qed. + Lemma eqsl_uo_prefix (s1 s2 : seq A) t : uniq s2 -> t \in s2 -> @@ -541,7 +559,7 @@ Lemma eqsl_filterL (p : pred A) b (y : A) s : &= (filter p s) (Interval -oo (BSide b y)) = filter p (&= s (Interval -oo (BSide b y))). Proof. case/orP=>Hy. -- rewrite !eqsl_notinR //=; first by rewrite !eqsl_uu. +- rewrite !eqsl_notinR //=; last by rewrite !eqsl_uu. by apply: contra Hy; rewrite mem_filter; case/andP. elim: s=>//= h s IH. case/boolP: (p h)=>/= Hp; last first. @@ -555,7 +573,8 @@ Qed. Lemma eqsl_filterR (p : pred A) b (x : A) s : (x \notin s) || p x -> - &= (filter p s) (Interval (BSide b x) +oo) = filter p (&= s (Interval (BSide b x) +oo)). + &= (filter p s) (Interval (BSide b x) +oo) = + filter p (&= s (Interval (BSide b x) +oo)). Proof. case/orP=>Hx. - by rewrite !eqsl_notinL //= mem_filter negb_and Hx orbT. @@ -576,8 +595,8 @@ case/orP=>[N1|/andP [H1]]. - by rewrite !eqsl_notinL //= mem_filter negb_and N1 orbT. case/orP=>H2. - rewrite !eqsl_notinR //=; last first. - - by rewrite mem_filter negb_and H2 orbT. - by rewrite eqsl_filterR // H1 orbT. + - by rewrite eqsl_filterR // H1 orbT. + by rewrite mem_filter negb_and H2 orbT. elim: s=>//= h s IH. case/boolP: (p h)=>/= Hp; last first. - rewrite {}IH eqsl_consE; case: eqVneq=>[E1|_]. @@ -586,12 +605,12 @@ case/boolP: (p h)=>/= Hp; last first. by rewrite -E2 H2 in Hp. rewrite !eqsl_consE; case: eqVneq=>/=_; case: eqVneq=>//=_. - by case: ifP=>//= _; rewrite Hp. -rewrite eqsl_filterL; last by rewrite H2 orbT. +rewrite eqsl_filterL; first by rewrite H2 orbT. by case: ifP=>//= _; rewrite Hp. Qed. Lemma eqslice_mem (i : interval A) (ks : seq A) (k : A) : - k \in &=ks i = + (k \in &=ks i) = has (fun j => j \in ix_itv ks i) (indexall k ks). Proof. by rewrite /eq_slice slice_memE. Qed. @@ -628,7 +647,7 @@ Lemma eqsl_lastR_uniq s x : uniq s -> s = &=s `]-oo, (last x s)]. Proof. -move=>U; rewrite /eq_slice /= [LHS]slice_usize index_last_size_uniq // slice_oPR. +move=>U; rewrite /eq_slice/= [LHS]slice_usize index_last_size_uniq // slice_oPR. by case: ifP=>// /negbT; rewrite -ltnNge /= ltnS leqn0 => /eqP/size0nil->. Qed. @@ -640,7 +659,7 @@ Qed. Lemma eqslice_mem_uniq (i : interval A) s (x : A) : uniq s -> - x \in &=s i = + (x \in &=s i) = (x \in s) && (index x s \in ix_itv s i). Proof. move=>U; rewrite eqslice_mem indexall_uniq //. @@ -715,6 +734,16 @@ rewrite IH //; apply: eq_in_filter=>z Hz /=. by rewrite sle_cons (negbTE N); case: (z =P h) Hz Nh=>// ->->. Qed. +Lemma uniq_filt_uxou s a : + uniq s -> + s = [seq x <- s | x <=[s] a] ++ [seq x <- s | a <[s] x]. +Proof. by move=>Us; rewrite -uniq_ux_filter -?uniq_ou_filter -?eqsl_uxou. Qed. + +Lemma uniq_filt_uoxu s a : + uniq s -> + s = [seq x <- s | x <[s] a] ++ [seq x <- s | a <=[s] x]. +Proof. by move=>Us; rewrite -uniq_uo_filter -?uniq_xu_filter -?eqsl_uoxu. Qed. + (* sequence ordering, intervals, and last *) Lemma olt_ole_last k s x t : diff --git a/meta.yml b/meta.yml index 3e39a29..ae42cf6 100644 --- a/meta.yml +++ b/meta.yml @@ -7,7 +7,7 @@ action: true coqdoc: false synopsis: >- - Coq library of Partial Commutative Monoids + Rocq library of Partial Commutative Monoids description: |- The PCM library provides a formalisation of Partial Commutative Monoids (PCMs), a common algebraic structure used in separation logic for verification of @@ -40,30 +40,40 @@ license: file: LICENSE supported_coq_versions: - text: 9.0 or later - opam: '{ (>= "9.0" & < "9.2~") | (= "dev") }' + text: "none" + opam: "" + +supported_rocq_versions: + text: 9.2 or later + opam: '{ (>= "9.2" & < "9.3~") | (= "dev") }' tested_coq_opam_versions: -- version: '2.4.0-rocq-prover-9.0' - repo: 'mathcomp/mathcomp' -- version: '2.5.0-rocq-prover-9.1' +- version: '2.6.0-rocq-prover-9.2' repo: 'mathcomp/mathcomp' - version: 'rocq-prover-dev' repo: 'mathcomp/mathcomp-dev' dependencies: - opam: - name: coq-mathcomp-ssreflect - version: '{ (>= "2.4.0" & < "2.6~") | (= "dev") }' + name: rocq-core + version: '{ (>= "9.2" & < "9.3~") | (= "dev") }' + description: "Rocq Core compiler engine" +- opam: + name: rocq-stdlib + version: '{ (>= "9.2" & < "9.3~") | (= "dev") }' + description: "Rocq Standard Library components" +- opam: + name: rocq-mathcomp-ssreflect + version: '{ (>= "2.6.0" & < "2.7~") | (= "dev") }' description: |- - [MathComp ssreflect 2.4 or later](https://math-comp.github.io) + [MathComp ssreflect 2.6 or later](https://math-comp.github.io) - opam: - name: coq-hierarchy-builder + name: rocq-hierarchy-builder version: '{ (>= "1.7.0" & < "1.11~") | (= "dev") }' description: |- [Hierarchy Builder 1.7.0 or later](https://github.com/math-comp/hierarchy-builder) - opam: - name: coq-mathcomp-algebra + name: rocq-mathcomp-algebra description: |- [MathComp algebra](https://math-comp.github.io) diff --git a/pcm/automap.v b/pcm/automap.v index d9d63f0..820a233 100644 --- a/pcm/automap.v +++ b/pcm/automap.v @@ -17,9 +17,6 @@ From pcm Require Import options pred prelude. From pcm Require Export auto. From pcm Require Import pcm unionmap natmap. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (**************************************************************************) (**************************************************************************) (* Canonical structure lemmas for automating three tasks: *) @@ -90,7 +87,7 @@ Definition interp' i t := end. (* main interpretation function *) -Notation fx i := (fun t f => interp' i t \+ f). +Abbreviation fx i := (fun t f => interp' i t \+ f). Definition interp i ts := foldr (fx i) Unit ts. Lemma fE i ts x : foldr (fx i) x ts = x \+ interp i ts. @@ -186,7 +183,7 @@ Proof. by elim: ts=>//= t ts IH; case: ifP=>_ /andP [] //= -> /IH ->. Qed. Definition getkeys := foldr (fun t ks => if t is Pts k _ then k :: ks else ks) [::]. -Lemma has_getkeys ts n : n \in getkeys ts = has (key n) ts. +Lemma has_getkeys ts n : (n \in getkeys ts) = has (key n) ts. Proof. by elim: ts=>//= t ts IH; case: t=>[m v|m] //; rewrite inE IH. Qed. End Reflection. @@ -409,8 +406,8 @@ Module ValidX. Section ValidX. Variables (K : ordType) (C : pred K) (T : Type) (U : union_map K C T). Implicit Types (j : ctx U) (ts : seq (term T)). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* The rform structure has two important components: *) (* *) @@ -476,8 +473,8 @@ Canonical start. Section Exports. Variables (K : ordType) (C : pred K) (T : Type) (U : union_map K C T). Implicit Types (j : ctx U) (ts : seq (term T)). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* the main lemma; note how the boolean component of rform is set to true *) @@ -495,10 +492,10 @@ Example ex0 (x y z : nat) (v1 v2 : nat) h: Proof. apply: validX. Abort. (* Automated versions of joinKx(xK), cancPL(PR) lemmas *) -Notation joinKX V E := (joinKx' E (validX V)). -Notation joinXK V E := (joinxK' E (validX V)). -Notation cancPLX pf V H1 H2 E := (cancPL' pf E H1 H2 (validX V)). -Notation cancPRX pf V H1 H2 E := (cancPR' pf E H1 H2 (validX V)). +Abbreviation joinKX V E := (joinKx' E (validX V)). +Abbreviation joinXK V E := (joinxK' E (validX V)). +Abbreviation cancPLX pf V H1 H2 E := (cancPL' pf E H1 H2 (validX V)). +Abbreviation cancPRX pf V H1 H2 E := (cancPR' pf E H1 H2 (validX V)). End Exports. End ValidX. @@ -514,8 +511,8 @@ Module DomeqX. Section DomeqX. Variables (K : ordType) (C : pred K) (T : Type) (U : union_map K C T). Implicit Types (j : ctx U) (ts : seq (term T)). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. Structure packed_map (m : U) := Pack {unpack : U}. Canonical equate (m : U) := Pack m m. @@ -553,8 +550,8 @@ Canonical start. Section Exports. Variables (K : ordType) (C : pred K) (T : Type) (U : union_map K C T). Implicit Types (j : ctx U) (ts : seq (term T)). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* the main lemma; notice how residuals rs1, rs2 are passed to g to compute *) @@ -588,8 +585,8 @@ Module InvalidX. Section InvalidX. Variables (K : ordType) (C : pred K) (T : Type) (U : union_map K C T). Implicit Types (i : ctx U) (ts : seq (term T)). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. Structure packed_map (m : U) := Pack {unpack : U}. Canonical equate (m : U) := Pack m m. @@ -619,8 +616,8 @@ Canonical start. Section Exports. Variables (K : ordType) (C : pred K) (T : Type) (U : union_map K C T). Implicit Types (i : ctx U) (ts : seq (term T)). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* the main lemmas *) @@ -749,7 +746,7 @@ case: g=>eq g /=; elim: ts eq=>[|s a|ts1 IH1 ts2 IH2|t] /= eq pf X. - by rewrite pf !pfunit. - rewrite validPt in X; rewrite pf omfPt // omf_comp /=. by case: (omf g _)=>[x|]; rewrite ?omfPt ?pfunit. -- rewrite pf /= !omfUn //; last by rewrite -omfUn ?pfVE. +- rewrite pf /= !omfUn //; first by rewrite -omfUn ?pfVE. by rewrite IH1 ?(validL X) // IH2 ?(validR X). by rewrite pf. Qed. diff --git a/pcm/autopcm.v b/pcm/autopcm.v index 8448bbd..dd8cff2 100644 --- a/pcm/autopcm.v +++ b/pcm/autopcm.v @@ -75,7 +75,7 @@ Definition interp' (i : ctx U) (t : term) : option U := let: Expr n := t in onth (expx i) n. (* main interpretation function *) -Notation fx i := (fun t f => interp' i t \+ f). +Abbreviation fx i := (fun t f => interp' i t \+ f). Definition interp (i : ctx U) (ts : seq term) : option U := foldr (fx i) Unit ts. @@ -269,8 +269,8 @@ Module PullX. Section PullX. Variables (U : pcm). Implicit Types (j k : ctx U) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. Structure packed_pcm (m : U) := Pack {unpack : U}. @@ -324,8 +324,8 @@ Canonical start. Section Exports. Variables (U : pcm). Implicit Types (j : ctx U) (ts : seq term). -Notation form := Syntactify.form. -Notation untag := Syntactify.untag. +Abbreviation form := Syntactify.form. +Abbreviation untag := Syntactify.untag. (* we need to syntactify first the subtractee (fm), then the goal (fg) *) @@ -342,7 +342,7 @@ Qed. End Exports. Arguments pullX' [U] s [j k ts g r fs fg] _. -Notation pullX s := (pullX' s erefl). +Abbreviation pullX s := (pullX' s erefl). Example ex0 (x y z : nat) : 1 \+ x \+ 2 \+ y \+ 3 \+ z = 0. diff --git a/pcm/heap.v b/pcm/heap.v index 78d93ec..679aec4 100644 --- a/pcm/heap.v +++ b/pcm/heap.v @@ -23,9 +23,6 @@ From mathcomp Require Import ssrnat eqtype fintype tuple finfun seq path bigop. From pcm Require Import options axioms prelude pred finmap. From pcm Require Import pcm unionmap natmap. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (************) (* Pointers *) (************) @@ -46,7 +43,7 @@ Proof. by rewrite /ptr_offset addn0. Qed. Lemma ptr1 x : x .+ 1 = x.+1. Proof. by rewrite /ptr_offset addn1. Qed. -Lemma ptrA x i j : x.+i.+j = x.+(i+j). +Lemma ptrA x i j : (x.+i).+j = x.+(i+j). Proof. by rewrite /ptr_offset addnA. Qed. Lemma ptrK x i j : (x.+i == x.+j) = (i == j). @@ -114,7 +111,7 @@ End NullLemmas. (* methods *) -Notation base := (@UM.base ptr (fun k => k != null) (dynamic id)). +Abbreviation base := (@UM.base ptr (fun k => k != null) (dynamic id)). Definition def h := if h is Def _ _ then true else false. Definition empty := @Def finmap.nil is_true_true. @@ -188,7 +185,7 @@ Implicit Types (x : ptr) (h : heap). Lemma hcancelPtT A1 A2 x (v1 : A1) (v2 : A2) : valid (x :-> v1) -> x :-> v1 = x :-> v2 -> A1 = A2. -Proof. by move=>V /(cancelPt V)/dyn_injT. Qed. +Proof. by move=>V /(cancelPt V)/inj_dynT. Qed. Lemma hcancelPtT2 A1 A2 x1 x2 (v1 : A1) (v2 : A2) : valid (x1 :-> v1) -> x1 :-> v1 = x2 :-> v2 -> (x1, A1) = (x2, A2). @@ -196,11 +193,11 @@ Proof. by move=>V; case/(cancelPt2 V)=>-> E _; rewrite E. Qed. Lemma hcancelPtV A x (v1 v2 : A) : valid (x :-> v1) -> x :-> v1 = x :-> v2 -> v1 = v2. -Proof. by move=>V; move/(cancelPt V)/dyn_inj. Qed. +Proof. by move=>V; move/(cancelPt V)/inj_dyn. Qed. Lemma hcancelPtV2 A x1 x2 (v1 v2 : A) : valid (x1 :-> v1) -> x1 :-> v1 = x2 :-> v2 -> (x1, v1) = (x2, v2). -Proof. by move=>V /(cancelPt2 V) [->] /dyn_inj ->. Qed. +Proof. by move=>V /(cancelPt2 V) [->] /inj_dyn ->. Qed. Lemma heap_eta x h : x \in dom h -> @@ -218,12 +215,12 @@ Proof. exact: um_eta2. Qed. Lemma hcancelT A1 A2 x (v1 : A1) (v2 : A2) h1 h2 : valid (x :-> v1 \+ h1) -> x :-> v1 \+ h1 = x :-> v2 \+ h2 -> A1 = A2. -Proof. by move=>V; case/(cancel V); move/dyn_injT. Qed. +Proof. by move=>V; case/(cancel V); move/inj_dynT. Qed. Lemma hcancelV A x (v1 v2 : A) h1 h2 : valid (x :-> v1 \+ h1) -> x :-> v1 \+ h1 = x :-> v2 \+ h2 -> [/\ v1 = v2, valid h1 & h1 = h2]. -Proof. by move=>V; case/(cancel V); move/dyn_inj. Qed. +Proof. by move=>V; case/(cancel V); move/inj_dyn. Qed. Lemma hcancel2V A x1 x2 (v1 v2 : A) h1 h2 : valid (x1 :-> v1 \+ h1) -> @@ -232,7 +229,7 @@ Lemma hcancel2V A x1 x2 (v1 v2 : A) h1 h2 : else [/\ free h2 x1 = free h1 x2, h1 = x2 :-> v2 \+ free h2 x1 & h2 = x1 :-> v1 \+ free h1 x2]. -Proof. by move=>V /(cancel2 V); case: ifP=>// _ [/dyn_inj]. Qed. +Proof. by move=>V /(cancel2 V); case: ifP=>// _ [/inj_dyn]. Qed. End HeapPointsToLemmas. @@ -286,7 +283,7 @@ by rewrite /= validPtUn -addn1 updiVm' // orbF IH addn1 /= andbT. Qed. Lemma updiVm x m xs : - x \in dom (updi x.+m xs) = [&& x != null, m == 0 & size xs > 0]. + (x \in dom (updi x.+m xs)) = [&& x != null, m == 0 & size xs > 0]. Proof. case: m=>[|m] /=; last first. - by rewrite andbF; apply/negbTE/updiVm'. @@ -295,7 +292,7 @@ by rewrite domPtUn inE /= eq_refl -updiS updiD orbF andbT /=. Qed. Lemma updimV x m xs : - x.+m \in dom (updi x xs) = (x != null) && (m < size xs). + (x.+m \in dom (updi x xs)) = (x != null) && (m < size xs). Proof. case H: (x == null)=>/=. - case: xs=>[|a s]; first by rewrite dom0. @@ -378,7 +375,7 @@ Lemma updi_split {I : finType} T p k (f : {ffun I -> T}) : updi (p.+(indx k).+1) (drop (indx k).+1 (fgraph f)). Proof. rewrite fgraph_codom /= codomE {1}(enum_split k) map_cat updi_cat /=. -rewrite map_take map_drop size_takel ?joinA; first by rewrite -ptr1 ptrA addn1. +rewrite map_take map_drop size_takel ?joinA; last by rewrite -ptr1 ptrA addn1. by rewrite size_map index_size. Qed. diff --git a/pcm/invertible.v b/pcm/invertible.v index 525e43c..d7d6b5e 100644 --- a/pcm/invertible.v +++ b/pcm/invertible.v @@ -21,9 +21,6 @@ From mathcomp Require Import eqtype. From pcm Require Import options axioms prelude. From pcm Require Import pcm morphism. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (* in the POPL21 paper, we use the notation x D y D z =def= x D y /\ (x \+ y) D z *) @@ -87,7 +84,7 @@ Lemma inv_ker (U V : pcm) (f : pcm_morph U V) : Proof. move=>Sf a1 a2 a' W /and3P [D1 /unitbP Eq1 _] /and3P [D2 /unitbP Eq2 /unitbP]. case/andP: (Sf _ _ _ W D1 D2)=>{}D1 {}D2. -rewrite /kerx !pfjoin ?(validLE3 W) //; last by rewrite (sepAxx W). +rewrite /kerx !pfjoin ?(validLE3 W) //; first by rewrite (sepAxx W). by rewrite /kerx Eq1 Eq2 D1 D2 !unitL=>->; rewrite /sepU pcmE. Qed. @@ -101,7 +98,7 @@ case/and4P=>X1 X2 Ex _ /and4P [Y1 Y2] Ey /eqP. case/andP: (Sf _ _ _ W X1 Y1)=>E1 E1'. case/andP: (Sg _ _ _ W X2 Y2)=>E2 E2'. rewrite E1 E2 Ex Ey E1' E2' !pfjoin ?(validLE3 W) 2?(sepAxx W) //=. -rewrite -(eqP Ex) (eqP Ey) eq_refl => /joinxK ->; first by rewrite eqxx. +rewrite -(eqP Ex) (eqP Ey) eq_refl => /joinxK ->; last by rewrite eqxx. by rewrite pfV2 ?(validLE3 W) // (sepAxx W). Qed. diff --git a/pcm/minus.v b/pcm/minus.v index 0605162..9066f03 100644 --- a/pcm/minus.v +++ b/pcm/minus.v @@ -16,9 +16,6 @@ From Stdlib Require Import ssreflect ssrbool ssrfun. From mathcomp Require Import choice ssrnat eqtype ssrint ssrnum order. From pcm Require Import options axioms prelude pcm mutex morphism. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (*************************) (*************************) (* PCMs with subtraction *) @@ -446,7 +443,7 @@ Lemma sepyS (U : pcms) (sep : sseprel U) (x y : U) : sep (x \- y) Unit -> sep y (x \- y). Proof. -move=>V Sx Sy S; rewrite sepC; first by apply: sepSy. +move=>V Sx Sy S; rewrite sepC; last by apply: sepSy. by rewrite joinxS // (validSL V). Qed. @@ -469,7 +466,7 @@ rewrite validSX valid_pvalE; case=>Vx _ S; split=>//. move: (validSR V). rewrite valid_pvalE. move=>Vy. case/(valid_sep (xsub R)): Vx=>Vx Sx. case/(valid_sep (xsub R)): Vy=>Vy Sy. -rewrite -{1}(psub_pval (xsub R) y) -pfjoin /=; last 2 first. +rewrite -{1}(psub_pval (xsub R) y) -pfjoin /=. - by rewrite joinxS. - by rewrite /sepx /= sepyS. by rewrite joinxS // psub_pval. @@ -489,25 +486,25 @@ HB.instance Definition _ := TPCMS.on oint2. Module RWsep. Import intZmod intOrdered ssralg.GRing ssralg.GRing.Theory Num.Theory Num.Def. Import Order.TTheory Order.DefaultProdOrder Order.ProdSyntax. -Import Order.DefaultProdLexiOrder Order.LexiSyntax. +Import Order.DefaultProdLexiOrder Order.LexiSyntax. Local Open Scope order_scope. Local Open Scope ring_scope. (* positive pairs, lexi smaller than (1, 0) *) -(* describes the valid states of a rw-lock *) +(* describes the valid states of a rewrite-lock *) (* we either have no writers and any positive number of readers *) (* or 1 writer and no readers *) Definition bnd2 (x : int *l int) := ((0,0)%Z <=^p x) && (x <=^l (1,0)%Z). (* here want to use \+ from pcm scope *) -Definition rwsep : rel oint2 := +Definition rewritesep : rel oint2 := fun x y => if (x, y) is (Some x, Some y) then [&& bnd2 x, bnd2 y & bnd2 (x \+ y)%pcm] else true. -Lemma rwsep_is_seprel : seprel_axiom rwsep. +Lemma rewritesep_is_seprel : seprel_axiom rewritesep. Proof. -rewrite /rwsep; split=>[|[[x1 x2]|][[y1 y2]|]| +rewrite /rewritesep; split=>[|[[x1 x2]|][[y1 y2]|]| [[x1 x2]|][[y1 y2]|]|[[x1 x2]|][[y1 y2]|][[z1 z2]|]] //= _. - by rewrite andbCA pcm.joinC. - by rewrite unitR andbb; case/and3P. @@ -525,76 +522,76 @@ by rewrite -(lerD2l x2) ler_wpDl. Qed. #[export] HB.instance Definition _ := - isSeprel.Build oint2 rwsep rwsep_is_seprel. + isSeprel.Build oint2 rewritesep rewritesep_is_seprel. -(* rwsep preserves subtraction *) -Lemma rwsep_is_sseprel : sseprel_axiom rwsep. +(* rewritesep preserves subtraction *) +Lemma rewritesep_is_sseprel : sseprel_axiom rewritesep. Proof. -rewrite /rwsep; case=>[[x1 x2]|][[y1 y2]|] //= _. +rewrite /rewritesep; case=>[[x1 x2]|][[y1 y2]|] //= _. do ![rewrite pcmE /unjoin /=]. by rewrite -!addrA !addNr !addr0 !andbb =>->->->. Qed. #[export] HB.instance Definition _ := - isSseprel.Build oint2 rwsep rwsep_is_sseprel. + isSseprel.Build oint2 rewritesep rewritesep_is_sseprel. -Definition rw := xsep rwsep. -Definition rwsub : sub_struct rw oint2 := xsub rwsep. -HB.instance Definition _ := TPCMS.on rw. -HB.instance Definition _ := SubTPCM_struct.on rwsub. +Definition rewrite := xsep rewritesep. +Definition rewritesub : sub_struct rewrite oint2 := xsub rewritesep. +HB.instance Definition _ := TPCMS.on rewrite. +HB.instance Definition _ := SubTPCM_struct.on rewritesub. -Lemma rw_is_conic : pcmc_axiom rw. +Lemma rewrite_is_conic : pcmc_axiom rewrite. Proof. -move=>x y; case: normalP=>// /[dup] V /(valid_sepUnS rwsub). -rewrite -!(unitb_pval rwsub) pfjoinT //= {V}. +move=>x y; case: normalP=>// /[dup] V /(valid_sepUnS rewritesub). +rewrite -!(unitb_pval rewritesub) pfjoinT //= {V}. case: {x}(pval _ x)=>[[x1 x2]|//]; case: {y}(pval _ y)=>[[y1 y2]|//]. -rewrite /sepx/=/rwsep; do ![rewrite pcmE /= /unitb]; rewrite !addr_eq0. +rewrite /sepx/=/rewritesep; do ![rewrite pcmE /= /unitb]; rewrite !addr_eq0. case: (x1 =P opp y1)=>// ->{x1}; case: (x2 =P opp y2)=>// ->{x2}. rewrite /bnd2/Order.le/=/Order.ProdOrder.le/Order.ProdLexiOrder.le /=. rewrite !oppr_eq0 !oppr_ge0 oppr_le0. by case: (ltgtP y1 0); case: (ltgtP y2 0)=>//=; rewrite andbF. Qed. -#[export] HB.instance Definition _ := isPCMC.Build rw rw_is_conic. +#[export] HB.instance Definition _ := isPCMC.Build rewrite rewrite_is_conic. -(* extracting number of writers and number of readers out of rw state *) +(* extracting number of writers and number of readers out of rewrite state *) (* explicitly made out to be nats, not ints *) -Definition wr_no (x : rw) := oapp (absz \o fst) 0 (pval rwsub x). -Definition rd_no (x : rw) := oapp (absz \o snd) 0 (pval rwsub x). +Definition wr_no (x : rewrite) := oapp (absz \o fst) 0 (pval rewritesub x). +Definition rd_no (x : rewrite) := oapp (absz \o snd) 0 (pval rewritesub x). Module Exports. -Notation rwsep := rwsep. -Notation rw := rw. -Notation rwsub := rwsub. +Abbreviation rewritesep := rewritesep. +Abbreviation rewrite := rewrite. +Abbreviation rewritesub := rewritesub. Notation "#w x" := (wr_no x) (at level 1). Notation "#r x" := (rd_no x) (at level 1). (* generic lemmas to relate x to the pair (#w x, #r x) *) -Lemma psub_rwsub (x : rw) : +Lemma psub_rewritesub (x : rewrite) : valid x -> - x = psub rwsub (Some (#w x %:Z, #r x %:Z)). + x = psub rewritesub (Some (#w x %:Z, #r x %:Z)). Proof. -move/[dup]/(valid_sepS rwsub). -rewrite -{2 3}(psub_pval rwsub x) /wr_no/rd_no/oapp /=. -case: (pval rwsub x)=>[[x1 x2]|] /=; last first. +move/[dup]/(valid_sepS rewritesub). +rewrite -{2 3}(psub_pval rewritesub x) /wr_no/rd_no/oapp /=. +case: (pval rewritesub x)=>[[x1 x2]|] /=; last first. - by rewrite (negbTE (psub_undef _)). case/andP=>/andP [/andP [/= X1 X2]] _ _ _. by case: x1 x2 X1 X2=>// x1 []. Qed. -Lemma pval_rwsub (x : rw) : +Lemma pval_rewritesub (x : rewrite) : valid x -> - pval rwsub x = Some (#w x %:Z, #r x %:Z). -Proof. by move=>V; rewrite {1}(psub_rwsub V) valid_psubS //= -psub_rwsub. Qed. + pval rewritesub x = Some (#w x %:Z, #r x %:Z). +Proof. by move=>V; rewrite {1}(psub_rewritesub V) valid_psubS //= -psub_rewritesub. Qed. -Lemma rwlex x : (#w x, #r x) <=^l (1, 0) :> (nat *l nat). +Lemma rewritelex x : (#w x, #r x) <=^l (1, 0) :> (nat *l nat). Proof. case: (normalP x)=>[->|V]. - by rewrite /wr_no/rd_no !pfundef. -move: (valid_sepS rwsub V); rewrite pval_rwsub //=. +move: (valid_sepS rewritesub V); rewrite pval_rewritesub //=. by case/andP=>/andP []. Qed. diff --git a/pcm/morphism.v b/pcm/morphism.v index d32e474..de3d48f 100644 --- a/pcm/morphism.v +++ b/pcm/morphism.v @@ -13,13 +13,10 @@ limitations under the License. From HB Require Import structures. From Stdlib Require Import ssreflect ssrbool ssrfun. -From mathcomp Require Import ssrnat eqtype fintype finfun. +From mathcomp Require Import ssrnat eqtype fintype finfun bigop. From pcm Require Import options pred axioms prelude. From pcm Require Import pcm. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (*****************) (*****************) (* PCM Morphisms *) @@ -367,7 +364,7 @@ HB.instance Definition _ := isSeprel.Build U (rel4I X Y Z W) rel4I_is_seprel. End Sep4I. (************************************) -(* projections and pairwise product *) +(* projections and pairewriteise product *) (************************************) Definition rel_fst U V (X : rel U) (x y : U * V) := X x.1 y.1. @@ -624,13 +621,13 @@ Arguments pcm_morph_subproof {U V}. (* option 1 *) Definition sepx U V (f : pcm_morph U V) of phantom (U -> V) f := sep_op f. -Notation sep f := (sepx (Phantom (_ -> _) f)). +Abbreviation sep f := (sepx (Phantom (_ -> _) f)). *) (* option 2 *) Definition sepx U V (f : pcm_morph U V) & phantom (U -> V) f : rel U := sep_op f. -Notation sep f := (sepx (Phantom (_ -> _) f)). +Abbreviation sep f := (sepx (Phantom (_ -> _) f)). HB.instance Definition _ U V (f : pcm_morph U V) := Seprel.on (sep f). @@ -638,7 +635,7 @@ HB.instance Definition _ U V (f : pcm_morph U V) := (* but we won't use this *) Definition morphx (U V : pcm) (f : pcm_morph U V) & phantom (U -> V) f := f. -Notation morph f := (morphx (Phantom (_ -> _) f)). +Abbreviation morph f := (morphx (Phantom (_ -> _) f)). Section Laws. @@ -735,6 +732,7 @@ Arguments pfR {U V} f {x y}. Arguments pfunitL {U V}. Arguments pfunitR {U V}. + (*********************) (* Morphism equality *) (*********************) @@ -770,7 +768,7 @@ Qed. Definition preimx (U V : pcm) (f : pcm_morph U V) & phantom (U -> V) f : rel V -> rel U := fun R x y => sep f x y && R (f x) (f y). -Notation preim f := (preimx (Phantom (_ -> _) f)). +Abbreviation preim f := (preimx (Phantom (_ -> _) f)). Arguments preimx {U V f} _ _ _ _ /. Section Preim. @@ -799,7 +797,7 @@ End Preim. Definition kerx (U V : pcm) (f : pcm_morph U V) & phantom (U -> V) f : rel U := fun x y => sep f x y && sepU (f x) (f y). -Notation ker f := (kerx (Phantom (_ -> _) f)). +Abbreviation ker f := (kerx (Phantom (_ -> _) f)). HB.instance Definition _ U V (f : pcm_morph U V) := isSeprel.Build U (ker f) (preim_is_seprel f _). @@ -827,7 +825,7 @@ End Restriction. Definition eqlzx (U : pcm) (V : eqpcm) (f1 f2 : pcm_morph U V) & phantom (U -> V) f1 & phantom (U -> V) f2 : rel U := fun x y => [&& sep f1 x y, sep f2 x y, f1 x == f2 x & f1 y == f2 y]. -Notation eqlz f1 f2 := (eqlzx (Phantom (_ -> _) f1) (Phantom (_ -> _) f2)). +Abbreviation eqlz f1 f2 := (eqlzx (Phantom (_ -> _) f1) (Phantom (_ -> _) f2)). Section Equalizer. Variables (U : pcm) (V : eqpcm) (f1 f2 : pcm_morph U V). @@ -852,7 +850,7 @@ Definition join_relx (U V : pcm) (f1 f2 : pcm_morph U V) & phantom (U -> V) f1 & phantom (U -> V) f2 : rel U := fun x y => [&& sep f1 x y, sep f2 x y & valid ((f1 x \+ f2 x) \+ (f1 y \+ f2 y))]. -Notation join_rel f1 f2 := +Abbreviation join_rel f1 f2 := (join_relx (Phantom (_ -> _) f1) (Phantom (_ -> _) f2)). Definition join_fun (U V : pcm) (f1 f2 : U -> V) : U -> V := @@ -954,7 +952,7 @@ HB.instance Definition _ := unit_fun unitfun_is_pcm_morph. End UnitFun. -(* pairwise product of morphisms is a morphism *) +(* pairewriteise product of morphisms is a morphism *) Section FProdMorph. Variables U1 U2 V1 V2 : pcm. Variables (f1 : pcm_morph U1 V1) (f2 : pcm_morph U2 V2). @@ -989,7 +987,7 @@ End ProjMorph. Section Proj3Morph. Variables U1 U2 U3 : pcm. -Notation tp := (Prod3 U1 U2 U3). +Abbreviation tp := (Prod3 U1 U2 U3). Lemma proj31_morph_ax : pcm_morph_axiom relT (proj31 : tp -> _). Proof. by split=>[|x y] // /and3P []. Qed. @@ -1005,7 +1003,7 @@ End Proj3Morph. Section Proj4Morph. Variables U1 U2 U3 U4 : pcm. -Notation tp := (Prod4 U1 U2 U3 U4). +Abbreviation tp := (Prod4 U1 U2 U3 U4). Lemma proj41_morph_ax : pcm_morph_axiom relT (proj41 : tp -> _). Proof. by split=>[|x y] // /and4P []. Qed. @@ -1024,7 +1022,7 @@ End Proj4Morph. Section Proj5Morph. Variables U1 U2 U3 U4 U5 : pcm. -Notation tp := (Prod5 U1 U2 U3 U4 U5). +Abbreviation tp := (Prod5 U1 U2 U3 U4 U5). Lemma proj51_morph_ax : pcm_morph_axiom relT (proj51 : tp -> _). Proof. by split=>[|x y] // /and5P []. Qed. @@ -1046,7 +1044,7 @@ End Proj5Morph. Section Proj6Morph. Variables U1 U2 U3 U4 U5 U6 : pcm. -Notation tp := (Prod6 U1 U2 U3 U4 U5 U6). +Abbreviation tp := (Prod6 U1 U2 U3 U4 U5 U6). Lemma proj61_morph_ax : pcm_morph_axiom relT (proj61 : tp -> _). Proof. by split=>[|x y] // /and6P []. Qed. @@ -1071,7 +1069,7 @@ End Proj6Morph. Section Proj7Morph. Variables U1 U2 U3 U4 U5 U6 U7 : pcm. -Notation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). +Abbreviation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). Lemma proj71_morph_ax : pcm_morph_axiom relT (proj71 : tp -> _). Proof. by split=>[|x y] // /and7P []. Qed. @@ -1481,10 +1479,10 @@ HB.structure Definition Full_Binorm_PCM_morphism (U V : pcm) := (* fullness lemmas *) -Lemma pfSE (U V : pcm) (f : full_pcm_morph U V) : sep f =2 relT. +Lemma pfSE {U V : pcm} {f : full_pcm_morph U V} : sep f =2 relT. Proof. by apply: full_pcm_morphism_subproof. Qed. -Lemma pfT (U V : pcm) (f : full_pcm_morph U V) x y : sep f x y. +Lemma pfT {U V : pcm} {f : full_pcm_morph U V} {x y} : sep f x y. Proof. by rewrite pfSE. Qed. #[export] Hint Resolve pfT : core. @@ -1612,7 +1610,7 @@ End UnitFun. Section Cartesians. -Notation pf := (fun _ _ => erefl _). +Abbreviation pf := (fun _ _ => erefl _). Section FProdMorph. Variables U1 U2 V1 V2 : pcm. @@ -1634,7 +1632,7 @@ End ProjMorph. Section Proj3Morph. Variables U1 U2 U3 : pcm. -Notation tp := (Prod3 U1 U2 U3). +Abbreviation tp := (Prod3 U1 U2 U3). HB.instance Definition _ := isFull_PCM_morphism.Build tp U1 proj31 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U2 proj32 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U3 proj33 pf. @@ -1642,7 +1640,7 @@ End Proj3Morph. Section Proj4Morph. Variables U1 U2 U3 U4 : pcm. -Notation tp := (Prod4 U1 U2 U3 U4). +Abbreviation tp := (Prod4 U1 U2 U3 U4). HB.instance Definition _ := isFull_PCM_morphism.Build tp U1 proj41 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U2 proj42 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U3 proj43 pf. @@ -1651,7 +1649,7 @@ End Proj4Morph. Section Proj5Morph. Variables U1 U2 U3 U4 U5 : pcm. -Notation tp := (Prod5 U1 U2 U3 U4 U5). +Abbreviation tp := (Prod5 U1 U2 U3 U4 U5). HB.instance Definition _ := isFull_PCM_morphism.Build tp U1 proj51 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U2 proj52 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U3 proj53 pf. @@ -1661,7 +1659,7 @@ End Proj5Morph. Section Proj6Morph. Variables U1 U2 U3 U4 U5 U6 : pcm. -Notation tp := (Prod6 U1 U2 U3 U4 U5 U6). +Abbreviation tp := (Prod6 U1 U2 U3 U4 U5 U6). HB.instance Definition _ := isFull_PCM_morphism.Build tp U1 proj61 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U2 proj62 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U3 proj63 pf. @@ -1672,7 +1670,7 @@ End Proj6Morph. Section Proj7Morph. Variables U1 U2 U3 U4 U5 U6 U7 : pcm. -Notation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). +Abbreviation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). HB.instance Definition _ := isFull_PCM_morphism.Build tp U1 proj71 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U2 proj72 pf. HB.instance Definition _ := isFull_PCM_morphism.Build tp U3 proj73 pf. @@ -1736,6 +1734,20 @@ HB.instance Definition _ := (f1 \** f2) pmorphism_is_full. End Pmorph. +(* bigops and full morphisms *) + +Section BigFullPCMmorph. +Context {U1 U2 : pcm} (f : full_pcm_morph U2 U1). + +Lemma big_pfjoin I r (P : pred I) F : + valid (\big[join/Unit]_(i <- r | P i) F i) -> + f (\big[join/Unit]_(i <- r | P i) F i) = + \big[join/Unit]_(i <- r | P i) f (F i). +Proof. by apply/big_pmorph/pfunit/@pfjoinT. Qed. + +End BigFullPCMmorph. + + (******************) (******************) (* TPCM morphisms *) @@ -1911,7 +1923,7 @@ End ProjMorph. Section Proj3Morph. Variables U1 U2 U3 : tpcm. -Notation tp := (Prod3 U1 U2 U3). +Abbreviation tp := (Prod3 U1 U2 U3). Lemma proj31_is_tpcm_morph : tpcm_morph_axiom (proj31 : tp -> _). Proof. by rewrite /tpcm_morph_axiom /undef. Qed. @@ -1927,7 +1939,7 @@ End Proj3Morph. Section Proj4Morph. Variables U1 U2 U3 U4 : tpcm. -Notation tp := (Prod4 U1 U2 U3 U4). +Abbreviation tp := (Prod4 U1 U2 U3 U4). Lemma proj41_is_tpcm_morph : tpcm_morph_axiom (proj41 : tp -> _). Proof. by rewrite /tpcm_morph_axiom /undef. Qed. @@ -1946,7 +1958,7 @@ End Proj4Morph. Section Proj5Morph. Variables U1 U2 U3 U4 U5 : tpcm. -Notation tp := (Prod5 U1 U2 U3 U4 U5). +Abbreviation tp := (Prod5 U1 U2 U3 U4 U5). Lemma proj51_is_tpcm_morph : tpcm_morph_axiom (proj51 : tp -> _). Proof. by rewrite /tpcm_morph_axiom /undef. Qed. @@ -1968,7 +1980,7 @@ End Proj5Morph. Section Proj6Morph. Variables U1 U2 U3 U4 U5 U6 : tpcm. -Notation tp := (Prod6 U1 U2 U3 U4 U5 U6). +Abbreviation tp := (Prod6 U1 U2 U3 U4 U5 U6). Lemma proj61_is_tpcm_morph : tpcm_morph_axiom (proj61 : tp -> _). Proof. by rewrite /tpcm_morph_axiom /undef. Qed. @@ -1993,7 +2005,7 @@ End Proj6Morph. Section Proj7Morph. Variables U1 U2 U3 U4 U5 U6 U7 : tpcm. -Notation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). +Abbreviation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). Lemma proj71_is_tpcm_morph : tpcm_morph_axiom (proj71 : tp -> _). Proof. by rewrite /tpcm_morph_axiom /undef. Qed. @@ -2192,7 +2204,7 @@ Definition subpcm_struct_axiom' (U V : pcm) (* retract then inject is id on valid elements *) forall v, valid v -> sep psub v Unit -> pval (psub v) = v]. -Notation subpcm_struct_axiom S := +Abbreviation subpcm_struct_axiom S := (subpcm_struct_axiom' (pval S) (psub S)). HB.mixin Record isSubPCM_struct (U V : pcm) (S : sub_struct U V) := { @@ -2216,7 +2228,7 @@ HB.instance Definition _ (U V : pcm) (S : subpcm_struct U V) := Binorm_PCM_morphism.copy (psub S) (Binorm_PCM_morphism.Pack psub_submix). -Notation subsep S := (sep (psub S)). +Abbreviation subsep S := (sep (psub S)). Section Repack. Variables (U V : pcm) (S : subpcm_struct U V). @@ -2362,10 +2374,13 @@ Proof. by rewrite joinC=>/pvalXUn <-; rewrite joinC. Qed. (* injectivity *) -Lemma pval_inj : injective (pval S). +Lemma inj_pval : injective (pval S). Proof. by move=>x y E; rewrite -(psub_pval S x) E psub_pval. Qed. -Lemma psub_inj (x y : V) : valid (psub S x) -> psub S x = psub S y -> x = y. +Lemma inj_psub (x y : V) : + valid (psub S x) -> + psub S x = psub S y -> + x = y. Proof. move/[swap]=>E /[dup]; rewrite {2}E. case/fpVI=>/= W1 H1 /fpVI [/= W2 H2]. @@ -2377,20 +2392,20 @@ Qed. Lemma unitb_psub (x : V) : unitb (psub S x) = unitb x. Proof. apply/unitbP/unitbP=>[E|->]; last by rewrite pfunit. -by apply: psub_inj; [rewrite E|rewrite pfunit]. +by apply: inj_psub; [rewrite E|rewrite pfunit]. Qed. Lemma unitb_pval (x : U) : unitb (pval S x) = unitb x. Proof. apply/unitbP/unitbP=>[E|->]; last by rewrite pfunit. -by apply: pval_inj; rewrite pfunit. +by apply: inj_pval; rewrite pfunit. Qed. End DerivedLemmas. Prenex Implicits valid_sepE valid_pvalE valid_pvalEP valid_pvalS valid_psubS valid_sepUnE valid_pvalUnE valid_pvalUnS valid_sep3E valid_psubUnX valid_psubXUn -psubUnX psubXUn pvalXUn pvalUnX pval_inj psub_inj unitb_psub unitb_pval. +psubUnX psubXUn pvalXUn pvalUnX inj_pval inj_psub unitb_psub unitb_pval. (* properties of V propagate to U *) @@ -2407,7 +2422,7 @@ Proof. move=>x1 x2 x W E; move: (W) (W). rewrite {1}E !(valid_sepUnE S)=>/andP [W2 D2] /andP [W1 D1]. move: E; rewrite -(psub_pval S x1) -(psub_pval S x2) -(psub_pval S x). -rewrite -pfjoin // -[R in _ = R]pfjoin //; move/psub_inj. +rewrite -pfjoin // -[R in _ = R]pfjoin //; move/inj_psub. by rewrite fpVE W1 sepU0 // => /(_ (erefl _)) /(joinKx W1) ->. Qed. @@ -2616,7 +2631,7 @@ Section XSepSubPCM. Variables (V : tpcm) (D : seprel V). (* helper lemma *) -Lemma valx_inj (x y : xsep D) : +Lemma inj_valx (x y : xsep D) : valx x = valx y -> x = y. Proof. @@ -2625,26 +2640,26 @@ by subst y; rewrite (pf_irr Hx). Qed. (* unary and binary orthogonality relations *) -Notation orth1 x := (valid x && D x Unit). -Notation orth2 x y := (valid (x \+ y) && D x y). +Abbreviation orth1 x := (valid x && D x Unit). +Abbreviation orth2 x y := (valid (x \+ y) && D x y). -Notation xsep_valid := (@xsep_valid V D). -Notation xsep_join := (@xsep_join V D). -Notation xsep_unit := (@xsep_unit V D). -Notation xsep_unitb := (@xsep_unitb V D). -Notation xsep_undef := (@xsep_undef V D). -Notation xsep_undefb := (@xsep_undefb V D). +Abbreviation xsep_valid := (@xsep_valid V D). +Abbreviation xsep_join := (@xsep_join V D). +Abbreviation xsep_unit := (@xsep_unit V D). +Abbreviation xsep_unitb := (@xsep_unitb V D). +Abbreviation xsep_undef := (@xsep_undef V D). +Abbreviation xsep_undefb := (@xsep_undefb V D). (* xsep is pcm *) Lemma xsep_is_pcm : pcm_axiom xsep_valid xsep_join xsep_unit xsep_unitb. Proof. have joinC : commutative xsep_join. -- case=>x Hx [y Hy]; apply: valx_inj; rewrite valxE xsep_joinE xsep_joinE'. +- case=>x Hx [y Hy]; apply: inj_valx; rewrite valxE xsep_joinE xsep_joinE'. by rewrite joinC; case W: (valid _)=>//=; rewrite -sepC. split=>[//||[x Hx]|x y||x]. - suff joinAC : right_commutative xsep_join. - by move=>a b c; rewrite !(joinC a) joinAC. - case=>a Ha [b Hb][c Hc]; apply: valx_inj; rewrite valxE. + case=>a Ha [b Hb][c Hc]; apply: inj_valx; rewrite valxE. rewrite xsep_joinE; do ![rewrite {1}xsep_joinE' !valxE /=]. case Sab: (orth2 a b); case Sac: (orth2 a c); rewrite ?tpcmE //=; last first. - case/andP: Sac=>_ Sac; case: andP=>//; case=>W Sacb. @@ -2658,7 +2673,7 @@ split=>[//||[x Hx]|x y||x]. case Sacb: (orth2 (a \+ c) b)=>//. case/andP: Sacb=>W Sacb; rewrite sepC (joinAC a b c) W // in Sabc. by rewrite (sepAxx W Sac Sacb) in Sabc. -- apply: valx_inj; rewrite !valxE /=. +- apply: inj_valx; rewrite !valxE /=. rewrite xsep_joinE xsep_unitE xsep_joinE' !{1}valxE. rewrite unitL; case: Hx=>[|->]; last by rewrite tpcmE. by case/andP=>W E; rewrite sepC ?unitL // W E. @@ -2682,7 +2697,7 @@ split=>[/= x||/= x]. case: undefbP=>X; constructor; last by case=>/X. by rewrite X in H *; rewrite (pf_irr H (xsep_undefP D)). - by rewrite pcmE /= xsep_validE xsep_undefE valxE tpcmE. -apply: valx_inj; rewrite xsep_undefE !valxE. +apply: inj_valx; rewrite xsep_undefE !valxE. by rewrite /join/= xsep_joinE xsep_joinE' valxE /= !tpcmE. Qed. @@ -2694,7 +2709,7 @@ Lemma xsep_is_normal : normal_tpcm_axiom (xsep D). Proof. case=>x [] H; [left|right]. - by rewrite /valid/= xsep_validE valxE. -by apply/valx_inj; rewrite !valxE /undef /= xsep_undefE. +by apply/inj_valx; rewrite !valxE /undef /= xsep_undefE. Qed. HB.instance Definition _ : isNormal_TPCM (xsep D) := @@ -2750,7 +2765,7 @@ Abort. Lemma subx_is_morph : pcm_morph_axiom D (@subx V D). Proof. rewrite subxE; split=>[|x y W E]. -- apply: valx_inj; rewrite !valxE /Unit /= xsep_unitE; case: eqP=>//=. +- apply: inj_valx; rewrite !valxE /Unit /= xsep_unitE; case: eqP=>//=. by rewrite valid_unit /= sep00. case: eqP=>Hx /=; last by rewrite (sep0E W E) (validE2 W) in Hx. case: eqP=>Hy /=; last by rewrite (sep0E W E) (validE2 W) in Hy. @@ -2758,7 +2773,7 @@ case: eqP=>H /=; last by rewrite W (sepU0 W E) in H. rewrite /valid/= xsep_validE pcm_joinE valxE /= xsep_joinE /=. do ![rewrite {1}xsep_joinE' valxE]. rewrite {1 2}W {1 2}E {1}W {1}(sepU0 W E) /=. -split=>//; apply: valx_inj; rewrite valxE /=. +split=>//; apply: inj_valx; rewrite valxE /=. by rewrite xsep_joinE' valxE W E. Qed. @@ -2788,7 +2803,7 @@ Proof. split=>[x|x] //=; last first. - rewrite /sepx/= subxE valxE => W H. by case: eqP=>//=; rewrite W H. -apply: valx_inj; rewrite valxE subxE /=. +apply: inj_valx; rewrite valxE subxE /=. by case: eqP; case: x=>// x []. Qed. @@ -2809,7 +2824,7 @@ Lemma psub_undefN (V : tpcm) (D : seprel V) (x : V) : ~~ D x Unit -> psub (xsub D) x = undef. Proof. -move=>X; apply: valx_inj. +move=>X; apply: inj_valx. rewrite /undef/= xsep_undefE valxE /psub/= subxE /=. by case: decP=>//; rewrite (negbTE X) andbF. Qed. @@ -3024,7 +3039,7 @@ Lemma sepon0x x y : Proof. move=>W sf; rewrite seponC // => Sf. rewrite sepC //= in sf; rewrite joinC in W. -rewrite -(pfunit f) -(@seponC y) ?pfunit ?unitR ?(validE2 W) //; last first. +rewrite -(pfunit f) -(@seponC y) ?pfunit ?unitR ?(validE2 W) //. - by apply: sepx0 W sf. by apply: seponx0 W sf Sf. Qed. @@ -3036,7 +3051,7 @@ Lemma sepon0E x y : S (f x) Unit * S (f y) Unit. Proof. move=>W sf Sf; rewrite (seponx0 W sf Sf). -rewrite -(pfunit f) seponC ?pfunit ?unitR ?(validE2 W) //; last first. +rewrite -(pfunit f) seponC ?pfunit ?unitR ?(validE2 W) //. - by rewrite (sep0E W sf). by rewrite (sepon0x W sf Sf). Qed. diff --git a/pcm/mutex.v b/pcm/mutex.v index 33ae5d3..29f7519 100644 --- a/pcm/mutex.v +++ b/pcm/mutex.v @@ -111,12 +111,12 @@ HB.instance Definition _ := hasDecEq.Build (mutex T) mutex_eqP. End Equality. (* mutexes with distingusihed own element *) -Notation mtx T := (mutex (option T)). -Notation mtx2 := (mtx False). -Notation mtx3 := (mtx unit). -Notation own := (mx None). -Notation auth x := (mx (Some x)). -Notation auth1 := (mx (Some tt)). +Abbreviation mtx T := (mutex (option T)). +Abbreviation mtx2 := (mtx False). +Abbreviation mtx3 := (mtx unit). +Abbreviation own := (mx None). +Abbreviation auth x := (mx (Some x)). +Abbreviation auth1 := (mx (Some tt)). (* some lemmas for generalized mutexes *) diff --git a/pcm/natmap.v b/pcm/natmap.v index ad07d14..e9e6da5 100644 --- a/pcm/natmap.v +++ b/pcm/natmap.v @@ -27,15 +27,12 @@ Import Order.NatOrder. (* listed last to avoid notation clash *) Local Open Scope order_scope. Local Open Scope nat_scope. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (************************) (* Maps over non-0 nats *) (************************) Definition null := 0. -Notation nat_pred := (fun x => x != 0). +Abbreviation nat_pred := (fun x => x != 0). (* natmap is union map of non-0 nat keys *) HB.mixin Record isNatMap V U & UMC nat (fun x => x != 0) V U. @@ -159,7 +156,7 @@ Proof. by move/In_cond; rewrite lt0n. Qed. Lemma mem_domN0 A (U : natmap A) {h : U} : 0 \notin dom h. Proof. by rewrite cond_dom. Qed. -Lemma mem_dom0 A (U : natmap A) {h : U} : 0 \in dom h = false. +Lemma mem_dom0 A (U : natmap A) {h : U} : (0 \in dom h) = false. Proof. by rewrite cond_dom. Qed. Lemma uniq_dom0 A (U : natmap A) {h : U} : uniq (0 :: dom h). @@ -190,8 +187,18 @@ Proof. by rewrite path_min_sorted // sorted_leq_dom. Qed. Lemma path_ltn_dom A {U : natmap A} {h : U} : path ltn 0 (dom h). Proof. by rewrite path_min_sorted. Qed. +(* alternative names for path_leq_dom and path_ltn_dom *) + +Lemma sorted_leq_dom0 A {U : natmap A} {h : U} : + sorted leq (0 :: dom h). +Proof. exact: path_leq_dom. Qed. + +Lemma sorted_ltn_dom0 A {U : natmap A} {h : U} : + sorted ltn (0 :: dom h). +Proof. exact: path_ltn_dom. Qed. + #[export] Hint Resolve sorted_leq_dom sorted_ltn_dom - path_leq_dom path_ltn_dom : core. + path_leq_dom path_ltn_dom sorted_leq_dom0 sorted_ltn_dom0 : core. (* form of totality of key order *) Lemma umfiltT A (U : natmap A) k1 k2 (h : U) : @@ -680,6 +687,9 @@ Qed. Lemma In_lastkey h k v : (k, v) \In h -> k <= last_key h. Proof. by move/In_dom/dom_lastkey. Qed. +Lemma lastkeyN0 h x : x \In h -> last_key h != 0. +Proof. by case: x=>k v; case: lastkeyP=>// ->; [move/In_undef|move/In0]. Qed. + Lemma In_lastkeyPtUn h x k v w : last_key h < k -> (x, w) \In h -> (x, w) \In pts k v \+ h. Proof. by move=>N H; apply: InR=>//; rewrite lastkeyPtUnV ?(In_valid H). Qed. @@ -694,6 +704,8 @@ Qed. End LastkeyConstructors. +Prenex Implicits In_lastkey lastkeyN0 In_lastkeyPtUn_inv. + (* last_key and omap_fun -- compositions with omf_subdom/omf_subdom0 *) Section LastKeyOmapFun. @@ -867,10 +879,10 @@ Lemma lastkey_sidePtUn (T : eqType) (Us : T -> Type) (h : U) t k v : fresh h <= k -> side_map Ut t (pts k v \+ h) = - if decP (t =P tag v) is left pf then - pts k (cast Us pf (tagged v)) \+ side_map Ut t h + if decP (tag v =P t) is left pf then + pts k (etagged pf) \+ side_map Ut t h else side_map Ut t h. -Proof. by case: v=>tx vx N; rewrite lastkey_omfPtUn //= /omfx/=; case: eqP. Qed. +Proof. by case: v=>tx vx N; rewrite lastkey_omfPtUn //= /omfx/=; case: decP. Qed. Lemma lastkey_dom_sidePtUn (T : eqType) (Us : T -> Type) (U : natmap (sigT Us)) (Ut : forall t, natmap (Us t)) @@ -878,13 +890,13 @@ Lemma lastkey_dom_sidePtUn (T : eqType) (Us : T -> Type) last_key h < k -> dom (side_map Ut t (pts k v \+ h)) = if valid h then - if t == tag v then rcons (dom (side_map Ut t h)) k + if tag v == t then rcons (dom (side_map Ut t h)) k else dom (side_map Ut t h) else [::]. Proof. case: (normalP h)=>[->|V N]; first by rewrite join_undef pfundef dom_undef. -rewrite lastkey_sidePtUn //; case: eqP=>//= ?; subst t. -by rewrite eqc lastkey_domPtUn ?(pfV (side_map Ut _)) ?lastkey_omfT'. +rewrite lastkey_sidePtUn //; case: eqP=>//= ?; subst t=>/=. +by rewrite lastkey_domPtUn ?(pfV (side_map Ut _)) ?lastkey_omfT'. Qed. (* last_key and non-omap morphisms *) @@ -1128,6 +1140,9 @@ Proof. by rewrite /fresh lastkeyUE maxnSS; case: ifP=>//; case: ifP. Qed. Lemma In_fresh h k v : (k, v) \In h -> k < fresh h. Proof. exact: In_lastkey. Qed. +Lemma freshN1 h x : x \In h -> 1 < fresh h. +Proof. by move/lastkeyN0; rewrite -lt0n. Qed. + Lemma In_freshPtUn h x k v w : fresh h <= k -> (x, w) \In h -> (x, w) \In pts k v \+ h. Proof. exact: In_lastkeyPtUn. Qed. @@ -1139,6 +1154,8 @@ Proof. exact: In_lastkeyPtUn_inv. Qed. End FreshConstructors. +Prenex Implicits In_fresh freshN1 In_freshPtUn_inv. + (* fresh and omap_fun -- compositions with omf_subdom/omf_subdom0 *) Section FreshOmapFun. Variables (A1 A2 : Type) (U1 : natmap A1) (U2 : natmap A2). @@ -1232,8 +1249,8 @@ Lemma fresh_sidePtUn (T : eqType) (Us : T -> Type) (h : U) t k v : fresh h <= k -> side_map Ut t (pts k v \+ h) = - if decP (t =P tag v) is left pf then - pts k (cast Us pf (tagged v)) \+ side_map Ut t h + if decP (tag v =P t) is left pf then + pts k (etagged pf) \+ side_map Ut t h else side_map Ut t h. Proof. exact: lastkey_sidePtUn. Qed. @@ -1243,7 +1260,7 @@ Lemma fresh_dom_sidePtUn (T : eqType) (Us : T -> Type) fresh h <= k -> dom (side_map Ut t (pts k v \+ h)) = if valid h then - if t == tag v then rcons (dom (side_map Ut t h)) k + if tag v == t then rcons (dom (side_map Ut t h)) k else dom (side_map Ut t h) else [::]. Proof. exact: lastkey_dom_sidePtUn. Qed. @@ -1333,7 +1350,7 @@ Lemma oexleNE V (U : natmap V) R a t (h : U) ks (z0 : R) : oexec_le a ks t h z0 = oexec_lt a ks t h z0. Proof. rewrite /oexec_le/oexec_lt; case K: (t \in ks)=>/= H; last first. -- rewrite (eqsl_uoxx (t1:=t) (t2:=t)); last exact: sle_refl. +- rewrite (eqsl_uoxx (t1:=t) (t2:=t)); first by exact: sle_refl. by rewrite eqsl_kk1 /= K cats0. rewrite [LHS]oevFK [RHS]oevFK; congr oeval. by rewrite eqsl_uxR K filter_rcons (negbTE H). @@ -1568,6 +1585,59 @@ Lemma oexle_filter_dom V (U : natmap V) R a ks t (h : U) (z0 : R) : oexec_le a (filter (mem (dom h)) ks) t h z0. Proof. by move=>H; rewrite oexle_filter // umfiltk_dom'. Qed. +(* when the map is a join *) +Lemma oexlt_subdom V (U : natmap V) R a ks t (h1 h2 : U) (z0 : R) : + [pcm h1 <= h2] -> + valid h2 -> + {subset ks <= dom h1} -> + oexec_lt a ks t h2 z0 = + oexec_lt a ks t h1 z0. +Proof. +move=>P W X; apply: oev_subdom P W _. +by move=>z /eqslice_subset_full /X. +Qed. + +Lemma oexle_subdom V (U : natmap V) R a ks t (h1 h2 : U) (z0 : R) : + [pcm h1 <= h2] -> + valid h2 -> + {subset ks <= dom h1} -> + oexec_le a ks t h2 z0 = + oexec_le a ks t h1 z0. +Proof. +move=>P W X; apply: oev_subdom P W _. +by move=>z /eqslice_subset_full /X. +Qed. + +Lemma oexltFK V (U : natmap V) R a ks t (h : U) (z0 : R) : + (t \notin ks) || (t \in dom h) -> + oexec_lt a ks t h z0 = + oexec_lt a [seq k <- ks | k \in dom h] t h z0. +Proof. by move=>D; rewrite /oexec_lt oevFK eqsl_filterL. Qed. + +Lemma oexleFK V (U : natmap V) R a ks t (h : U) (z0 : R) : + (t \notin ks) || (t \in dom h) -> + oexec_le a ks t h z0 = + oexec_le a [seq k <- ks | k \in dom h] t h z0. +Proof. by move=>D; rewrite /oexec_le oevFK eqsl_filterL. Qed. + +Lemma oexltFKD V (U : natmap V) R a ks t (h : U) (z0 : R) : + uniq ks -> + disjoint ks (dom h) -> + oexec_lt a ks t h z0 = z0. +Proof. +move=>Us /disjointPL D; rewrite /oexec_lt oevFKD //. +by apply/disjointPL=>z /(mem_uo _ _ Us) [/D]. +Qed. + +Lemma oexleFKD V (U : natmap V) R a ks t (h : U) (z0 : R) : + uniq ks -> + disjoint ks (dom h) -> + oexec_le a ks t h z0 = z0. +Proof. +move=>Us /disjointPL D; rewrite /oexec_le oevFKD //. +by apply/disjointPL=>z /(mem_ux _ _ Us) [/D]. +Qed. + (* interaction of oexlt, oexle and last *) Lemma oexlt_oexle_last V (U : natmap V) R a k ks t (h : U) (z0 : R) : @@ -1618,7 +1688,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_oo: (K)=>// [_ T1K T2K]. suff {IH Uq K}-> : ks1 = &=ks `]t1, k[ by rewrite -eqsl_uxoo //; apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=. - rewrite !lteBSide /= leEnat -seqlt_unlockE -seqle_unlock. by rewrite T1K (sltW T2K). rewrite eqsl_xoL T2K /= => Eh; rewrite (cat_cancel _ _ Eh) //. @@ -1643,7 +1713,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_xo: (K)=>// [_ T1K T2K]. suff {IH Uq K}-> : ks1 = &=ks `[t1, k[ by rewrite -eqsl_uoxo //; apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=. - by rewrite !lteBSide /= !leEnat -!seqle_unlock T1K (sltW T2K). rewrite (eqsl_xoL k) T2K /= => Eh; rewrite (cat_cancel _ _ Eh) //. by apply: eqsliceRO_notin. @@ -1662,7 +1732,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_xx: (K)=>// [Ks T1K T2K]. suff {IH Uq K}-> : ks1 = &=ks `[t1, k[ by rewrite -eqsl_uoxo //; apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=. - by rewrite /Order.le/=/Order.le/= -!seqle_unlock T1K T2K. rewrite eqsl_xxL T2K Ks /= => Eh; rewrite (cat_cancel _ _ Eh) //. by apply: eqsliceRO_notin. @@ -1681,7 +1751,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_ox: (K)=>// [Ks T1K T2K]. suff {IH Uq K}-> : ks1 = &=ks `]t1, k[ by rewrite -eqsl_uxoo //; apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=. - rewrite /Order.le/=/Order.le/=/Order.lt /=. by rewrite -seqlt_unlock -seqle_unlock T1K T2K. rewrite eqsl_xxL T2K Ks /= => Eh; rewrite (cat_cancel _ _ Eh) //. @@ -1708,7 +1778,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_ou: (K)=>// [Ks TK]. suff {IH Uq K}-> : ks1 = &=ks `]t, k[ by rewrite -eqsl_uxoo //; apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=. - by rewrite /Order.le/=/Order.lt/= -seqlt_unlock TK. rewrite eqsl_xuL Ks /= => Eh; rewrite (cat_cancel _ _ Eh) //. by apply: eqsliceRO_notin. @@ -1727,7 +1797,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_xu: (K)=>// [Ks TK]. suff {IH Uq K}-> : ks1 = &=ks `[t, k[ by rewrite -eqsl_uoxo //; apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=. - by rewrite /Order.le/=/Order.le/= -seqle_unlock TK. rewrite eqsl_xuL Ks => Eh; rewrite (cat_cancel _ _ Eh) //. by apply: eqsliceRO_notin. @@ -1745,7 +1815,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_ux: (K)=>// [Ks TK]. suff {IH Uq K}-> : ks1 = &=ks `]-oo, k[ by apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) //=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) //=. - by rewrite /Order.le/=/Order.le/= -seqle_unlock. rewrite eqsl_xxL TK Ks /= => Eh; rewrite (cat_cancel _ _ Eh) //. by apply: eqsliceRO_notin. @@ -1763,7 +1833,7 @@ have Nk : k \notin ks1. by rewrite Eh cat_uniq /= negb_or -andbA; case/and5P. case/mem_uo: (K)=>// [Ks TK]. suff {IH Uq K}-> : ks1 = &=ks `]-oo, k[ by apply: IH. -move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=; last first. +move: Eh; rewrite (eqslice_split (b:=true) (x:=k)) /=. - by rewrite lteBSide /= leEnat -seqle_unlock (sltW TK). rewrite eqsl_xoL TK => Eh; rewrite (cat_cancel _ _ Eh) //. by apply: eqsliceRO_notin. @@ -2102,7 +2172,8 @@ Lemma oexlt_slt V (U : natmap V) R (a : R -> V -> R) s t1 t2 (h : U) z0 : if t1 <=[s] t2 then oexec_lt a s t1 h z0 else oexec_lt a s t2 h z0. Proof. -move=>Us; rewrite /oexec_lt ?uniq_uo_filter ?filter_uniq // -filter_predI; case: ifPn=>T12; congr (oevalv a _ _ _); +move=>Us; rewrite /oexec_lt ?uniq_uo_filter ?filter_uniq // -filter_predI; +case: ifPn=>T12; congr (oevalv a _ _ _); apply: eq_in_filter=>z Z /=; rewrite andbC. - case T1 : (z <[s] t1)=>//=. by rewrite slt_filterL // ?T1 ?orbT ?(slt_sle_trans T1 T12). @@ -2111,6 +2182,67 @@ rewrite -sltNge in T12; apply/andP/idP=>[[T1]|T2]. by rewrite slt_filterL ?(slt_trans T2 T12) // orbT. Qed. +(* lemmas where filtering interval is bounded on both sides *) + +Lemma slt_oexle V (U : natmap V) R (a : R -> V -> R) s t1 t2 (h : U) z0 : + uniq s -> + oexec_le a [seq x <- s | t1 <[s] x] t2 h z0 = + if t1 <[s] t2 then + oevalv a [seq x <- s | t1 <[s] x && x <=[s] t2] h z0 + else oevalv a [seq x <- s | t1 <[s] x] h z0. +Proof. +move=>Us; rewrite /oexec_le !uniq_ux_filter ?filter_uniq //. +rewrite -filter_predI; case: ifPn=>T12; congr (oevalv a _ _ _); +apply: eq_in_filter=>z Z; rewrite inE andbC; case T1: (t1 <[s] z)=>//=. +- by rewrite sle_filter ?T1 ?T12 ?orbT. +by apply: sle_memI; rewrite mem_filter negb_and T12. +Qed. + +Lemma slt_oexlt V (U : natmap V) R (a : R -> V -> R) s t1 t2 (h : U) z0 : + uniq s -> + oexec_lt a [seq x <- s | t1 <[s] x] t2 h z0 = + if t1 <[s] t2 then + oevalv a [seq x <- s | t1 <[s] x && x <[s] t2] h z0 + else oevalv a [seq x <- s | t1 <[s] x] h z0. +Proof. +move=>Us; rewrite /oexec_lt uniq_uo_filter ?filter_uniq //. +rewrite -filter_predI; case: ifPn=>T12; congr (oevalv a _ _ _); +apply: eq_in_filter=>z Z; rewrite inE andbC; case T1: (t1 <[s] z)=>//=. +- by rewrite slt_filter ?T1 ?T12 ?orbT. +apply: slt_memI; first by rewrite mem_filter T1 Z. +by rewrite mem_filter negb_and T12. +Qed. + +Lemma sle_oexlt V (U : natmap V) R (a : R -> V -> R) s t1 t2 (h : U) z0 : + uniq s -> + oexec_lt a [seq x <- s | t1 <=[s] x] t2 h z0 = + if t1 <=[s] t2 then + oevalv a [seq x <- s | t1 <=[s] x && x <[s] t2] h z0 + else oevalv a [seq x <- s | t1 <=[s] x] h z0. +Proof. +move=>Us; rewrite /oexec_lt uniq_uo_filter ?filter_uniq //. +rewrite -filter_predI; case: ifPn=>T12; congr (oevalv a _ _ _); +apply: eq_in_filter=>z Z; rewrite inE andbC; case T1: (t1 <=[s] z)=>//=. +- by rewrite slt_filter ?T1 ?T12 ?orbT. +apply: slt_memI; first by rewrite mem_filter T1 Z. +by rewrite mem_filter negb_and T12. +Qed. + +Lemma sle_oexle V (U : natmap V) R (a : R -> V -> R) s t1 t2 (h : U) z0 : + uniq s -> + oexec_le a [seq x <- s | t1 <=[s] x] t2 h z0 = + if t1 <=[s] t2 then + oevalv a [seq x <- s | t1 <=[s] x && x <=[s] t2] h z0 + else oevalv a [seq x <- s | t1 <=[s] x] h z0. +Proof. +move=>Us; rewrite /oexec_le uniq_ux_filter ?filter_uniq //. +rewrite -filter_predI; case: ifPn=>T12; congr (oevalv a _ _ _); +apply: eq_in_filter=>z Z; rewrite inE andbC; case T1: (t1 <=[s] z)=>//=. +- by rewrite sle_filter ?T1 ?T12 ?orbT. +by apply: sle_memI; rewrite mem_filter negb_and T12. +Qed. + + (* The lemmas past this point are currently used for some examples, *) (* but will be deprecated and removed in future releases *) @@ -2290,7 +2422,7 @@ Lemma cn_fresh v h x : Proof. rewrite -(freshPtUnV x (leqnn _))=>V; split; last first. - case=>C H k y; rewrite !findPtUn2 // eqSS; case: ltngtP=>N. - - by rewrite ltn_eqF; [apply: C|apply: (ltn_trans N _)]. + - by rewrite ltn_eqF; [apply: (ltn_trans N _)|apply: C]. - by move/find_some/dom_fresh/(ltn_trans N); rewrite ltnn. by case=><-; rewrite N ltn_eqF. move=>C; split; last first. @@ -2366,8 +2498,8 @@ Prenex Implicits cm_valid cmPt. (************************) (************************) -Notation le t := (fun '(k, _) => k <= t). -Notation lt t := (fun '(k, _) => k < t). +Abbreviation le t := (fun '(k, _) => k <= t). +Abbreviation lt t := (fun '(k, _) => k < t). Lemma pts_sub V t1 t2 : t1 <= t2 -> subpred (T:=nat*V) (le t1) (le t2). Proof. by move=>T [k v] /leq_trans; apply. Qed. @@ -2438,7 +2570,7 @@ Lemma umfilt_le_split A (U : natmap A) (h : U) t1 t2 : um_filter (le t2) h = um_filter (le t1) h \+ um_filter (fun '(k, _) => t1 < k <= t2) h. Proof. -move=>T; rewrite -umfilt_dpredU; last first. +move=>T; rewrite -umfilt_dpredU. - by case=>x y /= N; rewrite negb_and -leqNgt N. apply/eq_in_umfilt; case=>k v _ => /=. by case: (leqP k t1)=>//= /leq_trans; apply. @@ -2450,7 +2582,7 @@ Lemma umfilt_lt_split A (U : natmap A) (h : U) t1 t2 k : um_filter (fun '(x, _)=>t1 < x <= k) h \+ um_filter (fun '(x, _)=>k < x <= t2) h. Proof. -move=>/andP [T1 T2]; rewrite -umfilt_dpredU; last first. +move=>/andP [T1 T2]; rewrite -umfilt_dpredU. - by case=>x y /andP [N1 N2]; rewrite /= negb_and -leqNgt N2. apply/eq_in_umfilt; case=>k1 v1 _ /=. case: (leqP k1 k)=>//=; last by move/(leq_ltn_trans T1)=>->. @@ -2537,7 +2669,7 @@ Lemma eval_le_split A (U : natmap A) R a (h : U) t1 t2 (z0 : R) : eval a (fun '(k, _)=>t1 < k <= t2) h (eval a (le t1) h z0). Proof. move=>T; case: (normalP h)=>[->|V]; first by rewrite !eval_undef. -rewrite eval_umfilt (umfilt_predD h (pts_sub T)) evalUn; last 2 first. +rewrite eval_umfilt (umfilt_predD h (pts_sub T)) evalUn. - by rewrite -(umfilt_predD h (pts_sub T)) pfV. - move=>x y /In_dom_umfilt [vx X _] /In_dom_umfilt [wy /= /andP][]. by rewrite /= -ltnNge; move/(leq_ltn_trans X). @@ -2550,7 +2682,7 @@ Lemma eval_lt_split A (U : natmap A) R a (h : U) t1 t2 (z0 : R) : eval a (fun '(k, _)=>t1 < k < t2) h (eval a (le t1) h z0). Proof. move=>T; case: (normalP h)=>[->|V]; first by rewrite !eval_undef. -rewrite eval_umfilt (umfilt_predD h (pts_sub_lt T)) evalUn; last 2 first. +rewrite eval_umfilt (umfilt_predD h (pts_sub_lt T)) evalUn. - by rewrite -(umfilt_predD h (pts_sub_lt T)) pfV. - move=>x y /In_dom_umfilt [vx X _] /In_dom_umfilt [wy /= /andP][]. by rewrite /= -ltnNge; move/(leq_ltn_trans X). @@ -2563,7 +2695,7 @@ Lemma eval_le_lt_split A (U : natmap A) R a (h : U) t (z0 : R) : Proof. case: (normalP h)=>[->|V]; first by rewrite !eval_undef. have D : subpred (T:=nat*A) (lt t) (le t) by case=>k v /ltnW. -rewrite eval_umfilt (umfilt_predD h D) evalUn; last 2 first. +rewrite eval_umfilt (umfilt_predD h D) evalUn. - by rewrite -(umfilt_predD h D) pfV. - move=>x y /In_dom_umfilt [vx X _] /In_dom_umfilt [wy /= /andP][]. by rewrite /= -ltnNge; move/(leq_ltn_trans X). @@ -2599,7 +2731,7 @@ case: (normalP h)=>[->|V]. - by rewrite join_undef !eval_undef; case: ifP. case: ifP=>H. - by rewrite eval_umfilt umfiltPtUn freshPtUnV // V ltnNge H -eval_umfilt. -rewrite joinC evalUnPt; last 2 first. +rewrite joinC evalUnPt. - by rewrite joinC freshPtUnV. - by apply/allP=>x; apply: dom_lastkey. rewrite ltnNge H; congr a; apply: eq_in_eval. @@ -2616,7 +2748,7 @@ case: (normalP h)=>[->|V]. - by rewrite join_undef !eval_undef; case: ifP. case: ifPn=>H. - by rewrite eval_umfilt umfiltPtUn valid_fresh // V ltnNge H -eval_umfilt. -rewrite joinC evalUnPt; last 2 first. +rewrite joinC evalUnPt. - by rewrite joinC valid_fresh. - by apply/allP=>x; apply: dom_lastkey. rewrite ltnNge H; congr a; apply: eq_in_eval. @@ -2721,7 +2853,7 @@ case: (normalP h)=>[->|V]. case: ifP=>H. - by rewrite -!umcnt_umfilt umfiltPtUn valid_fresh // V ltnNge H. rewrite umcntPtUn ?valid_fresh //= ltnNge H /=. -by rewrite umcnt_le_last; [case: ifP|case: ltngtP H]. +by rewrite umcnt_le_last; [case: ltngtP H | case: ifP]. Qed. Lemma umcnt_le_fresh A (U : natmap A) p (h : U) t v : @@ -2745,8 +2877,8 @@ Definition lt_fresh := (eval_lt_fresh). (* In exec and run, the timestamp shouldn't influence *) (* the val of the operation. So we need a coercion to *) (* account for the timestamp, which is then ignored *) -Notation exec a t h z0 := (evalv a (le t) h z0). -Notation run a h z0 := (evalv a xpredT h z0). +Abbreviation exec a t h z0 := (evalv a (le t) h z0). +Abbreviation run a h z0 := (evalv a xpredT h z0). Section Exec. Variables (V R : Type) (U : natmap V). @@ -2808,7 +2940,7 @@ Lemma helper2 p h1 h2 z0 k v : f (evalv a p (h1 \+ (pts k v \+ h2)) z0) = f z0 -> f (a (evalv a p h1 z0) v) = f (evalv a p h1 z0). Proof. -move=>G W D1 D2 P E1; rewrite evalUn ?W // in E1; last first. +move=>G W D1 D2 P E1; rewrite evalUn ?W // in E1. - move=>x y /D1 X1; rewrite domPtUn inE (validR W). by case/orP=>[/eqP <-|/(allP D2)] //; apply: ltn_trans. suff E2 : f (evalv a p h1 z0) = f z0. @@ -2827,7 +2959,7 @@ Proof. move=>G N; case W: (valid h); last first. - by move/negbT/invalidE: W=>->; rewrite !eval_undef. rewrite eval_umfilt [in X in oleq _ X]eval_umfilt (umfilt_le_split h N). -rewrite evalUn; first by apply: helper0=>x y z /In_umfiltX [_ /G]. +rewrite evalUn; last by apply: helper0=>x y z /In_umfiltX [_ /G]. - by rewrite -(umfilt_le_split h N) pfV. by move=>??/In_dom_umfilt[? /leq_ltn_trans Y _]/In_dom_umfilt[? /andP[/Y]]. Qed. @@ -2851,7 +2983,7 @@ have Eh: um_filter (le t2) h = h0 \+ (h1 \+ (pts k v \+ h2)). - rewrite (umfilt_le_split h N2) (umfilt_le_split h K1). by rewrite (umfilt_le_split h K2) (umfilt_pt_split H) -!joinA. have W1 : valid (h0 \+ (h1 \+ (pts k v \+ h2))) by rewrite -Eh pfV. -rewrite eval_umfilt (umfilt_le_split h K2) evalUn ?(validAL W1) //; last first. +rewrite eval_umfilt (umfilt_le_split h K2) evalUn ?(validAL W1) //. - by move=>??/In_dom_umfilt[?/leq_ltn_trans Y] _ /In_dom_umfilt[?] /andP [/Y]. rewrite -(eval_umfilt (le t1)); apply: helper2 (validR W1) _ _ _ _ =>//. - by apply: growR W1 _; rewrite -Eh=>k1 v1 z1 /In_umfiltX [] _ /G. diff --git a/pcm/nmodmap.v b/pcm/nmodmap.v new file mode 100644 index 0000000..b46c58e --- /dev/null +++ b/pcm/nmodmap.v @@ -0,0 +1,336 @@ +(* +Copyright 2025 IMDEA Software Institute +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + http://www.apache.org/licenses/LICENSE-2.0 +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +*) + +From Stdlib Require Import ssreflect ssrbool ssrfun. +From mathcomp Require Import ssrnat eqtype seq interval ssralg bigop. +From pcm Require Import options pred seqext pcm natmap. +Import ssralg.GRing. +Local Open Scope ring_scope. + +(**********************************************************) +(* Theory of oevalv/oexec_le/oexec_lt where the *) +(* sequenced operations form a (total) commutative monoid *) +(* (e.g., numbers). *) +(* Here we take them to form nmodType (number module) *) +(* to enable importing the ring library and scope *) +(**********************************************************) + +(* search for index i in history h *) +(* and if not found, return some default value *) +(* we give excplicit name to that operation *) +Definition ofind {K : ordType} {C : pred K} V (U : union_map K C V) + (x : V) i (h : U) : V := odflt x (find i h). + +Abbreviation fnd0 := (ofind 0%R). + +(* oeval and sum in number modules *) + +Section OevalNModType. +Context {V : nmodType} {U : natmap V}. +Implicit Type h : U. +Local Open Scope ring_scope. + +Lemma sum_dom_range h : + \sum_(i <- dom h) (fnd0 i h) = \sum_(i <- range h) i. +Proof. +rewrite assocs_dom !big_map. +apply: eq_bigR=>-[i v] /mem_seqP/In_assocs/In_findE E _ /=. +by rewrite /fnd0 E. +Qed. + +(* oevalv *) + +Lemma oevr_umfiltk s p h v : + oevalv +%R s (um_filterk p h) v = + \sum_(i <- s | p i) (fnd0 i h) + v. +Proof. +elim: s v=>[|x s IH] //= v; first by rewrite big_nil add0r. +rewrite find_umfiltk big_cons; case: ifP=>// D. +rewrite IH /ofind [RHS]addrC [LHS]addrC addrA. +by case: (find x h)=>//=; rewrite addr0. +Qed. + +Lemma oevr s h v : + oevalv +%R s h v = \sum_(i <- s) fnd0 i h + v. +Proof. +by rewrite -big_filter -oevr_umfiltk umfilt_predT filter_predT. +Qed. + +Lemma oevr0 s h : oevalv +%R s h 0 = \sum_(i <- s) fnd0 i h. +Proof. by rewrite oevr addr0. Qed. + +Lemma oevr_cat s1 s2 h : + oevalv +%R (s1 ++ s2) h 0 = + oevalv +%R s1 h 0 + oevalv +%R s2 h 0. +Proof. by rewrite !oevr0 big_cat. Qed. + +Lemma oevr_cons x s h : + oevalv +%R (x :: s) h 0 = + fnd0 x h + oevalv +%R s h 0. +Proof. +rewrite -cat1s oevr_cat /= /fnd0. +by case: (find x h)=>//= a; rewrite add0r. +Qed. + +Lemma oevr_rcons x s h : + oevalv +%R (rcons s x) h 0 = + oevalv +%R s h 0 + fnd0 x h. +Proof. +rewrite oev_rconsE /fnd0. +by case: (find x h)=>//=; rewrite addr0. +Qed. + +(* oevalv is pcm morphism *) +Lemma oevr_join s h1 h2 : + valid (h1 \+ h2)%pcm -> + oevalv +%R s ((h1 \+ h2)%pcm) 0 = + oevalv +%R s h1 0 + oevalv +%R s h2 0. +Proof. +move=>W; elim: s=>[|x s IH]; first by rewrite /= addr0. +rewrite !oevr !big_cons -addrA -!oevr {}IH !oevr /ofind !addr0. +case: validUn (W)=>//= V1 V2 L _; rewrite findUnL //. +case: dom_find (L x)=>[|v] /=. +- by rewrite add0r addrCA. +move=>_ _ /(_ erefl) /In_findN -> /=. +by rewrite add0r addrA. +Qed. + +Lemma perm_oevr s1 s2 h v : + perm_eq s1 s2 -> + oevalv +%R s1 h v = oevalv +%R s2 h v. +Proof. by move=>P; rewrite !oevr (perm_big _ P). Qed. + +Lemma oevr_join2 s h1 h2 : + valid (h1 \+ h2)%pcm -> + perm_eq s (dom h1 ++ dom h2) -> + oevalv +%R s ((h1 \+ h2)%pcm) 0 = + oevalv +%R (dom h1) h1 0 + oevalv +%R (dom h2) h2 0. +Proof. +move=>W S; rewrite (perm_oevr _ _ S) oevr_cat !oevr_join //. +by rewrite (oevFKD _ _ (disjointD W)) (oevFKD _ _ (disjointDC W)) add0r addr0. +Qed. + +Lemma oexler_umfiltk s p t h v : + uniq s -> + oexec_le +%R s t (um_filterk p h) v = + \sum_(i <- s | i <=[s] t && p i) fnd0 i h + v. +Proof. +move=>X; rewrite /oexec_le (uniq_ux_filter _ X). +by rewrite oevr_umfiltk big_filter_cond. +Qed. + +(* oexec_le *) + +Lemma oexler s t h v : + uniq s -> + oexec_le +%R s t h v = + \sum_(i <- s | i <=[s] t) fnd0 i h + v. +Proof. by move=>X; rewrite /oexec_le (uniq_ux_filter _ X) oevr big_filter. Qed. + +Lemma oexler0 s t h : + uniq s -> + oexec_le +%R s t h 0 = + \sum_(i <- s | i <=[s] t) fnd0 i h. +Proof. by move=>Us; rewrite oexler // addr0. Qed. + +Lemma oexler_cat s1 s2 t h : + oexec_le +%R (s1 ++ s2) t h 0 = + if t \in s1 then oexec_le +%R s1 t h 0 else + oexec_le +%R s1 t h 0 + oexec_le +%R s2 t h 0. +Proof. +rewrite oexle_cat; case: ifP=>// _. +by rewrite /oexec_le oevr addrC -[\sum_(i <- _) _]addr0 -oevr. +Qed. + +Lemma oexler_join s t h1 h2 : + valid (h1 \+ h2)%pcm -> + oexec_le +%R s t ((h1 \+ h2)%pcm) 0 = + oexec_le +%R s t h1 0 + oexec_le +%R s t h2 0. +Proof. exact: oevr_join. Qed. + +Lemma oexltr_umfiltk s p t h v : + uniq s -> + oexec_lt +%R s t (um_filterk p h) v = + \sum_(i <- s | i <[s] t && p i) fnd0 i h + v. +Proof. +move=>X; rewrite /oexec_lt (uniq_uo_filter _ X). +by rewrite oevr_umfiltk big_filter_cond. +Qed. + +(* oexec_lt *) + +Lemma oexltr s t h v : + uniq s -> + oexec_lt +%R s t h v = + \sum_(i <- s | i <[s] t) fnd0 i h + v. +Proof. by move=>X; rewrite /oexec_lt (uniq_uo_filter _ X) oevr big_filter. Qed. + +Lemma oexltr0 s t h : + uniq s -> + oexec_lt +%R s t h 0 = + \sum_(i <- s | i <[s] t) fnd0 i h. +Proof. by move=>X; rewrite oexltr // addr0. Qed. + +Lemma oexltr_cat s1 s2 t h : + oexec_lt +%R (s1 ++ s2) t h 0 = + if t \in s1 then oexec_lt +%R s1 t h 0 else + oexec_lt +%R s1 t h 0 + oexec_lt +%R s2 t h 0. +Proof. +rewrite oexlt_cat; case: ifP=>// _. +by rewrite /oexec_lt oevr addrC -[\sum_(i <- _) _]addr0 -oevr. +Qed. + +Lemma oexltr_join s t h1 h2 : + valid (h1 \+ h2)%pcm -> + oexec_lt +%R s t ((h1 \+ h2)%pcm) 0 = + oexec_lt +%R s t h1 0 + oexec_lt +%R s t h2 0. +Proof. exact: oevr_join. Qed. + +(* oexler and subsequences has *) +(* two mutually exclusive lemmas, both asuming t1 \in s1 *) + +(* if everything not in s1 is bigger than t1 *) +Lemma perm_oexle1 s1 s2 s t1 h : + uniq s -> + subseq s1 s -> + subseq s2 s -> + perm_eq s (s1 ++ s2) -> + (* t1 needn't be last in s1 *) + t1 \in s1 -> + (* everything in s2 must be after t1 *) + ~~ has (fun x => x <[s] t1) s2 -> + oexec_le +%R s t1 h 0 = oexec_le +%R s1 t1 h 0. +Proof. +move=>Us S1 S2 P T1 H; have Us1 : uniq s1 by apply: subseq_uniq Us. +rewrite !oexler0 // (perm_big _ P) big_cat /= addrC big_hasC ?add0r; last first. +- by rewrite big_mkcond [RHS]big_mkcond; apply: eq_bigR=>i /(sle_subseq S1) ->. +have N : {in s2, forall x, x \notin s1}. +- by move: Us (perm_uniq P)=>-> /esym; rewrite cat_uniq=>/and3P [_ /hasPn]. +move/hasPn: H=>H; apply/hasPn=>z X; rewrite sle_eqVlt. +- by rewrite (perm_mem P) mem_cat X orbT. +by rewrite negb_or; case: eqP X T1=>[->{z}/N/negbTE ->|_ /H]. +Qed. + +(* if there exists x not in s1 that's smaller than t1 *) +Lemma perm_oexle2 s1 s2 s t1 h : + uniq s -> + subseq s1 s -> + subseq s2 s -> + perm_eq s (s1 ++ s2) -> + t1 \in s1 -> + has (fun x => x <[s] t1) s2 -> + exists t2, + [/\ t2 \in s2, t2 <[s] t1, + {in s2, forall z, t2 <[s2] z -> ~~ z <[s] t1} & + oexec_le +%R s t1 h 0 = oexec_le +%R s1 t1 h 0 + + oexec_le +%R s2 t2 h 0]. +Proof. +move=>Us S1 S2 P T1 X; have : uniq (s1 ++ s2) by rewrite -(perm_uniq P). +rewrite cat_uniq=>/and3P [U1 /hasPn N U2]. +case/(slt_findlast U2): X=>t2 [T2 T X]; exists t2; split=>//. +rewrite !oexler0 // (perm_big _ P) big_cat /=; congr (_ + _). +- by rewrite big_mkcond [RHS]big_mkcond; apply: eq_bigR=>i /(sle_subseq S1) ->. +rewrite big_mkcond [RHS]big_mkcond; apply: eq_bigR=>i I _. +rewrite sle_eqVlt ?(perm_mem P) ?mem_cat ?I ?orbT //. +case: eqP T1 (N _ I)=>[->->|_ _ _] //=. +rewrite (_ : i <[s] t1 = i <=[s2] t2) //. +apply/idP/idP=>[Z|]; first by rewrite sleNgt (contraL (X _ I)). +by rewrite (sle_subseq S2 Us) //; move/sle_slt_trans; apply. +Qed. + +Lemma perm_oexleL s1 s2 s t1 h : + uniq s -> + subseq s1 s -> + subseq s2 s -> + perm_eq s (s1 ++ s2) -> + t1 \in s1 -> + exists2 s2', prefix s2' s2 & + oexec_le +%R s t1 h 0 = oexec_le +%R s1 t1 h 0 + + oevalv +%R s2' h 0. +Proof. +move=>Us S1 S2 P T1. +have [X|X] := boolP (has (fun x => x <[s] t1) s2); last first. +- exists [::]; first by apply: prefix0s. + by rewrite (perm_oexle1 _ Us S1 S2 P T1 X) addr0. +case/(perm_oexle2 h Us S1 S2 P T1): X=>t2 [T2 _ _] ->. +by exists &=s2 `]-oo, t2]=>//; apply: prefix_eqsl. +Qed. + +Lemma perm_oexleR s1 s2 s t2 h : + uniq s -> + subseq s1 s -> + subseq s2 s -> + perm_eq s (s1 ++ s2) -> + t2 \in s2 -> + exists2 s1', prefix s1' s1 & + oexec_le +%R s t2 h 0 = oevalv +%R s1' h 0 + + oexec_le +%R s2 t2 h 0. +Proof. +move=>Us S1 S2 P T1. +have {}P : perm_eq s (s2 ++ s1) by apply/perm_trans/permPl/perm_catC/P. +case: (perm_oexleL h Us S2 S1 P T1)=>s1' P1 ->; exists s1'=>//. +by rewrite addrC. +Qed. + +End OevalNModType. + +(* sum of two sequences in terms of set difference *) + +Lemma sumrD {I : eqType} {U : nmodType} (F : I -> U) (s1 s2 : seq I) : + uniq s1 -> + uniq s2 -> + \sum_(i <- s1) F i + \sum_(i <- s2 | i \notin s1) F i = + \sum_(i <- s2) F i + \sum_(i <- s1 | i \notin s2) F i. +Proof. +move=>U1 U2. +rewrite [in LHS](bigID_idem (addr0 _) _ [in s2]) /=. +rewrite [in RHS](bigID_idem (addr0 _) _ [in s1]) /=. +rewrite addrAC -!addrA; congr (_ + _). +rewrite -[LHS]big_filter -[RHS]big_filter. +by apply/perm_big/uniq_perm/filter_mem_sym; rewrite filter_uniq. +Qed. + +(*********************************************) +(* quantification over partial and full sums *) +(*********************************************) + +(* partial sums range over all prefixes *) +Definition all_presums {V : nmodType} (P : V -> bool) (s : seq V) : bool := + all (fun pfx => P (\sum_(i <- pfx) i)%R) (prefixes s). + +(* full sum takes the full prefix *) +Definition end_sum {V : nmodType} (P : V -> bool) (s : seq V) : bool := + P (\sum_(i <- s) i)%R. + +Lemma end_presum {V : nmodType} (P : V -> bool) (s : seq V) : + all_presums P s -> + end_sum P s. +Proof. by move/allP=>/= /(_ _ (prefixesT _)). Qed. + +Lemma consistently_oexle {V : nmodType} (P : V -> bool) (h : history V) s : + uniq s -> + reflect [/\ P 0%R & forall t, t \in s -> P (oexec_le +%R s t h 0%R)] + (all_presums P [seq fnd0 i h | i <- s]). +Proof. +move=>Us; apply/(iffP allP)=>[/= H|[/= H1 H2]]. +- split=>[|t Dt]; first by move: (H [::] (prefixes0 _)); rewrite big_nil. + set F0 := fun i => fnd0 i h. + have /H : map F0 &=s `]-oo, t] \in prefixes (map F0 s). + - by rewrite map_f_prefixes // prefixesE prefix_eqsl. + by rewrite big_map -[(\sum_(_ <- _) _)%R]addr0 -oevr. +move=>_ /map_image_prefixes [/= pfx ->]. +rewrite prefixesE=>/(eqsl_prefix Us) [->|[t /H2 /[swap] ->]]. +- by rewrite big_nil. +by rewrite /oexec_le oevr // addr0 big_map. +Qed. + diff --git a/pcm/pcm.v b/pcm/pcm.v index fde73aa..59b8f1f 100644 --- a/pcm/pcm.v +++ b/pcm/pcm.v @@ -26,9 +26,6 @@ Declare Scope pcm_scope. Delimit Scope pcm_scope with pcm. Open Scope pcm_scope. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (*******************************) (* Partial Commutative Monoids *) (*******************************) @@ -489,7 +486,6 @@ Qed. End BigPartialMorph. - (*********************) (* PCM constructions *) (*********************) @@ -672,7 +668,7 @@ Qed. Section ProdPCM. Variables U V : pcm. -Local Notation tp := (U * V)%type. +Local Abbreviation tp := (U * V)%type. Definition valid2 := [fun x : tp => valid x.1 && valid x.2]. Definition join2 := [fun x1 x2 : tp => (x1.1 \+ x2.1, x1.2 \+ x2.2)]. @@ -740,7 +736,7 @@ End Simplification. Section Prod3PCM. Variables U1 U2 U3 : pcm. -Notation tp := (Prod3 U1 U2 U3). +Abbreviation tp := (Prod3 U1 U2 U3). Definition valid3 := [fun x : tp => [&& valid (proj31 x), valid (proj32 x) & @@ -790,7 +786,7 @@ HB.instance Definition _ (U1 U2 U3 : pcmc) := Section Prod4PCM. Variables U1 U2 U3 U4 : pcm. -Notation tp := (Prod4 U1 U2 U3 U4). +Abbreviation tp := (Prod4 U1 U2 U3 U4). Definition valid4 := [fun x : tp => [&& valid (proj41 x), valid (proj42 x), @@ -843,7 +839,7 @@ HB.instance Definition _ (U1 U2 U3 U4 : pcmc) := Section Prod5PCM. Variables U1 U2 U3 U4 U5 : pcm. -Notation tp := (Prod5 U1 U2 U3 U4 U5). +Abbreviation tp := (Prod5 U1 U2 U3 U4 U5). Definition valid5 := [fun x : tp => [&& valid (proj51 x), @@ -902,7 +898,7 @@ HB.instance Definition _ (U1 U2 U3 U4 U5 : pcmc) := Section Prod6PCM. Variables U1 U2 U3 U4 U5 U6 : pcm. -Notation tp := (Prod6 U1 U2 U3 U4 U5 U6). +Abbreviation tp := (Prod6 U1 U2 U3 U4 U5 U6). Definition valid6 := [fun x : tp => [&& valid (proj61 x), @@ -964,7 +960,7 @@ HB.instance Definition _ (U1 U2 U3 U4 U5 U6 : pcmc) := Section Prod7PCM. Variables U1 U2 U3 U4 U5 U6 U7 : pcm. -Notation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). +Abbreviation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). Definition valid7 := [fun x : tp => [&& valid (proj71 x), @@ -1032,7 +1028,7 @@ HB.instance Definition _ (U1 U2 U3 U4 U5 U6 U7 : pcmc) := (* Finite products of PCMs as functions *) Section FunPCM. Variables (T : finType) (Us : T -> pcm). -Notation tp := (forall t, Us t). +Abbreviation tp := (forall t, Us t). Definition fun_valid := [fun f : tp => [forall t, valid (f t)]]. Definition fun_join := [fun f1 f2 : tp => fun t => f1 t \+ f2 t]. @@ -1068,7 +1064,7 @@ Arguments fun_unit /. (* dffun used for inheritance (see finfun.v) *) Section FinPCM. Variables (T : finType) (Us : T -> pcm). -Notation tp := {dffun forall t, Us t}. +Abbreviation tp := {dffun forall t, Us t}. Definition fin_valid := [fun f : tp => [forall t, valid (sel t f)]]. Definition fin_join := [fun f g : tp => [ffun t => sel t f \+ sel t g]]. @@ -1142,7 +1138,7 @@ Arguments undef2 /. Section Prod3TPCM. Variables U1 U2 U3 : tpcm. -Notation tp := (Prod3 U1 U2 U3). +Abbreviation tp := (Prod3 U1 U2 U3). Definition undef3 : tp := mk3 undef undef undef. Definition undefb3 := [fun x : tp => [&& undefb (proj31 x), @@ -1167,7 +1163,7 @@ Arguments undef3 /. Section Prod4TPCM. Variables U1 U2 U3 U4 : tpcm. -Notation tp := (Prod4 U1 U2 U3 U4). +Abbreviation tp := (Prod4 U1 U2 U3 U4). Definition undef4 : tp := mk4 undef undef undef undef. Definition undefb4 := [fun x : tp => [&& undefb (proj41 x), @@ -1193,7 +1189,7 @@ Arguments undef4 /. Section Prod5TPCM. Variables U1 U2 U3 U4 U5 : tpcm. -Notation tp := (Prod5 U1 U2 U3 U4 U5). +Abbreviation tp := (Prod5 U1 U2 U3 U4 U5). Definition undef5 : tp := mk5 undef undef undef undef undef. Definition undefb5 := [fun x : tp => [&& undefb (proj51 x), @@ -1221,7 +1217,7 @@ Arguments undef5 /. Section Prod6TPCM. Variables U1 U2 U3 U4 U5 U6 : tpcm. -Notation tp := (Prod6 U1 U2 U3 U4 U5 U6). +Abbreviation tp := (Prod6 U1 U2 U3 U4 U5 U6). Definition undef6 : tp := mk6 undef undef undef undef undef undef. Definition undefb6 := [fun x : tp => [&& undefb (proj61 x), @@ -1249,7 +1245,7 @@ Arguments undef6 /. Section Prod7TPCM. Variables U1 U2 U3 U4 U5 U6 U7 : tpcm. -Notation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). +Abbreviation tp := (Prod7 U1 U2 U3 U4 U5 U6 U7). Definition undef7 : tp := mk7 undef undef undef undef undef undef undef. Definition undefb7 := [fun x : tp => [&& undefb (proj71 x), @@ -1278,7 +1274,7 @@ Arguments undef7 /. (* TPCM proofs use function extensionality *) (* it's TPCM only if T inhabited finite type *) -(* (otherwise valid undef) *) +(* (otherewriteise valid undef) *) Definition fun_undef T (Us : T -> tpcm) : forall t, Us t := fun t => undef. @@ -1290,7 +1286,7 @@ Arguments fun_undefb {T Us} f /. Section FunTPCM. Variables (T : ifinType) (Us : T -> tpcm). -Notation tp := (forall t, Us t). +Abbreviation tp := (forall t, Us t). Lemma fun_is_tpcm : tpcm_axiom fun_undef (fun_undefb (Us:=Us)). Proof. @@ -1309,7 +1305,7 @@ End FunTPCM. (* TPCM only if T inhabited finite type *) -(* (otherwise valid undef) *) +(* (otherewriteise valid undef) *) Definition fin_undef (T : finType) (Us : T -> tpcm) : {dffun forall t, Us t} := [ffun t => undef]. Arguments fin_undef {T Us} /. @@ -1321,7 +1317,7 @@ Arguments fin_undefb {T Us} x /. Section FinTPCM. Variables (T : ifinType) (Us : T -> tpcm). -Notation tp := {dffun forall t, Us t}. +Abbreviation tp := {dffun forall t, Us t}. Lemma finprod_is_tpcm : tpcm_axiom fin_undef (fin_undefb (Us:=Us)). Proof. @@ -1412,9 +1408,9 @@ Hint Resolve pleq_unit pleq_refl pleq_joinr pleq_joinl : core. Prenex Implicits pleq_refl pleq_joinl pleq_joinr. (* shorter names *) -Notation pcmR := pleq_refl. -Notation pcmS := pleq_joinr. -Notation pcmO := pleq_joinl. +Abbreviation pcmR := pleq_refl. +Abbreviation pcmS := pleq_joinr. +Abbreviation pcmO := pleq_joinl. Lemma pleq_undef (U : tpcm) (x : U) : [pcm x <= undef]. Proof. by exists undef; rewrite join_undef. Qed. @@ -1466,7 +1462,7 @@ Lemma foldr_helper (s1 s2 : seq A) (z0 : R) x : foldr a z0 (s1 ++ x :: s2) = foldr a z0 (s1 ++ rcons s2 x). Proof. rewrite -!foldl_rev rev_cat rev_cons cat_rcons. -rewrite foldl_helper; last by move=>*; rewrite H. +rewrite foldl_helper; first by move=>*; rewrite H. by rewrite -[x :: _ ++ _]revK rev_cons rev_cat !revK rcons_cat. Qed. @@ -1618,7 +1614,7 @@ End StarMonoid. Section IterStarSeq. Context {U : pcm} {A : Type}. -Notation seq_join hs := (\big[join/Unit]_(i <- hs) i). +Abbreviation seq_join hs := (\big[join/Unit]_(i <- hs) i). (* definition is locked to prevent automation from going inside *) Definition sepit_seq (s : seq A) (f : A -> Pred U) : Pred U := @@ -1749,7 +1745,7 @@ Lemma sepitseq_emp (s : seq A) (f : A -> Pred U) : Proof. move=>H; rewrite sepit_seqE. elim: s H=>[|a xs IH] H; first by rewrite big_nil. -rewrite big_cons H ?InE; last by left. +rewrite big_cons H ?InE; first by left. by rewrite starL IH // => x X; apply: H; rewrite InE; right. Qed. diff --git a/pcm/unionmap.v b/pcm/unionmap.v index 6d9a269..974d213 100644 --- a/pcm/unionmap.v +++ b/pcm/unionmap.v @@ -46,7 +46,7 @@ limitations under the License. (* increasing order. *) (* um_foldl a z0 d f == if f is valid, a result of a left fold over its *) (* key-value pairs using function a and starting *) -(* value z0, d otherwise. *) +(* value z0, d otherewriteise. *) (* um_foldr a z0 d f == if f is valid, a result of a right fold over its *) (* key-value pairs using function a and starting *) (* value z0, d otherise. *) @@ -94,12 +94,9 @@ From HB Require Import structures. From Stdlib Require Import ssreflect ssrbool ssrfun. From mathcomp Require Import ssrnat eqtype seq path bigop. From pcm Require Import options axioms prelude finmap seqperm pred seqext. -From pcm Require Export ordtype. +From pcm Require Export ordtype useqord. From pcm Require Import pcm morphism. -(* change Set to Unset when porting the file, then remove the line when requiring MathComp >= 2.6 *) -Set SsrOldRewriteGoalsOrder. - (****************************) (****************************) (* Reference Implementation *) @@ -235,7 +232,7 @@ have: valid (union (pts k v) (Def T2)). case: decP; last by rewrite T1. by move=>T; case: ifP=>//; rewrite E disjC disj_ins N disj_nil. move/(H3 k v _ (IH T2)). -rewrite (_ : union (pts k v) (Def T2) = Def H); first by apply. +rewrite (_ : union (pts k v) (Def T2) = Def H); last by apply. rewrite umapE /union /pts /upd /=. case: decP=>// T; rewrite /disj /= N /=. by rewrite E fcat_inss // fcat0s. @@ -263,7 +260,7 @@ have: valid (union (Def T2) (pts k v)). case: decP; last by rewrite T1. by move=>T; case: ifP=>//; rewrite E disj_ins N disj_nil. move/(H3 k v _ (IH T2)). -rewrite (_ : union (pts k v) (Def T2) = Def H); first by apply; apply: S. +rewrite (_ : union (pts k v) (Def T2) = Def H); last by apply; apply: S. rewrite umapE /union /pts /upd /=. case: decP=>// T; rewrite /disj /= N /=. by rewrite E fcat_inss // fcat0s. @@ -452,7 +449,7 @@ Qed. HB.instance Definition _ := isPCMC.Build T union_map_is_conical. HB.end. -(* Notation for pts and dom that infers union_map structure. *) +(* Abbreviation for pts and dom that infers union_map structure. *) (* Different structures can use different syntax for pts and dom *) (* Making pts infer union_map structure *) @@ -461,8 +458,8 @@ Definition ptsx K C V (U : union_map K C V) k v & phant U : U := (* use ptsT to pass map type explicitly *) (* use pts when type inferrable or for printing *) -Notation ptsT U k v := (ptsx k v (Phant U)) (only parsing). -Notation pts k v := (ptsT _ k v). +Abbreviation ptsT U k v := (ptsx k v (Phant U)) (only parsing). +Abbreviation pts k v := (ptsT _ k v). Notation "@ 'pts' K C V U k v" := (@ptsx K C V U%type k v (Phant U)) (at level 10, K at level 8, C at level 8, V at level 8, U at level 8, k at level 8, v at level 8, only parsing). @@ -473,8 +470,8 @@ Definition domx K C V (U : union_map K C V) f & phant U : seq K := (* use domT to pass map type explicitly *) (* use dom when type inferrable or for printing *) -Notation domT U f := (domx f (Phant U)) (only parsing). -Notation dom f := (domT _ f). +Abbreviation domT U f := (domx f (Phant U)) (only parsing). +Abbreviation dom f := (domT _ f). Notation "@ 'dom' K C V U f" := (@domx K C V U%type f (Phant U)) (at level 10, K at level 8, C at level 8, V at level 8, U at level 8, f at level 8, only parsing). @@ -689,7 +686,7 @@ by move=>z; rewrite mem_filter domFF inE /= eq_sym; case: eqP. Qed. Lemma domF k x f : - x \in dom (free f k) = (x != k) && (x \in dom f). + (x \in dom (free f k)) = (x != k) && (x \in dom f). Proof. by rewrite domFE mem_filter. Qed. Lemma subdomF k f : {subset dom (free f k) <= dom f}. @@ -707,7 +704,7 @@ Qed. (* bidirectional version of domUn *) Lemma domUnE f1 f2 x : valid (f1 \+ f2) -> - x \in dom (f1 \+ f2) = (x \in dom f1) || (x \in dom f2). + (x \in dom (f1 \+ f2)) = (x \in dom f1) || (x \in dom f2). Proof. by move=>W; rewrite domUn inE W. Qed. Lemma dom_valid k f : k \in dom f -> valid f. @@ -716,7 +713,7 @@ Proof. by rewrite /domx !umEX; case: (UMC_from f). Qed. Lemma dom_cond k f : k \in dom f -> C k. Proof. by rewrite /domx !umEX; case: (UMC_from f)=>[|f' F] // /(allP F). Qed. -Lemma cond_dom k f : ~~ C k -> k \in dom f = false. +Lemma cond_dom k f : ~~ C k -> (k \in dom f) = false. Proof. by apply: contraTF=>/dom_cond ->. Qed. Lemma dom_inIL k f1 f2 : @@ -788,7 +785,8 @@ by move=>m s S; case: disjP=>//; move/(_ _ S)/negbTE; rewrite fnd_fcat=>->. Qed. Lemma perm_domUn f1 f2 : - valid (f1 \+ f2) -> perm_eq (dom (f1 \+ f2)) (dom f1 ++ dom f2). + valid (f1 \+ f2) -> + perm_eq (dom (f1 \+ f2)) (dom f1 ++ dom f2). Proof. move=>Vh; apply: uniq_perm; last 1 first. - by move=>x; rewrite mem_cat domUn inE Vh. @@ -799,6 +797,20 @@ case: (UMC_from f1) (UMC_from f2) Vh=>// f1' H1 [//|f2' H2]. by case: disjP=>// H _; apply: contraL (H x). Qed. +Lemma domUnEX f1 f2 : + valid (f1 \+ f2) -> + {in dom f1 & dom f2, forall x1 x2, ord x1 x2} -> + dom (f1 \+ f2) = dom f1 ++ dom f2. +Proof. +move=>W H; move: (sorted_dom f1) (sorted_dom f2)=>S1 S2. +apply: ord_sorted_eq=>//=; last 1 first. +- by apply/perm_mem/perm_domUn. +- by apply/sorted_dom. +case: (dom f1) S1 H=>[|x xs] //= S1 H. +rewrite cat_path S1 /= path_min_sorted //. +by apply/allP=>z Z; apply/H/Z/mem_last. +Qed. + Lemma size_domUn f1 f2 : valid (f1 \+ f2) -> size (dom (f1 \+ f2)) = size (dom f1) + size (dom f2). @@ -824,6 +836,81 @@ case: (UMC_from f)=>[|f'] //= H; case: decP=>// P _. by case: f' H=>f' F H; rewrite /supp /= !size_map size_ins'. Qed. +Lemma dom_subseqL f1 f2 : + valid (f1 \+ f2) -> + subseq (dom f1) (dom (f1 \+ f2)). +Proof. +move=>W; suff E : dom f1 = filter [in dom f1] (dom (f1 \+ f2)). +- by rewrite E filter_subseq. +apply: ord_sorted_eq; rewrite ?sorted_filter ?sorted_dom //. +by move=>z; rewrite mem_filter domUnE // orbC orKb. +Qed. + +Lemma dom_subseqR f1 f2 : + valid (f1 \+ f2) -> + subseq (dom f2) (dom (f1 \+ f2)). +Proof. by rewrite joinC; apply: dom_subseqL. Qed. + +Lemma dom_subsetL f1 f2 : + valid (f1 \+ f2) -> + {subset dom f1 <= dom (f1 \+ f2)}. +Proof. by move/dom_subseqL/mem_subseq. Qed. + +Lemma dom_subsetR f1 f2 : + valid (f1 \+ f2) -> + {subset dom f2 <= dom (f1 \+ f2)}. +Proof. by move/dom_subseqR/mem_subseq. Qed. + +Lemma slt_domE f x y : + y \in dom f -> + x <[dom f] y -> + ord x y. +Proof. by move=>Dy /(slt_sorted trans (sorted_dom _) Dy). Qed. + +Lemma slt_domI f x y : + x \in dom f -> + ord x y -> + x <[dom f] y. +Proof. +move=>Dx; apply: contraLR; rewrite -sleNgt. +by move/(sle_sorted (sorted_dom _) Dx); case: oleqP. +Qed. + +Lemma slt_dom f x y : + x \in dom f -> + y \in dom f -> + x <[dom f] y = ord x y. +Proof. +move=>Dx Dy; apply/idP/idP. +- by move/(slt_domE Dy). +by move/(slt_domI Dx). +Qed. + +Lemma sle_domE f x y : + y \in dom f -> + x <=[dom f] y -> + oleq x y. +Proof. by move=>Dy /(sle_sorted (sorted_dom _) Dy). Qed. + +Lemma sle_domI f x y : + x \in dom f -> + oleq x y -> + x <=[dom f] y. +Proof. +move=>Dx; apply: contraLR; rewrite -sltNge. +by move/(slt_sorted trans (sorted_dom _) Dx); case: oleqP. +Qed. + +Lemma sle_dom f x y : + x \in dom f -> + y \in dom f -> + x <=[dom f] y = oleq x y. +Proof. +move=>Dx Dy; apply/idP/idP. +- by move/(sle_domE Dy). +by move/(sle_domI Dx). +Qed. + End DomLemmas. Arguments subdomF {K C V U k f}. @@ -831,6 +918,8 @@ Arguments subdomF {K C V U k f}. #[export] Hint Resolve sorted_dom uniq_dom all_dom : core. Prenex Implicits find_some find_none subdomF. +Prenex Implicits dom_subseqL dom_subseqR. +Prenex Implicits slt_domE slt_domI slt_dom sle_domE sle_domI sle_dom. (* lemmas for comparing doms of two differently-typed maps *) Section DomLemmas2. @@ -889,6 +978,18 @@ Qed. End DomLemmas2. +(* common consequences of subdom_filter *) + +Lemma dom_maskUnL K C V (U : union_map K C V) (f1 f2 : U) : + valid (f1 \+ f2) -> + dom f1 = mask (map [dom f1] (dom (f1 \+ f2))) (dom (f1 \+ f2)). +Proof. by move/dom_subsetL=>S; rewrite -filter_mask -subdom_filter. Qed. + +Lemma dom_maskUnR K C V (U : union_map K C V) (f1 f2 : U) : + valid (f1 \+ f2) -> + dom f2 = mask (map [dom f2] (dom (f1 \+ f2))) (dom (f1 \+ f2)). +Proof. by rewrite joinC; apply/dom_maskUnL. Qed. + (*********) (* valid *) (*********) @@ -1025,6 +1126,31 @@ Lemma disjointD f1 f2 : disjoint (dom f1) (dom f2). Proof. by move=>W; apply/allP=>x /(dom_inNR W). Qed. +Lemma disjointDC f1 f2 : + valid (f1 \+ f2) -> + disjoint (dom f2) (dom f1). +Proof. by move/disjointD; rewrite disjointC. Qed. + +(* some more dom lemmas that can be proved *) +(* now that we have validUn lemmas *) + +Lemma domUnL_predC f1 f2 : + valid (f1 \+ f2) -> + dom f1 = filter [predC [dom f2]] (dom (f1 \+ f2)). +Proof. +move=>W; apply: ord_sorted_eq. +- by rewrite sorted_dom. +- by rewrite sorted_filter // sorted_dom. +move=>x; rewrite mem_filter /= domUnE // inE andb_orr andNb orbF. +case D1 : (x \in dom f1)=>//=; last by rewrite andbF. +by case: validUn W D1=>// _ _ H _ /H ->. +Qed. + +Lemma domUnR_predC f1 f2 : + valid (f1 \+ f2) -> + dom f2 = filter [predC [dom f1]] (dom (f1 \+ f2)). +Proof. by rewrite joinC; apply: domUnL_predC. Qed. + End ValidLemmas. @@ -1270,8 +1396,11 @@ case: (UMC_from f)=>[|f' H']=>//. by case: decP=>//= ->. Qed. -Lemma upd_inj k v1 v2 f : - valid f -> C k -> upd k v1 f = upd k v2 f -> v1 = v2. +Lemma inj_upd k v1 v2 f : + valid f -> + C k -> + upd k v1 f = upd k v2 f -> + v1 = v2. Proof. rewrite !umEX /UM.valid /UM.upd. case: (UMC_from f)=>[|f' F] // _; case: decP=>// H _ E. @@ -1382,7 +1511,7 @@ rewrite /domx !umEX /UM.free /UM.union /UM.dom. case: (UMC_from f1) (UMC_from f2)=>[|f1' F1][|f2' F2] //. case: ifP=>// E1; rewrite supp_fcat inE /=. case: ifP=>E2; last by rewrite !umEX rem_supp // supp_fcat inE E2. -rewrite disj_rem; last by rewrite disjC disj_rem // disjC. +rewrite disj_rem; first by rewrite disjC disj_rem // disjC. rewrite !umEX; case/orP: E2=>E2. - suff E3: k \notin supp f2' by rewrite -fcat_rems // (rem_supp E3). by case: disjP E1 E2=>// H _; move/H. @@ -1539,12 +1668,26 @@ Proof. by rewrite !umEX. Qed. Lemma assocs_undef : assocs (undef : U) = [::]. Proof. by rewrite !umEX. Qed. +Lemma assocs0E f : + assocs f = [::] -> + f = Unit \/ f = undef. +Proof. +rewrite !umEX -{2 3}(tfE f) /UM.assocs/UM.empty. +case: (UMC_from f); first by right. +case=>g psorted pall /= G; left. +rewrite {g}G in psorted pall *. +rewrite (bool_irrelevance psorted (sorted_nil K V)). +by rewrite (bool_irrelevance pall is_true_true). +Qed. + Lemma assocsF f x : - assocs (free f x) = filter (fun kv => kv.1 != x) (assocs f). + assocs (free f x) = + filter (fun kv => kv.1 != x) (assocs f). Proof. by rewrite !umEX /UM.assocs; case: (UMC_from f)=>//=; case. Qed. Lemma assocs_perm f1 f2 : - valid (f1 \+ f2) -> perm (assocs (f1 \+ f2)) (assocs f1 ++ assocs f2). + valid (f1 \+ f2) -> + perm (assocs (f1 \+ f2)) (assocs f1 ++ assocs f2). Proof. rewrite !umEX /UM.assocs/UM.union/UM.pts/UM.dom/supp /=. case: (UMC_from f1)=>//= g1 H1; case: (UMC_from f2)=>//= g2 H2. @@ -1557,17 +1700,10 @@ Proof. by rewrite /domx !umEX; case: (UMC_from f). Qed. Lemma size_assocs f : size (assocs f) = size (dom f). Proof. by rewrite assocs_dom size_map. Qed. -End AssocsLemmas. - -Lemma uniq_assocs K C (V : eqType) (U : @union_map K C V) (f : U) : - uniq (assocs f). -Proof. -rewrite !umEX /UM.assocs /=; case: (UMC_from f)=>[|[s H _]] //=. -by move/(sorted_uniq (@trans K) (@irr K)): H; apply: map_uniq. -Qed. - -Lemma assocs_map K C (V : Type) (U : @union_map K C V) (f : U) k v1 v2 : - (k, v1) \In assocs f -> (k, v2) \In assocs f -> v1 = v2. +Lemma In_assocs_fun (f : U) k v1 v2 : + (k, v1) \In assocs f -> + (k, v2) \In assocs f -> + v1 = v2. Proof. rewrite !umEX; case: (UMC_from f)=>//= g _; case: g=>g S /= H1 H2. have {S} S' : uniq [seq key i | i <- g]. @@ -1584,18 +1720,22 @@ move=>H1 H2; case: H2 H1. by move=>H1 H2; apply: IH H2 H1. Qed. -Lemma Uniq_assocs K C V (U : @union_map K C V) (f : U) : - Uniq (assocs f). +Lemma Uniq_assocs (f : U) : Uniq (assocs f). Proof. rewrite !umEX /UM.assocs /=; case: (UMC_from f)=>[|[s H _]] //=. move/(sorted_uniq (@trans K) (@irr K)): H. -apply: map_Uniq. +by move/UniqP/map_Uniq. Qed. -Lemma sorted_assocs K C V (U : @union_map K C V) (f : U) : - sorted (relpre fst ord) (assocs f). +Lemma sorted_assocs (f : U) : sorted (relpre fst ord) (assocs f). Proof. rewrite -sorted_map -assocs_dom; exact: sorted_dom. Qed. +End AssocsLemmas. + +Lemma uniq_assocs K C (V : eqType) (U : @union_map K C V) (f : U) : + uniq (assocs f). +Proof. by apply/UniqP/Uniq_assocs. Qed. + (*********************************) (* Interaction of subset and dom *) (*********************************) @@ -1699,7 +1839,7 @@ Lemma cancelPt k v1 v2 : valid (pts k v1 : U) -> pts k v1 = pts k v2 :> U -> v1 = v2. -Proof. by rewrite validPt !ptsU; apply: upd_inj. Qed. +Proof. by rewrite validPt !ptsU; apply: inj_upd. Qed. Lemma cancelPt2 k1 k2 v1 v2 : valid (pts k1 v1 : U) -> @@ -1822,10 +1962,10 @@ Lemma domUnPt k v f : [pred x | valid (f \+ pts k v) & (k == x) || (x \in dom f)]. Proof. by rewrite joinC; apply: domPtUn. Qed. -Lemma domPtUnE k v f : k \in dom (pts k v \+ f) = valid (pts k v \+ f). +Lemma domPtUnE k v f : (k \in dom (pts k v \+ f)) = valid (pts k v \+ f). Proof. by rewrite domPtUn inE eq_refl andbT. Qed. -Lemma domUnPtE k v f : k \in dom (f \+ pts k v) = valid (f \+ pts k v). +Lemma domUnPtE k v f : (k \in dom (f \+ pts k v)) = valid (f \+ pts k v). Proof. by rewrite joinC; apply: domPtUnE. Qed. Lemma domPtUnE2 k v1 v2 f : dom (pts k v1 \+ f) = dom (pts k v2 \+ f). @@ -1835,7 +1975,7 @@ Lemma domUnPtE2 k v1 v2 f : dom (f \+ pts k v1) = dom (f \+ pts k v2). Proof. by rewrite !(joinC f); apply: domPtUnE2. Qed. Lemma domPt2 k1 k2 v1 v2 x : - x \in dom (pts k1 v1 \+ pts k2 v2 : U) = + (x \in dom (pts k1 v1 \+ pts k2 v2 : U)) = [&& C k1, C k2, k1 != k2 & x \in pred2 k1 k2]. Proof. rewrite domPtUn !inE validPt2 domPt inE !(eq_sym x). @@ -2065,7 +2205,7 @@ move=>k v g H V1; move: (H3 k v _ H); rewrite !umEX. by apply. Qed. -(* validity holds pairwise *) +(* validity holds pairewriteise *) Lemma um_valid3 f1 f2 f3 : valid (f1 \+ f2 \+ f3) = [&& valid (f1 \+ f2), valid (f2 \+ f3) & valid (f1 \+ f3)]. @@ -2134,7 +2274,7 @@ Hint Resolve domeqPt domeqPtUn domeqUnPt : core. Section EqPtLemmas. Variables (K : ordType) (C : pred K) (V : eqType). Variables (U : union_map K C V). -Notation Ue := +Abbreviation Ue := (Equality.pack_ (Equality.Mixin (union_map_eqP (U:=U)))). Lemma umPtPtE (k1 k2 : K) (v1 v2 : V) : @@ -2187,7 +2327,7 @@ Lemma umUPtE (k : K) (v : V) f : (f \+ pts k v == Unit :> Ue) = false. Proof. by rewrite joinC umPtUE. Qed. Lemma umPtUPtE (k1 k2 : K) (v1 v2 : V) f : - pts k1 v1 \+ f == pts k2 v2 :> Ue = + (pts k1 v1 \+ f == pts k2 v2 :> Ue) = if C k1 then if C k2 then [&& k1 == k2, v1 == v2 & unitb f] else ~~ valid (pts k1 v1 \+ f) @@ -2211,7 +2351,7 @@ by move/unitbP; rewrite um_unitbPt. Qed. Lemma umPtPtUE (k1 k2 : K) (v1 v2 : V) f : - pts k1 v1 == pts k2 v2 \+ f :> Ue = + (pts k1 v1 == pts k2 v2 \+ f :> Ue) = if C k2 then if C k1 then [&& k1 == k2, v1 == v2 & unitb f] else ~~ valid (pts k2 v2 \+ f) @@ -2219,7 +2359,7 @@ Lemma umPtPtUE (k1 k2 : K) (v1 v2 : V) f : Proof. by rewrite eq_sym umPtUPtE (eq_sym k1) (eq_sym v1). Qed. Lemma umUPtPtE (k1 k2 : K) (v1 v2 : V) f : - f \+ pts k1 v1 == pts k2 v2 :> Ue = + (f \+ pts k1 v1 == pts k2 v2 :> Ue) = if C k1 then if C k2 then [&& k1 == k2, v1 == v2 & unitb f] else ~~ valid (pts k1 v1 \+ f) @@ -2227,7 +2367,7 @@ Lemma umUPtPtE (k1 k2 : K) (v1 v2 : V) f : Proof. by rewrite joinC umPtUPtE. Qed. Lemma umPtUPt2E (k1 k2 : K) (v1 v2 : V) f : - pts k1 v1 == f \+ pts k2 v2 :> Ue = + (pts k1 v1 == f \+ pts k2 v2 :> Ue) = if C k2 then if C k1 then [&& k1 == k2, v1 == v2 & unitb f] else ~~ valid (pts k2 v2 \+ f) @@ -2476,7 +2616,6 @@ Qed. (* if we have equality of domains, we can get rid of one direction *) (* in the hypothesis in umem_eq *) - Lemma umem_eqD f1 f2 : valid f1 -> valid f2 -> dom f1 =i dom f2 -> @@ -2487,6 +2626,7 @@ move=>H2; move: (In_dom H2); rewrite -E /= =>/In_domX [w H1]. by move/H/(In_fun H2): (H1)=>->. Qed. +(* assocs is injective on valid maps *) Lemma umem_eq_assocs f1 f2 : valid f1 -> valid f2 -> assocs f1 = assocs f2 -> @@ -2571,6 +2711,7 @@ Canonical fset_PredType (K : ordType) : PredType (K * unit) := Coercion Pred_of_fset K (x : fset K) : {Pred _} := [eta Mem_UmMap x]. + Section MorphMembership. Variables (K : ordType) (C : pred K) (V : Type). Variables (U1 : pcm) (U2 : union_map K C V). @@ -2631,7 +2772,7 @@ End MorphMembership. (*********) Section Range. -Variables (K : ordType) (C : pred K) (V : Type) (U : union_map K C V). +Context {K : ordType} {C : pred K} {V : Type} {U : union_map K C V}. Implicit Types f : U. Definition range f := map snd (assocs f). @@ -2720,6 +2861,49 @@ case=>k' Nk H; exists k'; apply/InF; split=>//. by rewrite validF (In_valid H). Qed. +Lemma range_perm (h1 h2 : U) : + valid (h1 \+ h2) -> + perm (range (h1 \+ h2)) (range h1 ++ range h2). +Proof. by move=>W; rewrite /range -map_cat; apply/pperm_map/assocs_perm. Qed. + +Lemma Uniq_rangeE f : + (forall k1 k2 v, (k1, v) \In f -> (k2, v) \In f -> k1 = k2) <-> + Uniq (range f). +Proof. +split=>[H|]. +- apply/map_inj_In_Uniq; last by apply/Uniq_assocs. + case=>k1 v1 [k2 v2] /In_assocs H1 /In_assocs /[swap] <-. + by move/(H _ _ _ H1)=>->. +rewrite /range=>H k1 k2 v /In_assocs H1 /In_assocs H2. +case/In_split: H1=>x1 [x2] E; rewrite E in H H2; case/In_cat: H2. +- case/In_split=>x3 [x4] {}E; rewrite E map_cat cat_Uniq in H. + case: H=>_ H _; apply/eqP; case: eqP=>// N; suff : False by []. + apply/H/HasP; exists v; first by left. + by apply/In_map; exists (k2, v)=>//; apply/In_cat; right; left. +rewrite InE; case=>[[//]|]; case/In_split=>x3 [x4] {}E; rewrite {x2}E in H. +rewrite map_cat cat_Uniq /= in H; case: H=>_ _ [H _]; suff : False by []. +by apply: H; rewrite map_cat /= In_cat InE; right; left. +Qed. + +Lemma Uniq_rangeUn f1 f2 : + valid (f1 \+ f2) -> + Uniq (range (f1 \+ f2)) <-> Uniq (range f1 ++ range f2). +Proof. by move=>W; apply/pperm_Uniq/range_perm. Qed. + +Lemma In_big_range I (r : seq I) (P : pred I) (F : I -> U) x : + valid (\big[join/Unit]_(i <- r | P i) F i) -> + x \In range (\big[join/Unit]_(i <- r | P i) F i) <-> + x \In \big[cat/[::]]_(i <- r | P i) range (F i). +Proof. +elim: r x=>[|a r IH] x; first by rewrite !big_nil range0. +rewrite !big_cons; case: ifP=>X W; last by apply: IH. +rewrite In_cat -IH ?(validR W) //; split. +- by case/In_rangeUn=>H; [left|right]. +case=>/In_rangeX [k H]; apply/In_rangeX; exists k. +- by apply/InL/H/W. +by apply/InR/H/W. +Qed. + End Range. Prenex Implicits In_range_valid In_range In_rangeUn In_rangeF. @@ -2734,38 +2918,7 @@ Lemma uniq_rangeP f : reflect (forall k1 k2 v, (k1, v) \In f -> (k2, v) \In f -> k1 = k2) (uniq (range f)). Proof. -case: (normalP f)=>[->|W]. -- by rewrite range_undef; constructor=>k1 k2 v /In_undef. -case H : (uniq (range f)); constructor; last first. -- move=>H'; move/negbT/negP: H; elim. - rewrite map_inj_in_uniq; first by apply: uniq_assocs. - case=>/= k1 v [k2 v'] /mem_seqP/In_assocs H1 /mem_seqP/In_assocs H2 /= H3. - by rewrite -H3 in H2 *; rewrite (H' _ _ _ H1 H2). -move/uniqP: H=>H k1 k2 v H1 H2. -set j1 := index k1 (dom f). -set j2 := index k2 (dom f). -have [D1 D2] : k1 \in dom f /\ k2 \in dom f. -- by move/In_dom: H1; move/In_dom: H2. -have [R1 R2] : j1 < size (assocs f) /\ j2 < size (assocs f). -- by rewrite size_assocs !index_mem. -have [M1 M2] : j1 < size (dom f) /\ j2 < size (dom f). -- by rewrite !index_mem. -have [A1 A2] : (k1, v) \in assocs f /\ (k2, v) \in assocs f. -- by move/In_assocs/mem_seqP: H1=>->; move/In_assocs/mem_seqP: H2=>->. -have InjF : {in assocs f &, injective fst}. -- case=>a1 v1 [a2 v2] /mem_seqP X1 /mem_seqP X2 /= E. - by move: E X1 X2 => -> X1 /(assocs_map X1) ->. -have /eqP E1 : j1 == index (k1,v) (assocs f). -- rewrite -(nth_uniq (k1,v) R1 _ (uniq_assocs _)); last by rewrite index_mem. - by rewrite /j1 assocs_dom (nth_index_map _ InjF A1) nth_index. -have /eqP E2 : j2 == index (k2,v) (assocs f). -- rewrite -(nth_uniq (k2,v) R2 _ (uniq_assocs _)); last by rewrite index_mem. - by rewrite /j2 assocs_dom (nth_index_map _ InjF A2) nth_index. -have E : nth v (range f) j1 = nth v (range f) j2. -- rewrite /range (nth_map (k1,v) v _ R1) (nth_map (k2,v) v _ R2). - by rewrite E1 E2 !nth_index. -have : j1 = j2 by apply: H E; rewrite inE size_range. -by move/eqP; rewrite -(nth_uniq k1 M1 M2 (uniq_dom _)) !nth_index // =>/eqP. +by case: UniqP=>H; constructor; [apply/Uniq_rangeE/H|move/Uniq_rangeE/H]. Qed. (* this is just a renaming of mem_seqP for easier finding *) @@ -2792,7 +2945,12 @@ move/mem_seqP=>H; rewrite (In_range_valid H) inE /=. by case/In_rangeUn: H=>/mem_seqP -> //; rewrite orbT. Qed. -Lemma rangePt x k v : C k -> x \in range (U:=U) (pts k v) = (x == v). +Lemma rangeUnE f1 f2 : + valid (f1 \+ f2) -> + range (f1 \+ f2) =i range f1 ++ range f2. +Proof. by move=>W x; rewrite rangeUn inE W mem_cat. Qed. + +Lemma rangePt x k v : C k -> (x \in range (U:=U) (pts k v)) = (x == v). Proof. by move=>C'; rewrite /range assocsPt C' inE. Qed. Lemma rangePtUn k v f : @@ -2814,23 +2972,7 @@ Qed. Lemma uniq_rangeUn f1 f2 : valid (f1 \+ f2) -> uniq (range (f1 \+ f2)) = uniq (range f1 ++ range f2). -Proof. -move=>W; apply/esym; case: uniq_rangeP=>H; last first. -- apply/negP; rewrite cat_uniq=>/and3P [H1 /hasP H2 H3]. - elim: H=>k1 k2 v /InUn [] F1 /InUn []; move: F1. - - by move/uniq_rangeP: H1; apply. - - by move/mem_range=>F1 /mem_range F2; elim: H2; exists v. - - by move/mem_range=>F1 /mem_range F2; elim: H2; exists v. - by move/uniq_rangeP: H3; apply. -rewrite cat_uniq; apply/and3P; split; last 1 first. -- by apply/uniq_rangeP=>k1 k2 v F1 F2; apply: (H k1 k2 v); apply/InR. -- by apply/uniq_rangeP=>k1 k2 v F1 F2; apply: (H k1 k2 v); apply/InL. -case: hasP=>//; case=>x /mem_rangeX [k1 H1] /mem_rangeX [k2 H2]. -have [G1 G2] : (k1, x) \In f1 \+ f2 /\ (k2, x) \In f1 \+ f2. -- by split; [apply/InR|apply/InL]. -rewrite -(H k1 k2 x G1 G2) in H2. -by move: (dom_inNR W (In_dom H1)); rewrite (In_dom H2). -Qed. +Proof. by move=>W; apply/UniqP/UniqP=>/(Uniq_rangeUn W). Qed. Lemma uniq_rangePtUn k v f : valid (pts k v \+ f) -> @@ -2852,6 +2994,12 @@ case D : (k \in dom f); last by move/negbT/dom_free: D=>E; rewrite -{1}E. by case: (um_eta D) W=>x [_] E; rewrite {1 2}E; apply: uniq_rangeR. Qed. +Lemma mem_big_range I (r : seq I) (P : pred I) (F : I -> U) : + valid (\big[join/Unit]_(i <- r | P i) F i) -> + range (\big[join/Unit]_(i <- r | P i) F i) =i + \big[cat/[::]]_(i <- r | P i) range (F i). +Proof. by move=>W z; apply/mem_seqP/mem_seqP=>/(In_big_range _ W). Qed. + End DecidableRange. @@ -2870,6 +3018,19 @@ Definition um_mono_ltE f := forall k k' v v', (k, v) \In f -> (k', v') \In f -> ord k k' <-> ord v v'. Definition um_mono_leE f := forall k k' v v', (k, v) \In f -> (k', v') \In f -> oleq k k' <-> oleq v v'. +(* map injectivity is a variant *) +Definition um_inj f := forall k k' v, + (k, v) \In f -> (k', v) \In f -> k = k'. +(* monotonicity when keys ordered by sequence *) +Definition um_mono_slt f ks := forall k k' v v', + k' \in ks -> (k, v) \In f -> (k', v') \In f -> + k <[ks] k' -> ord v v'. +(* alternative form that's useful in practice *) +(* it's equivalent to um_mono_slt because *) +(* (x < y -> f x < f y) <=> (f x >= f y -> x >= y) *) +Definition um_slt_mono f ks := forall k k' v v', + k \in ks -> (k, v) \In f -> (k', v') \In f -> + ord v v' -> k <[ks] k'. Lemma ummonoP f : reflect (um_mono_lt f) (um_mono f). Proof. @@ -2878,7 +3039,7 @@ apply/(equivP idP); elim/um_indf: f=>[||k v f IH W P]. - by rewrite assocs_undef; split=>// _ ???? /In_undef. - by rewrite assocs0; split=>// _ ???? /In0. rewrite assocsPtUn ?(order_path_min (@trans _) P) //=; split=>H; last first. -- rewrite path_min_sorted; first by apply/IH=>??????; apply: H; apply/InR. +- rewrite path_min_sorted; last by apply/IH=>??????; apply: H; apply/InR. apply/allP=>x /mapP [[y w]] /mem_seqP/In_assocs X ->. by apply: H (path_mem (@trans K) P (In_dom X)); [apply/InPtUnL|apply/InR]. move=>x x' w w'; rewrite !InPtUnE //. @@ -2913,7 +3074,8 @@ by [rewrite irr|case/H|case/H; case: ordP|apply: X]. Qed. Lemma In_mono_fun k1 k2 v f : - um_mono f -> (k1, v) \In f -> (k2, v) \In f -> k1 = k2. + um_mono f -> + (k1, v) \In f -> (k2, v) \In f -> k1 = k2. Proof. move/ummonoP=>M H1 H2; case: (ordP k1 k2). - by move/(M _ _ _ _ H1 H2); rewrite irr. @@ -2921,6 +3083,9 @@ move/ummonoP=>M H1 H2; case: (ordP k1 k2). by move/(M _ _ _ _ H2 H1); rewrite irr. Qed. +Lemma um_mono_inj f : um_mono f -> um_inj f. +Proof. by move/In_mono_fun; apply. Qed. + Lemma In_mono_range v f1 f2 : valid (f1 \+ f2) -> um_mono (f1 \+ f2) -> v \in range f1 -> v \in range f2 -> false. @@ -2956,20 +3121,18 @@ case: ordP=>Y1; case: ordP=>Y2 //=. by move/O1: Y1; case: ordP Y2. Qed. -Lemma ummono_inj_find f : - um_mono f -> {in dom f & predT, injective (fun x => find x f)}. +Lemma uminj_find f : + um_inj f -> + {in dom f & predT, injective (fun x => find x f)}. Proof. -move/ummono_leP=>H k1 k2 /In_domX [x1 F1] _ E. -have /In_domX [x2 F2] : k2 \in dom f. -- by case: (dom_find k2) F1 E=>// _ /In_find ->. -move/In_find: (F1) E=>->; move/In_find: (F2)=>-> [?]; subst x2. -move: (H _ _ _ _ F1 F2) (H _ _ _ _ F2 F1); rewrite orefl=>{H} H1 H2. -case: (equivP idP H1) (@oantisym K k1 k2)=>// _. -by case: (equivP idP H2)=>// _; apply. +move=>M k1 k2 /In_domX [v] /[dup] X /In_findE -> _ /esym. +by move/In_find/(M _ _ _ X). Qed. Lemma index_mem_dom_range f k t : - (k, t) \In f -> uniq (range f) -> index k (dom f) = index t (range f). + (k, t) \In f -> + uniq (range f) -> + index k (dom f) = index t (range f). Proof. rewrite /range assocs_dom. elim/um_indf: f k t=>[||k' t' f IH W /(order_path_min (@trans K)) P] k t. @@ -2984,8 +3147,10 @@ by rewrite (IH _ _ H1). Qed. Lemma index_dom_range_mem f k t : - index k (dom f) = index t (range f) -> - index k (dom f) != size (dom f) -> (k, t) \In f. + index k (dom f) = + index t (range f) -> + index k (dom f) != size (dom f) -> + (k, t) \In f. Proof. rewrite /range assocs_dom. elim/um_indf: f k t=>[||k' t' f IH W /(order_path_min (@trans K)) P] k t. @@ -2997,12 +3162,54 @@ case: eqP=>// _ [H1]; rewrite eqSS=>H2. by apply/InPtUnE=>//; right; apply: IH H1 H2. Qed. -Lemma ummonoF f x : um_mono f -> um_mono (free f x). +Lemma ummonoF f x : + um_mono f -> + um_mono (free f x). Proof. move/ummonoP=>X; apply/ummonoP=>k k' v v'. by case/InF=>_ _ F /InF [_ _]; apply: X F. Qed. +(* um_mono_slt and um_slt_mono are *) +(* equivalent up to injectivity *) + +Lemma ummono_sltI f ks : + um_mono_slt f ks -> + um_slt_mono f ks. +Proof. +move=>P x y x' y' Ox Gx Gy N. +case/or3P: (slt_total y Ox)=>[/eqP E|//|H]. +- by move: E Gy N=><- /(In_fun Gx) ->; rewrite irr. +by case: ordP N (P _ _ _ _ Ox Gy Gx H). +Qed. + +Lemma ummono_inj_sltI f ks : + um_inj f -> + um_slt_mono f ks -> + um_mono_slt f ks. +Proof. +move=>Ui P x y x' y' Oy Gx Gy N; case: (ordP x' y')=>[//||] E. +- by move/eqP: E Gy N=><- /(Ui _ _ _ Gx) <-; rewrite slt_irr. +by move/(slt_trans N): (P _ _ _ _ Oy Gy Gx E); rewrite slt_irr. +Qed. + +Lemma ummono_sltP f : + reflect (um_mono_slt f (dom f)) (um_mono f). +Proof. +apply/(iffP idP)=>[/ummonoP|] M. +- by move=>k k' v v' D H H'; rewrite slt_dom ?(In_dom H) //; apply: M. +apply/ummonoP=>k k' v v' H H' O; move: (In_dom H) (In_dom H')=>/= D D'. +by apply: (M k k' v v')=>//; rewrite slt_dom. +Qed. + +Lemma ummono_inj_sltP f : + um_inj f -> + reflect (um_slt_mono f (dom f)) (um_mono f). +Proof. +move=>Ui; apply/(iffP idP); first by move/ummono_sltP/ummono_sltI. +by move/(ummono_inj_sltI Ui)/ummono_sltP. +Qed. + End MapMonotonicity. @@ -3075,11 +3282,11 @@ Proof. move: f2; apply: um_indb=>[W H|W H|k v f2 IH W' P W H]. - by rewrite join_undef !umfoldl_undef. - by rewrite unitR umfoldl0. -rewrite -(joinC f2) joinA in W *; rewrite umfoldlUnPt //; last first. +rewrite -(joinC f2) joinA in W *; rewrite umfoldlUnPt //. - apply/allP=>x; rewrite domUn inE (validL W). case/orP=>[/H|]; last by apply: P. by apply; rewrite domPtUn inE joinC W' eq_refl. -rewrite umfoldlUnPt ?(validAR W) //; last by apply/allP. +rewrite umfoldlUnPt ?(validAR W) //; first by apply/allP. rewrite (IH (validL W)) // => k1 k2 D1 D2; apply: H D1 _. by rewrite domPtUn inE joinC W' D2 orbT. Qed. @@ -3091,7 +3298,7 @@ Proof. move: f1; apply: um_indf=>[W H|W H|k v f1 IH W' P W H]. - by rewrite undef_join !umfoldr_undef. - by rewrite unitL umfoldr0. -rewrite -!joinA in W *; rewrite umfoldrPtUn //. +rewrite -!joinA in W *; rewrite umfoldrPtUn //; last first. - rewrite umfoldrPtUn ?(order_path_min (@trans K) P) // (IH (validR W)) //. by move=>k1 k2 D1; apply: H; rewrite domPtUn inE W' D1 orbT. apply/allP=>x; rewrite domUn inE (validR W) /=. @@ -3144,8 +3351,8 @@ Lemma umfoldl_ind (P : R -> Prop) a z0 d f : P (um_foldl a z0 d f). Proof. move=>W H1 H2; elim/um_indf: f z0 W H1 H2=>[||k v f IH W O] z0; -rewrite ?valid_undef ?umfoldl0 // => _ H1 H2; rewrite umfoldlPtUn //; - last by apply: order_path_min O; apply: trans. +rewrite ?valid_undef ?umfoldl0 // => _ H1 H2; rewrite umfoldlPtUn //. +- by apply: order_path_min O; apply: trans. apply: IH (validR W) _ _; first by apply: H2 (InPtUnL W) H1. by move=>z1 k0 v0 F; apply: H2 (InR W F). Qed. @@ -3270,7 +3477,7 @@ move: h1 h2; apply: um_indf=>[h1|h2 W H| k v f IH W1 /(order_path_min (@trans _)) P h2 W2 H]. - by rewrite undef_join valid_undef. - by rewrite assocs0 unitL. -rewrite -joinA in W2; rewrite -joinA !assocsPtUn //= ?IH //. +rewrite -joinA in W2; rewrite -joinA !assocsPtUn //= ?IH //; last 2 first. - by rewrite (validR W2). - by move=>k1 k2 K1 K2; apply: H=>//; rewrite domPtUn inE K1 orbT W1. apply/allP=>x; rewrite domUn inE (validR W2) /=. @@ -3287,7 +3494,7 @@ Lemma umpfxE h1 h : valid h1 -> um_prefix h1 h -> exists2 h2, h = h1 \+ h2 & - forall x y, x \in dom h1 -> y \in dom h2 -> ord x y. + forall x y, x \in dom h1 -> y \in dom h2 -> ord x y. Proof. move=>V1; case: (normalP h)=>[->|W]. - by exists undef; rewrite ?join_undef ?dom_undef. @@ -3311,7 +3518,7 @@ move/eqP=><-{x} Dy. have : y \in dom h' by rewrite Eh' domUn inE -Eh' W' /= Dy orbT. rewrite domF eq_sym; case: (k =P y)=>// /eqP N. rewrite assocs_dom Eh /= inE eq_sym (negbTE N) /=. -case/mem_seqP/MapP; case=>a b X -> /=. +case/mem_seqP/In_map; case=>a b -> X /=. have {}P : path ord k (map fst (assocs h1 ++ h2')). - by move: (sorted_dom h); rewrite assocs_dom Eh /=. suff {X} : forall x, x \In assocs h1 ++ h2' -> ord k x.1 by move/(_ _ X). @@ -3424,7 +3631,7 @@ Definition omap_fun_axiom (K : ordType) (C : pred K) (V V' : Type) (* factory to use if full/norm/tpcm morphism property already proved *) (* (omap_fun isn't binormal as it can drop timestamps) *) HB.mixin Record isOmapFun_morph (K : ordType) (C : pred K) (V V' : Type) - (U : union_map K C V) (U' : union_map K C V') (f : U -> U') & + (U : union_map K C V) (U' : union_map K C V') (f : U -> U') & @Full_Norm_TPCM_morphism U U' f := { omf_op : K * V -> option V'; omfE_op : omap_fun_axiom f omf_op}. @@ -3477,20 +3684,20 @@ HB.instance Definition _ := HB.end. (* notation to hide the structure when projecting omf *) -Section OmapFunNotation. +Section OmapFunAbbreviation. Variables (K : ordType) (C : pred K) (V V' : Type). Variables (U : union_map K C V) (U' : union_map K C V'). Definition omfx (f : omap_fun U U') & phantom (U -> U') f : K * V -> option V' := omf_op f. -Notation omf f := (omfx (Phantom (_ -> _) f)). +Abbreviation omf f := (omfx (Phantom (_ -> _) f)). Lemma omfE (f : omap_fun U U') : f =1 omap (omf f). Proof. exact: omfE_op. Qed. -End OmapFunNotation. +End OmapFunAbbreviation. -Notation omf f := (omfx (Phantom (_ -> _) f)). +Abbreviation omf f := (omfx (Phantom (_ -> _) f)). (* omap is omap_fun *) Section OmapOmapFun. @@ -3582,6 +3789,11 @@ Proof. rewrite omfE; apply: omap_subdom. Qed. Arguments omf_subdom {f x}. +Lemma omf_subdomT f (x : U) (xs : seq K) : + {subset dom x <= xs} -> + {subset dom (f x) <= xs}. +Proof. by move=>H z /omf_subdom/H. Qed. + Lemma In_odom f x k : k \In f x -> k.1 \in dom x. Proof. by move/In_dom/omf_subdom. Qed. @@ -3591,16 +3803,31 @@ Proof. by move/omf_subdom/dom_cond. Qed. Lemma omf_sorted f x : sorted ord (dom (f x)). Proof. by apply: sorted_dom. Qed. -Lemma path_omf f x k : path ord k (dom x) -> path ord k (dom (f x)). +Lemma path_omf f x k : + path ord k (dom x) -> + path ord k (dom (f x)). Proof. apply: subseq_path; first by apply: trans. -apply: (sorted_subset_subseq (ltT := ord)); last by apply: omf_subdom. +apply: (sorted_subset_subseq_irr (ltT := ord)); last by apply: omf_subdom. - by apply: irr. - by apply: trans. - by apply: sorted_dom. by apply: sorted_dom. Qed. +Lemma omf_subseq f x : subseq (dom (f x)) (dom x). +Proof. +rewrite -(sorted_slt_subseq (uniq_dom _) omf_subdom). +rewrite (eq_in_sorted (e':=ord) (P:=[dom f x])) ?sorted_dom //. +move=>z z'; rewrite !inE=>/omf_subdom Dz /omf_subdom Dz'. +by rewrite slt_dom. +Qed. + +Lemma omf_subseqT f x xs : + subseq (dom x) xs -> + subseq (dom (f x)) xs. +Proof. by apply/subseq_trans/omf_subseq. Qed. + Lemma In_dom_omfX f x k : reflect (exists v, (k, v) \In x /\ omf f (k, v)) (k \in dom (f x)). @@ -3725,6 +3952,21 @@ Lemma omfU f k (v : V) (x : U) : else free (f x) k. Proof. by move=>D; rewrite omfUE D. Qed. +Lemma assocs_omf f h : + assocs (f h) = + pmap (fun x : K * V => ssrfun.omap (pair x.1) (omf f x)) + (assocs h). +Proof. +elim/um_indf: h=>[||]. +- by rewrite pfundef !assocs_undef. +- by rewrite pfunit !assocs0. +move=>k v h IH W /(order_path_min trans) A. +rewrite omfPtUn W assocsPtUn //= /oapp /=. +case D : (omf f _)=>[a|]; last by apply: IH. +have Wf : valid (pts k a \+ f h) by rewrite validPtUn in W; rewrite valid_omfPtUn. +by rewrite assocsPtUn -?IH //; apply/allP=>x /omf_subdom; apply/allP/A. +Qed. + (* when mapped functions are equal *) Lemma eq_in_omf f1 f2 x : @@ -3817,6 +4059,13 @@ Lemma omf_noneR f x : f x = Unit -> forall kv, kv \In x -> omf f kv = None. Proof. by case/unitbP/omf_unit. Qed. +Lemma range_omf f x : + range (f x) = pmap (omf f) (assocs x). +Proof. +rewrite /range assocs_omf map_pmap -pmap_pcomp /pcomp. +by apply/eq_In_pmap=>kv; case: (omf _ _). +Qed. + End OmapFunLemmas. Arguments omf_subdom {K C V V' U U' f x}. @@ -3844,16 +4093,16 @@ have B : (k, v) \In pts k v \+ x by apply: InPtUnL. case E1 : (omf f1 (k, v))=>[x1|]. - have /(H _ B): (omf f1 (k, v)) by rewrite E1. case: (omf f2 (k, v))=>// x2 _. - rewrite !domPtUnK //=; last first. - - by apply/allP=>? /In_dom_omfX [?][] /In_dom Y _; apply: path_mem Y. + rewrite !domPtUnK //=. - by rewrite valid_omfPtUn. - by apply/allP=>? /In_dom_omfX [?][] /In_dom Y _; apply: path_mem Y. - by rewrite valid_omfPtUn. + - by apply/allP=>? /In_dom_omfX [?][] /In_dom Y _; apply: path_mem Y. by rewrite eq_refl; apply: IH=>kx X; apply: H (InR _ _). case E2 : (omf f2 (k, v))=>[x2|]; last by apply: IH=>kx X; apply: H (InR _ _). -rewrite domPtUnK /=; last first. -- by apply/allP=>? /In_dom_omfX [?][] /In_dom Y _; apply: path_mem Y. +rewrite domPtUnK /=. - by rewrite valid_omfPtUn. +- by apply/allP=>? /In_dom_omfX [?][] /In_dom Y _; apply: path_mem Y. case D : (dom (f1 x))=>[//|t ts]. case: eqP D=>[-> D|_ <-]; last by apply: IH=>kv X; apply: H (InR _ _). have : k \in dom (f1 x) by rewrite D inE eq_refl. @@ -3876,6 +4125,14 @@ move=>H; apply: subseq_anti. by rewrite !omf_dom_subseq // => kv /H ->. Qed. +Lemma omf_disj x1 x2 : + valid (x1 \+ x2) -> + disjoint (dom (f1 x1)) (dom (f2 x2)). +Proof. +move=>W; apply/disjointPL=>z /omf_subdom Dz. +by apply/negP=>/omf_subdom/(dom_inNLX W Dz). +Qed. + End OmapFun2Eq. Section OmapMembershipExtra. @@ -4036,9 +4293,9 @@ End OmapFunComp. (* special notation for some common variants of omap *) (* when we don't supply the key *) -Notation omapv f := (omap (f \o snd)). +Abbreviation omapv f := (omap (f \o snd)). (* when the don't supply the key and the map is total *) -Notation mapv f := (omapv (Some \o f)). +Abbreviation mapv f := (omapv (Some \o f)). Section OmapId. Variables (K : ordType) (C : pred K) (V : Type) (U : union_map K C V). @@ -4143,7 +4400,7 @@ Variables (U : union_map K C V) (U' : union_map K C V'). (* decidable variant of In_rangev *) Lemma mem_rangev f g v (x : U) : ocancel f g -> pcancel g f -> - v \in range (omapv f x : U') = (g v \in range x). + (v \in range (omapv f x : U')) = (g v \in range x). Proof. by move=>O P; apply/idP/idP; move/mem_seqP/(In_rangev _ _ _ O P)/mem_seqP. Qed. @@ -4311,6 +4568,22 @@ Lemma eq_in_umfiltE p1 p2 f : p1 =1 p2 -> um_filter p1 f = um_filter p2 f. Proof. by move=>S; apply/eq_in_umfilt=>kv _; apply: S. Qed. +(* convenient form of umfilt_predT and umfilt_pred0 *) + +Lemma umfilt_subT p f : + (forall kv, kv \In f -> p kv) -> + um_filter p f = f. +Proof. by move/eq_in_umfilt=>->; rewrite umfilt_predT. Qed. + +Lemma umfilt_sub0 p f : + valid f -> + (forall kv, kv \In f -> ~~ p kv) -> + um_filter p f = Unit. +Proof. +move=>W H; rewrite -[RHS](umfilt_pred0 W). +by apply/eq_in_umfilt=>kv /H/negbTE. +Qed. + (* filters of the same map are equal if their domains are equal *) Lemma eq_umfiltD p1 p2 f : dom (um_filter p1 f) =i dom (um_filter p2 f) -> @@ -4338,9 +4611,9 @@ Lemma umfilt_predU p1 p2 f : um_filter (predU p1 p2) f = um_filter p1 f \+ um_filter (predD p2 p1) f. Proof. -rewrite omf_predU=>[|kv]. -- by rewrite eq_in_omf !omf_omap /= => kv; case: (p1 _). -by rewrite !omf_omap /=; case: (p1 _)=>/=; [right|left]. +rewrite omf_predU=>[kv|]. +- by rewrite !omf_omap /=; case: (p1 _)=>/=; [right|left]. +by rewrite eq_in_omf !omf_omap /= => kv; case: (p1 _). Qed. (* we put localization back In for xor *) @@ -4374,7 +4647,7 @@ Qed. Corollary umfilt_predC f p : f = um_filter p f \+ um_filter (predC p) f. Proof. -rewrite -umfilt_dpredU; last by move=>? /=; rewrite negbK. +rewrite -umfilt_dpredU; first by move=>? /=; rewrite negbK. rewrite -[LHS]umfilt_predT; apply: eq_in_umfiltE=>kv /=. by rewrite orbN. Qed. @@ -4450,7 +4723,7 @@ elim/um_indf: f=>[||k v f IH W /(order_path_min (@trans K)) P]. - by rewrite pfundef assocs_undef. - by rewrite pfunit assocs0. rewrite umfiltPtUn W assocsPtUn //=. -case: ifP W=>// H W; rewrite assocsPtUn; first by rewrite IH. +case: ifP W=>// H W; rewrite assocsPtUn; last by rewrite IH. - suff: valid (um_filter p (pts k v \+ f)) by rewrite umfiltPtUn W H. by rewrite pfVE. by apply/allP=>x; move/allP: P=>P; move/omf_subdom/P. @@ -4476,7 +4749,7 @@ Qed. Hint Resolve umfilt_pleqI : core. Lemma dom_umfilt2 p1 p2 f x : - x \in dom (um_filter p1 (um_filter p2 f)) = + (x \in dom (um_filter p1 (um_filter p2 f))) = (x \in dom (um_filter p1 f)) && (x \in dom (um_filter p2 f)). Proof. rewrite -umfilt_predI; apply/idP/idP. @@ -4488,7 +4761,7 @@ by apply/In_dom_umfilt; exists v1=>//; apply/andP. Qed. Lemma dom_umfiltF p f z x : - z \in dom (um_filter p (free f x)) = + (z \in dom (um_filter p (free f x))) = (z != x) && (z \in dom (um_filter p f)). Proof. by rewrite omfF /= domF eq_sym; case: eqP. Qed. @@ -4498,16 +4771,62 @@ End FilterDefLemmas. Hint Extern 0 [pcm um_filter _ ?X <= ?X] => apply: umfilt_pleqI : core. -Notation um_filterk p f := (um_filter (p \o fst) f). -Notation um_filterv p f := (um_filter (p \o snd) f). +Abbreviation um_filterk p f := (um_filter (p \o fst) f). +Abbreviation um_filterv p f := (um_filter (p \o snd) f). Arguments In_umfilt [K C V U] p x f _ _. +(* um_filter and range *) + +Section RangeUmfilt. + +(* range of filter is subsequence of range *) +Lemma range_umfilt {K C V} {U : union_map K C V} {p} {f : U} : + range (um_filter p f) = mask (map p (assocs f)) (range f). +Proof. +rewrite /range assocs_umfilt; elim: (assocs f)=>[|[k v] xs IH] //=. +by case: ifP=>//=; rewrite IH. +Qed. + +(* decidable variant *) +Lemma subseq_range_umfilt {K C} {V : eqType} {U : union_map K C V} {p} {f : U} : + subseq (range (um_filter p f)) (range f). +Proof. by rewrite map_subseq // assocs_umfilt filter_subseq. Qed. + +End RangeUmfilt. + Section FilterKLemmas. Variables (K : ordType) (C : pred K) (V : Type) (U : union_map K C V). Implicit Type f : U. Implicit Type p q : pred K. +Lemma umfiltk_subT p f : + {subset dom f <= p} -> + um_filterk p f = f. +Proof. by move=>H; rewrite umfilt_subT //=; case=>k v /In_dom/H. Qed. + +Lemma umfiltv_subT (p : pred V) f : + (forall x, x \In range f -> p x) -> + um_filterv p f = f. +Proof. by move=>H; apply/umfilt_subT; case=>k v /In_range/H. Qed. + +Lemma umfiltk_sub0 p f : + valid f -> + {in dom f, forall k, ~~ p k} -> + um_filterk p f = Unit. +Proof. by move=>W H; rewrite umfilt_sub0 //=; case=>k v /In_dom/H. Qed. + +Lemma umfiltv_sub0 (p : pred V) f : + valid f -> + (forall x, x \In range f -> ~~ p x) -> + um_filterv p f = Unit. +Proof. by move=>W H; apply/umfilt_sub0=>//=; case=>k v /In_range/H. Qed. + +Lemma umfiltk_dpredU f p q : + subpred p (predC q) -> + um_filterk (predU p q) f = um_filterk p f \+ um_filterk q f. +Proof. by move=>H; rewrite umfilt_dpredU // => x /H. Qed. + Lemma dom_umfiltkE p f : dom (um_filterk p f) = filter p (dom f). Proof. apply: ord_sorted_eq=>//=. @@ -4651,11 +4970,11 @@ Lemma umfiltkC1 (f : U) x : Proof. case: (normalP f)=>[->|W]; first by rewrite pfundef free_undef. rewrite [in RHS](umfilt_predC f (pred1 x \o fst)). -rewrite freeUnL; last first. +rewrite freeUnL. - rewrite dom_umfiltE mem_filter. by case: dom_find=>//= v; rewrite eqxx. rewrite (_ : free (um_filterk (pred1 x) f) x = - um_filterk (pred1 x) (free f x)); last first. + um_filterk (pred1 x) (free f x)). - by rewrite umfiltkF /= eqxx. rewrite [in RHS]umfilt_mem0L ?unitL ?validF //. by move=>k v /InF []. @@ -4706,7 +5025,7 @@ Definition map_fun_axiom (K : ordType) (C : pred K) V V' forall x, isSome (omf f x). HB.mixin Record isMapFun (K : ordType) (C : pred K) (V V' : Type) - (U : @union_map K C V) (U' : @union_map K C V') (f : U -> U') & + (U : @union_map K C V) (U' : @union_map K C V') (f : U -> U') & @OmapFun K C V V' U U' f := { mapfun_subproof : map_fun_axiom f}. @@ -4776,10 +5095,273 @@ apply/omf_unit/validEb; case=>W H; split=>// k. by move/In_dom; rewrite (negbTE (H _)). Qed. +Lemma assocs_mf f h : + assocs (f h) = + map (fun x : K * V => (x.1, mfx f x)) (assocs h). +Proof. by rewrite assocs_omf map_pmap; apply: eq_pmap; case=>k v; rewrite mfE. Qed. + End MapFunLemmas. Arguments mfx {K C V V' U U'} _ _ /. +(********************) +(* Inversion lemmas *) +(********************) + +(* for assocs and range *) + +Section Inversion. +Context {K : ordType} {C : pred K} {V : Type} {U : union_map K C V}. +Implicit Types f : U. + +Lemma assocs_nil_inv f : + valid f -> + assocs f = [::] -> + f = Unit. +Proof. by move=>W /assocs0E H; case: H W=>// ->; rewrite valid_undef. Qed. + +Lemma assocs_cons_inv {f} {k v xs} : + assocs f = (k, v) :: xs -> + [/\ (k, v) \In f, + assocs (free f k) = xs & + all (ord k) (dom (free f k))]. +Proof. +move=>E; move: (sorted_assocs f); rewrite E /=. +move/(order_path_min (ssrbool.relpre_trans ordtype.trans))/allPIn=>/= H. +rewrite assocsF domFE /= E /= eqxx /=; split. +- by rewrite -In_assocs E InE; left. +- rewrite -[RHS]filter_predT; apply/eq_In_filter. + by move=>x /H; case: eqP=>// ->; rewrite irr. +rewrite all_filter assocs_dom E /= eqxx /= all_map. +by apply/allPIn=>x /H /= ->; rewrite implybT. +Qed. + +Lemma assocs_cat_inv {f} {xs1 xs2} : + assocs f = xs1 ++ xs2 -> + exists f1 f2, + [/\ f = f1 \+ f2, + assocs f1 = xs1, + assocs f2 = xs2 & + {in dom f1, forall k, all (ord k) (dom f2)}]. +Proof. +move=>E; move: (sorted_assocs f); rewrite E. +move/(sorted_cat (ssrbool.relpre_trans ordtype.trans))=>X. +set h1 := um_filterk [in map fst xs1] f. +set h2 := um_filterk [in map fst xs2] f. +exists h1, h2. +suff [X1 X2] : assocs h1 = xs1 /\ assocs h2 = xs2. +- split=>//; last first. + - by move=>z; rewrite !assocs_dom X1 X2=>/mapPP [x] -> /X A; rewrite all_map. + rewrite -umfiltk_dpredU /=. + - move=>_ /mapPP [x] -> /X/allPIn H. + by apply/mapPP; case=>-[_ z] /= <- /H /=; rewrite irr. + rewrite id_umfiltD // dom_umfiltkE => z; rewrite mem_filter andbC /=. + by rewrite -mem_cat -map_cat -E -assocs_dom andbb. +rewrite !assocs_umfilt E !filter_cat /comp /=. +set s1 := (filter _ xs1 in X in _ /\ X). +set s2 := (filter _ xs2 in X in X /\ _). +rewrite (_ : s1 = [::]) /=. +- apply/hasN_filter/hasPIn; case=>[[k w]] /X/allPIn Y /=. + by case/mapPP=>-[ _ x] /= <- /Y /=; rewrite irr. +rewrite (_ : s2 = [::]) ?cats0. +- apply/hasN_filter/hasPIn; case=>[[k w]]/[swap] /=. + by case/mapPP=>x -> /X/allPIn Y /Y /=; rewrite irr. +rewrite -{3}(filter_predT xs1) -{3}(filter_predT xs2). +by split; apply/eq_In_filter=>x H; apply/mapPP; exists x. +Qed. + +Lemma assocs_rcons_inv {f : U} {xs k v} : + assocs f = rcons xs (k, v) -> + [/\ (k, v) \In f, + assocs (free f k) = xs & + all (ord^~ k) (dom (free f k))]. +Proof. +move=>E; move: (sorted_assocs f); rewrite E /=. +rewrite sorted_rconsE; first by apply: ssrbool.relpre_trans ordtype.trans. +case/andP=>/allPIn /= H _. +rewrite assocsF domFE E filter_rcons /= eqxx /=; split. +- by rewrite -In_assocs E In_rcons; right. +- rewrite -[RHS]filter_predT; apply/eq_In_filter. + by move=>x /H; case: eqP=>// ->; rewrite irr. +rewrite all_filter assocs_dom E map_rcons all_rcons /= eqxx all_map /=. +by apply/allPIn=>x /H /= ->; rewrite implybT. +Qed. + +(* for range *) + +Lemma range_nil_inv {f} : + valid f -> + range f = [::] -> + f = Unit. +Proof. +rewrite /range=>W E; apply/(assocs_nil_inv W). +by case: (assocs f) E. +Qed. + +Lemma range_cons_inv {f} {x xs} : + range f = x :: xs -> + exists k, + [/\ (k, x) \In f, + range (free f k) = xs & + all (ord k) (dom (free f k))]. +Proof. +case/map_cons_inv; case=>k _ [xs'][/[swap] /= ->]. +case/assocs_cons_inv=>H A D <-{xs}; exists k; split=>//. +by rewrite /range A. +Qed. + +Lemma range_cat_inv {f} {xs1 xs2} : + range f = xs1 ++ xs2 -> + exists f1 f2, + [/\ f = f1 \+ f2, + range f1 = xs1, + range f2 = xs2 & + {in dom f1, forall k, all (ord k) (dom f2)}]. +Proof. +case/map_cat_inv=>xs3 [xs4][] /assocs_cat_inv [f1][f2][->{f} H1 H2 H3 <-<-]. +by exists f1, f2; rewrite /range H1 H2. +Qed. + +Lemma range_rcons_inv {f} {xs x} : + range f = rcons xs x -> + exists k, + [/\ (k, x) \In f, + range (free f k) = xs & + all (ord^~ k) (dom (free f k))]. +Proof. +case/map_rcons_inv=>xs' [[k v]][A <-<-{xs x} /=]. +case/assocs_rcons_inv: A=>H A D; exists k; split=>//. +by rewrite /range A. +Qed. + +End Inversion. + +(* some consequences of inversion *) + +Lemma assocs_filterUnL K C V (U : union_map K C V) (f1 f2 : U) : + valid (f1 \+ f2) -> + assocs f1 = filter (fun x => x.1 \in dom f1) + (assocs (f1 \+ f2)). +Proof. +move: {2}(assocs (f1 \+ f2)) (erefl (assocs (f1 \+ f2)))=>x H W. +elim: x f1 f2 W H=>[|[k v] xs IH] f1 f2 W. +- by case/(assocs_nil_inv W)/join0I=>->->; rewrite unitL assocs0. +case/assocs_cons_inv=>/InUn [] H H1 H2; last first. +- move: (dom_inNR W (In_dom H))=>/= Nk. + rewrite (In_eta H) joinCA in W *; rewrite (freeUnR _ Nk) in H1 H2. + by rewrite !assocsPtUn //= (negbTE Nk) -(IH f1 (free f2 k) (validR W) H1). +move: (dom_inNL W (In_dom H))=>/= Nk. +rewrite (In_eta H) -joinA in W *; rewrite (freeUnL _ Nk) in H1 H2. +move: (subset_all (dom_subsetL (validR W)) H2)=>H2'. +rewrite !assocsPtUn ?domPtUnK ?(validRE3 W) //= inE eqxx /=. +congr (_ :: _); rewrite (IH (free f1 k) f2 (validR W) H1). +apply/eq_In_filter; case=>x w /In_assocs/In_dom/(dom_inNR W) /=. +by rewrite domPt !inE (In_cond H) eq_sym /= => /negbTE ->. +Qed. + +Lemma assocs_filterUnR K C V (U : union_map K C V) (f1 f2 : U) : + valid (f1 \+ f2) -> + assocs f2 = filter (fun x => x.1 \in dom f2) + (assocs (f1 \+ f2)). +Proof. by rewrite joinC; apply/assocs_filterUnL. Qed. + +Lemma assocs_maskUn K C V (U : union_map K C V) (f1 f2 : U) : + valid (f1 \+ f2) -> + exists m, + [/\ assocs f1 = mask m (assocs (f1 \+ f2)), + assocs f2 = mask (map negb m) (assocs (f1 \+ f2)) & + size (assocs (f1 \+ f2)) = size m]. +Proof. +move=>W; exists (map (fun x => x.1 \in dom f1) (assocs (f1 \+ f2))). +split; last by rewrite size_map. +- by rewrite -filter_mask; apply: assocs_filterUnL. +rewrite -map_comp -filter_mask (assocs_filterUnR W). +apply: eq_In_filter; case=>x v /In_assocs/In_dom /=. +rewrite domUnE //; case/orP=>/[dup]; last by move/(dom_inNR W)=>->->. +by move/(dom_inNL W)/negbTE=>->->. +Qed. + +Lemma assocs_interleave K C V (U : union_map K C V) (h1 h2 : U) : + valid (h1 \+ h2) -> + interleave (assocs (h1 \+ h2)) + (assocs h1) (assocs h2). +Proof. by move=>W; apply/interleave_mask/assocs_maskUn. Qed. + +Lemma range_interleave K C V (U : union_map K C V) (h1 h2 : U) : + valid (h1 \+ h2) -> + interleave (range (h1 \+ h2)) + (range h1) (range h2). +Proof. +move=>W; case: (assocs_maskUn W)=>m [H1 H2 H3]. +apply/interleave_mask; exists m. +by rewrite /range H1 H2 !map_mask size_map. +Qed. + +Lemma dom_maskUn K C V (U : union_map K C V) (f1 f2 : U) : + valid (f1 \+ f2) -> + exists m, + [/\ dom f1 = mask m (dom (f1 \+ f2)), + dom f2 = mask (map negb m) (dom (f1 \+ f2)) & + size (dom (f1 \+ f2)) = size m]. +Proof. +move=>W; exists (map [dom f1] (dom (f1 \+ f2))); split; last 1 first. +- by rewrite size_map. +- by rewrite -dom_maskUnL. +rewrite -map_comp (dom_maskUnR W); congr (mask _). +apply/eq_in_map=>z; rewrite domUnE //=; case/orP=>/[dup]. +- by move/(dom_inNL W)=>/negbTE ->->. +by move/(dom_inNR W)=>->->. +Qed. + +Lemma dom_interleave K C V (U : union_map K C V) (h1 h2 : U) : + valid (h1 \+ h2) -> + interleave (dom (h1 \+ h2)) + (dom h1) (dom h2). +Proof. by move=>W; apply/interleave_mask/dom_maskUn. Qed. + +(* bigops and interleaving *) + +Lemma map_interleave_seq (U : pcm) T I (r : seq I) + (F : I -> U) (f : U -> seq T) : + (f Unit = [::]) -> + (forall h1 h2, valid (h1 \+ h2) -> + interleave (f (h1 \+ h2)) (f h1) (f h2)) -> + valid (\big[join/Unit]_(i <- r) F i) -> + interleave_seq + (f (\big[join/Unit]_(i <- r) F i)) + [seq f (F i) | i <- r]. +Proof. +move=>X1 X2; elim: r=>[|h r IH]; first by rewrite !big_nil /= X1. +rewrite !big_cons /= => W; exists (f (\big[join/Unit]_(i <- r) F i)); +by [apply/X2/W|apply/IH/(validR W)]. +Qed. + +Section MapInterleaveSeq. +Context {K : ordType} {C : pred K} {V} {U : union_map K C V}. +Context I (r : seq I) (F : I -> U). + +Lemma assocs_interleave_seq : + valid (\big[join/Unit]_(i <- r) F i) -> + interleave_seq + (assocs (\big[join/Unit]_(i <- r) F i)) + [seq assocs (F i) | i <- r]. +Proof. by apply/map_interleave_seq/assocs_interleave/assocs0. Qed. + +Lemma range_interleave_seq : + valid (\big[join/Unit]_(i <- r) F i) -> + interleave_seq + (range (\big[join/Unit]_(i <- r) F i)) + [seq range (F i) | i <- r]. +Proof. by apply/map_interleave_seq/range_interleave/range0. Qed. + +Lemma dom_interleave_seq : + valid (\big[join/Unit]_(i <- r) F i) -> + interleave_seq + (dom (\big[join/Unit]_(i <- r) F i)) + [seq dom (F i) | i <- r]. +Proof. by apply/map_interleave_seq/dom_interleave/dom0. Qed. + +End MapInterleaveSeq. (************************) (* PCM-induced ordering *) @@ -4922,7 +5504,7 @@ move=>V1 E; case X : (valid (x1 \+ y2)); constructor; last first. - case: (prec_domV V1 E) X=>// St _ H; apply: St. by move=>n; rewrite H dom_umfiltk inE; case/andP. move: (umfiltk_dom V1); rewrite E umfiltUn -?E //. -rewrite (eq_in_umfiltk (f:=y2) (p2:=pred0)); last first. +rewrite (eq_in_umfiltk (f:=y2) (p2:=pred0)). - by move=>n; case: validUn X=>// _ _ L _ /(contraL (L _)) /negbTE. by rewrite umfilt_pred0 ?unitR //; rewrite E in V1; rewrite (validE2 V1). Qed. @@ -5043,6 +5625,15 @@ elim: ks a z0=>[|k ks IH] a z0 //=. by case E: (find k f)=>[b|] //; rewrite (find_some E). Qed. +Lemma oevFKD a ks f z0 : + disjoint ks (dom f) -> + oeval a ks f z0 = z0. +Proof. +move=>D. +rewrite oevFK (_ : filter _ _ = [::]) //= -(filter_pred0 ks). +by apply: eq_in_filter=>z Z; apply/idP/idP/disjointPL/Z/D. +Qed. + Lemma oevKF a ks f z0 : oeval a ks f z0 = oeval a ks (um_filter (fun x => x.1 \in ks) f) z0. @@ -5080,6 +5671,30 @@ rewrite oev_umfilt oevFK -filter_predI; congr oeval. by apply: eq_in_filter=>k D /=; case: dom_find. Qed. +Lemma oev_subdom {a ks} {h1 h2 : U} {z0} : + [pcm h1 <= h2] -> + valid h2 -> + {subset ks <= dom h1} -> + oeval a ks h2 z0 = + oeval a ks h1 z0. +Proof. +case=>h -> W S; rewrite -(filter_in ks) !oev_filter ?orNb //. +rewrite pfjoinT //= (umfilt_mem0L (validR W)) ?unitR //. +by move=>k v /In_dom/(dom_inNR W); apply: contra (S _). +Qed. + +Lemma oev_subdomL {a ks} {h1 h2 : U} {z0} : + valid (h1 \+ h2) -> + {subset ks <= dom h1} -> + oeval a ks (h1 \+ h2) z0 = oeval a ks h1 z0. +Proof. by move=>W S; rewrite (oev_subdom _ W S). Qed. + +Lemma oev_subdomR {a ks} {h1 h2 : U} {z0} : + valid (h1 \+ h2) -> + {subset ks <= dom h2} -> + oeval a ks (h1 \+ h2) z0 = oeval a ks h2 z0. +Proof. by move=>W S; rewrite (oev_subdom _ W S). Qed. + Lemma oev_umfiltA a ks p f z0 : oeval a ks (um_filter p f) z0 = oeval (fun r k v => if p (k, v) then a r k v else r) ks f z0. @@ -5120,7 +5735,7 @@ Lemma oevU a k ks v1 v2 f z0 : Proof. move=>X H. have [C' W] : C k /\ valid f by move/In_dom/dom_cond: (X); case: (X). -rewrite [in RHS](_ : f = upd k v2 f); first by apply: oevUE. +rewrite [in RHS](_ : f = upd k v2 f); last by apply: oevUE. apply: umem_eq=>//; first by rewrite validU C' W. case=>k' v'; rewrite InU validU C' W /=. case: ifP=>[/eqP ->|_]; last by split=>//; case. @@ -5196,7 +5811,7 @@ Qed. End OrdEvalDefLemmas. Arguments oev_sub_filter {K C V R U a ks p}. -Notation oevalv a ks f z0 := (oeval (fun r _ => a r) ks f z0). +Abbreviation oevalv a ks f z0 := (oeval (fun r _ => a r) ks f z0). Section OrdEvalRelationalInduction1. Variables (K : ordType) (C : pred K) (V R1 R2 : Type) (U : union_map K C V). @@ -5296,7 +5911,7 @@ rewrite /eval umfiltPtUn W. case: (p (k, v))=>W'; last first. - rewrite oevPtUn //; apply/negP=>/omf_subdom. by rewrite (negbTE (validPtUnD W)). -rewrite domPtUnK //=; last by apply/allP=>x /omf_subdom /H. +rewrite domPtUnK //=; first by apply/allP=>x /omf_subdom /H. by rewrite findPtUn // oevPtUn // (validPtUnD W'). Qed. @@ -5310,7 +5925,7 @@ rewrite /eval umfiltUnPt W. case: (p (k, v))=>W'; last first. - rewrite joinC oevPtUn //; first by rewrite joinC. by apply/negP=>/omf_subdom; rewrite (negbTE (validUnPtD W)). -rewrite domUnPtK //=; last by apply/allP=>x /omf_subdom /H. +rewrite domUnPtK //=; first by apply/allP=>x /omf_subdom /H. rewrite (oev_rconsP _ (v:=v)) // joinC oevPtUn //; first by rewrite joinC. by apply/negP=>/omf_subdom; rewrite (negbTE (validUnPtD W)). Qed. @@ -5322,11 +5937,11 @@ Proof. elim/um_indb: f2=>[||k v f2 IH W' P W H]. - by rewrite join_undef valid_undef. - by rewrite dom0 !unitR eval0. -rewrite -(joinC f2) joinA in W *; rewrite evalUnPt //; last first. +rewrite -(joinC f2) joinA in W *; rewrite evalUnPt //. - apply/allP=>x; rewrite domUn inE (validL W). case/orP=>[/H|]; last by apply: P. by apply; rewrite domPtUn inE joinC W' eq_refl. -rewrite evalUnPt //; last by apply/allP. +rewrite evalUnPt //; first by apply/allP. rewrite (IH (validL W)) // => k1 k2 D1 D2; apply: H D1 _. by rewrite domPtUn inE joinC W' D2 orbT. Qed. @@ -5508,11 +6123,11 @@ have D2 : dom phi2 = dom f1. - apply/domE=>x; rewrite domF D1 inE. by case: eqP=>// ->{x}; rewrite (negbTE (validPtUnD W)). have R2' : range phi2 = dom (free f2 k2). - move/In_eta: (I1) (R)=>E1; rewrite E1 rangePtUnK; last 2 first. + move/In_eta: (I1) (R)=>E1; rewrite E1 rangePtUnK; last 1 first. + - by rewrite {1}E2 domPtUnK //; [rewrite -E2|case]. - by rewrite -E1. - - apply/allP=>x; rewrite domF D1 inE. - by case: eqP=>//= _; apply/allP/A1. - - by rewrite {1}E2 domPtUnK //; [case|rewrite -E2]. + apply/allP=>x; rewrite domF D1 inE. + by case: eqP=>//= _; apply/allP/A1. have {}H x1 w1 x2 w2 t1 t2 : (x1, x2) \In phi2 -> (x1, w1) \In f1 -> (x2, w2) \In free f2 k2 -> P t1 t2 -> P (if p1 (x1, w1) then a1 t1 x1 w1 else t1) @@ -5546,7 +6161,7 @@ have Ck : C k by apply: (validPtUn_cond W). case: ifP=>_; last by apply: oevPtUn_sub=>//; apply: omf_subdom. rewrite oevUn // -(oev_sub_filter (p:=mem [:: k])) ?(domPtK,Ck) //. rewrite -dom_umfiltkE umfiltPtUn /= valid_omfUnR // inE eq_refl. -rewrite umfilt_mem0L ?(inE,pfV,validR W) //=; last first. +rewrite umfilt_mem0L ?(inE,pfV,validR W) //=. - by move=>?? /In_umfiltX [] _ /In_dom Df; rewrite inE; case: eqP Df D=>// ->->. rewrite unitR domPtK Ck /= findPt Ck -frame unitL. rewrite -(oev_sub_filter (p:=mem (dom f))) //. @@ -5569,7 +6184,7 @@ Qed. End EvalFrame. -Notation evalv a p f z0 := (eval (fun r _ => a r) p f z0). +Abbreviation evalv a p f z0 := (eval (fun r _ => a r) p f z0). (************) @@ -5791,24 +6406,30 @@ End CountDefLemmas. (*************************************) Section SideFilter. -Variables (T : eqType) (Us : T -> Type). +Context {T : eqType} {Us : T -> Type}. (* could also be defined as *) (* Definition side_m t : sigT Us -> option (Us t) := *) -(* fun '(Tag tx ux) => *) -(* if t =P tx is ReflectT pf then Some (cast Us pf ux) *) -(* else None. *) -(* but that doesn't reduce to then/else clause *) -(* if t == tx and t != tx, respectively *) -(* The following definition gets that reduction *) +(* fun '(Tag tx ux) => *) +(* if tx =P t is ReflectT pf then Some (etagged (u:=Tag tx ux) pf) *) +(* else None. *) +(* However, that definition doesn't reduce *) +(* even when it's decidable that t == tx or t != tx *) +(* e.g., when t and tx are both concrete values of type T. *) +(* Instead, the user has to build an explicit proof by casing on (tx =P t). *) +(* The following definition gets that reduction automatically *) +(* without casing, and thus leads to better proofs in practice. *) Definition side_m t : sigT Us -> option (Us t) := fun '(Tag tx ux) => - if decP (t =P tx) is left pf then Some (cast Us pf ux) + if decP (tx =P t) is left pf then Some (cast Us pf ux) else None. +Lemma sideqc t x : side_m t (Tag t x) = Some x. +Proof. by rewrite /=; case: decP=>// pf; rewrite eqd. Qed. + Lemma side_ocancel t : ocancel (side_m t) (Tag t). -Proof. by case=>tx vx /=; case: eqP=>//= pf; subst tx; rewrite eqc. Qed. +Proof. by case=>tx vx /=; case: decP=>// ?; subst tx. Qed. End SideFilter. @@ -5843,9 +6464,8 @@ Lemma In_side x (v : Us t) (h : U) : (x, v) \In side_map h <-> (x, Tag t v) \In h. Proof. rewrite side_unlock In_omapX; split=>[|H]; last first. -- by exists (Tag t v)=>//=; case: eqP=>//= ?; rewrite eqc. -case; case=>t' v' /= H; case: eqP=>//= ?; subst t'. -by rewrite eqc; case=><-. +- by exists (Tag t v)=>//=; case: eqP=>//= ?; rewrite eqd. +by case; case=>t' v' /= H; case: decP=>//= ?; subst t'; case=><-. Qed. Lemma side_umfilt p q (h : U) : @@ -5855,7 +6475,7 @@ Lemma side_umfilt p q (h : U) : Proof. move=>H; rewrite side_unlock /um_filter !omap_omap eq_in_omf !omf_omap /=. rewrite /side_m/obind/oapp/=; case=>k; case=>t' v X /=. -by case P : (p _); case: eqP=>//= ?; subst t'; rewrite eqc -H // P. +by case P : (p _); case: decP=>//= ?; subst t'; rewrite -H //= P. Qed. (* if p can only inspect keys *) @@ -5892,14 +6512,14 @@ Proof. by move/In_side/In_dom. Qed. Lemma sidePtE x e : side_map (pts x e) = if C x then - if decP (t =P tag e) is left pf then - pts x (cast Us pf (tagged e)) else Unit + if decP (tag e =P t) is left pf + then pts x (etagged pf) else Unit else undef. Proof. by case: e=>k v; rewrite omfPtE /omfx/=; case: eqP. Qed. Lemma dom_sidePt x e : dom (side_map (pts x e)) = - if C x && (t == tag e) then [:: x] else [::]. + if C x && (tag e == t) then [:: x] else [::]. Proof. rewrite sidePtE; case H : (C x)=>//=; last by rewrite dom_undef. case: eqP=>[pf|] /=; last by rewrite dom0. @@ -5909,7 +6529,7 @@ Qed. Lemma dom_sidePtUn k e h : dom (side_map (pts k e \+ h)) =i [pred x | valid (pts k e \+ h) & - (x == k) && (t == tag e) || (x \in dom (side_map h))]. + (x == k) && (tag e == t) || (x \in dom (side_map h))]. Proof. move=>x; rewrite dom_omfPtUn !inE /omfx/= (andbC (x == k)). by case: e=>t' v /=; case: eqP. @@ -5944,10 +6564,10 @@ Qed. Lemma In_side_fun k (v1 : Us t1) (v2 : Us t2) (h : U) : (k, v1) \In side_map Ut t1 h -> (k, v2) \In side_map Ut t2 h -> - t1 = t2 /\ jmeq Us v1 v2. -Proof. + Tag t1 v1 = Tag t2 v2. +Proof. move/In_side=>H /In_side/(In_fun H) [?]; subst t2. -by move/inj_pair2=>->. +by move/inj_tag=>->. Qed. Lemma dom_sideE k (h : U) : @@ -5958,7 +6578,7 @@ Proof. by case/In_domX=>v1 H1 /In_domX [v2] /(In_side_fun H1) []. Qed. Lemma dom_sideEX k (h : U) : k \in dom (side_map Ut t1 h) -> - k \in dom (side_map Ut t2 h) = (t1 == t2). + (k \in dom (side_map Ut t2 h)) = (t1 == t2). Proof. case/In_dom_sideX=>v H; case: (t1 =P t2)=>[?|N]. - by subst t2; apply/In_dom_sideX; exists v. @@ -6006,9 +6626,8 @@ Lemma In_slice x t (k : Ts t) (v : Us (Tag t k)) h : Proof. rewrite In_omfX; split=>[|H]; last first. - by exists (Tag (Tag t k) v). -case; case; case=>t' k' v' H /=. -case=>?; subst t'=>/inj_pair2 ?; subst k'. -by move/inj_pair2/inj_pair2=><-. +case; case; case=>t' k' v' H [?]; subst t'. +by move/inj_tagK=>?; subst k'=>/inj_tagK/inj_tagK <-. Qed. Lemma In_gather x t (k : Ts t) (v : Us (Tag t k)) h : @@ -6017,9 +6636,8 @@ Lemma In_gather x t (k : Ts t) (v : Us (Tag t k)) h : Proof. rewrite In_omfX; split=>[|H]; last first. - by exists (Tag t (Tag k v)). -case; case=>t' [k' v'] H /=. -case=>?; subst t'=>/inj_pair2 ?; subst k'. -by move/inj_pair2=><-. +case; case=>t' [k' v'] H /= [?]; subst t'. +by move/inj_tagK=>?; subst k'=>/inj_tagK <-. Qed. Lemma gather_slice h : gather (slice h) = h. @@ -6091,7 +6709,7 @@ case=>Vh V D1 D2. rewrite validUnAE valid_graft ?(validL Vh, validR Vh) //=. apply/allP=>x D; apply/In_domX; case; case=>tx vx. case/InUn; first by case/In_umfiltX=>_ /In_dom /(dom_inNLX Vh). -case/In_omapX=>w /In_dom /= H [?]; subst tx=>/inj_pair2 ?; subst w. +case/In_omapX=>w /In_dom /= H [?]; subst tx=>/inj_tag ?; subst w. by move: (D2 _ D H). Qed. @@ -6108,7 +6726,7 @@ have W : valid (graft h t ht) by apply: valid_graft. rewrite /graft pfjoin //=; apply/umem_eq=>//=; first by rewrite pfV2. case=>k v; split=>[|H]. - case/InUn; first by case/In_side/In_umfiltX; rewrite /= eqxx. - by case/In_side/In_omapX=>w H [] /inj_pair2 <-. + by case/In_side/In_omapX=>w H [] /inj_tag <-. apply: InR; first by rewrite pfV2. by apply/In_side/(In_omap _ H). Qed. @@ -6232,7 +6850,7 @@ Lemma dom_invert f : valid (invert f) -> dom (invert f) =i range f. Proof. rewrite /invert/um_foldl/range; case: ifP=>_; last by rewrite valid_undef. elim: (assocs f)=>[|x g IH] /= W k; first by rewrite dom0. -rewrite foldl_init in W *; last by move=>*; rewrite joinAC. +rewrite foldl_init in W *; first by move=>*; rewrite joinAC. by rewrite domUnPt !inE W /= eq_sym IH // (validL W). Qed. @@ -6276,8 +6894,8 @@ Proof. elim/um_indf: f k v=>[||x w f IH W /(order_path_min (@trans K)) P] k v. - by rewrite invert_undef valid_undef. - by rewrite invert0; split=>/In0. -move=>W'; rewrite invertPtUn // !InPtUnE //; last by rewrite -invertPtUn. -rewrite IH; first by split; case=>[[->->]|]; auto. +move=>W'; rewrite invertPtUn // !InPtUnE //; first by rewrite -invertPtUn. +rewrite IH; last by split; case=>[[->->]|]; auto. rewrite !valid_invert rangePtUnK // (validR W) in W' *. by case/and3P: W'=>_ /= /andP [_ ->] /andP [_ ->]. Qed. @@ -6285,7 +6903,7 @@ Qed. Lemma uniq_range_invert f : uniq (range (invert f)). Proof. case: (normalP (invert f))=>[->|W]; first by rewrite range_undef. -rewrite /range map_inj_in_uniq. +rewrite /range map_inj_in_uniq; last first. - by apply: (@map_uniq _ _ fst); rewrite -assocs_dom; apply: uniq_dom. case=>x1 x2 [y1 y] /= H1 H2 E; rewrite {x2}E in H1 *. move/mem_seqP/In_assocs/(In_invert _ _ W): H1=>H1. @@ -6336,6 +6954,12 @@ case: x H=>k v /(In_invert _ _ W)/In_invert; apply. by rewrite valid_invert_idemp. Qed. +Lemma inj_invert (f : U) : um_inj (invert f : U'). +Proof. +move=>k1 k2 v H1 H2; move: (In_valid H1)=>W. +by move/(In_invert _ _ W): H1 H2=>H1 /(In_invert _ _ W)/(In_fun H1). +Qed. + End InvertLaws. Arguments In_invert {K V C C' U U' k v f}. @@ -6380,7 +7004,7 @@ Proof. rewrite /um_comp; elim/um_indf: f=>[||k v f IH W P] x. - by rewrite umfoldl_undef dom_undef. - by rewrite umfoldl0 dom0. -rewrite umfoldlUn_frame //; last first. +rewrite umfoldlUn_frame //. - by move=>*; case: (find _ _)=>// a; rewrite joinA. rewrite unitR umfoldlPt (validPtUn_cond W). case E : (find v g)=>[b|]; last first. @@ -6395,7 +7019,7 @@ Proof. rewrite /um_comp; elim/um_indf: f=>[||k v f IH W P]. - by rewrite umfoldl_undef !valid_undef. - by rewrite umfoldl0 !valid_unit. -rewrite umfoldlUn_frame //; last first. +rewrite umfoldlUn_frame //. - by move=>*; case: (find _ _)=>// a; rewrite joinA. rewrite unitR W umfoldlPt (validPtUn_cond W). case: (find v g)=>[a|]; last by rewrite unitL IH (validR W). @@ -6487,7 +7111,7 @@ split=>[H|[W][k'][]]. elim/um_indf: f H=>[||x w f IH P W]. - by rewrite umcomp_fundef=>/In_undef. - by rewrite umcompf0=>/In0. - rewrite /um_comp umfoldlUn_frame //; last first. + rewrite /um_comp umfoldlUn_frame //. - by move=>*; case: (find _ _)=>// a; rewrite joinA. rewrite unitR !umfoldlPt; case: ifP=>C; last first. - by rewrite undef_join=>/In_undef. @@ -6632,6 +7256,14 @@ Qed. Lemma umallbF p k f : um_allb p f -> um_allb p (free f k). Proof. by move/umallbP=>H; apply/umallbP=>kv /InF [_ _ /H]. Qed. +Lemma eq_in_umallb p1 p2 f : + (forall kv, kv \In f -> p1 kv = p2 kv) -> + um_allb p1 f = um_allb p2 f. +Proof. +move=>H. +by apply/umallbP/umallbP=>X z /[dup] Z /X; rewrite (H _ Z). +Qed. + End MapAllDecidable. @@ -6891,7 +7523,7 @@ Qed. Lemma big_domUnE (xs : seq I) a : valid (\big[join/Unit]_(i <- xs) f i) -> - a \in dom (\big[join/Unit]_(i <- xs) f i) = + (a \in dom (\big[join/Unit]_(i <- xs) f i)) = has (fun i => a \in dom (f i)) xs. Proof. by move=>V; rewrite big_domUn inE V. Qed. @@ -6905,8 +7537,8 @@ Lemma big_validV2I (xs : seq I) : Proof. elim: xs=>[|x xs IH] /=; first by rewrite big_nil valid_unit. case=>X Uq H1 H2; rewrite big_cons validUnAE. -rewrite H1 /=; last by rewrite InE; left. -rewrite IH //=; last 2 first. +rewrite H1 /=; first by rewrite InE; left. +rewrite IH //=. - by move=>i Xi; apply: H1; rewrite InE; right. - by move=>i j Xi Xj; apply: H2; rewrite InE; right. apply/allP=>a /=; apply: contraL=>Dx; apply/negP. @@ -6935,7 +7567,7 @@ Proof. elim: xs=>[|x xs IH /[swap]] //; rewrite big_cons InE. case=>[<-{x}|Xi] V E; first by rewrite findUnL // (find_some E). rewrite findUnR // big_domUnE ?(validR V) //=. -rewrite ifT; first by apply: IH (validR V) Xi E. +rewrite ifT; last by apply: IH (validR V) Xi E. by apply/hasPIn; exists i=>//; apply: find_some E. Qed. @@ -6948,7 +7580,7 @@ Proof. elim: xs v=>[|y xs IH] v //=; rewrite big_cons InE. case=>[->|Xi] Da /[dup]/In_find/In_valid V; first by rewrite findUnL // Da. rewrite findUnR // big_domUnE ?(validR V) //=. -by rewrite ifT; [apply: IH|apply/hasPIn; exists i]. +by rewrite ifT; [apply/hasPIn; exists i|apply: IH]. Qed. Lemma big_find_someX (xs : seq I) a v : @@ -7177,3 +7809,256 @@ Qed. End OMapBig. + + +(******************************************) +(* making a map from a key-value sequence *) +(******************************************) + +Section KVseq. +Context {K : ordType} {C : pred K} {V : Type}. +Context {U : union_map K C V}. + +Definition kvseq (xs : seq (K * V)) : U := + foldl (fun f kv => pts kv.1 kv.2 \+ f) Unit xs. + +Lemma kvseq_nil : kvseq [::] = Unit. +Proof. by []. Qed. + +Lemma kvseq_cons k v xs : + kvseq ((k, v) :: xs) = pts k v \+ kvseq xs. +Proof. by rewrite /kvseq /= unitR foldl_join joinC. Qed. + +Lemma kvseq_cat xs1 xs2 : + kvseq (xs1 ++ xs2) = kvseq xs1 \+ kvseq xs2. +Proof. +elim: xs1=>[|[k1 v1] xs1 IH] /=. +- by rewrite kvseq_nil unitL. +by rewrite !kvseq_cons IH joinA. +Qed. + +Lemma kvseq_helper' (xs : seq (K * V)) : + valid (kvseq xs) = + uniq (map fst xs) && all C (map fst xs) /\ + (valid (kvseq xs) -> + dom (kvseq xs) =i map fst xs). +Proof. +rewrite /kvseq /=; elim: xs=>[|x xs IH] /=. +- by rewrite valid_unit dom0. +case: IH=>IH1 IH2; split; last first. +- rewrite unitR foldl_join=>W z. + by rewrite domUnPt !inE W eq_sym IH2 // (validL W). +rewrite unitR foldl_join validUnPt -!andbA. +case: (C x.1)=>//=; last by rewrite !andbF. +rewrite -IH1; case W: (valid _)=>//=; last by rewrite !andbF. +by rewrite IH2 // andbT. +Qed. + +Lemma valid_kvseq (xs : seq (K * V)) : + valid (kvseq xs) = + uniq (map fst xs) && all C (map fst xs). +Proof. by case: (kvseq_helper' xs). Qed. + +Lemma kvseq_uniq (xs : seq (K * V)) : + valid (kvseq xs) -> + uniq (map fst xs). +Proof. by rewrite valid_kvseq=>/andP []. Qed. + +Lemma kvseq_all (xs : seq (K * V)) : + valid (kvseq xs) -> + all C (map fst xs). +Proof. by rewrite valid_kvseq=>/andP []. Qed. + +Lemma dom_kvseq (xs : seq (K * V)) : + valid (kvseq xs) -> + dom (kvseq xs) =i map fst xs. +Proof. by case: (kvseq_helper' xs). Qed. + +Lemma dom_kvseqE (xs : seq (K * V)) : + valid (kvseq xs) -> + dom (kvseq xs) = sort ord (map fst xs). +Proof. +move=>W; apply: ord_sorted_eq; last 1 first. +- by move=>z; rewrite dom_kvseq // mem_sort. +- by rewrite sorted_dom. +- rewrite -sort_lt_le ?(kvseq_uniq W) //. + apply: sort_sorted_in_lt. + - by apply: irr. + - by move=>x y; case: ordP. + - by apply: trans. + by rewrite (kvseq_uniq W). +move=>x y /mem_seqP/In_map [x' -> X] /mem_seqP/In_map [y' -> Y]. +by case: ordP=>//=; rewrite ?orbT. +Qed. + +Lemma size_dom_kvseq (xs : seq (K * V)) : + valid (kvseq xs) -> + size (dom (kvseq xs)) = size xs. +Proof. by move=>W; rewrite dom_kvseqE // size_sort size_map. Qed. + +Lemma In_kvseq (xs : seq (K * V)) {kv} : + valid (kvseq xs) -> + kv \In kvseq xs <-> kv \In xs. +Proof. +elim: xs=>[|[k v] xs IH] /=; first by split=>// /In0. +rewrite /kvseq /= unitR foldl_join -/(kvseq _) InE. +move=>W; split. +- by case/InUn; [move/(IH (validL W)); right|case/InPt; left]. +case=>[->|H]. +- by apply/InR/In_condPt/validUnPt_cond/W. +by apply/InL/IH/H/(validL W). +Qed. + +Lemma assocs_kvseq (xs : seq (K * V)) : + valid (kvseq xs) -> + assocs (kvseq xs) = sort (relpre fst ord) xs. +Proof. +move=>W; apply: (inj_map (f:=Some)); first by move=>?? []. +set f := fun x => if find x (kvseq xs) is Some t + then Some (x, t) else None. +rewrite (_ : map Some (assocs (kvseq xs)) = map f (dom (kvseq xs))). +- rewrite assocs_dom -map_comp; apply/eq_In_map; rewrite /f /=. + by case=>k v /In_assocs/In_findE ->. +rewrite (_ : map Some (sort (relpre fst ord) xs) = map f (sort ord (map fst xs))). +- rewrite sort_map -map_comp; apply/eq_In_map; rewrite /f /=. + by case=>k v /In_sort/(In_kvseq W)/In_findE ->. +by rewrite dom_kvseqE. +Qed. + +Lemma kvseq_pperm (xs ys : seq (K * V)) : + perm xs ys -> + kvseq xs = kvseq ys. +Proof. +move=>P; have : valid (kvseq xs) = valid (kvseq ys). +- have {}P : perm_eq (map fst xs) (map fst ys). + - by apply/perm_eq_perm/pperm_map. + by rewrite !valid_kvseq (perm_uniq P) (perm_all _ P). +case: (normalP (kvseq ys))=>[->|Vy Vx]. +- by move/negbT/invalidE. +apply/umem_eq=>//; case=>k v; rewrite !In_kvseq //. +by split; apply/pperm_in=>//; apply/pperm_sym. +Qed. + +Lemma kvseq_assocs h : + valid h -> + kvseq (assocs h) = h. +Proof. +apply/(um_indf (P:=fun h=>valid h -> kvseq (assocs h) = h)): h. +- by rewrite valid_undef. +- by rewrite assocs0 kvseq_nil. +move=>k v f IH W /(order_path_min trans) A _. +by rewrite assocsPtUn // kvseq_cons IH // (validR W). +Qed. + +End KVseq. + +Section KVseq2. +Context {K : ordType} {C : pred K} {V V' : Type}. +Context {U : union_map K C V} {U' : union_map K C V'}. +Implicit Type xs : seq (K * V). + +(* validity and pmap *) + +Lemma valid_kvseq_pmap_inj f xs : + (forall x y v, x \In xs -> f x = Some (y, v) -> C x.1 -> C y) -> + (forall x1 x2 y v1 v2, x1 \In xs -> x2 \In xs -> + f x1 = Some (y, v1) -> f x2 = Some (y, v2) -> x1 = x2) -> + valid (kvseq xs : U) -> + valid (kvseq (pmap f xs) : U'). +Proof. +move=>Cp I; rewrite !valid_kvseq; case/andP=>H1 H2. +apply/andP; split; last first. +- apply/allP=>x /mapPP [[_ v]] /= <- /In_pmap [z] E Z. + by apply: Cp (Z) E _; apply/(allP H2)/mapPP; exists z. +elim: xs Cp I H1 {H2}=>[|x xs IH] Cp I //= /andP [H1 H2]. +rewrite /oapp; case Ex : (f x)=>[[y vx]|] /=; last first. +- by apply: IH H2=>[????|???????]; [apply:Cp|apply:I]; right. +apply/andP; split; last first. +- by apply: IH H2=>[????|???????]; [apply:Cp|apply:I]; right. +apply: contra H1. +case/mapPP=>-[_ vz] /= <- /In_pmap [z Ez] Z. +have E : x = z by apply: I Ex Ez; [left|right]. +by subst z; apply/mapPP; exists x. +Qed. + +Lemma valid_kvseq_map_inj f xs : + (forall x, x \In xs -> C x.1 -> C (f x).1) -> + (forall x1 x2, x1 \In xs -> x2 \In xs -> + (f x1).1 = (f x2).1 -> x1 = x2) -> + valid (kvseq xs : U) -> + valid (kvseq (map f xs) : U'). +Proof. +move=>Cp I W; rewrite map_pmap; apply/valid_kvseq_pmap_inj/W. +- by move=>x y v X [E] /(Cp _ X); rewrite E. +move=>x1 x2 y v1 v2 X1 X2 [E1][E2]. +by apply: (I _ _ X1 X2); rewrite E1 E2. +Qed. + +(* map_fun *) + +Lemma mf_kvseq (f : map_fun U U') xs : + f (kvseq xs) = + kvseq (map (fun x => (x.1, mfx f x)) xs). +Proof. +set F := fun x => (x.1, mfx f x). +have E : map fst xs = map fst (map F xs). +- by rewrite -map_comp; apply/eq_In_map. +have : valid (kvseq (map F xs) : U') = valid (kvseq xs : U). +- by rewrite !valid_kvseq -E. +case: (normalP (kvseq xs))=>[|W _]. +- by move=>-> /negbT/invalidE ->; rewrite pfundef. +rewrite -[LHS]kvseq_assocs ?pfVE // assocs_mf assocs_kvseq //. +by apply/kvseq_pperm/pperm_map/pperm_sort. +Qed. + +(* special case for omap \o Some, as then *) +(* applying mf_kvseq requires some glue *) +Lemma omap_some_kvseq (f : K * V -> V') xs : + omap (Some \o f) (kvseq xs : U) = + kvseq (map (fun x => (x.1, f x)) xs) :> U'. +Proof. +set F : omap_fun U U' := omap (Some \o f). +have m_pf : map_fun_axiom F by []. +have pcm_pf : binorm_pcm_morph_axiom F. +- by move=>x y; rewrite -omfUn_some // pfVE. +set m := isMapFun.Build _ _ _ _ _ _ F m_pf. +set pcm := isBinorm_PCM_morphism.Build _ _ _ pcm_pf. +by rewrite -(mf_kvseq (MapFun.pack_ pcm m)). +Qed. + +(* alternative name for omap_some_kvseq *) +Lemma mapv_kvseq (f : V -> V') xs : + mapv f (kvseq xs : U) = + kvseq (map (fun x => (x.1, f x.2)) xs) :> U'. +Proof. exact: omap_some_kvseq. Qed. + +Lemma kvseq_assocs_mf (f : map_fun U U') h : + valid h -> + f h = + kvseq (map (fun x => (x.1, mfx f x)) (assocs h)). +Proof. by move=>W; rewrite -mf_kvseq kvseq_assocs. Qed. + +(* omap_fun *) +(* requires extra condition on validity *) + +Lemma omf_kvseq (f : omap_fun U U') xs : + valid (kvseq xs : U) -> + f (kvseq xs) = + kvseq (pmap (fun x => ssrfun.omap (pair x.1) (omf f x)) xs). +Proof. +move=>W; rewrite -[LHS]kvseq_assocs ?pfVE // assocs_omf assocs_kvseq //. +by apply/kvseq_pperm/pperm_pmap/pperm_sort. +Qed. + +Lemma kvseq_assocs_omf (f : omap_fun U U') h : + valid h -> + f h = + kvseq (pmap (fun x => ssrfun.omap (pair x.1) (omf f x)) + (assocs h)). +Proof. by move=>W; rewrite -assocs_omf kvseq_assocs ?pfVI. Qed. + +End KVseq2. + + + + diff --git a/post-generate.sh b/post-generate.sh new file mode 100755 index 0000000..5faed7e --- /dev/null +++ b/post-generate.sh @@ -0,0 +1,77 @@ +#!/usr/bin/env bash + +# Fix the Rocq dependencies that coq-community/templates cannot currently +# express. Run this after regenerating the repository files from meta.yml. + +set -euo pipefail + +script_dir=$(CDPATH= cd -- "$(dirname -- "$0")" && pwd) +opam_file=${1:-"${script_dir}/coq-fcsl-pcm.opam"} + +if [[ ! -f ${opam_file} ]]; then + echo "error: opam file not found: ${opam_file}" >&2 + exit 1 +fi + +dependency_count() { + local package=$1 + awk -v package="${package}" ' + $0 ~ "^[[:space:]]*\"" package "\"[[:space:]]*($|\\{)" { + count++ + } + END { + print count + 0 + } + ' "${opam_file}" +} + +coq_count=$(dependency_count coq) +rocq_core_count=$(dependency_count rocq-core) +rocq_stdlib_count=$(dependency_count rocq-stdlib) + +if (( coq_count == 0 && rocq_core_count == 1 && rocq_stdlib_count == 1 )); then + echo "Rocq dependencies are already patched in ${opam_file}" + exit 0 +fi + +if (( coq_count != 1 || rocq_core_count != 0 || rocq_stdlib_count != 0 )); then + echo "error: unexpected Rocq dependency layout in ${opam_file}" >&2 + echo " expected one coq dependency and no rocq-core/rocq-stdlib dependencies" >&2 + echo " found coq=${coq_count}, rocq-core=${rocq_core_count}, rocq-stdlib=${rocq_stdlib_count}" >&2 + exit 1 +fi + +temporary_file=$(mktemp "${opam_file}.tmp.XXXXXX") +trap 'rm -f -- "${temporary_file}"' EXIT +cp -p -- "${opam_file}" "${temporary_file}" + +awk ' + /^[[:space:]]*"coq"[[:space:]]*($|\{)/ { + dependency = $0 + sub(/"coq"/, "\"rocq-core\"", dependency) + print dependency + + match($0, /^[[:space:]]*/) + indentation = substr($0, RSTART, RLENGTH) + print indentation "\"rocq-stdlib\"" + patched++ + next + } + { + print + } + END { + if (patched != 1) { + exit 1 + } + } +' "${opam_file}" > "${temporary_file}" + +if command -v opam >/dev/null 2>&1; then + opam lint "${temporary_file}" +fi + +mv -- "${temporary_file}" "${opam_file}" +trap - EXIT + +echo "Patched ${opam_file}: coq -> rocq-core; added rocq-stdlib"