diff --git a/.gitignore b/.gitignore index 2b00553..77aa892 100644 --- a/.gitignore +++ b/.gitignore @@ -7,6 +7,8 @@ // Coq Files CoqMakefile.conf *.vo +*.vok +*.vos *.glob *.aux *.d diff --git a/.gitmodules b/.gitmodules index 9c8d76a..3c778e0 100644 --- a/.gitmodules +++ b/.gitmodules @@ -3,4 +3,7 @@ url = https://github.com/tebbi/coqdocjs.git [submodule "external/smpl"] path = external/smpl - url = https://github.com/sigurdschneider/smpl.git + url = https://github.com/uds-psl/smpl.git +[submodule "external/base"] + path = external/base + url = https://github.com/haansn08/base-library.git diff --git a/_CoqProject b/_CoqProject index 7859249..2e9d61f 100644 --- a/_CoqProject +++ b/_CoqProject @@ -1,9 +1,8 @@ --R external/base/ "Shared" +-R external/base/ "PslBase" -R external/smpl/theories/ smpl -I external/smpl/src/ -R theories/ "ProgrammingTuringMachines" --install none COQDOCFLAGS = "--charset utf-8 --parse-comments --with-header ./website/header.html --with-footer ./website/footer.html --index indexpage --coqlib https://coq.inria.fr/distrib/V8.8.1/stdlib/" # Basics diff --git a/external/base b/external/base new file mode 160000 index 0000000..0fea72a --- /dev/null +++ b/external/base @@ -0,0 +1 @@ +Subproject commit 0fea72a935443656d7effd0c50ceaaccdb04e4de diff --git a/external/base/.gitignore b/external/base/.gitignore deleted file mode 100644 index d0b67e2..0000000 --- a/external/base/.gitignore +++ /dev/null @@ -1,70 +0,0 @@ -# Created by http://www.gitignore.io - -### LaTeX ### -*.acn -*.acr -*.alg -*.aux -*.bbl -*.blg -*.dvi -*.fdb_latexmk -*.glg -*.glo -*.gls -*.idx -*.ilg -*.ind -*.ist -*.lof -*.log -*.lot -*.maf -*.mtc -*.mtc0 -*.nav -*.nlo -*.out -*.pdfsync -*.ps -*.snm -*.synctex.gz -*.toc -*.vrb -*.xdy -*.tdo - -### Coq ### -*.vo -*.glob -*.v.d -/.coq-native/ -Makefile.coq -CoqMakefile.conf - -### Emacs ### -# -*- mode: gitignore; -*- -*~ -\#*\# -/.emacs.desktop -/.emacs.desktop.lock -*.elc -auto-save-list -tramp -.\#* - -# Org-mode -.org-id-locations -*_archive - -# flymake-mode -*_flymake.* - -# eshell files -/eshell/history -/eshell/lastdir - -# elpa packages -/elpa/ - -*.pdf diff --git a/external/base/Base.v b/external/base/Base.v deleted file mode 100644 index 49ea3ae..0000000 --- a/external/base/Base.v +++ /dev/null @@ -1,17 +0,0 @@ -(** * Base Library for ICL - - - Version: 3 October 2016 - - Author: Gert Smolka, Saarland University - - Acknowlegments: Sigurd Schneider, Dominik Kirst, Yannick Forster, Fabian Kunze, Maximilian Wuttke - *) - -Require Export - Prelim - Numbers - BaseLists - Lists.Cardinality - Dupfree - Filter - Position - Power - Removal. \ No newline at end of file diff --git a/external/base/Bijection.v b/external/base/Bijection.v deleted file mode 100644 index 86b47a7..0000000 --- a/external/base/Bijection.v +++ /dev/null @@ -1,52 +0,0 @@ -(** * Bijective functions *) - -(* Author: Maximilian Wuttke *) - - -Require Import Shared.Base. - - -Section Bijection. - Variable X Y : Type. - - (* - * f - * ------> - * X Y - * <------ - * g - *) - - Definition left_inverse (f : X -> Y) (g : Y -> X) := forall x : X, g (f x) = x. - Definition right_inverse (f : X -> Y) (g : Y -> X) := forall y : Y, f (g y) = y. - Definition inverse (f : X -> Y) (g : Y -> X) := left_inverse f g /\ right_inverse f g. - - Definition injective (f : X -> Y) := - forall x y, f x = f y -> x = y. - - Lemma left_inv_inj (f : X -> Y) (g : Y -> X) : left_inverse f g -> injective f. - Proof. - intros HInv. hnf in *. intros x1 x2 Heq. - enough (g (f x1) = g (f x2)) as L by now rewrite !HInv in L. - f_equal. assumption. - Qed. - - Definition surjective (f : X -> Y) := - forall y, exists x, f x = y. - - Lemma right_inv_surjective f g : - right_inverse f g -> surjective f. - Proof. intros HInv. hnf. eauto. Qed. - - Definition bijective (f : X -> Y) := - injective f /\ surjective f. - - Lemma inverse_bijective f g : - inverse f g -> bijective f. - Proof. - intros (HInv1&HInv2). hnf. split. - - eapply left_inv_inj; eauto. - - eapply right_inv_surjective; eauto. - Qed. - -End Bijection. diff --git a/external/base/EqDec.v b/external/base/EqDec.v deleted file mode 100644 index a995130..0000000 --- a/external/base/EqDec.v +++ /dev/null @@ -1,236 +0,0 @@ -Require Import Prelim. - -(** * Decidable predicates *) - - -Definition dec (X: Prop) : Type := {X} + {~ X}. - -Coercion dec2bool P (d: dec P) := if d then true else false. - -Existing Class dec. - -Definition Dec (X: Prop) (d: dec X) : dec X := d. -Arguments Dec X {d}. - - -Lemma Dec_reflect (X: Prop) (d: dec X) : - Dec X <-> X. -Proof. - destruct d as [A|A]; cbn; tauto. -Qed. - -Notation Decb X := (dec2bool (Dec X)). - -Lemma Dec_reflect_eq (X Y: Prop) (d: dec X) (e: dec Y) : - Decb X = Decb Y <-> (X <-> Y). -Proof. - destruct d as [D|D], e as [E|E]; cbn; intuition congruence. -Qed. - -Lemma Dec_auto (X: Prop) (d: dec X) : - X -> Dec X. -Proof. - destruct d as [A|A]; cbn; tauto. -Qed. - -Lemma Dec_auto_not (X: Prop) (d: dec X) : - ~ X -> ~ Dec X. -Proof. - destruct d as [A|A]; cbn; tauto. -Qed. - -Hint Resolve Dec_auto Dec_auto_not. -Hint Extern 4 => (* Improves type class inference *) -match goal with - | [ |- dec ((fun _ => _) _) ] => cbn -end : typeclass_instances. - -Tactic Notation "decide" constr(p) := - destruct (Dec p). -Tactic Notation "decide" constr(p) "as" simple_intropattern(i) := - destruct (Dec p) as i. -Tactic Notation "decide" "_" := - destruct (Dec _). -Tactic Notation "have" constr(E) := let X := fresh "E" in decide E as [X|X]; subst; try congruence; try omega; clear X. - -Lemma Dec_true P {H : dec P} : dec2bool (Dec P) = true -> P. -Proof. - decide P; cbv in *; firstorder. -Qed. - -Lemma Dec_false P {H : dec P} : dec2bool (Dec P) = false -> ~P. -Proof. - decide P; cbv in *; firstorder. -Qed. - -Lemma Dec_true' (P : Prop) (d : dec P) : P -> Decb P = true. -Proof. intros H. decide P; cbn; tauto. Qed. - -Lemma Dec_false' (P : Prop) (d : dec P) : (~ P) -> Decb P = false. -Proof. intros H. decide P; cbn; tauto. Qed. - -Hint Extern 4 => -match goal with - [ H : dec2bool (Dec ?P) = true |- _ ] => apply Dec_true in H -| [ H : dec2bool (Dec ?P) = false |- _ ] => apply Dec_false in H -| [ |- dec2bool (Dec ?P) = true] => apply Dec_true' -| [ |- dec2bool (Dec ?P) = false] => apply Dec_false' -end. - -(** Decided propositions behave classically *) - -Lemma dec_DN X : - dec X -> ~~ X -> X. -Proof. - unfold dec; tauto. -Qed. - -Lemma dec_DM_and X Y : - dec X -> dec Y -> ~ (X /\ Y) -> ~ X \/ ~ Y. -Proof. - unfold dec; tauto. -Qed. - -Lemma dec_DM_impl X Y : - dec X -> dec Y -> ~ (X -> Y) -> X /\ ~ Y. -Proof. - unfold dec; tauto. -Qed. - -(** Propagation rules for decisions *) - -Fact dec_transfer P Q : - P <-> Q -> dec P -> dec Q. -Proof. - unfold dec. tauto. -Defined. - -Instance bool_dec (b: bool) : - dec b. -Proof. - unfold dec. destruct b; cbn; auto. -Defined. - -Instance True_dec : - dec True. -Proof. - unfold dec; tauto. -Defined. - -Instance False_dec : - dec False. -Proof. - unfold dec; tauto. -Defined. - -Instance impl_dec (X Y : Prop) : - dec X -> dec Y -> dec (X -> Y). -Proof. - unfold dec; tauto. -Defined. - -Instance and_dec (X Y : Prop) : - dec X -> dec Y -> dec (X /\ Y). -Proof. - unfold dec; tauto. -Defined. - -Instance or_dec (X Y : Prop) : - dec X -> dec Y -> dec (X \/ Y). -Proof. - unfold dec; tauto. -Defined. - -(* Coq standard modules make "not" and "iff" opaque for type class inference, - can be seen with Print HintDb typeclass_instances. *) - -Instance not_dec (X : Prop) : - dec X -> dec (~ X). -Proof. - unfold not. auto. -Defined. - -Instance iff_dec (X Y : Prop) : - dec X -> dec Y -> dec (X <-> Y). -Proof. - unfold iff. auto. -Defined. - -(** ** Discrete types *) - -Notation "'eq_dec' X" := (forall x y : X, dec (x=y)) (at level 70). - -Structure eqType := - EqType { - eqType_X :> Type; - eqType_dec : eq_dec eqType_X - }. - -Arguments EqType X {_} : rename. - -Canonical Structure eqType_CS X (A: eq_dec X) := EqType X. - -Existing Instance eqType_dec. - -(** Print the base type of [eqType] in the Canonical Structure. *) -Arguments eqType_CS (X) {_}. - -Instance unit_eq_dec : - eq_dec unit. -Proof. - unfold dec. decide equality. -Defined. - -Instance bool_eq_dec : - eq_dec bool. -Proof. - unfold dec. decide equality. -Defined. - -Instance nat_eq_dec : - eq_dec nat. -Proof. - unfold dec. decide equality. -Defined. - -Instance prod_eq_dec X Y : - eq_dec X -> eq_dec Y -> eq_dec (X * Y). -Proof. - unfold dec. decide equality. -Defined. - -Instance list_eq_dec X : - eq_dec X -> eq_dec (list X). -Proof. - unfold dec. decide equality. -Defined. - -Instance sum_eq_dec X Y : - eq_dec X -> eq_dec Y -> eq_dec (X + Y). -Proof. - unfold dec. decide equality. -Defined. - -Instance option_eq_dec X : - eq_dec X -> eq_dec (option X). -Proof. - unfold dec. decide equality. -Defined. - -Instance Empty_set_eq_dec: - eq_dec Empty_set. -Proof. - unfold dec. decide equality. -Defined. - -Instance True_eq_dec: - eq_dec True. -Proof. - intros x y. destruct x,y. now left. -Defined. - -Instance False_eq_dec: - eq_dec False. -Proof. - intros []. -Defined. \ No newline at end of file diff --git a/external/base/FCI.v b/external/base/FCI.v deleted file mode 100644 index 99b63f7..0000000 --- a/external/base/FCI.v +++ /dev/null @@ -1,158 +0,0 @@ -Require Import Lists.Cardinality Numbers. - -(** ** Finite inductive predicates *) - -Section Fip. - Variables (X: eqType) (sigma: list X -> X -> bool) (R: list X). - - Inductive fip : X -> Prop := - | fip_intro A x : (forall x, x el A -> fip x) -> sigma A x -> x el R -> fip x. - - Definition fip_monotone := forall A B x, A <<= B -> sigma A x -> sigma B x. - Definition fip_closed A := forall x, x el R -> sigma A x -> x el A. - - Lemma fip_least A x : - fip_monotone -> fip_closed A -> fip x -> x el A. - Proof. - intros C D. induction 1 as [B x _ IH F G]. - apply (D _ G). revert F. apply C. exact IH. - Qed. - - Fixpoint fip_it n A : list X := - match n, find (fun x => Dec (~ x el A /\ sigma A x)) R with - | S n', Some x => fip_it n' (x::A) - | _, _ => A - end. - - Lemma fip_it_sound n A : - inclp A fip -> inclp (fip_it n A) fip. - Proof. - revert A; induction n as [|n IH]; cbn; intros A H. - - exact H. - - destruct (find _ R) as[x|] eqn:E. - (* New: Remember equation, apply find specs to it, elim Dec _ = true *) - + apply find_some in E as [H1 (H2&H3) % Dec_true]. - apply IH. intros z [<-|H4]. - * apply fip_intro with (A:= A); auto. - * apply H, H4. - + apply H. - Qed. - - Lemma fip_it_closed n A : - A <<= R -> card R <= n + card A -> fip_closed (fip_it n A). - Proof. - revert A. induction n as [|n IH]; cbn; intros A H H1. - - enough (A === R) as (H2&H3) by (hnf; auto). - apply card_or in H as [H|H]. exact H. omega. - - destruct (find _ R) eqn:E. - + apply find_some in E as [H2 (H3&H4) % Dec_true]. apply IH. now auto. - rewrite card_cons'. omega. auto. - + intros x H2 H3. apply dec_DN. now auto. - apply find_none with (x := x) in E; auto. - apply Dec_false in E; auto. - Qed. - - Theorem fip_dec x : - fip_monotone -> dec (fip x). - Proof. - intros D. - apply dec_transfer with (P:= x el fip_it (card R) nil); [ | now auto]. - split. - - revert x. apply fip_it_sound. hnf. auto. - - apply (fip_least D). apply fip_it_closed. now auto. omega. - Qed. - -End Fip. - -(** ** Finite closure iteration *) - -Module FCI. -Section FCI. - Variables (X: eqType) (sigma: list X -> X -> bool) (R: list X). - - Lemma pick (A : list X) : - { x | x el R /\ sigma A x /\ ~ x el A } + { forall x, x el R -> sigma A x -> x el A }. - Proof. - destruct (cfind R (fun x => sigma A x /\ ~ x el A)) as [E|E]. - - auto. - - right. intros x F G. - decide (x el A). assumption. exfalso. - eapply E; eauto. - Qed. - - Definition F (A : list X) : list X. - destruct (pick A) as [[x _]|_]. - - exact (x::A). - - exact A. - Defined. - - Definition C := it F (card R) nil. - - Lemma it_incl n : - it F n nil <<= R. - Proof. - apply it_ind. now auto. - intros A E. unfold F. - destruct (pick A) as [[x G]|G]; intuition. - Qed. - - Lemma incl : - C <<= R. - Proof. - apply it_incl. - Qed. - - Lemma ind p : - (forall A x, inclp A p -> x el R -> sigma A x -> p x) -> inclp C p. - Proof. - intros B. unfold C. apply it_ind. - + intros x []. - + intros D G x. unfold F. - destruct (pick D) as [[y E]|E]. - * intros [[]|]; intuition; eauto. - * intuition. - Qed. - - Lemma fp : - F C = C. - Proof. - pose (size (A : list X) := card R - card A). - replace C with (it F (size nil) nil). - - apply it_fp. intros n. cbn. - set (J:= it F n nil). unfold FP, F. - destruct (pick J) as [[x B]|B]. - + right. - assert (G: card J < card (x :: J)). - { apply card_lt with (x:=x); intuition. } - assert (H: card (x :: J) <= card R). - { apply card_le, incl_cons. apply B. apply it_incl. } - unfold size. omega. - + auto. - - unfold C, size. f_equal. change (card nil) with 0. omega. - Qed. - - Lemma closure x : - x el R -> sigma C x -> x el C. - Proof. - assert (A2:= fp). - unfold F in A2. - destruct (pick C) as [[y C]| B]. - + contradiction (list_cycle A2). - + apply B. - Qed. - - Theorem fip_dec x : (* Proof using FCI *) - fip_monotone sigma -> dec (fip sigma R x). - Proof. - intros D. - apply dec_transfer with (P:= x el C). Focus 2. now auto. - split. - - revert x. apply FCI.ind. intros A x IH E F. - apply fip_intro with (A:=A); auto. - - apply (fip_least D). intros z. apply FCI.closure. - Qed. - -End FCI. -End FCI. - -(* Print Graph. (* prints transitive closure of coercions *) *) diff --git a/external/base/FiniteTypes.v b/external/base/FiniteTypes.v deleted file mode 100644 index b4334c1..0000000 --- a/external/base/FiniteTypes.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Export -FiniteTypes.BasicDefinitions -FiniteTypes.FinTypes -FiniteTypes.BasicFinTypes -FiniteTypes.CompoundFinTypes -FiniteTypes.VectorFin -FiniteTypes.FiniteFunction -FiniteTypes.Cardinality -FiniteTypes.DepPairs -FiniteTypes.Arbitrary. - - diff --git a/external/base/FiniteTypes/Arbitrary.v b/external/base/FiniteTypes/Arbitrary.v deleted file mode 100644 index 8cc77ff..0000000 --- a/external/base/FiniteTypes/Arbitrary.v +++ /dev/null @@ -1,194 +0,0 @@ -Require Import Shared.Base Shared.Bijection Shared.FiniteTypes.FinTypes. -Require Import Coq.Vectors.Fin. - -Instance Fin_eq_dec n : eq_dec (Fin.t n). -Proof. - intros; hnf. - destruct (eqb x y) eqn:E. - - left. now eapply eqb_eq. - - right. intros H. eapply eqb_eq in H. congruence. -Defined. - -Definition all_Fin n := nat_rec (fun n0 : nat => list (t n0)) [] (fun (n0 : nat) (IHn : list (t n0)) => F1 :: map FS IHn) n. - - -Lemma in_undup_iff (X: eqType) (A: list X) x : x el A <-> x el (undup A). -Proof. - now rewrite undup_id_equi. -Qed. - -(* (** * finTypes from Lists *) *) -(* (* Conversion of lists over eqTypes to finite types *) *) -(* (* *) *) - - -(** * Pure predicates *) -(* taken from the development of Herditarily finite sets by Prof. Smolka and Kathrin Stark. *) -(* *) - -Definition pure (X:Type) (p: X -> Prop) {D:forall x, dec (p x)} x := if Dec (p x) then True else False. -Arguments pure {X} p {D} x. - -Lemma pure_equiv (X:Type) (p: X -> Prop) {D:forall x, dec (p x)} x : p x <-> pure p x. -Proof. - unfold pure. now dec. -Qed. - -Lemma pure_impure (P: Prop) (_: dec P) (norm: if Dec (P) then True else False) : P. -Proof. - dec; tauto. -Qed. -Ltac impurify H := pose proof (pure_impure H) as impureH; try (clear H; rename impureH into H). - -Lemma purify (X: Type) (p: X -> Prop) (D:forall x, dec (p x)) x (px: p x): pure p x. -Proof. - now apply pure_equiv. -Qed. - -Arguments purify {X} {p} {D} {x} px. - -Lemma pure_eq (X: Type) (p: X -> Prop) (D: forall x, dec (p x)) x (p1 p2: pure p x) : p1 = p2. -Proof. - unfold pure in *. dec. - + now destruct p1, p2. - + contradiction p1. -Qed. - -(* (** * Definition of subtypes *) *) - -Definition subtype {X:Type} (p: X -> Prop) {D: forall x, dec (p x)} := { x:X | pure p x}. -Arguments subtype {X} p {D}. - -Lemma subtype_extensionality (X: Type) (p: X -> Prop) {D: forall x, dec (p x)} (x x': subtype p) : proj1_sig x = proj1_sig x' <-> x = x'. -Proof. - split. - - intros H. destruct x, x'. cbn in H. subst x0. f_equal. apply pure_eq. - - congruence. -Qed. - -Instance subType_eq_dec X (_:eq_dec X) (p: X -> Prop) (_: forall x, dec (p x)): eq_dec (subtype p). -Proof. - intros y z. destruct y as [x p1], z as [x' p2]. decide (x=x'). - - left. now apply subtype_extensionality. - - right. intro H. apply n. now inv H. -Qed. - -(* Lemma proj1_sig_fun (X: eqType) (p: X -> Prop) (x x': X) (p1: p x) (p2: p x'): exist p x p1 = exist p x' p2 -> x = x'. *) -(* Proof. *) -(* intro E. change x with (proj1_sig (exist p x p1)). change x' with (proj1_sig (exist p x' p2)). *) -(* now inv E. *) -(* Qed. *) - -(* (** * Subtypes from lists *) *) - -(* Lemma in_undup_iff (X: eqType) (A: list X) x : x el A <-> x el (undup A). *) -(* Proof. *) -(* now rewrite undup_id_equi. *) -(* Qed. *) - -Fixpoint toSubList (X: Type) (A: list X) (p: X -> Prop) (D:forall x, dec (p x)) : list (subtype p) := - match A with - | nil => nil - | cons x A' => match Dec (p x) with - | left px => (exist _ x (purify px)) :: toSubList A' D - | right _ => toSubList A' _ end - end. - -Arguments toSubList {X} A p {D}. - -Lemma toSubList_count (X: eqType) (p: X -> Prop) (A: list X) (_:forall x, dec (p x)) x: - count (toSubList A p) x = count A (proj1_sig x). -Proof. - induction A. - - reflexivity. - - cbn. decide (p a). - + simpl. dec. - * congruence. - * now rewrite <- subtype_extensionality in e. - * change a with (proj1_sig (exist (pure p) a (purify p0))) in e. now rewrite subtype_extensionality in e. - * exact IHA. - + destruct x. cbn. dec. - * subst a. now impurify p0. - * exact IHA. -Qed. - -(* Lemma subType_enum_ok (X:finType) (p: X -> Prop) (_: forall x, dec (p x)) x: *) -(* count (toSubList (elem X) p) x = 1. *) -(* Proof. *) -(* rewrite toSubList_count. apply enum_ok. *) -(* Qed. *) - -Notation "'Subtype' p" := (finTypeC (EqType (subtype p))) (at level 5). - -(* Instance finTypeC_sub (X:finType) (p: X -> Prop) (_:forall x, dec (p x)): Subtype p. *) -(* Proof. *) -(* econstructor. apply subType_enum_ok. *) -(* Defined. *) - -(** * finTypes from Lists *) -(* Conversion of lists over eqTypes to finite types *) -(* *) -Lemma enum_ok_fromList (X: eqType) (A: list X) x : count (undup (toSubList A (fun x => x el A))) x = 1. -Proof. - apply dupfreeCount. - - apply dupfree_undup. - - rewrite <- in_undup_iff. apply countIn. cbn in *. - rewrite toSubList_count. - destruct x as [x p]. cbn. apply InCount. now impurify p. -Qed. - -Instance fromListC (X: eqType) (A: list X) : Subtype (fun x => x el A). -Proof. -econstructor. intros [x p]. apply enum_ok_fromList. -Defined. - -(* (* Canonical Structure finType_fromList (X: eqType) (A: list X) := FinType (EqSubType (fun x => x el A)). *) *) - -(* (* Lemma finType_fromList_correct (X: eqType) (A: list X) : *) *) -(* (* map (@proj1_sig _ _) (elem (finType_fromList A)) === A. *) *) -(* (* Proof. *) *) -(* (* cbn. split. *) *) -(* (* - intros x H. destruct (in_map_iff (@proj1_sig _ _) (undup (toSubList A (fun x => x el A))) x) as [H0 _]. *) *) -(* (* specialize (H0 H). destruct H0 as [[y p] [E _]]. cbn in *. subst y. now impurify p. *) *) -(* (* - intros x H. apply in_map_iff. *) *) -(* (* eexists. Unshelve. Focus 2. *) *) -(* (* + exists x. unfold pure. now dec. *) *) -(* (* + cbn. split; auto. apply countIn with (A:= undup (toSubList A _)). rewrite enum_ok_fromList. omega. *) *) -(* (* Qed. *) *) - - - -(* Definition finType_of := {x : X | x el A}. *) - -(* Lemma eqType_finType_of : eq_dec finType_of. *) -(* Proof. *) -(* eapply subType_eq_dec. *) - - - - (* Lemma enum_ok_fromList (X: eqType) (A: list X) x : count (undup (toSubList A (fun x => x el A))) x = 1. *) - (* Proof. *) - (* apply dupfreeCount. *) - (* - apply dupfree_undup. *) - (* - rewrite <- in_undup. apply countIn. rewrite toSubList_count. *) - (* destruct x as [x p]. cbn. apply InCount. now impurify p. *) - (* Qed. *) - -(* Instance fromListC (X: eqType) (A: list X) : finTypeC (EqSubType (fun x => x el A)). *) -(* Proof. *) -(* econstructor. intros [x p]. apply enum_ok_fromList. *) -(* Defined. *) - -(* Canonical Structure finType_fromList (X: eqType) (A: list X) := FinType (EqSubType (fun x => x el A)). *) - -(* Lemma finType_fromList_correct (X: eqType) (A: list X) : *) -(* map (@proj1_sig _ _) (elem (finType_fromList A)) === A. *) -(* Proof. *) -(* cbn. split. *) -(* - intros x H. destruct (in_map_iff (@proj1_sig _ _) (undup (toSubList A (fun x => x el A))) x) as [H0 _]. *) -(* specialize (H0 H). destruct H0 as [[y p] [E _]]. cbn in *. subst y. now impurify p. *) -(* - intros x H. apply in_map_iff. *) -(* eexists. Unshelve. Focus 2. *) -(* + exists x. unfold pure. now dec. *) -(* + cbn. split; auto. apply countIn with (A:= undup (toSubList A _)). rewrite enum_ok_fromList. omega. *) -(* Qed. *) diff --git a/external/base/FiniteTypes/Automata.v b/external/base/FiniteTypes/Automata.v deleted file mode 100644 index 4204421..0000000 --- a/external/base/FiniteTypes/Automata.v +++ /dev/null @@ -1,754 +0,0 @@ -Require Import FinTypes. -(** Proofs about DFA as a test for the finType library *) -Set Implicit Arguments. -Unset Printing Implicit Defensive. -Unset Strict Implicit. -Set Contextual Implicit. - -(** * Conversion between Props and bools *) - -Coercion toProp (b:bool) := if b then True else False. - -Instance toProp_dec b : dec (toProp b). -Proof. - destruct b; auto. -Qed. - -Section DFA. - (** * Definition of the alphabet, words and dfa*) - Variable Sig: finType. - Definition word := list Sig. - -Record dfa: Type := - DFA { - S:> finType; - s: S; - F: decPred S; - delta_S: S -> Sig -> S - }. - -Section Reachability. -Variable A : dfa. -(** transition function for whole words *) -Fixpoint delta_star (q: A) (w: word) := - match w with - | nil => q - | x::w' => delta_star (delta_S q x) w' - end. - -(** Definition if acceptance *) -Definition accept (w:word) := F (@delta_star s w). - -Instance accept_dec w : dec (accept w). -Proof. - auto. -Qed. - -(** * Reachability -- normal reachability -- reachability with a specific word - *) - -Inductive reachable (q: A) : A -> Prop := -| refl: reachable q q -| step q' x: reachable (delta_S q x) q' -> reachable q q'. - -Definition reachable_with q w q':= delta_star q w = q'. - -Hint Constructors reachable. - -Lemma reachable_with_reachable (q q': A): reachable q q' <-> exists w, reachable_with q w q'. -Proof. - split. - - intro R. induction R. - + now exists nil. - + destruct IHR as [w IHR]. exists (x::w). unfold reachable_with. cbn. congruence. - - intros [w H]. revert q H. induction w; intros q H. - + now rewrite H. - + econstructor 2. apply IHw. apply H. -Qed. - -Hint Resolve reachable_with_reachable. - -Lemma reachable_transitive (q:A) q' q'': reachable q q' /\ reachable q' q'' -> reachable q q''. -Proof. - intros [R R']. induction R; eauto. -Qed. -(* -Lemma reachable_delta_star q w: reachable q (delta_star q w). -Proof. - apply reachable_with_reachable. now exists w. -Qed. -*) -(** * Reach (set of all reachable states) -- defined using fixed-point iteration *) - -(* The predicate for the fixed-point iteration *) -Definition step_reach (set: list A) (q: A) := exists q' x, q' el set /\ reachable_with q' [x] q. - -Lemma step_reach_consistent: step_consistent step_reach. -Proof. - intros B q H B' sub. destruct H as [q' [x [E R]]]. exists q', x. auto. -Qed. - -Definition reach (q: A) := FCIter step_reach [q]. - -Lemma reach_least_fp q: least_fp_containing (FCStep step_reach) (reach q) [q]. -Proof. - apply step_consistent_least_fp. apply step_reach_consistent. -Qed. - -Lemma reach_correct1 (q:A): inclp (reach q) (reachable q). -Proof. - apply FCIter_ind. - - intro x. cbn. now intros [[]|[]]. - - intros set q' H [q'' [x [E H1]]]. eapply reachable_transitive; split. - + apply (H _ E). - + apply reachable_with_reachable. eauto. -Qed. - -Lemma reach_correct2' q q': q' el reach q -> forall q'', reachable q' q'' -> q'' el reach q. -Proof. - intros E q'' R. induction R. - - exact E. - - apply IHR. apply Closure_FCIter. now exists q0, x. -Qed. - -Lemma reach_correct2 q: forall q', reachable q q' -> q' el reach q. -Proof. -apply reach_correct2'. now apply preservation_FCIter. -Qed. - -Lemma reach_correct q q': reachable q q' <-> q' el (reach q). -Proof. - split. - - apply reach_correct2. - - apply reach_correct1. -Qed. - -Global Instance reachable_dec q q': dec (reachable q q'). -Proof. - eapply dec_prop_iff. - - symmetry. apply reach_correct. - - auto. -Qed. - -Global Instance reachable_with_something_dec q q': dec (exists w, reachable_with q w q'). -Proof. - eauto. -Qed. - -Lemma reach_reachable_with q q': (exists w, reachable_with q w q') <-> q' el reach q. -Proof. - rewrite <- reachable_with_reachable. apply reach_correct. -Qed. - -Lemma delta_star_reach w q: delta_star q w el (reach q). -Proof. - apply reach_reachable_with. now exists w. -Qed. - -Notation in_lang w := (accept w) (only parsing). - -Lemma Sig_reach : (forall w, in_lang w) <-> forall (q: A), q el (reach s) -> F q. -Proof. - split. - - intros H q E. rewrite <- reach_reachable_with in E. destruct E as [w R]. - rewrite <- R. apply (H w). - - intros H w. apply (H (delta_star s w)). apply delta_star_reach. -Qed. - -Global Instance Sig_dec : dec (forall w, in_lang w). -Proof. - decide( forall q, q el reach s -> F q) as [H | H]. - - left. now apply Sig_reach. - - right. now rewrite Sig_reach. -Qed. - -Definition empty := forall w, ~ in_lang w. - -Definition neg_F := DecPred (fun x => ~ (@F A x)). - -Definition complement := DFA s neg_F (@delta_S A). - -End Reachability. -Notation in_lang A w := (accept A w) (only parsing). -Section Operations. -Variable A : dfa. - -Lemma complement_correct w: accept (complement A) w <-> ~ (accept A w). -Proof. - split; auto. -Qed. - -Global Instance empty_dec : dec (empty A). -Proof. - apply (dec_trans (@Sig_dec (complement A))). now setoid_rewrite complement_correct. -Qed. - -Lemma empty_reach: empty A <-> forall (q:A), q el (reach s) -> ~ (F q). -Proof. - split. - - intros empt q E F . rewrite <- reach_reachable_with in E. destruct E as [w R]. - specialize (empt w). apply empt. unfold accept. now rewrite R. - - intros H w acc. specialize (H (delta_star s w)). apply H. - + apply delta_star_reach. - + exact acc. -Qed. - -Instance exists_accept_dec: dec (exists w, accept A w). -Proof. -decide (empty A) as [H | H]. -- firstorder. -- left. unfold empty in H. rewrite empty_reach in H. rewrite DM_notAll in H. - + destruct H as [q H]. destruct (dec_DM_impl _ _ H) as [H' acc]. - rewrite <- reach_reachable_with in H'. destruct H' as [w R]. exists w. rewrite <- R in acc. - apply dec_DN; auto. - + auto. -Qed. - -Instance exists_not_accept_dec : dec (exists w, ~ accept A w). -Proof. - decide (forall w, accept A w) as [H|H]. - - right. firstorder. - - left. rewrite Sig_reach in H. rewrite DM_notAll in H. - + destruct H as [q H]. destruct (dec_DM_impl _ _ H) as [H' acc]. - rewrite <- reach_reachable_with in H'. destruct H' as [w R]. exists w. now rewrite <- R in acc. - + auto. -Qed. - -Definition Epsilon_autom : dfa. -Proof. - refine (DFA (inl tt) (DecPred (fun q: unit + unit => if q then True else False)) (fun _ _ => inr tt)). - intros [[]|[]]; auto. -Defined. - - -Lemma inr_fix_epsilon w : (@delta_star Epsilon_autom (inr tt) w) = inr tt. -Proof. - now induction w. -Qed. - -Lemma Epsilon_autom_correct w: accept Epsilon_autom w <-> w = nil. -Proof. - split. - - cbn. destruct w. - + reflexivity. - + cbn. now rewrite inr_fix_epsilon. - - intros H. subst w. cbn. exact I. -Qed. - - - -Definition predCons (A:dfa) (q: option A + unit) := match q with - | inl None => False - | inl (Some q) => F q - | inr tt => False end. - -Definition deltaCons x (A:dfa) (q: option A + unit) y := match q with - | inl None => if decision (y = x) then inl (Some s) else inr tt - | inl (Some q) => inl (Some (delta_S q y)) - | inr tt => inr tt end. - -Instance predCons_dec (A:dfa) (q: option A + unit) : dec (predCons q). -Proof. - destruct q. - - destruct o; auto. - - destruct u; auto. -Qed. - - -Definition cons (A: dfa) (x:Sig) := - DFA (inl None) (DecPred (@predCons A)) (@deltaCons x A). - - -Lemma inr_fix A' x w : (@delta_star (cons A' x) (inr tt) w) = inr tt. -Proof. - now induction w. -Qed. - -Lemma cons_correct (A':dfa) x w : accept A' w <-> accept (cons A' x) (x::w). -Proof. - cbn in *. deq x. unfold accept. generalize (@s A'). induction w; firstorder. -Qed. - - -Fixpoint exactW (w: word) := match w with - | nil => Epsilon_autom - | x::w' => cons (exactW w') x end. - -Lemma exactW_correct w w': accept (exactW w) w' <-> w' = w. -Proof. - split. - - revert w'; induction w; intros w'; destruct w'. - + reflexivity. - + simpl. apply Epsilon_autom_correct. - + cbn. tauto. - + intros H. pose proof (@cons_correct (exactW w) a w') as nc; cbn in *. deq a. - dec. - * subst e. rewrite <- nc in H. f_equal. now apply IHw. - * unfold predCons in *. now rewrite (@inr_fix (exactW w) _ w') in H. - - intros []. induction w'. - + exact I. - + simpl. now rewrite <- cons_correct. -Qed. - -Variable A':dfa. - - -Section Product_automaton. - Variable op: Prop -> Prop -> Prop. - Variable op_dec: forall P Q, dec P -> dec Q -> dec (op P Q). - - Definition prod_delta: A (x) A' -> Sig -> A (x) A' := - fun P x => match P with (q1,q2) => (delta_S q1 x, delta_S q2 x) end. -Definition prod_pred := (fun P => match P with (q1,q2) => op (@F A q1) (@F A' q2) end). - -Global Instance prod_pred_dec P: dec (prod_pred P). -Proof. - destruct P as [q1 q2]. auto. -Qed. - -Definition prod_F := DecPred prod_pred. - -Definition prod := DFA (s,s) prod_F prod_delta. - -Lemma prod_delta_star w q1 q2 : @delta_star prod (q1, q2) w = (delta_star q1 w, delta_star q2 w). -Proof. - revert q1 q2. induction w; now cbn. -Qed. - -Lemma prod_correct w: accept prod w <-> op (accept A w) (accept A' w). -Proof. - cbn. now rewrite prod_delta_star. -Qed. - -End Product_automaton. -Arguments prod op {op_dec}. - -Definition intersect := prod and. - -Lemma intersect_correct w: accept intersect w <-> accept A w /\ accept A' w. -Proof. - apply prod_correct. -Qed. - -Definition U := prod or. - -Lemma U_correct w: accept U w <-> accept A w \/ accept A' w. -Proof. - apply prod_correct. -Qed. - -Definition diff := prod (fun P Q => P /\ ~ Q). - -Lemma diff_correct w : accept diff w <-> accept A w /\ ~ accept A' w. -Proof. - unfold diff. now rewrite prod_correct. -Qed. - -Definition lang_incl := forall w, in_lang A w -> in_lang A' w. - -Lemma lang_incl_iff : lang_incl <-> empty diff. -Proof. - unfold empty. setoid_rewrite diff_correct. split. - - firstorder. - - intros H w H'. specialize (H w). destruct (dec_DM_and _ H). - + tauto. - + apply dec_DN; auto. -Qed. - -End Operations. - -Definition lang_equiv A A':= lang_incl A A' /\ lang_incl A' A. - -Instance lang_sub_dec A A' : dec (lang_incl A A'). -Proof. - decide (empty (diff A A')) as [H|H]; unfold empty in H; setoid_rewrite diff_correct in H. - - left. intros w acc. specialize (H w). decide (accept A' w); tauto. - - right. firstorder. -Qed. - -Instance equiv_eq_dec A A': dec (lang_equiv A A'). -Proof. - auto. -Qed. - -(** * Nondeterministic finite automata (NFA)*) - -Record nfa := NFA { - Q :> finType; - q0:Q; - Q_acc: decPred Q; - delta_Q: Q -> Sig -> decPred Q - }. - -Implicit Type B : nfa. -Implicit Type A: dfa. -Fixpoint delta_Q_star B q w: B -> Prop := - match w with - | nil => fun q' => q' = q - |x::w' => fun q'' => exists q', delta_Q q x q' /\ delta_Q_star q' w' q'' - end. -Arguments delta_Q_star {B} q w q'. - -Instance delta_Q_star_dec B (q q': B) w: dec (delta_Q_star q w q'). -Proof. - revert q. induction w. - - cbn. auto. - - intros q. cbn. auto. -Qed. - -Lemma delta_Q_star_trans B w w' (q q' q'': B) : delta_Q_star q w q' /\ delta_Q_star q' w' q'' -> delta_Q_star q (w ++ w') q''. -Proof. - intros [H H']. revert q H. induction w; intros q H. - - cbn in *. congruence. - - cbn in *. destruct H as [q_m [D H]]. exists q_m. split. - + exact D. - + now apply IHw. -Qed. - -Definition n_accept B w := exists (q:B), Q_acc q /\ delta_Q_star q0 w q. - -Definition toNFA A := @NFA (S A) s F (fun q x => DecPred (fun q' => delta_S q x = q')). - - -Lemma toNFA_delta_star_correct A q w q': q' = delta_star q w <-> @delta_Q_star (toNFA A) q w q'. -Proof. - revert q. induction w. - - reflexivity. - - intro q; cbn. rewrite IHw. split. - +eauto. - +now intros [q'' [[] H]]. -Qed. - -Lemma toNFA_correct A : forall w, accept A w <-> n_accept (toNFA A) w. -Proof. - intros w. unfold accept, n_accept. split. - - intros H. exists (delta_star s w). now rewrite <- toNFA_delta_star_correct. - - intros [q [acc H]]. rewrite <- toNFA_delta_star_correct in H. now subst q. -Qed. - -Definition toDFA_F B := fun f: B --> bool => exists q, f q /\ Q_acc q. - -Definition toDFA_delta B := fun (f: B --> bool) x => vectorise (fun q => toBool (exists q':B, f q' /\ delta_Q q' x q)). - -Lemma toDFA_delta_correct B f x q : toDFA_delta f x q -> exists q':B, f q' /\ delta_Q q' x q. -Proof. - intros H. unfold toDFA_delta in H. rewrite apply_vectorise_inverse in H. unfold toBool in H. dec. - - assumption. - - contradiction H. -Qed. - -Definition onestate B q:= (vectorise (fun q':B => toBool (q' = q) )). - -Lemma onestate_correct B q q' : @onestate B q q' <-> q = q'. -Proof. - unfold onestate. rewrite apply_vectorise_inverse. unfold toBool. dec; cbn. - - subst q. tauto. - - split; [>tauto | auto]. -Qed. - -Definition toDFA B := DFA (onestate q0) (DecPred (@toDFA_F B)) (@toDFA_delta B). - -Lemma toDFA_delta_star_correct1 B q w q': - delta_Q_star q w q' -> forall f: B --> bool, f q -> applyVect (@delta_star (toDFA B) f w) q'. -Proof. - intros H f F. revert f q F H. induction w; intros f q F H; cbn in *. - - now subst q'. - - destruct H as [q'' [H S]]. eapply IHw; eauto. - unfold toDFA_delta. rewrite apply_vectorise_inverse. unfold toBool. dec. - + exact I. - + apply n. now exists q. - Qed. - -Lemma toDFA_delta_star_correct2 B (f: B --> bool) w q': - applyVect (@delta_star (toDFA B) f w) q' -> exists q, f q /\ delta_Q_star q w q'. -Proof. - revert f. induction w. - - cbn. eauto. - - intros f. cbn. intros H. specialize (IHw _ H). destruct IHw as [q'' [E E']]. - destruct (toDFA_delta_correct E). firstorder. -Qed. - -Lemma toDFA_correct B w: n_accept B w <-> accept (toDFA B) w. -Proof. - cbn. unfold n_accept, toDFA_F. split. - - intros [q [acc G]]. exists q; split. - + apply (toDFA_delta_star_correct1 G). now apply onestate_correct. - + exact acc. - - intros [q [H acc]]. exists q; split. - + exact acc. - + destruct (toDFA_delta_star_correct2 H) as [q' [E D]]. rewrite onestate_correct in E. now subst q'. -Qed. - -(** * Concatenation of two regular languages *) - -Definition concat_acc_pred B B' := fun (q: B + B') => match q with - | inl q => if decision (Q_acc (@q0 B')) then Q_acc q else False - | inr q => Q_acc q - end. - -Instance acc_dec B B' q: dec (@concat_acc_pred B B' q). -Proof. - destruct q as [q | q]. - - cbn. dec; auto. - - auto. -Qed. - -Definition concat_acc_decPred B B':= DecPred (@concat_acc_pred B B'). - -Definition concat_delta B B' (q q': B + B') x:= match q with - | inl q => match q' with - | inl q' => delta_Q q x q' - | inr q' => if decision (@Q_acc B q) then delta_Q q0 x q' else False - end - | inr q => match q' with - | inl q' => False - | inr q' => delta_Q q x q' - end - end. - -Instance conact_delta_dec B B' (q: B + B') x q' : dec (concat_delta q q' x). -Proof. - destruct q, q'. - - auto. - - cbn. dec; auto. - - auto. - - auto. -Qed. - -Definition concat_delta_Q B B':= fun (q: B + B') x => DecPred (fun q' => concat_delta q q' x). - -Definition concat B B' := NFA (inl (@q0 B)) (@concat_acc_decPred B B') (@concat_delta_Q B B'). - - -Lemma concat_delta_Q_star_correct1 B B' q q' w: @delta_Q_star (concat B B') (inr q) w (inl q') <-> False. -Proof. - split; try tauto. revert q; induction w; intro q. - - congruence. - - cbn. intros [[q''|q''] H]; firstorder. -Qed. - -Lemma concat_delta_Q_star_correct2 B B' q q' w: @delta_Q_star (concat B B') (inl q) w (inl q') <-> delta_Q_star q w q'. -Proof. - split; revert q; induction w; intro q; try congruence. - - intros [[q''|q''] [S H]]. - + exists q''. firstorder. - + now rewrite concat_delta_Q_star_correct1 in H. - - intro H. firstorder. -Qed. - -Lemma concat_delta_Q_star_correct3 B B' q q' w: @delta_Q_star (concat B B') (inr q) w (inr q') <-> delta_Q_star q w q'. -Proof. - split; revert q; induction w; intro q; try congruence. - - intros [[q''|q''] [S H]]. - + contradiction S. - + exists q''. firstorder. - - intro H. firstorder. -Qed. - -Lemma concat_delta_Q_star_correct4 B B' q q' w: @delta_Q_star (concat B B') (inl q) w (inr q') <-> exists w' q'', delta_Q_star q w' q'' /\ Q_acc q'' /\ exists w'', w = w' ++ w'' /\ delta_Q_star q0 w'' q' /\ (w'' = nil -> q0 <> q'). -Proof. - split; revert q; induction w; intro q; try congruence. - -intros [[q''|q''] [S H]]. - + specialize (IHw q'' H). destruct IHw as [w' [q_m [S' [acc [w'' [E [D IHw]]]]]]]. exists (a::w'), q_m. repeat split. - * cbn. now exists q''. - * exact acc. - * subst w. exists w''. tauto. - + exists nil, q. cbn in S. dec; repeat split; try tauto. - exists (a::w). cbn. repeat split; try congruence. - exists q''. split. - * exact S. - * eapply concat_delta_Q_star_correct3. exact H. - - intros [w' [_ [_ [_ [w'' [E [D H]]]]]]]. symmetry in E. pose proof ( app_eq_nil _ _ E) as [E1 E2]. subst w'' w'. - cbn in *. exfalso; now apply H. - - intros [w' [q'' [H [ acc [w'' [E [D S]]]]]]]. cbn. destruct w'. - + cbn in *. subst q'' w''. destruct D as [q'' [D H]]. exists (inr q''). split. - * now dec. - * now apply concat_delta_Q_star_correct3. - + cbn in *. inv E. destruct H as [q1 [D' H]]. exists (inl q1). eauto 10. -Qed. - -Lemma concat_correct B B' w : n_accept (concat B B') w <-> exists w' w'', n_accept B w' /\ n_accept B' w'' /\ w = w' ++ w''. -Proof. - split. - - intros acc. destruct acc as [q [acc H]]. destruct q as [q |q]. - + cbn in H. rewrite concat_delta_Q_star_correct2 in H. exists w, nil. rewrite app_nil_r. cbn in acc. dec; firstorder. - + cbn in H. rewrite concat_delta_Q_star_correct4 in H. firstorder. - - intros [w' [w'' [[q1 [acc1 D1]] [[q2 [acc2 D2]] eqn]]]]. destruct w''. - + rewrite app_nil_r in eqn. subst w'. exists (inl q1). cbn. dec. - * now rewrite concat_delta_Q_star_correct2. - * cbn in D2. subst q2. tauto. - + subst w. exists (inr q2). split; auto. cbn. rewrite concat_delta_Q_star_correct4. - exists w', q1. firstorder. exists (e::w''). firstorder. congruence. -Qed. -(** * Kleene Operator *) - -Definition kleene_acc_pred B := fun q => match q with - | None => True - | Some q => @Q_acc B q end. - -Instance kleene_acc_dec B (q: option B): dec (kleene_acc_pred q). -Proof. - unfold kleene_acc_pred. destruct q; auto. -Qed. - -Definition kleene_acc_decPred B:= DecPred (@kleene_acc_pred B). - -Definition kleene_delta B (q: option B) x q':= match q' with - | Some q' => match q with - | None => delta_Q q0 x q' - | Some q => delta_Q q x q' \/ (Q_acc q /\ delta_Q q0 x q') - end - | _ => False end. -Instance kleene_delta_dec B (q q': option B) x : dec (kleene_delta q x q'). Proof. -destruct q, q'; auto. Qed. - -Definition kleene_star B := NFA (None) (@kleene_acc_decPred B) (fun (q: option B) x => DecPred (fun q' => kleene_delta q x q')). - -Lemma nil_kleene B : n_accept (kleene_star B) nil. -Proof. - unfold n_accept. now exists q0. -Qed. - -Lemma kleene_delta_ok1 B (q q': B) w: delta_Q_star q w q' -> @delta_Q_star (kleene_star B) (Some q) w (Some q'). -Proof. - revert q. induction w; intros q H. - - cbn in *. congruence. - - cbn in *. firstorder. -Qed. - -Lemma kleene_delta_ok2 B q q' x w: - Q_acc q -> @delta_Q_star (kleene_star B) None (x::w) q' -> @delta_Q_star (kleene_star B) q (x::w) q'. -Proof. - intros acc H. cbn in *. unfold kleene_acc_pred in acc. destruct q. - - destruct H as [q'' [D H]]. exists q''. split. - + unfold kleene_delta. destruct q''. - * tauto. - * contradiction D. - + exact H. - - exact H. -Qed. - -Lemma kleene_delta_ok_3 B w: n_accept B w -> n_accept (kleene_star B) w. - destruct w. - - intros _. apply nil_kleene. - - intros [q [acc H]]. exists (Some q). split. - + exact acc. - + destruct H as [q' [H' H]]. exists (Some q'). split. - * exact H'. - * now apply kleene_delta_ok1. -Qed. - - -Lemma kleene_delta_ok_4 B x w q': @delta_Q_star B q0 (x:: w) q' -> @delta_Q_star (kleene_star B) q0 (x::w) (Some q'). -Proof. - cbn. intros [q [H S]]. exists (Some q). split. - + exact H. - + now apply kleene_delta_ok1. -Qed. - -Lemma kleene_delta_ok_5 B a w: - n_accept B a -> n_accept (kleene_star B) w -> n_accept (kleene_star B) (a++ w). -Proof. - - (* If there is a rest (w is not empty), then the last state is the last state after reading w, otherwise it is the last state after reading a. we need to know which one it is because we have to commit to a final state now *) - destruct w. - - rewrite app_nil_r. intros H _. now apply kleene_delta_ok_3. - - destruct a. - + now cbn. - + intros [q' [acc' H]] [q [acc H1]]. exists q. split. - * exact acc. - * eapply delta_Q_star_trans. split. - { - apply kleene_delta_ok_4. exact H. - } - { - now apply kleene_delta_ok2. - } -Qed. - -Lemma kleene_star_correct1 B w: (forall w', w' el w -> n_accept B w') -> n_accept (kleene_star B) (List.concat w). -Proof. - induction w. - - cbn. intros _. apply nil_kleene. - - intros H. - assert (forall w', w' el w -> n_accept B w') as ass by firstorder. specialize (IHw ass); clear ass. - cbn. apply kleene_delta_ok_5. - + now apply H. - + exact IHw. -Qed. - -Lemma kleene_delta_ok6 B (q:B) w (q':B) : - @delta_Q_star (kleene_star B) (Some q) w (Some q') -> @delta_Q_star B q w q' \/ exists w' w'' q'', w = w' ++ w'' /\ Q_acc q'' /\ @delta_Q_star B q w' q'' /\ @delta_Q_star (kleene_star B) None w'' (Some q'). -Proof. - revert q. induction w; intros q H. - - left. cbn in H. now inv H. - - destruct H as [q_m [H D]]. destruct q_m; try contradiction H. specialize (IHw _ D). destruct H as [H |acc H]. - + destruct IHw as [IHw | [w' [w'' [q'' [E [acc IHw]]]]]]. - * firstorder. - * right. exists (a::w'), w''. subst w. exists q''. firstorder. - + right. exists nil, (a::w), q. cbn. firstorder. -Qed. - -Lemma kleene_delta_ok7 B q w : - @delta_Q_star (kleene_star B) q w None <-> q= None /\ w = nil. -Proof. - split. - - revert q. induction w; intros q H. - + cbn in H. now subst q. - + cbn in H. destruct H as [q' [D H]]. specialize (IHw _ H). destruct IHw as [E E']. subst q' w. - contradiction D. - - intros [E E']. now subst q w. -Qed. - -(* w must not be empty because kleene_star B accepts nil no matter what B does. *) -Lemma kleene_delta_ok8 B x w: - n_accept (kleene_star B) (x::w) -> n_accept B (x::w) \/ exists w' w'', w = w' ++ w'' /\ n_accept B (x::w') /\ n_accept (kleene_star B) w''. -Proof. - intros [q [acc [q' [H S]]]]. cbn in *. destruct q, q'. - - pose proof (kleene_delta_ok6 S) as [H'|H']; clear S. - + left. exists e. firstorder. - + right. destruct H' as [w' [w'' [q [E [acc' [S S']]]]]]. exists w', w''. firstorder. - - contradiction H. - - rewrite kleene_delta_ok7 in S. destruct S as [S _]. discriminate S. - - contradiction H. -Qed. - -Lemma kleene_star_correct2 B w : - n_accept (kleene_star B) w -> exists w', List.concat w' = w /\ (forall w'', w'' el w' -> n_accept B w''). -Proof. - intros H. induction w using (@size_induction _ (@length Sig)). destruct w. -- exists nil. firstorder. -- destruct (kleene_delta_ok8 H) as [H' | H']; clear H. - + exists [(e::w)]. cbn. rewrite app_nil_r. split. - * reflexivity. - * now intros w' [[]| []]. - + destruct H' as [w' [w'' [E [acc1 acc2]]]]. - assert (|w''| < | e::w|) as L. - { - subst w. cbn. rewrite app_length. omega. - } - specialize (H0 w'' L acc2); clear L. destruct H0 as [w1 [E' H]]. exists ((e::w')::w1). split. - * cbn. rewrite E'. now subst w. - * intros w2 [[]|H']; auto. -Qed. - -Lemma kleene_star_correct B w: n_accept (kleene_star B) w <-> exists w', List.concat w' = w /\ (forall w'', w'' el w' -> n_accept B w''). -Proof. - split. - - apply kleene_star_correct2. - - intros [w' [[] H]]. now apply kleene_star_correct1. -Qed. - -End DFA. - - - - - - - - - diff --git a/external/base/FiniteTypes/BasicDefinitions.v b/external/base/FiniteTypes/BasicDefinitions.v deleted file mode 100644 index ea482e6..0000000 --- a/external/base/FiniteTypes/BasicDefinitions.v +++ /dev/null @@ -1,205 +0,0 @@ -(* * Basic definitions of decidablility and Functions -- includes basic Lemmas about said functions - *) - -Require Export Shared.Base. - -(** * Definition of useful tactics *) - -(** dec is used to destruct all decisions appearing in the goal or assumptions. *) -Ltac dec := repeat (destruct Dec). - -(** This tactic completely solves listComplete goals for base types *) -Ltac listComplete := intros x; simpl; dec; destruct x; try congruence. -(** simplifies (decision x = x) *) -Ltac deq x := destruct (Dec (x=x)) as [[] | isnotequal]; [> | contradict isnotequal; reflexivity] . - - - -(** Function that takes two lists and returns the list of all pairs of elements from the two lists *) -Fixpoint prodLists {X Y: Type} (A: list X) (B: list Y) {struct A} := - match A with - | nil => nil - | cons x A' => map (fun y => (x,y)) B ++ prodLists A' B end. - -(** Crossing any list with the empty list always yields the empty list *) -Lemma prod_nil (X Y: Type) (A: list X) : - prodLists A ([]: list Y) = []. -Proof. - induction A. - - reflexivity. - - cbn. assumption. -Qed. - -(** This function takes a (A: list X) and yields a list (option X) which for every x in A contains Some x. The resultung list also contains None. The order is preserved. None is the first element of the resulting list. *) - -Definition toOptionList {X: Type} (A: list X) := - None :: map (@Some _) A . - -(** This function counts the number of occurences of an element in a given list and returns the result *) -Fixpoint count (X: Type) `{eq_dec X} (A: list X) (x: X) {struct A} : nat := - match A with - | nil => O - | cons y A' => if Dec (x=y) then S(count A' x) else count A' x end. - -Definition toSumList1 {X: Type} (Y: Type) (A: list X): list (X + Y) := - map inl A. -Definition toSumList2 {Y: Type} (X: Type) (A: list Y): list (X + Y) := - map inr A. - -(** * Basic lemmas about functions *) - -(** In the list containing all pairs of (x,y') with y' from a list B the pair (x,y) is contained exactly as many times as y is contained in the list B. *) - -Lemma countMap (X Y: eqType) (x:X) (B: list Y) y : - count ( map (fun y => (x,y)) B) (x, y) = count B y. -Proof. - induction B. - - reflexivity. - - simpl. dec; congruence. -Qed. - -(** If a list is split somewhere in two list the number of occurences of an element in the list is equal to the sum of the number of occurences in the left and the right part. *) - -Lemma countSplit (X: eqType) (A B: list X) (x: X) : count A x + count B x = count (A ++ B) x. -Proof. - induction A. - - reflexivity. - - cbn. decide (x=a). - +cbn. f_equal; exact IHA. - + exact IHA. -Qed. - -(** In a list of tupels with x as a left element the number of tupels with something different from x as a left element is 0. *) -Lemma countMapZero (X Y: eqType) (x x':X) (B: list Y) y : x' <> x -> count ( map (fun y => (x,y)) B) (x', y) =0. -Proof. - intros ineq. induction B. - - reflexivity. - - simpl. dec. - + inversion e; congruence. - + exact IHB. -Qed. - - -Lemma notInZero (X: eqType) (x: X) A : - not (x el A) <-> count A x = 0. -Proof. - split; induction A. - - reflexivity. - - intros H. cbn in *. dec. - + exfalso. apply H. left. congruence. - + apply IHA. intros F. apply H. now right. - - tauto. - - cbn. dec. - + subst a. omega. - + intros H [E | E]. - * now symmetry in E. - * tauto. -Qed. - -Lemma countIn (X:eqType) (x:X) A: - count A x > 0 -> x el A. -Proof. - induction A. - - cbn. omega. - - cbn. dec. - + intros. left. symmetry. exact e. - + intros. right. apply IHA. exact H. -Qed. - -Lemma InCount (X:eqType) (x:X) A: - x el A -> count A x > 0. -Proof. - induction A. - - intros []. - - intros [[] | E]; cbn. - + deq a. omega. - + specialize (IHA E). dec; omega. -Qed. - -Lemma count_in_equiv (X: eqType) (x:X) A : count A x > 0 <-> x el A. -Proof. - split. - - apply countIn. - - apply InCount. -Qed. - - -Lemma countApp (X: eqType) (x: X) (A B: list X) : - count (A ++ x::B) x > 0. -Proof. - auto using InCount. -Qed. - - -(** Dupfree Lists containing every x countain x exactly once *) -Lemma dupfreeCount (X: eqType) (x:X) (A: list X) : dupfree A -> x el A -> count A x = 1. -Proof. - intros D E. induction D. - - contradiction E. - - cbn. dec. - + f_equal. subst x0. now apply notInZero. - + destruct E as [E | E]; [> congruence | auto]. -Qed. - -(** toSumlist1 does not change the number of occurences of an existing element in the list *) -Lemma toSumList1_count (X: eqType) (x: X) (Y: eqType) (A: list X) : - count (toSumList1 Y A) (inl x) = count A x . -Proof. - induction A; simpl; dec; congruence. -Qed. - -(** toSumlist2 odes not change the numbe of occurences of an existing element in the list *) -Lemma toSumList2_count (X Y: eqType) (y: Y) (A: list Y): - count (toSumList2 X A) (inr y) = count A y. -Proof. - induction A; simpl; dec; congruence. -Qed. - -(** to sumList1 does not produce inr proofs *) -Lemma toSumList1_missing (X Y: eqType) (y: Y) (A: list X): - count (toSumList1 Y A ) (inr y) = 0. -Proof. - induction A; dec; firstorder. -Qed. - -(** toSumlist2 does not produce inl proofs *) -Lemma toSumList2_missing (X Y: eqType) (x: X) (A: list Y): - count (toSumList2 X A ) (inl x) = 0. -Proof. - induction A; dec; firstorder. -Qed. - - -(** * Cardinality Lemmas for lists*) -Lemma cons_incll (X: Type) (A B: list X) (x:X) : x::A <<= B -> A <<= B. -Proof. - unfold "<<=". auto. -Qed. - -Lemma card_length_leq (X: eqType) (A: list X) : card A <= length A. -Proof. - induction A; auto. cbn. dec; omega. -Qed. - -(** * Various helpful Lemmas *) - - -(** If the concatenation of two lists is nil then each list was nil *) -Lemma appendNil (X: Type) (A B: list X) : - A ++ B = nil -> A = nil /\ B = nil. -Proof. - intros H. assert (|A ++ B| = 0) by now rewrite H. - rewrite app_length in H0. rewrite <- !length_zero_iff_nil. omega. -Qed. - -Lemma countZero (X: eqType) (x: X) (A: list X) : count A x = 0 -> not (x el A). -Proof. - induction A; cbn in *; dec; firstorder congruence. -Qed. - -(** The product of two numbers is greater zero if both numbers are greater zero *) -Lemma NullMul a b : a > 0 -> b > 0 -> a * b > 0. -Proof. - induction 1; cbn; omega. -Qed. \ No newline at end of file diff --git a/external/base/FiniteTypes/BasicFinTypes.v b/external/base/FiniteTypes/BasicFinTypes.v deleted file mode 100644 index 08d8764..0000000 --- a/external/base/FiniteTypes/BasicFinTypes.v +++ /dev/null @@ -1,64 +0,0 @@ -Require Import FinTypes. - -(** * Completeness Lemmas for lists of basic types *) - -Lemma bool_enum_ok x: - count [true; false] x = 1. -Proof. - simpl. dec; destruct x; congruence. -Qed. - -Lemma unit_enum_ok x: - count [tt] x = 1. -Proof. - simpl. destruct x; dec; congruence. -Qed. - -Lemma Empty_set_enum_ok (x: Empty_set): - count nil x = 1. -Proof. - tauto. -Qed. - -Lemma True_enum_ok x: - count [I] x = 1. -Proof. - simpl; dec; destruct x; congruence. -Qed. - -Lemma False_enum_ok (x: False): - count nil x = 1. -Proof. - tauto. -Qed. - -(** ** Declaration of finTypeCs for base types as instances of the type class *) - -Instance finTypeC_Empty_set: finTypeC (EqType Empty_set). -Proof. - econstructor. eapply Empty_set_enum_ok. -Defined. - -Instance finTypeC_bool: finTypeC (EqType bool). -Proof. - econstructor. apply bool_enum_ok. -Defined. - -Instance finTypeC_unit: finTypeC (EqType unit). -Proof. econstructor. apply unit_enum_ok. -Defined. - -(* Instance finTypeC_empty : finTypeC (EqType emptu *) -(* Proof. *) -(* econstructor. apply Empty_set_enum_ok. *) -(* Defined. *) - -Instance finTypeC_True : finTypeC (EqType True). -Proof. - econstructor. apply True_enum_ok. -Defined. - -Instance finTypeC_False : finTypeC (EqType False). -Proof. - econstructor. apply False_enum_ok. -Defined. diff --git a/external/base/FiniteTypes/Cardinality.v b/external/base/FiniteTypes/Cardinality.v deleted file mode 100644 index 682e522..0000000 --- a/external/base/FiniteTypes/Cardinality.v +++ /dev/null @@ -1,152 +0,0 @@ -Require Import FinTypes. - -Definition Cardinality (F: finType) := | elem F |. - -(** * Dupfreeness *) -(* Proofs about dupfreeness *) - - -Lemma dupfree_countOne (X: eqType) (A: list X) : (forall x, count A x <= 1) -> dupfree A. -Proof. - induction A. - - constructor. - - intro H. constructor. - + cbn in H. specialize (H a). deq a. assert (count A a = 0) by omega. now apply countZero. - + apply IHA. intro x. specialize (H x). cbn in H. dec; omega. -Qed. - -Lemma dupfree_elements (X: finType) : dupfree (elem X). -Proof. - destruct X as [X [A AI]]. assert (forall x, count A x <= 1) as H'. - { - intro x. specialize (AI x). omega. - } - now apply dupfree_countOne. -Qed. - -Lemma dupfree_length (X: finType) (A: list X) : dupfree A -> |A| <= Cardinality X. -Proof. - unfold Cardinality. intros D. - rewrite <- (dupfree_card D). rewrite <- (dupfree_card (dupfree_elements X)). - apply card_le. apply allSub. -Qed. - -Lemma disjoint_concat X (A: list (list X)) (B: list X) : (forall C, C el A -> disjoint B C) -> disjoint B (concat A). -Proof. - intros H. induction A. - - cbn. auto. - - cbn. apply disjoint_symm. apply disjoint_app. split; auto using disjoint_symm. -Qed. - -Lemma dupfree_concat (X: Type) (A: list (list X)) : (forall B, B el A -> dupfree B) /\ (forall B C, B <> C -> B el A -> C el A -> disjoint B C) -> dupfree A -> dupfree (concat A). -Proof. - induction A. - - constructor. - - intros [H H'] D. cbn. apply dupfree_app. - + apply disjoint_concat. intros C E. apply H'; auto. inv D. intro G; apply H2. now subst a. - + now apply H. - + inv D; apply IHA; auto. -Qed. - -(* (** * Proofs about Cardinality *) *) - -(* Lemma Card_positiv (X: finType) (x:X) : Cardinality X > 0. *) -(* Proof. *) -(* pose proof (elem_spec x). unfold Cardinality. destruct (elem X). *) -(* - contradiction H. *) -(* - cbn. omega. *) -(* Qed. *) - -(* Lemma Cardinality_card_eq (X: finType): card (elem X) = Cardinality X. *) -(* Proof. *) -(* apply dupfree_card. apply dupfree_elements. *) -(* Qed. *) - -(* Lemma card_upper_bound (X: finType) (A: list X): card A <= Cardinality X. *) -(* Proof. *) -(* rewrite <- Cardinality_card_eq. apply card_le. apply allSub. *) -(* Qed. *) - - -(* Lemma injective_dupfree (X: finType) (Y: Type) (A: list X) (f: X -> Y) : injective f -> dupfree (getImage f). *) -(* Proof. *) -(* intro inj. unfold injective in inj. *) -(* unfold getImage. apply dupfree_map. *) -(* - firstorder. *) -(* - apply dupfree_elements. *) -(* Qed. *) - -(* Theorem pidgeonHole_inj (X Y: finType) (f: X -> Y) (inj: injective f): Cardinality X <= Cardinality Y. *) -(* Proof. *) -(* rewrite <- (getImage_length f). apply dupfree_length. apply (injective_dupfree (elem X) inj). *) -(* Qed. *) - -(* Lemma surj_sub (X Y: finType) (f: X -> Y) (surj: surjective f): elem Y <<= getImage f. *) -(* Proof. *) -(* intros y E. specialize (surj y). destruct surj as [x H]. subst y. apply getImage_in. *) -(* Qed. *) - -(* Theorem pidgeonHole_surj (X Y: finType) (f: X -> Y) (surj: surjective f): Cardinality X >= Cardinality Y. *) -(* Proof. *) -(* rewrite <- (getImage_length f). rewrite <- Cardinality_card_eq. *) -(* pose proof (card_le (surj_sub surj)) as H. pose proof (card_length_leq (getImage f)) as H'. omega. *) -(* Qed. *) - -(* Lemma eq_iff (x y: nat) : x >= y /\ x <= y -> x = y. *) -(* Proof. *) -(* omega. *) -(* Qed. *) - -(* Corollary pidgeonHole_bij (X Y: finType) (f: X -> Y) (bij: bijective f): *) -(* Cardinality X = Cardinality Y. *) -(* Proof. *) -(* destruct bij as [inj surj]. apply eq_iff. split. *) -(* - now eapply pidgeonHole_surj. *) -(* - eapply pidgeonHole_inj; eauto. *) -(* Qed. *) - -(* Lemma Prod_Card (X Y: finType) : Cardinality (X (x) Y) = Cardinality X * Cardinality Y. *) -(* Proof. *) -(* cbn. unfold prodLists. unfold Cardinality. induction (elem X). *) -(* - reflexivity. *) -(* - cbn. rewrite app_length. rewrite IHl. f_equal. apply map_length. *) -(* Qed. *) - -(* Lemma Option_Card (X: finType) : Cardinality (? X) = S(Cardinality X). *) -(* Proof. *) -(* cbn. now rewrite map_length. *) -(* Qed. *) - -(* Lemma SumCard (X Y: finType) : Cardinality (finType_sum X Y) = Cardinality X + Cardinality Y. *) -(* Proof. *) -(* unfold Cardinality. cbn. rewrite app_length. unfold toSumList1, toSumList2. now repeat rewrite map_length. *) -(* Qed. *) - -(* Lemma extPow_length X Y L P: |@extensionalPower X Y L P| = | L |. *) -(* Proof. *) -(* induction L. *) -(* - reflexivity. *) -(* - simpl. f_equal. apply IHL. *) -(* Qed. *) - - -(* Lemma concat_map_length (X: Type) (A: list X) (B: list (list X)) : *) -(* | concat (map (fun x => map (cons x) B) A) |= |A| * |B|. *) -(* Proof. *) -(* induction A. *) -(* - reflexivity. *) -(* - cbn. rewrite app_length. rewrite map_length. congruence. *) -(* Qed. *) - -(* Lemma images_length Y (A: list Y) n : |images A n| = (|A| ^ n)%nat. *) -(* Proof. *) -(* induction n. *) -(* - reflexivity. *) -(* - cbn. rewrite concat_map_length. now rewrite IHn. *) -(* Qed. *) - -(* Lemma Vector_Card (X Y: finType): Cardinality (Y ^ X) = (Cardinality Y ^ (Cardinality X ))%nat. *) -(* Proof. *) -(* cbn. rewrite extPow_length. now rewrite images_length. *) -(* Qed. *) - diff --git a/external/base/FiniteTypes/CompoundFinTypes.v b/external/base/FiniteTypes/CompoundFinTypes.v deleted file mode 100644 index 7a8cf81..0000000 --- a/external/base/FiniteTypes/CompoundFinTypes.v +++ /dev/null @@ -1,92 +0,0 @@ -Require Import FinTypes. - -(** * Definition of prod as finType *) - -Lemma ProdCount (T1 T2: eqType) (A: list T1) (B: list T2) (a:T1) (b:T2) : - count (prodLists A B) (a,b) = count A a * count B b . -Proof. - induction A. - - reflexivity. - - cbn. rewrite <- countSplit. decide (a = a0) as [E | E]. - + cbn. f_equal. subst a0. apply countMap. eauto. - + rewrite <- plus_O_n. f_equal. now apply countMapZero. eauto. -Qed. - -Lemma prod_enum_ok (T1 T2: finType) (x: T1 * T2): - count (prodLists (elem T1) (elem T2)) x = 1. -Proof. - destruct x as [x y]. rewrite ProdCount. unfold elem. - now repeat rewrite enum_ok. -Qed. - -Instance finTypeC_Prod (F1 F2: finType) : finTypeC (EqType (F1 * F2)). -Proof. - econstructor. apply prod_enum_ok. -Defined. - -(** * Definition of option as finType *) - -(** Wrapping elements in "Some" does not change the number of occurences in a list *) -Lemma SomeElement (X: eqType) (A: list X) x: - count (toOptionList A) (Some x) = count A x . -Proof. - unfold toOptionList. simpl. dec; try congruence. - induction A. - + tauto. - + simpl. dec; congruence. -Qed. - -(** A list produced by toOptionList contains None exactly once *) -Lemma NoneElement (X: eqType) (A: list X) : - count (toOptionList A) None = 1. -Proof. - unfold toOptionList. simpl. dec; try congruence. f_equal. - induction A. - - reflexivity. - - simpl; dec; congruence. -Qed. - -Lemma option_enum_ok (T: finType) x : - count (toOptionList (elem T)) x = 1. -Proof. - destruct x. - + rewrite SomeElement. apply enum_ok. - + apply NoneElement. -Qed. - -Instance finTypeC_Option(F: finType): finTypeC (EqType (option F)). -Proof. - eapply FinTypeC. apply option_enum_ok. -Defined. - -(** * Definition of sum as finType *) - -(** The sum of two nats can only be 1 if one of them is 1 and the other one is 0 *) -Lemma proveOne m n: m = 1 /\ n = 0 \/ n = 1 /\ m = 0 -> m + n = 1. -Proof. - omega. -Qed. - -Lemma sum_enum_ok (X: finType) (Y: finType) x : - count (toSumList1 Y (elem X) ++ toSumList2 X (elem Y)) x = 1. -Proof. - rewrite <- countSplit. apply proveOne. destruct x. - - left. split; cbn. - + rewrite toSumList1_count. apply enum_ok. - + apply toSumList2_missing. - - right. split; cbn. - + rewrite toSumList2_count. apply enum_ok. - + apply toSumList1_missing. -Qed. - -(** Instance declaration for sum types for the type class *) -Instance finTypeC_sum (X Y: finType) : finTypeC (EqType ( X + Y)). -Proof. - eapply FinTypeC. apply sum_enum_ok. -Defined. - -(* Some hints to make the typeclass inference work *) - -Hint Extern 4 (finTypeC (EqType (_ * _))) => eapply finTypeC_Prod : typeclass_instances. -Hint Extern 4 (finTypeC (EqType (_ + _))) => eapply finTypeC_sum : typeclass_instances. -Hint Extern 4 (finTypeC (EqType (option _))) => eapply finTypeC_Option : typeclass_instances. diff --git a/external/base/FiniteTypes/DepPairs.v b/external/base/FiniteTypes/DepPairs.v deleted file mode 100644 index c8cbde0..0000000 --- a/external/base/FiniteTypes/DepPairs.v +++ /dev/null @@ -1,101 +0,0 @@ -(** Instance declaration for dependent pairs *) - -Require Import Base FinTypes EqdepFacts List. - -Instance eqType_depPair (F : eqType) (a : F -> eqType) : eq_dec {f : F & a f}. -Proof. - intros [x fx] [y fy]. eapply dec_transfer. now rewrite eq_sigT_iff_eq_dep. - decide (x=y). - subst y. decide (fx = fy). - +subst fy. left. reflexivity. - +right. intros eq. apply n. apply Eqdep_dec.eq_dep_eq_dec in eq. auto. intros. decide (x0=y);econstructor;eassumption;eauto. - +right. intros eq. now inv eq. -Qed. - -Instance finType_depPair (F : finType) (a : F -> finType) : finTypeC (EqType( {f : F & a f} )). -Proof. - exists (undup (concat (map (fun f => map (fun x => existT a _ x) (elem (a f))) (elem F)))). - intros H. hnf in H. apply dupfreeCount. now apply dupfree_undup. - rewrite undup_id_equi. apply in_concat_iff. - exists ((fun f : F => map (fun x : a f => existT (fun x0 : F => a x0) f x) (elem (a f))) (projT1 H)). - split. - -rewrite in_map_iff. destruct H. cbn. exists e. split. - +reflexivity. - +apply countIn. setoid_rewrite enum_ok. omega. - -rewrite in_map_iff. eexists. split. reflexivity. - apply countIn. setoid_rewrite enum_ok. omega. -Qed. - -Hint Extern 4 (finTypeC (EqType ({_ : _ & _}))) => eapply finType_depPair : typeclass_instances. - -(* (** * Dependent pairs *) *) - -(* Fixpoint toSigTList (X: Type) (f: X -> finType) (A: list X) : list (sigT f) := *) -(* match A with *) -(* | nil => nil *) -(* | cons x A' => (map (existT f x) (elem (f x))) ++ toSigTList f A' end. *) - - -(* Lemma countMapExistT (X: eqType) (f: X -> eqType) (x:X) (A: list (f x)) (y: f x) : *) -(* count (map (existT f x) A) (existT f x y) = count A y. *) -(* Proof. *) -(* induction A. *) -(* - reflexivity. *) -(* - simpl. dec. *) -(* + subst a. f_equal. apply IHA. *) -(* + contradict n. exact (sigT_proj2_fun _ e). *) -(* + subst a. contradict n. reflexivity. *) -(* + exact IHA. *) -(* Qed. *) - -(* Lemma countMapExistT_Zero (X: eqType) (f: X -> eqType) (x x':X) (A: list (f x)) (y: f x') : *) -(* x <> x' -> count (map (existT f x) A) (existT f x' y) = 0. *) -(* Proof. *) -(* intros E. induction A. *) -(* - reflexivity. *) -(* - simpl. dec. *) -(* + contradict E. eapply sigT_proj1_fun; eauto. *) -(* + exact IHA. *) -(* Qed. *) - -(* Lemma toSigTList_count (X: eqType) (f: X -> finType) (A: list X) (s: sigT f): *) -(* count (toSigTList f A) s = count A (projT1 s). *) -(* Proof. *) -(* induction A. *) -(* - reflexivity. *) -(* - destruct s. cbn in *. rewrite <- countSplit. rewrite IHA. dec. *) -(* + change (S (count A x)) with (1 + count A x). f_equal. subst a. *) -(* rewrite (@countMapExistT _ f x (elem (f x)) e). apply enum_ok. *) -(* + change (count A x) with (0+ (count A x)). f_equal. rewrite (@countMapExistT_Zero _ f a x); auto. *) -(* Qed. *) - -(* Lemma sigT_enum_ok (X:finType) (f: X -> finType) (s: sigT f) : count (toSigTList f (elem X)) s = 1. *) -(* Proof. *) -(* rewrite toSigTList_count. now pose proof (enum_ok (projT1 s)). *) -(* Qed. *) - -(* Instance finTypeC_sigT (X: finType) (f: X -> finType): finTypeC (EqSigT f). *) -(* Proof. *) -(* econstructor. apply sigT_enum_ok. *) -(* Defined. *) - -(* Canonical Structure finType_sigT (X: finType) (f: X -> finType) := FinType (EqSigT f). *) - -(* Lemma finType_sigT_correct (X: finType) (f: X -> finType): *) -(* sigT f = finType_sigT f. *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) - -(* Lemma finType_sigT_enum (X: finType) (f: X -> finType) : *) -(* toSigTList f (elem X) = (elem (finType_sigT f)). *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) -(* Set Printing Coercions. *) -(* Lemma tofinType_sigT_correct (X: finType) (f: X -> finType) : *) -(* tofinType (sigT f) = finType_sigT f. *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) -(* Unset Printing Coercions. *) diff --git a/external/base/FiniteTypes/External.v b/external/base/FiniteTypes/External.v deleted file mode 100644 index 8a05644..0000000 --- a/external/base/FiniteTypes/External.v +++ /dev/null @@ -1,1270 +0,0 @@ -(** * Proofs and definitions obtained from external sources - -This file contains proofs and definitions from external sources. Specifically from thr base library used in IC -by Prof. Gert Smolka in the version from 15. February 2016. Some other definitions are taken from the preliminary file of then -development of Heriditarily finite sets by Prof. Gert Smolka and Kathrin Stark. Mainly these are newer versions of the definitions from the base library from ICL. - *) - - -Global Set Implicit Arguments. -Global Unset Strict Implicit. -Global Unset Printing Records. -Global Unset Printing Implicit Defensive. -Global Set Regular Subst Tactic. -Hint Extern 4 => exact _. (* make auto use type class inference *) -Require Export Setoid Morphisms. -Require Export Omega List Morphisms. - -Set Implicit Arguments. -(* Set Universe Polymorphism. *) - -(* exists-style notation for Sigma-types *) -Notation "'Sigma' x .. y , p" := - (sigT (fun x => .. (sigT (fun y => p)) ..)) - (at level 200, x binder, right associativity, - format "'[' 'Sigma' '/ ' x .. y , '/ ' p ']'") - : type_scope. - -Ltac inv A := inversion A; subst; try clear A. - - -(** * De Morgan laws *) - -Lemma DM_or (X Y : Prop) : - ~ (X \/ Y) <-> ~ X /\ ~ Y. -Proof. - tauto. -Qed. - -Lemma DM_not_exists X (p : X -> Prop) : - ~ (exists x, p x) <-> forall x, ~ p x. -Proof. - firstorder. -Qed. - -(** Decidable propositions *) - -Definition dec (P : Prop) := {P} + {~ P}. -Existing Class dec. - -Definition decision (P : Prop) (d : dec P) : dec P := d. -Arguments decision P {d}. - -Tactic Notation "decide" constr(p) := - destruct (decision p). - -Tactic Notation "decide" constr(p) "as" simple_intropattern(i) := - destruct (decision p) as i. - -Fact dec_trans P Q : - dec P -> P <-> Q -> dec Q. -Proof. - unfold dec. tauto. -Qed. - -Instance True_dec : - dec True. -Proof. - unfold dec; auto. -Qed. - -Instance False_dec : - dec False. -Proof. - unfold dec; auto. -Qed. - -Instance impl_dec (P Q : Prop) : - dec P -> dec Q -> dec (P -> Q). -Proof. - unfold dec; tauto. -Qed. - -Instance and_dec (P Q : Prop) : - dec P -> dec Q -> dec (P /\ Q). -Proof. - unfold dec; tauto. -Qed. - -Instance or_dec (P Q : Prop) : - dec P -> dec Q -> dec (P \/ Q). -Proof. - unfold dec; tauto. -Qed. - -Instance not_dec (P : Prop) : - dec P -> dec (~P). -Proof. - unfold not. auto. -Qed. - -Instance iff_dec (P Q : Prop) : - dec P -> dec Q -> dec (P <-> Q). -Proof. - unfold iff. auto. -Qed. - -Notation "'eq_dec' X" := (forall x y : X, dec (x=y)) (at level 70). - -(** Discrete types and decidable predicates *) - -Structure eqType := EqType { - eqtype :> Type; - decide_eq : eq_dec eqtype }. - -Arguments EqType eqtype {decide_eq}. -(** This is like defined and not like Qed *) -Existing Instance decide_eq. - -Structure decPred X := DecPred { - predicate :> X -> Prop; - decide_pred x : dec (predicate x) }. - -Arguments DecPred {X} predicate {decide_pred}. - -Existing Instance decide_pred. -Instance decp_dec X (p : decPred X) x : - dec (p x). -Proof. - apply decide_pred. -Qed. - -(** Decidable relations *) - -Structure decRel X := DecRel { - relation :> X -> X -> Prop; - decide_rel x y : dec (relation x y) }. - -Arguments DecRel {X} relation {decide_rel}. - -Instance decRel_dec X (R : decRel X) x y : - dec (R x y). -Proof. - apply decide_rel. -Qed. - -Lemma dec_DN X : - dec X -> ~~ X -> X. -Proof. - unfold dec; tauto. -Qed. - -Lemma dec_DM_and X Y : - dec X -> ~ (X /\ Y) -> ~ X \/ ~ Y. -Proof. - unfold dec; tauto. -Qed. - -Lemma dec_DM_and' X Y : - dec Y -> ~ (X /\ Y) -> ~ X \/ ~ Y. -Proof. - unfold dec; tauto. -Qed. - -Lemma dec_DM_impl X Y : - dec X -> dec Y -> ~ (X -> Y) -> X /\ ~ Y. -Proof. - unfold dec; tauto. -Qed. - -Lemma dec_DM_all X (p: X -> Prop) (_:forall x, dec (p x)): - (forall x, p x) <-> ~ exists x, ~ p x. -Proof. - firstorder. -Qed. - -Lemma dec_prop_iff (X Y : Prop) : - (X <-> Y) -> dec X -> dec Y. -Proof. - unfold dec; tauto. -Qed. - -Instance bool_eq_dec : - eq_dec bool. -Proof. - intros x y. hnf. decide equality. -Qed. - -Instance nat_eq_dec : - eq_dec nat. -Proof. - intros x y. hnf. decide equality. -Qed. - -Hint Resolve dec_prop_iff. - -Instance nat_le_dec (x y : nat) : dec (x <= y) := - le_dec x y. - -Instance list_eq_dec X : - eq_dec X -> eq_dec (list X). -Proof. - intros D. apply list_eq_dec. exact D. -Qed. - -Instance list_in_dec (X : Type) (x : X) (A : list X) : - eq_dec X -> dec (In x A). -Proof. - intros D. apply in_dec. exact D. -Qed. - -(** * Lists *) - -Definition equi X (A B : list X) : Prop := - incl A B /\ incl B A. - -Hint Unfold equi. - -Export ListNotations. -Notation "| A |" := (length A) (at level 65). -Notation "x 'el' A" := (In x A) (at level 70). -Notation "A <<= B" := (incl A B) (at level 70). -Notation "A === B" := (equi A B) (at level 70). - -(* The following comments are for coqdoc *) -(** printing el #∊# *) -(** printing <<= #⊆# *) -(** printing === #≡# *) - -(** Register additional simplification rules with autorewrite / simpl_list *) - -Hint Rewrite <- app_assoc : list. -Hint Rewrite rev_app_distr map_app prod_length : list. -(* Print Rewrite HintDb list. *) - -Lemma list_cycle (X : Type) (A : list X) x : - x::A <> A. -Proof. - intros B. - assert (C: |x::A| <> |A|) by (simpl; omega). - apply C. now rewrite B. -Qed. - -(** * Decidability laws for lists *) - -Lemma list_sigma_forall X A (p : X -> Prop) (p_dec : forall x, dec (p x)) : - {x | x el A /\ p x} + {forall x, x el A -> ~ p x}. -Proof. - induction A as [|x A]; simpl. - - tauto. - - destruct IHA as [[y [D E]]|D]. - + eauto. - + destruct (p_dec x) as [E|E]. - * eauto. - * right. intros y [[]|F]; auto. -Defined. - -Arguments list_sigma_forall {X} A p {p_dec}. - -Instance list_forall_dec X A (p : X -> Prop) : - (forall x, dec (p x)) -> dec (forall x, x el A -> p x). -Proof. - intros p_dec. - destruct (list_sigma_forall A (fun x => ~ p x)) as [[x [D E]]|D]. - - right. auto. - - left. intros x E. apply dec_DN; auto. -Qed. - -Instance list_exists_dec X A (p : X -> Prop) : - (forall x, dec (p x)) -> dec (exists x, x el A /\ p x). -Proof. - intros p_dec. - destruct (list_sigma_forall A p) as [[x [D E]]|D]. - - unfold dec. eauto. - - right. intros [x [E F]]. exact (D x E F). -Qed. - -Lemma list_exists_DM X A (p : X -> Prop) : - (forall x, dec (p x)) -> - ~ (forall x, x el A -> ~ p x) -> exists x, x el A /\ p x. -Proof. - intros D E. - destruct (list_sigma_forall A p) as [F|F]. - + destruct F as [x F]. eauto. - + contradiction (E F). -Qed. - -Lemma list_exists_not_incl X (A B : list X) : - eq_dec X -> - ~ A <<= B -> exists x, x el A /\ ~ x el B. -Proof. - intros D E. - apply list_exists_DM; auto. - intros F. apply E. intros x G. - apply dec_DN; auto. -Qed. - -Lemma list_cc X (p : X -> Prop) A : - (forall x, dec (p x)) -> - (exists x, x el A /\ p x) -> {x | x el A /\ p x}. -Proof. - intros D E. - destruct (list_sigma_forall A p) as [[x [F G]]|F]. - - eauto. - - exfalso. destruct E as [x [G H]]. apply (F x); auto. -Defined. - -(** * Membership - -We use the following lemmas from Coq's standard library List. -- [in_eq : x el x::A] -- [in_nil : ~ x el nil] -- [in_cons : x el A -> x el y::A] -- [in_or_app : x el A \/ x el B -> x el A++B] -- [in_app_iff : x el A++B <-> x el A \/ x el B] -- [in_map_iff : y el map f A <-> exists x, f x = y /\ x el A] -*) - -Hint Resolve in_eq in_nil in_cons in_or_app. - -Section Membership. - Variable X : Type. - Implicit Types (x y : X) (A B : list X). - - Lemma in_sing x y : - x el [y] -> x = y. - Proof. - simpl. intros [[]|[]]. reflexivity. - Qed. - - Lemma in_cons_neq x y A : - x el y::A -> x <> y -> x el A. - Proof. - simpl. intros [[]|D] E; congruence. - Qed. - - Lemma not_in_cons x y A : - ~ x el y :: A -> x <> y /\ ~ x el A. - Proof. - intuition; subst; auto. - Qed. - -(** * Disjointness *) - - Definition disjoint A B := - ~ exists x, x el A /\ x el B. - - Lemma disjoint_forall A B : - disjoint A B <-> forall x, x el A -> ~ x el B. - Proof. - split. - - intros D x E F. apply D. exists x. auto. - - intros D [x [E F]]. exact (D x E F). - Qed. - - Lemma disjoint_symm A B : - disjoint A B -> disjoint B A. - Proof. - firstorder. - Qed. - - Lemma disjoint_incl A B B' : - B' <<= B -> disjoint A B -> disjoint A B'. - Proof. - firstorder. - Qed. - - Lemma disjoint_nil B : - disjoint nil B. - Proof. - firstorder. - Qed. - - Lemma disjoint_nil' A : - disjoint A nil. - Proof. - firstorder. - Qed. - - Lemma disjoint_cons x A B : - disjoint (x::A) B <-> ~ x el B /\ disjoint A B. - Proof. - split. - - intros D. split. - + intros E. apply D. eauto. - + intros [y [E F]]. apply D. eauto. - - intros [D E] [y [[F|F] G]]. - + congruence. - + apply E. eauto. - Qed. - - Lemma disjoint_app A B C : - disjoint (A ++ B) C <-> disjoint A C /\ disjoint B C. - Proof. - split. - - intros D. split. - + intros [x [E F]]. eauto 6. - + intros [x [E F]]. eauto 6. - - intros [D E] [x [F G]]. - apply in_app_iff in F as [F|F]; eauto. - Qed. - -End Membership. - -Hint Resolve disjoint_nil disjoint_nil'. - -(** * Inclusion - -We use the following lemmas from Coq's standard library List. -- [incl_refl : A <<= A] -- [incl_tl : A <<= B -> A <<= x::B] -- [incl_cons : x el B -> A <<= B -> x::A <<= B] -- [incl_appl : A <<= B -> A <<= B++C] -- [incl_appr : A <<= C -> A <<= B++C] -- [incl_app : A <<= C -> B <<= C -> A++B <<= C] -*) - -Hint Resolve incl_refl incl_tl incl_cons incl_appl incl_appr incl_app. - -Lemma incl_nil X (A : list X) : - nil <<= A. - -Proof. intros x []. Qed. - -Hint Resolve incl_nil. - -Lemma incl_map X Y A B (f : X -> Y) : - A <<= B -> map f A <<= map f B. - -Proof. - intros D y E. apply in_map_iff in E as [x [E E']]. - subst y. apply in_map_iff. eauto. -Qed. - -Section Inclusion. - Variable X : Type. - Implicit Types A B : list X. - - Lemma incl_nil_eq A : - A <<= nil -> A=nil. - - Proof. - intros D. destruct A as [|x A]. - - reflexivity. - - exfalso. apply (D x). auto. - Qed. - - Lemma incl_shift x A B : - A <<= B -> x::A <<= x::B. - - Proof. auto. Qed. - - Lemma incl_lcons x A B : - x::A <<= B <-> x el B /\ A <<= B. - Proof. - split. - - intros D. split; hnf; auto. - - intros [D E] z [F|F]; subst; auto. - Qed. - - Lemma incl_sing x A y : - x::A <<= [y] -> x = y /\ A <<= [y]. - Proof. - rewrite incl_lcons. intros [D E]. - apply in_sing in D. auto. - Qed. - - Lemma incl_rcons x A B : - A <<= x::B -> ~ x el A -> A <<= B. - - Proof. intros C D y E. destruct (C y E) as [F|F]; congruence. Qed. - - Lemma incl_lrcons x A B : - x::A <<= x::B -> ~ x el A -> A <<= B. - - Proof. - intros C D y E. - assert (F: y el x::B) by auto. - destruct F as [F|F]; congruence. - Qed. - - Lemma incl_app_left A B C : - A ++ B <<= C -> A <<= C /\ B <<= C. - Proof. - firstorder. - Qed. - -End Inclusion. - -Definition inclp (X : Type) (A : list X) (p : X -> Prop) : Prop := - forall x, x el A -> p x. - -(** * Setoid rewriting with list inclusion and list equivalence *) - -Instance incl_preorder X : - PreOrder (@incl X). -Proof. - constructor; hnf; unfold incl; auto. -Qed. - -Instance equi_Equivalence X : - Equivalence (@equi X). -Proof. - constructor; hnf; firstorder. -Qed. - -Instance incl_equi_proper X : - Proper (@equi X ==> @equi X ==> iff) (@incl X). -Proof. - hnf. intros A B D. hnf. firstorder. -Qed. - -Instance cons_incl_proper X x : - Proper (@incl X ==> @incl X) (@cons X x). -Proof. - hnf. apply incl_shift. -Qed. - -Instance cons_equi_proper X x : - Proper (@equi X ==> @equi X) (@cons X x). -Proof. - hnf. firstorder. -Qed. - -Instance in_incl_proper X x : - Proper (@incl X ==> Basics.impl) (@In X x). -Proof. - intros A B D. hnf. auto. -Qed. - -Instance in_equi_proper X x : - Proper (@equi X ==> iff) (@In X x). -Proof. - intros A B D. firstorder. -Qed. - -Instance app_incl_proper X : - Proper (@incl X ==> @incl X ==> @incl X) (@app X). -Proof. - intros A B D A' B' E. auto. -Qed. - -Instance app_equi_proper X : - Proper (@equi X ==> @equi X ==> @equi X) (@app X). -Proof. - hnf. intros A B D. hnf. intros A' B' E. - destruct D, E; auto. -Qed. - -(** * Equivalence *) - -Section Equi. - Variable X : Type. - Implicit Types A B : list X. - - Lemma equi_push x A : - x el A -> A === x::A. - - Proof. auto. Qed. - - Lemma equi_dup x A : - x::A === x::x::A. - - Proof. auto. Qed. - - Lemma equi_swap x y A: - x::y::A === y::x::A. - - Proof. split; intros z; simpl; tauto. Qed. - - Lemma equi_shift x A B : - x::A++B === A++x::B. - - Proof. - split; intros y. - - intros [D|D]. - + subst; auto. - + apply in_app_iff in D as [D|D]; auto. - - intros D. apply in_app_iff in D as [D|D]. - + auto. - + destruct D; subst; auto. - Qed. - - Lemma equi_rotate x A : - x::A === A++[x]. - - Proof. - split; intros y; simpl. - - intros [D|D]; subst; auto. - - intros D. apply in_app_iff in D as [D|D]. - + auto. - + apply in_sing in D. auto. - Qed. -End Equi. - -(** * Filter *) - -Fixpoint filter X (p : decPred X) (A : list X) : list X := - match A with - | nil => nil - | x::A' => if decision (p x) then x :: filter p A' else filter p A' - end. - -Section FilterLemmas. - Variable X : Type. - Variable p : decPred X. - - Lemma in_filter_iff x A : - x el filter p A <-> x el A /\ p x. - Proof. - induction A as [|y A]; cbn. - - tauto. - - decide (p y) as [C|C]; cbn; - rewrite IHA; intuition; subst; tauto. - Qed. - - Lemma filter_incl A : - filter p A <<= A. - Proof. - intros x D. apply in_filter_iff in D. apply D. - Qed. - - Lemma filter_mono A B : - A <<= B -> filter p A <<= filter p B. - - Proof. - intros D x E. apply in_filter_iff in E as [E E']. - apply in_filter_iff. auto. - Qed. - - Lemma filter_id A : - (forall x, x el A -> p x) -> filter p A = A. - Proof. - intros D. - induction A as [|x A]; simpl. - - reflexivity. - - decide (p x) as [E|E]. - + f_equal; auto. - + exfalso. auto. - Qed. - - Lemma filter_app A B : - filter p (A ++ B) = filter p A ++ filter p B. - Proof. - induction A as [|y A]; simpl. - - reflexivity. - - rewrite IHA. decide (p y); reflexivity. - Qed. - - Lemma filter_fst x A : - p x -> filter p (x::A) = x::filter p A. - Proof. - simpl. decide (p x); tauto. - Qed. - - Lemma filter_fst' x A : - ~ p x -> filter p (x::A) = filter p A. - Proof. - simpl. decide (p x); tauto. - Qed. - -End FilterLemmas. - - -Ltac filter_case p x A H := - decide (p x) as [H|H]; - [rewrite (filter_fst A H) | rewrite (filter_fst' A H)]. - - -Section FilterLemmas_pq. - Variable X : Type. - Variable p q : decPred X. - - Lemma filter_pq_mono A : - (forall x, x el A -> p x -> q x) -> filter p A <<= filter q A. - Proof. - intros D x. - rewrite !in_filter_iff. intuition. - Qed. - - Lemma filter_pq_eq A : - (forall x, x el A -> (p x <-> q x)) -> filter p A = filter q A. - Proof. - intros C; induction A as [|x A]; cbn. - - reflexivity. - - decide (p x) as [D|D]; decide (q x) as [E|E]. - + f_equal; auto. - + exfalso. apply E, C; auto. - + exfalso. apply D, C; auto. - + auto. - Qed. - - Lemma filter_and A : - filter p (filter q A) = filter (DecPred (fun x => p x /\ q x)) A. - Proof. - induction A as [|x A]; cbn. - - reflexivity. - - rewrite <- IHA. - decide (q x) as [D|D]; decide (p x /\ q x) as [E|E]. - + apply filter_fst. intuition. - + apply filter_fst'. intuition. - + tauto. - + reflexivity. - Qed. -End FilterLemmas_pq. - -Lemma filter_comm X p q (A :list X) : - filter p (filter q A) = filter q (filter p A). -Proof. - rewrite !filter_and. apply filter_pq_eq. cbn. tauto. -Qed. -(** * Element removal *) - -Section Removal. - Variable X : eqType. - Implicit Types x y : X. - - (* Definition neq (x : X) := decp (fun y => y <> x). *) - - Definition rem A x := filter (DecPred (fun y => y <> x)) A. - - Lemma in_rem_iff x A y : - x el rem A y <-> x el A /\ x <> y. - Proof. - apply in_filter_iff. - Qed. - - Lemma rem_not_in x y A : - x = y \/ ~ x el A -> ~ x el rem A y. - Proof. - intros D E. apply in_rem_iff in E. tauto. - Qed. - - Lemma rem_incl A x : - rem A x <<= A. - Proof. - apply filter_incl. - Qed. - - Lemma rem_mono A B x : - A <<= B -> rem A x <<= rem B x. - Proof. - apply filter_mono. - Qed. - - Lemma rem_cons A B x : - A <<= B -> rem (x::A) x <<= B. - Proof. - intros E y F. apply E. apply in_rem_iff in F. - destruct F as [[|]]; congruence. - Qed. - - Lemma rem_cons' A B x y : - x el B -> rem A y <<= B -> rem (x::A) y <<= B. - Proof. - intros E F u G. - apply in_rem_iff in G as [[[]|G] H]. exact E. - apply F. apply in_rem_iff. auto. - Qed. - - Lemma rem_in x y A : - x el rem A y -> x el A. - Proof. - apply rem_incl. - Qed. - - Lemma rem_neq x y A : - x <> y -> x el A -> x el rem A y. - Proof. - intros E F. apply in_rem_iff. auto. - Qed. - - Lemma rem_app x A B : - x el A -> B <<= A ++ rem B x. - Proof. - intros E y F. - decide (x=y) as [<-|G]; auto using rem_neq. - Qed. - - Lemma rem_app' x A B C : - rem A x <<= C -> rem B x <<= C -> rem (A ++ B) x <<= C. - Proof. - unfold rem; rewrite filter_app; auto. - Qed. - - Lemma rem_equi x A : - x::A === x::rem A x. - Proof. - split; intros y; - intros [[]|E]; decide (x=y) as [[]|D]; - eauto using rem_in, rem_neq. - Qed. - - Lemma rem_comm A x y : - rem (rem A x) y = rem (rem A y) x. - Proof. - apply filter_comm. - Qed. - - Lemma rem_fst x A : - rem (x::A) x = rem A x. - Proof. - unfold rem. rewrite filter_fst'; auto. - Qed. - - Lemma rem_fst' x y A : - x <> y -> rem (x::A) y = x::rem A y. - Proof. - intros E. unfold rem. rewrite filter_fst; auto. - Qed. - - Lemma rem_id x A : - ~ x el A -> rem A x = A. - Proof. - intros D. apply filter_id. - intros y E F. subst. auto. - Qed. - - Lemma rem_reorder x A : - x el A -> A === x :: rem A x. - Proof. - intros D. rewrite <- rem_equi. apply equi_push, D. - Qed. - - Lemma rem_inclr A B x : - A <<= B -> ~ x el A -> A <<= rem B x. - Proof. - intros D E y F. apply in_rem_iff. - intuition; subst; auto. - Qed. - -End Removal. - -Hint Resolve rem_not_in rem_incl rem_mono rem_cons rem_cons' rem_app rem_app' rem_in rem_neq rem_inclr. - -(** * Cardinality *) - -Section Cardinality. - Variable X : eqType. - Implicit Types A B : list X. - - Fixpoint card A : nat := - match A with - | nil => 0 - | x::A => if decision (x el A) then card A else 1 + card A - end. - - Lemma card_in_rem x A : - x el A -> card A = 1 + card (rem A x). - Proof. - intros D. - induction A as [|y A]; simpl. - - contradiction D. - - decide (y <> x) as [E|E]; simpl. - + rewrite IHA. - * { rewrite (rem_fst' _ E). - decide (y el A) as [G|G]; simpl; f_equal; - decide (y el rem A x) as [K|K]; simpl; try reflexivity. - - exfalso. apply K. apply in_rem_iff; auto. - - exfalso. apply in_rem_iff in K. tauto. } - * destruct D; tauto. - + apply dec_DN in E. - * { subst y. rewrite rem_fst. - decide (x el A) as [E|E]. - - auto. - - rewrite rem_id; auto. } - * auto. - Qed. - - Lemma card_not_in_rem A x : - ~ x el A -> card A = card (rem A x). - Proof. - intros D; rewrite rem_id; auto. - Qed. - - Lemma card_le A B : - A <<= B -> card A <= card B. - Proof. - revert B. - induction A as [|x A]; intros B D; simpl. - - omega. - - apply incl_lcons in D as [D D1]. - decide (x el A) as [E|E]. - + auto. - + rewrite (card_in_rem D). - cut (card A <= card (rem B x)). omega. - apply IHA. auto. - Qed. - - Lemma card_eq A B : - A === B -> card A = card B. - Proof. - intros [E F]. apply card_le in E. apply card_le in F. omega. - Qed. - - Lemma card_cons_rem x A : - card (x::A) = 1 + card (rem A x). - Proof. - rewrite (card_eq (rem_equi x A)). simpl. - decide (x el rem A x) as [D|D]. - - exfalso. apply in_rem_iff in D; tauto. - - reflexivity. - Qed. - - Lemma card_0 A : - card A = 0 -> A = nil. - Proof. - destruct A as [|x A]; intros D. - - reflexivity. - - exfalso. rewrite card_cons_rem in D. omega. - Qed. - - Lemma card_ex A B : - card A < card B -> exists x, x el B /\ ~ x el A. - Proof. - intros D. - decide (B <<= A) as [E|E]. - - exfalso. apply card_le in E. omega. - - apply list_exists_not_incl; auto. - Qed. - - Lemma card_equi A B : - A <<= B -> card A = card B -> A === B. - Proof. - revert B. - induction A as [|x A]; simpl; intros B D E. - - symmetry in E. now apply card_0 in E as ->. - - apply incl_lcons in D as [D D1]. - decide (x el A) as [F|F]. - + rewrite (IHA B); auto. - + rewrite (IHA (rem B x)). - * symmetry. apply rem_reorder, D. - * auto. - * apply card_in_rem in D. omega. - Qed. - - Lemma card_lt A B x : - A <<= B -> x el B -> ~ x el A -> card A < card B. - Proof. - intros D E F. - decide (card A = card B) as [G|G]. - + exfalso. apply F. apply (card_equi D); auto. - + apply card_le in D. omega. - Qed. - - Lemma card_or A B : - A <<= B -> A === B \/ card A < card B. - Proof. - intros D. - decide (card A = card B) as [F|F]. - - left. apply card_equi; auto. - - right. apply card_le in D. omega. - Qed. - -End Cardinality. - -Instance card_equi_proper (X : eqType) : - Proper (@equi X ==> eq) (@card X). -Proof. - hnf. apply card_eq. -Qed. - -(** * Duplicate-free lists *) - -Inductive dupfree (X : Type) : list X -> Prop := -| dupfreeN : dupfree nil -| dupfreeC x A : ~ x el A -> dupfree A -> dupfree (x::A). - -Section Dupfree. - Variable X : Type. - Implicit Types A B : list X. - - Lemma dupfree_cons x A : - dupfree (x::A) <-> ~ x el A /\ dupfree A. - Proof. - split; intros D. - - inv D; auto. - - apply dupfreeC; tauto. - Qed. - - Lemma dupfree_app A B : - disjoint A B -> dupfree A -> dupfree B -> dupfree (A++B). - - Proof. - intros D E F. induction E as [|x A E' E]; simpl. - - exact F. - - apply disjoint_cons in D as [D D']. - constructor; [|exact (IHE D')]. - intros G. apply in_app_iff in G; tauto. - Qed. - - Lemma dupfree_map Y A (f : X -> Y) : - (forall x y, x el A -> y el A -> f x = f y -> x=y) -> - dupfree A -> dupfree (map f A). - - Proof. - intros D E. induction E as [|x A E' E]; simpl. - - constructor. - - constructor; [|now auto]. - intros F. apply in_map_iff in F as [y [F F']]. - rewrite (D y x) in F'; auto. - Qed. - - Lemma dupfree_filter p A : - dupfree A -> dupfree (filter p A). - - Proof. - intros D. induction D as [|x A C D]; simpl. - - left. - - decide (p x) as [E|E]; auto. - right; auto. rewrite in_filter_iff. tauto. - Qed. - -End Dupfree. - -Section DupFreeDis. - Variable X : eqType. - Implicit Types A : list X. - - Lemma dupfree_dec A : - dec (dupfree A). - Proof. - induction A as [|x A]. - - left. left. - - decide (x el A) as [E|E]. - + right. intros F. inv F; tauto. - + destruct (IHA) as [F|F]. - * unfold dec. auto using dupfree. - * right. intros G. inv G; tauto. - Qed. - - Lemma dupfree_card A : - dupfree A -> card A = |A|. - Proof. - intros D. - induction D as [|x A E F]; simpl. - - reflexivity. - - decide (x el A) as [G|]. - + contradiction (E G). - + omega. - Qed. -End DupFreeDis. - -Section Undup. - Variable X : eqType. - Implicit Types A B : list X. - - Fixpoint undup A : list X := - match A with - | nil => nil - | x::A' => if decision (x el A') then undup A' else x :: undup A' - end. - - Lemma undup_id_equi A : - undup A === A. - Proof. - induction A as [|x A]; simpl. - - reflexivity. - - decide (x el A) as [E|E]; rewrite IHA; auto. - Qed. - - Lemma dupfree_undup A : - dupfree (undup A). - Proof. - induction A as [|x A]; simpl. - - left. - - decide (x el A) as [E|E]; auto. - right; auto. now rewrite undup_id_equi. - Qed. - - Lemma undup_incl A B : - A <<= B <-> undup A <<= undup B. - Proof. - now rewrite !undup_id_equi. - Qed. - - Lemma undup_equi A B : - A === B <-> undup A === undup B. - Proof. - now rewrite !undup_id_equi. - Qed. - - Lemma undup_id A : - dupfree A -> undup A = A. - Proof. - intros E. induction E as [|x A E F]; simpl. - - reflexivity. - - rewrite IHF. decide (x el A) as [G|G]; tauto. - Qed. - - Lemma undup_idempotent A : - undup (undup A) = undup A. - - Proof. apply undup_id, dupfree_undup. Qed. - -End Undup. - -(** * Power lists *) - -Section PowerRep. - Variable X : eqType. - - Implicit Types A U : list X. - - Fixpoint power (U : list X ) : list (list X) := - match U with - | nil => [nil] - | x :: U' => power U' ++ map (cons x) (power U') - end. - - Lemma power_incl A U : - A el power U -> A <<= U. - - Proof. - revert A; induction U as [|x U]; simpl; intros A D. - - destruct D as [[]|[]]; auto. - - apply in_app_iff in D as [E|E]. now auto. - apply in_map_iff in E as [A' [E F]]. subst A. - auto. - Qed. - - Lemma power_nil U : - nil el power U. - - Proof. induction U; simpl; auto. Qed. - -(* Definition member A := decp (fun x => x el A). *) - - Definition rep (A U : list X) : list X := - filter (DecPred (fun x => x el A)) U. - - Lemma rep_power A U : - rep A U el power U. - - Proof. - unfold rep. - induction U as [|x U]. - - simpl; auto. - - simpl power. - decide (x el A) as [D|D]. - + rewrite filter_fst; simpl; auto using in_map. - + rewrite filter_fst'; simpl; auto using in_map. - Qed. - - Lemma rep_incl A U : - rep A U <<= A. - - Proof. - unfold rep. intros x D. apply in_filter_iff in D. apply D. - Qed. - - Lemma rep_in x A U : - A <<= U -> x el A -> x el rep A U. - Proof. - intros D E. apply in_filter_iff; auto. - Qed. - - Lemma rep_equi A U : - A <<= U -> rep A U === A. - - Proof. - intros D. split. now apply rep_incl. - intros x. apply rep_in, D. - Qed. - - Lemma rep_mono A B U : - A <<= B -> rep A U <<= rep B U. - - Proof. intros D. apply filter_pq_mono. simpl. auto. Qed. - - Lemma rep_eq' A B U : - (forall x, x el U -> (x el A <-> x el B)) -> rep A U = rep B U. - - Proof. intros D. apply filter_pq_eq. auto. Qed. - - Lemma rep_eq A B U : - A === B -> rep A U = rep B U. - - Proof. intros D. apply filter_pq_eq; simpl. firstorder. Qed. - - Lemma rep_injective A B U : - A <<= U -> B <<= U -> rep A U = rep B U -> A === B. - - Proof. - intros D E F. transitivity (rep A U). - - symmetry. apply rep_equi, D. - - rewrite F. apply rep_equi, E. - Qed. - - Lemma rep_idempotent A U : - rep (rep A U) U = rep A U. - - Proof. - unfold rep at 1 3. apply filter_pq_eq. - intros x D. split. - + apply rep_incl. - + intros E. apply in_filter_iff. auto. - Qed. - - Lemma dupfree_power U : - dupfree U -> dupfree (power U). - - Proof. - intros D. induction D as [|x U E D]; simpl. - - constructor. now auto. constructor. - - apply dupfree_app. - + intros [A [F G]]. apply in_map_iff in G as [A' [G G']]. - subst A. apply E. apply (power_incl F). auto. - + exact IHD. - + apply dupfree_map; congruence. - Qed. - - Lemma dupfree_in_power U A : - A el power U -> dupfree U -> dupfree A. - - Proof. - intros E D. revert A E. - induction D as [|x U D D']; simpl; intros A E. - - destruct E as [[]|[]]. constructor. - - apply in_app_iff in E as [E|E]. - + auto. - + apply in_map_iff in E as [A' [E E']]. subst A. - constructor. - * intros F; apply D. apply (power_incl E'), F. - * auto. - Qed. - - Lemma rep_dupfree A U : - dupfree U -> A el power U -> rep A U = A. - - Proof. - unfold rep. - intros D; revert A. - induction D as [|x U E F]; intros A G. - - destruct G as [[]|[]]; reflexivity. - - simpl in G. apply in_app_iff in G as [G|G]. - + decide (x el A) as [H|H]. - * exfalso. apply E. apply (power_incl G), H. - * rewrite filter_fst'; simpl; auto. - + apply in_map_iff in G as [A' [G H]]. subst A. - rewrite filter_fst. - * f_equal. pattern A' at 3. rewrite <- (IHF _ H). - apply filter_pq_eq. simpl. intuition subst; intuition. - * simpl; auto. - Qed. - - Lemma power_extensional A B U : - dupfree U -> A el power U -> B el power U -> A === B -> A = B. - - Proof. - intros D E F G. - rewrite <- (rep_dupfree D E). rewrite <- (rep_dupfree D F). - apply rep_eq, G. - Qed. - -End PowerRep. - - -(** Size induction from ICL *) - -Lemma size_induction X (f : X -> nat) (p : X -> Prop) : - (forall x, (forall y, f y < f x -> p y) -> p x) -> - forall x, p x. -Proof. - intros step x. apply step. - assert (G: forall n y, f y < n -> p y). - { intros n. induction n. - - intros y B. exfalso. omega. - - intros y B. apply step. intros z C. apply IHn. omega. } - apply G. -Qed. \ No newline at end of file diff --git a/external/base/FiniteTypes/FCI.v b/external/base/FiniteTypes/FCI.v deleted file mode 100644 index 9d83cec..0000000 --- a/external/base/FiniteTypes/FCI.v +++ /dev/null @@ -1,192 +0,0 @@ - - -(* (** * Finite Closure Iteration *) *) -(* Section Fixedpoints. *) -(* Variable X: Type. *) -(* Variable f: X -> X. *) -(* Definition fp x := f x = x. *) - -(* Lemma fp_trans x: fp x -> fp (f x). *) -(* Proof. *) -(* congruence. *) -(* Qed. *) - -(* Lemma fInduction (p: X -> Prop) (x:X) (px: p x) (IHf: forall y, p y -> p (f y)) n: p (Nat.iter n f x). *) -(* Proof. *) -(* induction n. *) -(* - exact px. *) -(* - firstorder. *) -(* Qed. *) - -(* Lemma fp_iter_trans x n: fp (Nat.iter n f x) -> forall m, m >= n -> fp (Nat.iter m f x). *) -(* Proof. *) -(* intros F m H. induction m. *) -(* - destruct n; auto. omega. *) -(* - decide (S m = n). *) -(* + now rewrite e. *) -(* + assert (m >= n) as G by omega. *) -(* specialize (IHm G). simpl. now apply fp_trans. *) -(* Qed. *) - -(* End Fixedpoints. *) - -(* Definition admissible (X: eqType) f := forall A: list X, fp f A \/ card (f A) > card A. *) - - -(* Lemma fp_card_admissible (X:eqType) f n: *) -(* admissible f -> forall A: list X, fp f (Nat.iter n f A) \/ card (Nat.iter n f A) >= n. *) -(* Proof. *) -(* intros M A. induction n. *) -(* - cbn in *. right. omega. *) -(* - simpl in *. destruct IHn as [IHn | IHn] . *) -(* + left. now apply fp_trans. *) -(* + destruct (M ((Nat.iter n f A))) as [M' | M']. *) -(* * left. now apply fp_trans. *) -(* * right. omega. *) -(* Qed. *) - -(* Lemma fp_admissible (X:finType) (f: list X -> list X): *) -(* admissible f -> forall A, fp f (Nat.iter (Cardinality X) f A). *) -(* Proof. *) -(* intros F A. *) -(* destruct (fp_card_admissible (Cardinality X) F A) as [H | H]. *) -(* - exact H. *) -(* - specialize (F (Nat.iter (Cardinality X) f A)). destruct F as [F |F]. *) -(* + tauto. *) -(* + pose proof (card_upper_bound (f (Nat.iter (Cardinality X) f A))). omega. *) -(* Qed. *) - -(* Section FiniteClosureIteration. *) -(* Variable X : finType. *) -(* Variable step:list X -> X -> Prop. *) -(* Variable step_dec: forall A x, dec (step A x). *) - - -(* Lemma pick A : {x | step A x /\ ~ (x el A)} + forall x, step A x -> x el A. *) -(* Proof. *) -(* decide (forall x, step A x -> x el A). *) -(* - tauto. *) -(* - left. destruct (DM_notAll _ (p:= fun x => step A x -> x el A)) as [H _]. *) -(* destruct (finType_cc _ (H n)) as [x H']. firstorder. *) -(* Defined. *) - -(* Definition FCStep A := *) -(* match (pick A) with *) -(* | inl L => match L with *) -(* exist _ x _ => x::A end *) -(* | inr _ => A end. *) - -(* Definition FCIter := Nat.iter (Cardinality X) FCStep. *) - -(* Lemma FCStep_admissible: admissible FCStep. *) -(* Proof. *) -(* intro A. unfold fp. unfold FCStep. destruct (pick A) as [[y [S ne]] | S];auto. *) -(* right. cbn. dec. *) -(* - tauto. *) -(* - omega. *) -(* Qed. *) - -(* Lemma FCIter_fp A: fp FCStep (FCIter A). *) -(* Proof. *) -(* unfold FCIter. apply fp_admissible. exact FCStep_admissible. *) -(* Qed. *) - -(* (* inclp A p means every x in A satisfies p *) *) - -(* Lemma FCIter_ind (p: X -> Prop) A : inclp A p -> (forall A x , (inclp A p) -> (step A x -> p x)) -> inclp (FCIter A) p. *) -(* Proof. *) -(* intros incl H. unfold FCIter. apply fInduction. *) -(* - assumption. *) -(* - intros B H1 x E. unfold FCStep in E. destruct (pick B) as [[y [S nE]] | S]. *) -(* + destruct E as [E|E]; try subst x; eauto. *) -(* + auto. *) -(* Qed. *) - -(* Lemma Closure x A: fp FCStep A -> step A x -> x el A. *) -(* Proof. *) -(* intros F. unfold fp in F. unfold FCStep in F. destruct (pick A) as [[y _] | S]. *) -(* - contradiction (list_cycle F). *) -(* - exact (S x). *) -(* Qed. *) - -(* Lemma Closure_FCIter x A: step (FCIter A) x -> x el (FCIter A). *) -(* Proof. apply Closure. apply FCIter_fp. *) -(* Qed. *) - -(* Lemma preservation_step A: A <<= FCStep A. *) -(* Proof. *) -(* intro H. unfold FCStep. destruct (pick A) as [[y [S ne]] | S]; cbn; tauto. *) -(* Qed. *) - -(* Lemma preservation_iter A n: A <<= Nat.iter n FCStep A. *) -(* Proof. *) -(* intros x E. induction n. *) -(* - assumption. *) -(* - simpl. now apply preservation_step. *) -(* Qed. *) - -(* Lemma preservation_FCIter A: A <<= FCIter A. *) -(* Proof. *) -(* apply preservation_iter. *) -(* Qed. *) - -(* Definition least_fp_containing f (B A: list X) := fp f B /\ A <<= B /\ forall B', fp f B' /\ A <<= B' -> B <<= B'. *) - -(* Definition step_consistent:= forall A x, step A x -> forall A', A <<= A' -> step A' x. *) - -(* Lemma step_iter_consistent: step_consistent -> forall A x n, step A x -> step (Nat.iter n FCStep A) x. *) -(* Proof. *) -(* intros H A x n S. eapply H. *) -(* - exact S. *) -(* - apply preservation_iter. *) -(* Qed. *) - - - -(* Lemma step_trans_fp_incl: step_consistent -> forall A B, fp FCStep B -> A <<= B -> forall n, Nat.iter n FCStep A <<= B. *) -(* Proof. *) -(* intros ST A B F H n. apply fInduction. *) -(* - exact H. *) -(* - intros B' H'. unfold FCStep at 1. destruct (pick B') as [[y [S _]] | _]. *) -(* + specialize (ST _ _ S _ H'). intros x [E |E]. *) -(* * subst x. now apply Closure. *) -(* * auto. *) -(* + exact H'. *) -(* Qed. *) - -(* Lemma step_consistent_least_fp: step_consistent -> forall A, least_fp_containing FCStep (FCIter A) A. *) -(* Proof. *) -(* intros ST A. repeat split. *) -(* - apply FCIter_fp. *) -(* - apply preservation_FCIter. *) -(* - intros B [H H']. now apply step_trans_fp_incl. *) -(* Qed. *) - -(* (** Dupfreeness of FCIter *) -(* - relict of an old proof *) -(* - might still be useful in concrete applications *) *) - -(* Lemma dupfree_FCStep A: dupfree A -> dupfree (FCStep A). *) -(* Proof. *) -(* intro DA. unfold FCStep. destruct (pick A) as [[y [S ne]] | S]; auto. now constructor. *) -(* Qed. *) - -(* Lemma dupfree_iterstep n A: dupfree A -> dupfree (Nat.iter n FCStep A). *) -(* Proof. *) -(* induction n. *) -(* - now cbn. *) -(* - intro H. simpl. apply dupfree_FCStep; tauto. *) -(* Qed. *) - -(* Lemma dupfree_FCIter A : dupfree A -> dupfree (FCIter A). *) -(* Proof. *) -(* apply dupfree_iterstep. *) -(* Qed. *) - -(* End FiniteClosureIteration. *) -(* Arguments FCIter {X} step {step_dec} x. *) -(* Arguments FCStep {X} step {step_dec} A. *) -(* Arguments pick {X} {step} {step_dec} A. *) - - - diff --git a/external/base/FiniteTypes/FinTypes.v b/external/base/FiniteTypes/FinTypes.v deleted file mode 100644 index 4589ba7..0000000 --- a/external/base/FiniteTypes/FinTypes.v +++ /dev/null @@ -1,141 +0,0 @@ -Require Export BasicDefinitions. -Require Import Shared.Bijection. - -(** ** Formalisation of finite types using canonical structures and type classes *) - -(** * Definition of finite Types *) - -Class finTypeC (type:eqType) : Type := - FinTypeC { - enum: list type; - enum_ok: forall x: type, count enum x = 1 - }. - -Structure finType : Type := - FinType - { - type:> eqType; - class: finTypeC type - }. - -Arguments FinType type {class}. -Existing Instance class | 0. - - -(* This is a hack to work-around a problem with a class of hacks *) -Hint Extern 5 (finTypeC (EqType ?x)) => unfold x : typeclass_instances. - -Canonical Structure finType_CS (X : Type) {p : eq_dec X} {class : finTypeC (EqType X)} : finType := FinType (EqType X). - -(** Print the base type of [finType] in the Canonical Structure. *) -Arguments finType_CS (X) {_ _}. - -Definition elem (F: finType) := @enum (type F) (class F). -Hint Unfold elem. -Hint Unfold class. - -Lemma elem_spec (X: finType) (x:X) : x el (elem X). -Proof. - apply countIn. pose proof (enum_ok x) as H. unfold elem. omega. -Qed. - -Hint Resolve elem_spec. -Hint Resolve enum_ok. - -Lemma allSub (X: finType) (A:list X) : A <<= elem X. -Proof. - intros x _. apply elem_spec. -Qed. -Hint Resolve allSub. - -(** A properties that hold on every element of (elem X) hold for every element of the finType X *) -Theorem Equivalence_property_all (X: finType) (p: X -> Prop) : - (forall x, p x) <-> forall x, x el (elem X) -> p x. -Proof. - split; auto. -Qed. - -Theorem Equivalence_property_exists (X: finType) (p:X -> Prop): - (exists x, p x) <-> exists x, x el (elem X) /\ p x. -Proof. - split. - - intros [x P]. eauto. - - intros [x [E P]]. eauto. -Qed. - -Instance finType_forall_dec (X: finType) (p: X -> Prop): (forall x, dec (p x)) -> dec (forall x, p x). -Proof. - intros D. eapply dec_transfer. - - symmetry. exact (Equivalence_property_all p). - - auto. -Qed. - -Instance finType_exists_dec (X:finType) (p: X -> Prop) : (forall x, dec (p x)) -> dec (exists x, p x). -Proof. - intros D. eapply dec_transfer. - - symmetry. exact (Equivalence_property_exists p). - - auto. -Qed. - -Definition finType_cc (X: finType) (p: X -> Prop) (D: forall x, dec (p x)) : (exists x, p x) -> {x | p x}. -Proof. - intro H. - assert(exists x, x el (elem X) /\ p x) as E by firstorder. - pose proof (list_cc D E) as [x G]. - now exists x. -Defined. - -Definition pickx (X: finType): X + (X -> False). -Proof. - destruct X as [X [enum ok]]. induction enum. - - right. intro x. discriminate (ok x). - - tauto. -Defined. - -(** * Properties of decidable Propositions *) - -Lemma DM_notAll (X: finType) (p: X -> Prop) (D:forall x, dec (p x)): (~ (forall x, p x)) <-> exists x, ~ (p x). -Proof. - decide (exists x,~ p x); firstorder. -Qed. - -Lemma DM_exists (X: finType) (p: X -> Prop) (D: forall x, dec (p x)): - (exists x, p x) <-> ~(forall x, ~ p x). -Proof. - split. - - firstorder. - - decide (exists x, p x); firstorder. -Qed. - -(* Index is an injective function *) - - -Fixpoint getPosition {E: eqType} (A: list E) x := match A with - | nil => 0 - | cons x' A' => if Dec (x=x') then 0 else 1 + getPosition A' x end. - -Lemma getPosition_correct {E: eqType} (x:E) A: if Dec (x el A) then forall z, (nth (getPosition A x) A z) = x else getPosition A x = |A |. -Proof. - induction A;cbn. - -repeat destruct Dec;tauto. - -repeat destruct Dec;intuition; congruence. -Qed. - -Definition pos_def (X : eqType) (x : X) A n := match pos x A with None => n | Some n => n end. - -Definition index {F: finType} (x:F) := getPosition (elem F) x. - -Lemma index_nth {F : finType} (x:F) y: nth (index x) (elem F) y = x. - unfold index, elem, enum. - destruct F as [[X E] [A all_A]];cbn. - pose proof (getPosition_correct x A) as H. - destruct Dec. auto. apply notInZero in n. now setoid_rewrite all_A in n. -Qed. - -Lemma injective_index (A: finType) (x1 x2 : A) : index x1 = index x2 -> x1 = x2. -Proof. - destruct (elem A) eqn:E. - - hnf. intros. assert (x1 el elem A) by eauto using elem_spec. rewrite E in H0. auto. - - clear E. eapply (left_inv_inj (g := (fun y => nth y (elem A) e))). - hnf. intros. now rewrite index_nth. -Qed. \ No newline at end of file diff --git a/external/base/FiniteTypes/FiniteFunction.v b/external/base/FiniteTypes/FiniteFunction.v deleted file mode 100644 index 193581e..0000000 --- a/external/base/FiniteTypes/FiniteFunction.v +++ /dev/null @@ -1,384 +0,0 @@ -Require Import FinTypes Base. -Require Import Bijection. - -(* Require Import Vector. *) - -(* Definition vector X Y := Vector.t Y (|elem X|). *) - -Definition finfunc_table (A : finType) (B: Type) (f: A -> B) := - List.map (fun x => (x, f x)) (elem A). - -(* Now we prove that the tranformation of a function of finite domain to a table is correct *) - -Lemma finfunc_comp (A : finType) (B: Type) (f: A -> B) a : (a,f a) el finfunc_table f. -Proof. - unfold finfunc_table. now eapply (in_map (fun x => (x, f x))). -Qed. - -Lemma finfunc_sound (A : finType) (B : Type) (f: A -> B) a b: (a,b) el finfunc_table f -> b = f a. -Proof. - unfold finfunc_table. rewrite in_map_iff. firstorder congruence. -Qed. - -Lemma finfunc_sound_cor (A : finType) (B:Type) (f: A -> B) a b b' : (a,b) el finfunc_table f -> (a,b') el finfunc_table f -> b = b'. -Proof. - intros H1 H2. specialize (finfunc_sound H1). specialize (finfunc_sound H2). congruence. -Qed. - - -Definition lookup (A : eqType) (B : Type) (l : list (A * B)) (a : A) (def : B) : B := - match (filter (fun p => Dec (fst p = a)) l) with - List.nil => def - | p :: _ => snd p - end. - - -Lemma lookup_sound (A: eqType) (B: Type) (L : list (prod A B)) a b def : - (forall a' b1 b2, (a',b1) el L -> (a',b2) el L -> b1=b2) -> (a,b) el L -> lookup L a def = b. -Proof. - intros H1 H2. unfold lookup. - destruct filter eqn:E. - - assert ((a,b) el filter (fun p : A * B => Dec (fst p = a)) L) by ( rewrite in_filter_iff ; eauto). - now rewrite E in H. - - destruct p. assert ((e,b0) el (filter (fun p : A * B => Dec (fst p = a)) L)) by now rewrite E. - rewrite in_filter_iff in H. - dec; cbn in *; subst; firstorder. -Qed. - -Lemma finfunc_correct (A: finType) B (f: A -> B) a def: lookup (finfunc_table f) a def = f a. -Proof. - eapply lookup_sound; [ apply finfunc_sound_cor | apply finfunc_comp ]. -Qed. - - -(* Now we can prove that the transformation of the function table into another type is correct as long -as the conversion is injective *) - -Lemma finfunc_conv (A: finType) (cA : eqType) (B cB : Type) (f: A -> B) (mA : A -> cA) (mB : B -> cB) a def: - injective mA -> lookup (List.map (fun x => (mA (fst x), mB (snd x))) (finfunc_table f)) (mA a) def = mB (f a). -Proof. - intros INJ. - erewrite lookup_sound; eauto. - - intros a' b1 b2 H1 H2. rewrite in_map_iff in *. destruct H1 as [[] [L1 R1]]. destruct H2 as [[] [L2 R2]]. - cbn in *. - inv L1; inv L2. rewrite (finfunc_sound R1), (finfunc_sound R2), (INJ e e0); congruence. - - rewrite in_map_iff. exists (a, f a). subst. split; auto. apply finfunc_comp. -Qed. - - - - -(* (** * Definition of vectors (extensional/ set theoretic functions) *) - (* structure containing a list representing the image and a proof that the list has exactly as many elements as the source type *) *) -(* Definition Card_X_eq X Y (A: list Y) := |A| = Cardinality X. *) -(* Definition vector (X: finType) (Y: Type) := subtype (@Card_X_eq X Y). *) -(* Notation "X --> Y" := (vector X Y) (at level 55, right associativity). *) -(* Hint Unfold pure. *) -(* Hint Unfold Card_X_eq. *) -(* (** Projects the list from a STF *) *) -(* Definition image (X: finType) (Y: Type) (f: X --> Y) := proj1_sig f. *) - -(* (** Instance Declaration for Type Dec Type class for vectors. *) *) -(* Instance vector_eq_dec (X: finType) (Y: eqType) : eq_dec (X --> Y). *) -(* Proof. *) -(* auto. *) -(* Qed. *) - -(* Canonical Structure EqVect (X: finType) (Y: eqType) := EqType (X --> Y). *) - -(* (** Function which produces a list of all list containing elements from A with length n *) *) -(* Fixpoint images (Y: Type) (A: list Y) (n: nat): list (list Y) := *) -(* match n with *) -(* | 0 => [[]] *) -(* | S n' => concat (map (fun x => map (cons x) (images A n')) A) *) -(* end. *) - -(* Lemma imagesNonempty (Y: Type) y (A: list Y) : forall n, images (y::A) n <> nil. *) -(* Proof. *) -(* intro n. induction n. *) -(* - cbn. congruence. *) -(* - cbn. intro H. pose proof (app_eq_nil _ _ H) as [E1 E2]. clear H. pose proof (map_eq_nil _ _ E1). auto. *) -(* Qed. *) - -(* (** If x is unequal to y then a list starting with y cannot be found in a list of list all starting with x *) *) -(* Lemma notInMapCons (X: Type) (x y: X) (A: list X) (B: list (list X)): *) -(* x <> y -> y::A el (map (cons x) B) -> False. *) -(* Proof. *) -(* intros neq E. rewrite in_map_iff in E. destruct E as [C [E _]]. congruence. *) -(* Qed. *) - -(* Definition mC X B := (fun x:X => map (cons x) B). *) -(* Definition mmC X B (A: list X) := map (mC B) A. *) - -(* Lemma disjoint_map_cons X (A: list (list X)) (x y: X): x <> y -> disjoint (map (cons x) A) (map (cons y) A). *) -(* Proof. *) -(* intro N; induction A. *) -(* - cbn. auto. *) -(* - cbn. unfold disjoint. intros [B [H1 H2]]. destruct H1, H2. *) -(* + congruence. *) -(* + subst B. eapply notInMapCons. Focus 2. *) -(* * apply H0. *) -(* * congruence. *) -(* + subst B. eapply notInMapCons; eauto. *) -(* + apply IHA. now exists B. *) -(* Qed. *) - -(* Lemma disjoint_in (X: Type) x A (B: list (list X)) (E: B <> nil) B' (H: ~ x el A): B' el map (mC B) A -> disjoint (map (cons x) B) B'. *) -(* Proof. *) -(* destruct B; try congruence. *) -(* intro H'. induction A. *) -(* - contradiction H'. *) -(* - pose proof (negOr H) as [G G']. destruct H' as [H' | H']. *) -(* + subst B'. apply disjoint_map_cons; congruence. *) -(* + apply IHA; auto. *) -(* Qed. *) - -(* Lemma disjoint_in_map_map_cons X (A: list X) (B C C': list (list X)) (H: C <> C') (E: C el (mmC B A)) (E': C' el (mmC B A)) (N: B <> nil) (D: dupfree A): *) -(* disjoint C C'. *) -(* Proof. *) -(* induction D. *) -(* - contradiction E. *) -(* - destruct B; try congruence; clear N. destruct E, E'; try congruence. *) -(* + subst C. eapply disjoint_in; now eauto. *) -(* + subst C'. apply disjoint_symm. eapply disjoint_in; now eauto. *) -(* + now apply IHD. *) -(* Qed. *) - -(* Lemma dupfree_concat_map_cons (X: Type) (A: list X) (B: list (list X)): *) -(* dupfree A -> dupfree B -> B <> nil -> dupfree (concat (map (fun x => map (cons x) B) A)). *) -(* Proof. *) -(* intros D D' N. apply dupfree_concat; try split. *) -(* - intros C E. induction D. *) -(* + contradiction E. *) -(* + destruct E; auto. subst C. apply dupfree_map; auto. congruence. *) -(* - intros B' B'' E E' H. eapply disjoint_in_map_map_cons; eauto. *) -(* - apply dupfree_map; auto. intros x y _ _ E. destruct B. *) -(* + congruence. *) -(* + cbn in E. now inv E. *) -(* Qed. *) - -(* Lemma imagesDupfree (Y: Type) (A: list Y) (n:nat) : dupfree A -> dupfree (images A n). *) -(* Proof. *) -(* induction n. *) -(* - now repeat constructor. *) -(* - cbn. intro D. destruct A. *) -(* +constructor. *) -(* + apply dupfree_concat_map_cons; auto. apply imagesNonempty. *) -(* Qed. *) - -(* Lemma inConcatCons (Y: Type) (A C: list Y) (B: list (list Y)) y: y el A /\ C el B -> (y::C) el (concat (map (fun x => map (cons x) B) A)). *) -(* Proof. *) -(* intros [E E']. induction A. *) -(* - contradiction E. *) -(* - cbn. destruct E as [E | E]. *) -(* + subst a. apply in_app_iff. left. apply in_map_iff. now exists C. *) -(* + auto. *) -(* Qed. *) - -(* Lemma inImages (Y: Type) (A B: list Y): (forall x, x el B -> x el A) -> B el images A (|B|). *) -(* Proof. *) -(* intros E. induction B. *) -(* - cbn. now left. *) -(* - cbn. apply inConcatCons. auto. *) -(* Qed. *) - -(* (** images produces a list of containing all lists of correct length *) *) -(* Lemma vector_enum_ok (X: finType) (Y: finType) f: *) -(* |f| = Cardinality X -> count (images (elem Y) (Cardinality X)) f= 1. *) -(* Proof. *) -(* intros H. apply dupfreeCount. *) -(* - apply imagesDupfree. apply dupfree_elements. *) -(* - rewrite <- H. now apply inImages. *) -(* Qed. *) - -(* (** FunctionLists A n only produces lists of length n *) *) -(* Lemma imagesInnerLength (Y: Type) (n: nat) : *) -(* forall (A: list Y) B, B el (images A n) -> | B | = n. *) -(* Proof. *) -(* induction n; intros A B; cbn. *) -(* - intros H. destruct H; try tauto. now subst B. *) -(* - pattern A at 1. generalize A at 2. induction A; cbn. *) -(* + tauto. *) -(* + intros C E. destruct (in_app_or _ _ B E) as [H|H]. *) -(* * pose proof (in_map_iff (cons a) (images C n) B) as [G _]. specialize (G H); clear H. *) -(* destruct G as [D [H G]]. specialize (IHn _ _ G). subst B. cbn. omega. *) -(* * now apply (IHA C). *) -(* Qed. *) - -(* (** Function converting a list (list Y) containing lists of length Cardinality X into a lists of vectors (X --> Y) *) *) -(* Definition extensionalPower (X Y: finType) (L: list (list Y)) (P: L <<= images (elem Y) (Cardinality X)): list (X --> Y). *) -(* Proof. *) -(* revert L P. *) -(* refine (fix extPow L P := _). destruct L. *) -(* - exact nil. *) -(* - apply cons. *) -(* + exists l. specialize (P l (or_introl eq_refl)). unfold pure. dec; auto. contradiction ( n (imagesInnerLength P)). *) -(* + eapply extPow. intros A E. apply P. exact (or_intror E). *) -(* Defined. *) - -(* (** To vectors are equal if there images are equal *) *) -(* Lemma vector_extensionality (X: finType) (Y: Type) (F G: X --> Y) : (image F = image G) -> F = G. *) -(* Proof. *) -(* apply subtype_extensionality. *) -(* Qed. *) - -(* (** The number if occurences of a function in extensionalpower is equal to the number of occurences of its image in the original list given to extensionalpower as an argument *) *) -(* Lemma counttFL X Y L P f : *) -(* count (@extensionalPower X Y L P) f = count L (image f). *) -(* Proof. *) -(* induction L. *) -(* - reflexivity. *) -(* - simpl. dec; rename a into A; decide (image f = A). *) -(* + now rewrite IHL. *) -(* +contradict n. now subst f. *) -(* + contradict n. now apply vector_extensionality. *) -(* + apply IHL. *) -(* Qed. *) - -(* Instance finTypeC_vector (X Y: finType) : *) -(* finTypeC (EqVect X Y). *) -(* Proof. *) -(* apply (FinTypeC (enum := @extensionalPower _ _ (images (elem Y) (Cardinality X)) (fun x => fun y => y))). *) -(* intro f. rewrite counttFL. apply vector_enum_ok. destruct f as [A p]. cbn. now impurify p. *) -(* Defined. *) - -(* Canonical Structure finType_vector (X Y: finType) := FinType (EqVect X Y). *) - -(* Notation "Y ^ X" := (finType_vector X Y). *) - -(* Lemma finType_vector_correct (X Y: finType): *) -(* X --> Y = Y^ X. *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) - -(* Lemma finType_vector_enum (X Y: finType): *) -(* elem (Y^ X) = @extensionalPower _ _ (images (elem Y) (Cardinality X)) (fun x => fun y => y). *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) - -(* Set Printing Coercions. *) - -(* Lemma tofinType_vector_correct (X Y: finType): *) -(* tofinType (X --> Y) = Y ^ X. *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) -(* Unset Printing Coercions. *) -(* (** ** Conversion between vectors and functions *) *) - - -(* (** Function that applies a vector to an argument *) *) -(* Definition applyVect (X: finType) (Y: Type) (f: X --> Y): X -> Y. *) -(* Proof. *) -(* refine (fun x: X => _). *) -(* destruct (elem X) eqn: E. *) -(* - exfalso. pose proof (elem_spec x). now rewrite E in H. *) -(* - destruct f as [image p]. destruct image. *) -(* + exfalso. unfold Card_X_eq, Cardinality in p. rewrite E in p. now impurify p. *) -(* + exact (getAt (y::image0) (index x) y). *) -(* Defined. *) - -(* Coercion applyVect: vector >-> Funclass. *) - -(* (** A function converting A function f into the list representing its image on elements of A*) *) -(* Definition getImage {X: finType} {Y: Type} (f: X -> Y) :=map f (elem X). *) - -(* (** getImage contains the right elements *) *) -(* Lemma getImage_in (X: finType) (Y: Type) (f: X -> Y) (x:X) : (f x) el (getImage f). *) -(* Proof. *) -(* unfold getImage. now apply in_map. *) -(* Qed. *) -(* (** getImage only produces lists of the correct length *) *) -(* Lemma getImage_length (X: finType) (Y: Type) (f: X -> Y) : |getImage f| = Cardinality X. *) -(* Proof. *) -(* apply map_length. *) -(* Qed. *) - -(* (** Function converting a function into a vector *) *) -(* Definition vectorise {X: finType} {Y: Type} (f: X -> Y) : X --> Y := *) -(* exist (pure (@Card_X_eq X Y)) (getImage f) (purify (getImage_length f)). *) - -(* Lemma getImage_correct (X:finType) (Y:Type) (f: X -> Y): *) -(* getImage f = image (vectorise f). *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) - -(* (** A generalisation of a late case of apply_toVector_inverse *) *) -(* Lemma HelpApply (X: eqType) (Y: Type) (A: list X) (f: X -> Y) x y (C: count A x > 0): *) -(* getAt (map f A) (getPosition A x) y = f x. *) -(* Proof. *) -(* induction A. *) -(* - cbn in *. omega. *) -(* - cbn in *. dec. *) -(* + congruence. *) -(* + now apply IHA. *) -(* Qed. *) - -(* (** If a function is converted into a vector and then applied to an argument the result is the same as if one had just applied the function to the argument *) *) -(* Lemma apply_vectorise_inverse (X: finType) (Y: Type) (f: X -> Y) (x: X) : *) -(* (vectorise f) x = f x. *) -(* Proof. *) -(* destruct X as [X [A ok]]. destruct A. *) -(* - discriminate (ok x). *) -(* - cbn in *. specialize (ok x). dec. *) -(* + congruence. *) -(* + apply HelpApply. omega. *) -(* Qed. *) - -(* (** The position of x in a list containg x exactly once is one greater than the size of the sublist befor x *) *) -(* Lemma countNumberApp (X: eqType) (x:X) (A B: list X) (ok : count (A ++ x::B) x = 1) : *) -(* getPosition (A ++ x::B) x = |A|. *) -(* Proof. *) -(* induction A. *) -(* - cbn. now deq x. *) -(* - cbn in *. dec. *) -(* + inv ok. pose proof (countApp a A B). omega. *) -(* + auto. *) -(* Qed. *) - -(* Lemma getAt_correct (Y:Type) (A A': list Y) y y': *) -(* getAt (A' ++ y::A) (|A'|) y' = y. *) -(* Proof. *) -(* induction A'; cbn. *) -(* - reflexivity. *) -(* - cbn in *. apply IHA'. *) -(* Qed. *) - -(* Lemma rightResult (X: finType) (x:X) (B B': list X) (Y: Type) (y:Y) (A A': list Y) (H: pure (@Card_X_eq X Y) (A' ++ y::A)) (H': |A'| = | B'|) (G: elem X = B' ++ x::B): *) -(* ((exist _ _ H): X --> Y) x = y. *) -(* Proof. *) -(* destruct X as [X [C ok]]. unfold applyVect. cbn in *. subst C. destruct B'; destruct A' ; cbn in *; impurify H; unfold Card_X_eq in H; cbn in H. *) -(* - now deq x. *) -(* - rewrite app_length in H. inv H. omega. *) -(* - rewrite app_length in H. cbn in H. omega. *) -(* - specialize (ok x). dec. *) -(* + subst e. inv ok. pose proof countApp x B' B. omega. *) -(* + rewrite countNumberApp; auto. *) -(* inv H'. eapply getAt_correct. *) -(* Qed. *) - -(* Lemma vectorise_apply_inverse' (X: finType) (B B': list X) (Y: Type) (A A' A'': list Y) (H: pure (@Card_X_eq X Y) A'') (H': |A'| = | B' |) (H'': |A| = | B|) (E: A' ++ A = A'') (G: elem X = B' ++ B) : *) -(* map ((exist _ _ H): X --> Y) B= A. *) -(* Proof. *) -(* revert A A' B' H' H'' E G. induction B; intros A A' B' H' H'' E G. *) -(* - cbn. symmetry. now rewrite <- length_zero_iff_nil. *) -(* - cbn. destruct A; try (discriminate H''). f_equal. *) -(* + subst A''. eapply rightResult. *) -(* * inv H'. exact H1. *) -(* * exact G. *) -(* + apply (IHB A (A' ++ [y]) (B' ++ [a])). *) -(* * repeat rewrite app_length. cbn. omega. *) -(* * now inv H''. *) -(* * now rewrite app_assoc_reverse. *) -(* * rewrite G. replace (a::B) with ([a]++B) by auto. now rewrite app_assoc. *) -(* Qed. *) - -(* Lemma vectorise_apply_inverse (X: finType) (Y: Type) (f: X --> Y): vectorise f = f. *) -(* Proof. *) -(* apply vector_extensionality. cbn. destruct f as [A p]. *) -(* eapply vectorise_apply_inverse'; eauto using app_nil_l; now impurify p. *) -(* Qed. *) - diff --git a/external/base/FiniteTypes/Subtypes.v b/external/base/FiniteTypes/Subtypes.v deleted file mode 100644 index 6e16ffa..0000000 --- a/external/base/FiniteTypes/Subtypes.v +++ /dev/null @@ -1,59 +0,0 @@ - -(* (** * Subtypes *) *) - -(* Fixpoint toSubList (X: Type) (A: list X) (p: X -> Prop) (D:forall x, dec (p x)) : list (subtype p) := *) -(* match A with *) -(* | nil => nil *) -(* | cons x A' => match Dec (p x) with *) -(* | left px => (exist _ x (purify px)) :: toSubList A' D *) -(* | right _ => toSubList A' _ end *) -(* end. *) - -(* Arguments toSubList {X} A p {D}. *) - -(* Lemma toSubList_count (X: eqType) (p: X -> Prop) (A: list X) (_:forall x, dec (p x)) x: *) -(* count (toSubList A p) x = count A (proj1_sig x). *) -(* Proof. *) -(* induction A. *) -(* - reflexivity. *) -(* - cbn. decide (p a). *) -(* + simpl. dec. *) -(* * congruence. *) -(* * now rewrite <- subtype_extensionality in e. *) -(* * change a with (proj1_sig (exist (pure p) a (purify p0))) in e. now rewrite subtype_extensionality in e. *) -(* * exact IHA. *) -(* + destruct x. cbn. dec. *) -(* * subst a. now impurify p0. *) -(* * exact IHA. *) -(* Qed. *) - -(* Lemma subType_enum_ok (X:finType) (p: X -> Prop) (_: forall x, dec (p x)) x: *) -(* count (toSubList (elem X) p) x = 1. *) -(* Proof. *) -(* rewrite toSubList_count. apply enum_ok. *) -(* Qed. *) - -(* Instance finTypeC_sub (X:finType) (p: X -> Prop) (_:forall x, dec (p x)): finTypeC (EqSubType p). *) -(* Proof. *) -(* econstructor. apply subType_enum_ok. *) -(* Defined. *) - -(* Canonical Structure finType_sub (X: finType) (p: X -> Prop) (_: forall x, dec (p x)) := FinType (EqSubType p). *) -(* Arguments finType_sub {X} p {_}. *) - -(* Lemma finType_sub_correct (X: finType) (p: X -> Prop) (_: forall x, dec (p x)) : subtype p = finType_sub p _. *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) - -(* Lemma finType_sub_enum (X: finType) (p: X -> Prop) (_: forall x, dec (p x)): *) -(* toSubList (elem X) p= elem (finType_sub p _). *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) -(* Set Printing Coercions. *) -(* Lemma tofinType_sub_correct (X: finType) (p: X -> Prop) (_: forall x, dec (p x)) : *) -(* tofinType (subtype p) = finType_sub p _. *) -(* Proof. *) -(* reflexivity. *) -(* Qed. *) diff --git a/external/base/FiniteTypes/VectorFin.v b/external/base/FiniteTypes/VectorFin.v deleted file mode 100644 index e61b82c..0000000 --- a/external/base/FiniteTypes/VectorFin.v +++ /dev/null @@ -1,35 +0,0 @@ -Require Import Shared.FiniteTypes.FinTypes. -Require Import Shared.Vectors.Vectors. -Require Import Shared.Vectors.VectorDupfree. - - -Definition Fin_initVect (n : nat) : Vector.t (Fin.t n) n := - tabulate (fun i : Fin.t n => i). - -Lemma Fin_initVect_dupfree n : - dupfree (Fin_initVect n). -Proof. - unfold Fin_initVect. - apply dupfree_tabulate_injective. - firstorder. -Qed. - -Lemma Fin_initVect_full n k : - Vector.In k (Fin_initVect n). -Proof. - unfold Fin_initVect. - apply in_tabulate. eauto. -Qed. - -Definition Fin_initVect_nth (n : nat) (k : Fin.t n) : - Vector.nth (Fin_initVect n) k = k. -Proof. unfold Fin_initVect. apply nth_tabulate. Qed. - -Instance Fin_finTypeC n : finTypeC (EqType (Fin.t n)). -Proof. - constructor 1 with (enum := Fin_initVect n). - intros x. cbn in x. - eapply dupfreeCount. - - eapply tolist_dupfree. apply Fin_initVect_dupfree. - - eapply tolist_In. apply Fin_initVect_full. -Qed. \ No newline at end of file diff --git a/external/base/Inhabited.v b/external/base/Inhabited.v deleted file mode 100644 index d2aef0d..0000000 --- a/external/base/Inhabited.v +++ /dev/null @@ -1,73 +0,0 @@ -(** * Inhabited types *) - -(* Author: Maximilian Wuttke *) - - -Require Shared.Prelim. -Require Import Coq.Vectors.Vector Coq.Vectors.Fin. -Require Import FiniteTypes.FinTypes. - -Class inhabitedC (X : Type) := - { - default : X; - }. - -Instance inhabited_unit : inhabitedC unit. -Proof. do 2 constructor. Defined. - -Instance inhabited_True : inhabitedC True. -Proof. do 2 constructor. Defined. - -Instance inhabited_inl (A B : Type) (inh_a : inhabitedC A) : inhabitedC (A + B). -Proof. constructor. left. apply default. Defined. - -Instance inhabited_inr (A B : Type) (inh_B : inhabitedC B) : inhabitedC (A + B). -Proof. constructor. right. apply default. Defined. - -Instance inhabited_option (A : Type) : inhabitedC (option A). -Proof. constructor. right. Defined. - -Instance inhabited_bool : inhabitedC bool. -Proof. do 2 constructor. Defined. - -Instance inhabited_list (A : Type) : inhabitedC (list A). -Proof. do 2 constructor. Defined. - -Instance inhabited_vector (A : Type) (n : nat) (inh_A : inhabitedC A) : inhabitedC (Vector.t A n). -Proof. constructor. eapply VectorDef.const. apply default. Defined. - -Instance inhabited_fin (n : nat) : inhabitedC (Fin.t (S n)). -Proof. repeat constructor. Defined. - -Instance inhabited_nat : inhabitedC nat. -Proof. do 2 constructor. Defined. - -Instance inhabited_prod (A B : Type) : inhabitedC A -> inhabitedC B -> inhabitedC (A*B). -Proof. intros ia ib. do 2 constructor; apply default. Defined. - -Instance inhabited_arrow (A B : Type) : inhabitedC B -> inhabitedC (A -> B). -Proof. intros. constructor. intros _. apply default. Defined. - -Instance inhabited_arrow_empty (B : Type) : inhabitedC (Empty_set -> B). -Proof. intros. constructor. apply Empty_set_rect. Defined. - -Instance inhabited_arrow_sum (A B C : Type) : inhabitedC (A->C) -> inhabitedC (B->C) -> inhabitedC (A+B->C). -Proof. intros iac ibc. constructor. intros [?|?]. now apply iac. now apply ibc. Defined. - -Instance inhabited_arrow_prod (A B C : Type) : inhabitedC (A->B) -> inhabitedC (A->C) -> inhabitedC (A->B*C). -Proof. intros iab iac. constructor. intros a. constructor. now apply iab. now apply iac. Defined. - - -(** Derive inhabitedC instances, if an instance of this type is a hypothesis *) -Hint Extern 10 => match goal with - | [ H : ?X |- inhabitedC ?X ] => now econstructor - end : typeclass_instances. -(* -Section Test. - Variable lie : False. - Compute default : False. - Variable somebool : bool. - (* This should prefer the instance, not the variable. *) - Compute default : bool. -End Test. -*) diff --git a/external/base/Lists/BaseLists.v b/external/base/Lists/BaseLists.v deleted file mode 100644 index 3bbb26e..0000000 --- a/external/base/Lists/BaseLists.v +++ /dev/null @@ -1,592 +0,0 @@ -Require Export Prelim EqDec. - -Export ListNotations. -Notation "x 'el' A" := (In x A) (at level 70). -Notation "A <<= B" := (incl A B) (at level 70). -Notation "| A |" := (length A) (at level 65). -Definition equi X (A B : list X) : Prop := incl A B /\ incl B A. -Notation "A === B" := (equi A B) (at level 70). -Hint Unfold equi. - -Hint Extern 4 => -match goal with -|[ H: ?x el nil |- _ ] => destruct H -end. - -(** ** Lists *) - -(* Register additional simplification rules with autorewrite / simpl_list *) -(* Print Rewrite HintDb list. *) -Hint Rewrite <- app_assoc : list. -Hint Rewrite rev_app_distr map_app prod_length : list. - -Lemma list_cycle (X : Type) (A : list X) x : - x::A <> A. -Proof. - intros B. - assert (C: |x::A| <> |A|) by (cbn; omega). - apply C. now rewrite B. -Qed. - -(** *** Decisions for lists *) - -Instance list_in_dec X (x : X) (A : list X) : - eq_dec X -> dec (x el A). -Proof. - intros D. apply in_dec. exact D. -Qed. - -(* Certifying find *) - -Lemma cfind X A (p: X -> Prop) (p_dec: forall x, dec (p x)) : - {x | x el A /\ p x} + {forall x, x el A -> ~ p x}. -Proof. - destruct (find (fun x => Dec (p x)) A) eqn:E. - - apply find_some in E. firstorder. - - right. intros. eapply find_none in E; eauto. -Qed. - -Arguments cfind {X} A p {p_dec}. - -Instance list_forall_dec X A (p : X -> Prop) : - (forall x, dec (p x)) -> dec (forall x, x el A -> p x). -Proof. - intros p_dec. - destruct (find (fun x => Dec (~ p x)) A) eqn:Eq. - - apply find_some in Eq as [H1 H0 %Dec_true]; right; auto. - - left. intros x E. apply find_none with (x := x) in Eq. apply dec_DN; auto. auto. -Qed. - -Instance list_exists_dec X A (p : X -> Prop) : - (forall x, dec (p x)) -> dec (exists x, x el A /\ p x). -Proof. - intros p_dec. - destruct (find (fun x => Dec (p x)) A) eqn:Eq. (* New: eta expansion needed *) - - apply find_some in Eq as [H0 H1 %Dec_true]. firstorder. (* New: Need firstorder here *) - - right. intros [x [E F]]. apply find_none with (x := x) in Eq; auto. eauto. (* New: Why can't auto solve this? *) -Qed. - -Lemma list_exists_DM X A (p : X -> Prop) : - (forall x, dec (p x)) -> - ~ (forall x, x el A -> ~ p x) -> exists x, x el A /\ p x. -Proof. - intros D E. - destruct (find (fun x => Dec (p x)) A) eqn:Eq. - + apply find_some in Eq as [? ?%Dec_true]. eauto. - + exfalso. apply E. intros. apply find_none with (x := x) in Eq; eauto. -Qed. - -Lemma list_exists_not_incl (X: eqType) (A B : list X) : - ~ A <<= B -> exists x, x el A /\ ~ x el B. -Proof. - intros E. - apply list_exists_DM; auto. - intros F. apply E. intros x G. - apply dec_DN; auto. -Qed. - -Lemma list_cc X (p : X -> Prop) A : - (forall x, dec (p x)) -> - (exists x, x el A /\ p x) -> {x | x el A /\ p x}. -Proof. - intros D E. - destruct (cfind A p) as [[x [F G]]|F]. - - eauto. - - exfalso. destruct E as [x [G H]]. apply (F x); auto. -Qed. - - - -(** *** Membership - -We use the following lemmas from Coq's standard library List. -- [in_eq : x el x::A] -- [in_nil : ~ x el nil] -- [in_cons : x el A -> x el y::A] -- [in_or_app : x el A \/ x el B -> x el A++B] -- [in_app_iff : x el A++B <-> x el A \/ x el B] -- [in_map_iff : y el map f A <-> exists x, f x = y /\ x el A] -*) - -Hint Resolve in_eq in_nil in_cons in_or_app. - -Section Membership. - Variable X : Type. - Implicit Types (x y: X) (A B: list X). - - Lemma in_sing x y : - x el [y] -> x = y. - Proof. - cbn. intros [[]|[]]. reflexivity. - Qed. - - Lemma in_cons_neq x y A : - x el y::A -> x <> y -> x el A. - Proof. - cbn. intros [[]|D] E; congruence. - Qed. - - Lemma not_in_cons x y A : - ~ x el y :: A -> x <> y /\ ~ x el A. - Proof. - intuition; subst; auto. - Qed. - -(** *** Disjointness *) - - Definition disjoint A B := - ~ exists x, x el A /\ x el B. - - Lemma disjoint_forall A B : - disjoint A B <-> forall x, x el A -> ~ x el B. - Proof. - split. - - intros D x E F. apply D. exists x. auto. - - intros D [x [E F]]. exact (D x E F). - Qed. - - Lemma disjoint_symm A B : - disjoint A B -> disjoint B A. - Proof. - firstorder. - Qed. - - Lemma disjoint_incl A B B' : - B' <<= B -> disjoint A B -> disjoint A B'. - Proof. - firstorder. - Qed. - - Lemma disjoint_nil B : - disjoint nil B. - Proof. - firstorder. - Qed. - - Lemma disjoint_nil' A : - disjoint A nil. - Proof. - firstorder. - Qed. - - Lemma disjoint_cons x A B : - disjoint (x::A) B <-> ~ x el B /\ disjoint A B. - Proof. - split. - - intros D. split. - + intros E. apply D. eauto. - + intros [y [E F]]. apply D. eauto. - - intros [D E] [y [[F|F] G]]. - + congruence. - + apply E. eauto. - Qed. - - Lemma disjoint_app A B C : - disjoint (A ++ B) C <-> disjoint A C /\ disjoint B C. - Proof. - split. - - intros D. split. - + intros [x [E F]]. eauto 6. - + intros [x [E F]]. eauto 6. - - intros [D E] [x [F G]]. - apply in_app_iff in F as [F|F]; eauto. - Qed. - -End Membership. - -Hint Resolve disjoint_nil disjoint_nil'. - -(** *** Inclusion - -We use the following lemmas from Coq's standard library List. -- [incl_refl : A <<= A] -- [incl_tl : A <<= B -> A <<= x::B] -- [incl_cons : x el B -> A <<= B -> x::A <<= B] -- [incl_appl : A <<= B -> A <<= B++C] -- [incl_appr : A <<= C -> A <<= B++C] -- [incl_app : A <<= C -> B <<= C -> A++B <<= C] -*) - -Hint Resolve incl_refl incl_tl incl_cons incl_appl incl_appr incl_app. - -Lemma incl_nil X (A : list X) : - nil <<= A. - -Proof. intros x []. Qed. - -Hint Resolve incl_nil. - -Lemma incl_map X Y A B (f : X -> Y) : - A <<= B -> map f A <<= map f B. - -Proof. - intros D y E. apply in_map_iff in E as [x [E E']]. - subst y. apply in_map_iff. eauto. -Qed. - -Section Inclusion. - Variable X : Type. - Implicit Types A B : list X. - - Lemma incl_nil_eq A : - A <<= nil -> A=nil. - - Proof. - intros D. destruct A as [|x A]. - - reflexivity. - - exfalso. apply (D x). auto. - Qed. - - Lemma incl_shift x A B : - A <<= B -> x::A <<= x::B. - - Proof. auto. Qed. - - Lemma incl_lcons x A B : - x::A <<= B <-> x el B /\ A <<= B. - Proof. - split. - - intros D. split; hnf; auto. - - intros [D E] z [F|F]; subst; auto. - Qed. - - Lemma incl_sing x A y : - x::A <<= [y] -> x = y /\ A <<= [y]. - Proof. - rewrite incl_lcons. intros [D E]. - apply in_sing in D. auto. - Qed. - - Lemma incl_rcons x A B : - A <<= x::B -> ~ x el A -> A <<= B. - - Proof. intros C D y E. destruct (C y E) as [F|F]; congruence. Qed. - - Lemma incl_lrcons x A B : - x::A <<= x::B -> ~ x el A -> A <<= B. - - Proof. - intros C D y E. - assert (F: y el x::B) by auto. - destruct F as [F|F]; congruence. - Qed. - - Lemma incl_app_left A B C : - A ++ B <<= C -> A <<= C /\ B <<= C. - Proof. - firstorder. - Qed. - -End Inclusion. - -Definition inclp (X : Type) (A : list X) (p : X -> Prop) : Prop := - forall x, x el A -> p x. - -(** *** Setoid rewriting with list inclusion and list equivalence *) - -Instance incl_preorder X : - PreOrder (@incl X). -Proof. - constructor; hnf; unfold incl; auto. -Qed. - -Instance equi_Equivalence X : - Equivalence (@equi X). -Proof. - constructor; hnf; firstorder. -Qed. - -Instance incl_equi_proper X : - Proper (@equi X ==> @equi X ==> iff) (@incl X). -Proof. - hnf. intros A B D. hnf. firstorder. -Qed. - -Instance cons_incl_proper X x : - Proper (@incl X ==> @incl X) (@cons X x). -Proof. - hnf. apply incl_shift. -Qed. - -Instance cons_equi_proper X x : - Proper (@equi X ==> @equi X) (@cons X x). -Proof. - hnf. firstorder. -Qed. - -Instance in_incl_proper X x : - Proper (@incl X ==> Basics.impl) (@In X x). -Proof. - intros A B D. hnf. auto. -Qed. - -Instance in_equi_proper X x : - Proper (@equi X ==> iff) (@In X x). -Proof. - intros A B D. firstorder. -Qed. - -Instance app_incl_proper X : - Proper (@incl X ==> @incl X ==> @incl X) (@app X). -Proof. - intros A B D A' B' E. auto. -Qed. - -Instance app_equi_proper X : - Proper (@equi X ==> @equi X ==> @equi X) (@app X). -Proof. - hnf. intros A B D. hnf. intros A' B' E. - destruct D, E; auto. -Qed. - -Section Equi. - Variable X : Type. - Implicit Types A B : list X. - - Lemma equi_push x A : - x el A -> A === x::A. - Proof. - auto. - Qed. - - Lemma equi_dup x A : - x::A === x::x::A. - - Proof. - auto. - Qed. - - Lemma equi_swap x y A: - x::y::A === y::x::A. - Proof. - split; intros z; cbn; tauto. - Qed. - - Lemma equi_shift x A B : - x::A++B === A++x::B. - Proof. - split; intros y. - - intros [D|D]. - + subst; auto. - + apply in_app_iff in D as [D|D]; auto. - - intros D. apply in_app_iff in D as [D|D]. - + auto. - + destruct D; subst; auto. - Qed. - - Lemma equi_rotate x A : - x::A === A++[x]. - Proof. - split; intros y; cbn. - - intros [D|D]; subst; auto. - - intros D. apply in_app_iff in D as [D|D]. - + auto. - + apply in_sing in D. auto. - Qed. - -End Equi. - -Lemma in_concat_iff A l (a:A) : a el concat l <-> exists l', a el l' /\ l' el l. -Proof. - induction l; cbn. - - intuition. now destruct H. - - rewrite in_app_iff, IHl. firstorder subst. auto. -Qed. - - -Lemma app_comm_cons' (A : Type) (x y : list A) (a : A) : - x ++ a :: y = (x ++ [a]) ++ y. -Proof. rewrite <- app_assoc. cbn. trivial. Qed. - - -(** skipn *) - -Lemma skipn_nil (X : Type) (n : nat) : skipn n nil = @nil X. -Proof. destruct n; cbn; auto. Qed. - -Lemma skipn_app (X : Type) (xs ys : list X) (n : nat) : - n = (| xs |) -> - skipn n (xs ++ ys) = ys. -Proof. - intros ->. revert ys. induction xs; cbn; auto. -Qed. - -Lemma skipn_length (X : Type) (n : nat) (xs : list X) : - length (skipn n xs) = length xs - n. -Proof. - revert xs. induction n; intros; cbn. - - omega. - - destruct xs; cbn; auto. -Qed. - - - -(** Repeat *) - -Lemma map_repeat (X Y : Type) (f : X -> Y) (n : nat) (a : X) : - map f (repeat a n) = repeat (f a) n. -Proof. induction n; cbn in *; f_equal; auto. Qed. - -Lemma repeat_add_app (X : Type) (m n : nat) (a : X) : - repeat a (m + n) = repeat a m ++ repeat a n. -Proof. induction m; cbn; f_equal; auto. Qed. - -Lemma repeat_S_cons (X : Type) (n : nat) (a : X) : - a :: repeat a n = repeat a n ++ [a]. -Proof. - replace (a :: repeat a n) with (repeat a (S n)) by trivial. replace (S n) with (n+1) by omega. - rewrite repeat_add_app. cbn. trivial. -Qed. - -Lemma repeat_app_eq (X : Type) (m n : nat) (a : X) : - repeat a n ++ repeat a m = repeat a m ++ repeat a n. -Proof. rewrite <- !repeat_add_app. f_equal. omega. Qed. - -Lemma repeat_eq_iff (X : Type) (n : nat) (a : X) x : - x = repeat a n <-> length x = n /\ forall y, y el x -> y = a. -Proof. - split. - { - intros ->. split. apply repeat_length. apply repeat_spec. - } - { - revert x. induction n; intros x (H1&H2); cbn in *. - - destruct x; cbn in *; congruence. - - destruct x; cbn in *; inv H1. f_equal. - + apply H2. auto. - + apply IHn. auto. - } -Qed. - -Lemma rev_repeat (X : Type) (n : nat) (a : X) : - rev (repeat a n) = repeat a n. -Proof. - apply repeat_eq_iff. split. - - rewrite rev_length. rewrite repeat_length. auto. - - intros y Hx % in_rev. eapply repeat_spec; eauto. -Qed. - -Lemma concat_repeat_repeat (X : Type) (n m : nat) (a : X) : - concat (repeat (repeat a n) m) = repeat a (m*n). -Proof. - induction m as [ | m' IHm]; cbn. - - auto. - - rewrite repeat_add_app. f_equal. auto. -Qed. - - -Corollary skipn_repeat_add (X : Type) (n m : nat) (a : X) : - skipn n (repeat a (n + m)) = repeat a m. -Proof. - rewrite repeat_add_app. erewrite skipn_app; eauto. symmetry. apply repeat_length. -Qed. - -Corollary skipn_repeat (X : Type) (n : nat) (a : X) : - skipn n (repeat a n) = nil. -Proof. - rewrite <- (app_nil_r (repeat a n)). erewrite skipn_app; eauto. symmetry. apply repeat_length. -Qed. - - -(** Facts about equality for [map] and [rev] *) -Lemma rev_eq_nil (Z: Type) (l: list Z) : - rev l = nil -> l = nil. -Proof. intros. destruct l; cbn in *. reflexivity. symmetry in H. now apply app_cons_not_nil in H. Qed. - -Lemma map_eq_nil (Y Z: Type) (f: Y->Z) (l: list Y) : - map f l = nil -> l = nil. -Proof. intros. destruct l; cbn in *. reflexivity. congruence. Qed. - -Lemma map_eq_nil' (Y Z: Type) (f: Y->Z) (l: list Y) : - nil = map f l -> l = nil. -Proof. now intros H % eq_sym % map_eq_nil. Qed. - -Lemma map_eq_cons (A B: Type) (f: A->B) (xs: list A) (y: B) (ys: list B) : - map f xs = y :: ys -> - exists x xs', xs = x :: xs' /\ - y = f x /\ - ys = map f xs'. -Proof. induction xs; intros H; cbn in *; inv H; eauto. Qed. - -Lemma map_eq_cons' (A B: Type) (f: A -> B) (xs: list A) (y: B) (ys: list B) : - y :: ys = map f xs -> - exists x xs', xs = x :: xs' /\ - y = f x /\ - ys = map f xs'. -Proof. now intros H % eq_sym % map_eq_cons. Qed. - - -Lemma map_eq_app (A B: Type) (f: A -> B) (ls : list A) (xs ys : list B) : - map f ls = xs ++ ys -> - exists ls1 ls2, ls = ls1 ++ ls2 /\ - xs = map f ls1 /\ - ys = map f ls2. -Proof. - revert xs ys. induction ls; intros; cbn in *. - - symmetry in H. apply app_eq_nil in H as (->&->). exists nil, nil. cbn. tauto. - - destruct xs; cbn in *. - + exists nil. eexists. repeat split. cbn. now subst. - + inv H. specialize IHls with (1 := H2) as (ls1&ls2&->&->&->). - repeat econstructor. 2: instantiate (1 := a :: ls1). all: reflexivity. -Qed. - -Lemma rev_eq_cons (A: Type) (ls: list A) (x : A) (xs: list A) : - rev ls = x :: xs -> - ls = rev xs ++ [x]. -Proof. intros H. rewrite <- rev_involutive at 1. rewrite H. cbn. reflexivity. Qed. - - - -(** Injectivity of [map], if the function is injective *) -Lemma map_injective (X Y: Type) (f: X -> Y) : - (forall x y, f x = f y -> x = y) -> - forall xs ys, map f xs = map f ys -> xs = ys. -Proof. - intros HInj. hnf. intros x1. induction x1 as [ | x x1' IH]; intros; cbn in *. - - now apply map_eq_nil' in H. - - now apply map_eq_cons' in H as (l1&l2&->&->%HInj&->%IH). -Qed. - - - -(* ** Lemmas about [hd], [tl] and [removelast] *) - -Lemma tl_map (A B: Type) (f: A -> B) (xs : list A) : - tl (map f xs) = map f (tl xs). -Proof. now destruct xs; cbn. Qed. - - -(* Analogous to [removelast_app] *) - -Lemma tl_app (A: Type) (xs ys : list A) : - xs <> nil -> - tl (xs ++ ys) = tl xs ++ ys. -Proof. destruct xs; cbn; congruence. Qed. - -Lemma tl_rev (A: Type) (xs : list A) : - tl (rev xs) = rev (removelast xs). -Proof. - induction xs; cbn; auto. - destruct xs; cbn in *; auto. - rewrite tl_app; cbn in *. - - now rewrite IHxs. - - intros (H1&H2) % app_eq_nil; inv H2. -Qed. - -Lemma hd_map (A B: Type) (f: A -> B) (xs : list A) (a : A) : - hd (f a) (map f xs) = f (hd a xs). -Proof. destruct xs; cbn; auto. Qed. - -Lemma hd_app (A: Type) (xs ys : list A) a : - xs <> nil -> - hd a (xs ++ ys) = hd a xs. -Proof. intros H. destruct xs; auto. now contradiction H. Qed. - -Lemma hd_rev (A: Type) (xs : list A) (a : A) : - hd a (rev xs) = last xs a. -Proof. - induction xs; cbn; auto. - destruct xs; cbn; auto. - rewrite hd_app. now apply IHxs. - intros (H1&H2)%app_eq_nil; inv H2. -Qed. \ No newline at end of file diff --git a/external/base/Lists/Cardinality.v b/external/base/Lists/Cardinality.v deleted file mode 100644 index e87458d..0000000 --- a/external/base/Lists/Cardinality.v +++ /dev/null @@ -1,139 +0,0 @@ -Require Export BaseLists Removal. - -(** *** Cardinality *) - -Section Cardinality. - Variable X : eqType. - Implicit Types A B : list X. - - Fixpoint card A := - match A with - | nil => 0 - | x::A => if Dec (x el A) then card A else 1 + card A - end. - - Lemma card_cons x A : - x el A -> card (x::A) = card A. - Proof. - intros H. cbn. decide (x el A) as [H1|H1]; tauto. - Qed. - - Lemma card_cons' x A : - ~ x el A -> card (x::A) = 1 + card A. - Proof. - intros H. cbn. decide (x el A) as [H1|H1]; tauto. - Qed. - - Lemma card_in_rem x A : - x el A -> card A = 1 + card (rem A x). - Proof. - intros D. - induction A as [|y A]. - - contradiction D. - - decide (y = x) as [->|H]. - + clear D. rewrite rem_fst. - cbn. decide (x el A) as [H1|H1]. - * auto. - * now rewrite (rem_id H1). - + assert (x el A) as H1 by (destruct D; tauto). clear D. - rewrite (rem_fst' _ H). specialize (IHA H1). - simpl card at 2. - decide (y el rem A x) as [H2|H2]. - * rewrite card_cons. exact IHA. - apply in_rem_iff in H2. intuition. - * rewrite card_cons'. now rewrite IHA. - contradict H2. now apply in_rem_iff. - Qed. - - Lemma card_not_in_rem A x : - ~ x el A -> card A = card (rem A x). - Proof. - intros D; rewrite rem_id; auto. - Qed. - - Lemma card_le A B : - A <<= B -> card A <= card B. - Proof. - revert B. - induction A as [|x A]; intros B D; cbn. - - omega. - - apply incl_lcons in D as [D D1]. - decide (x el A) as [E|E]. - + auto. - + rewrite (card_in_rem D). - enough (card A <= card (rem B x)) by omega. - apply IHA. auto. - Qed. - - Lemma card_eq A B : - A === B -> card A = card B. - Proof. - intros [E F]. apply card_le in E. apply card_le in F. omega. - Qed. - - Lemma card_cons_rem x A : - card (x::A) = 1 + card (rem A x). - Proof. - rewrite (card_eq (rem_equi x A)). cbn. - decide (x el rem A x) as [D|D]. - - exfalso. apply in_rem_iff in D; tauto. - - reflexivity. - Qed. - - Lemma card_0 A : - card A = 0 -> A = nil. - Proof. - destruct A as [|x A]; intros D. - - reflexivity. - - exfalso. rewrite card_cons_rem in D. omega. - Qed. - - Lemma card_ex A B : - card A < card B -> exists x, x el B /\ ~ x el A. - Proof. - intros D. - decide (B <<= A) as [E|E]. - - exfalso. apply card_le in E. omega. - - apply list_exists_not_incl; auto. - Qed. - - Lemma card_equi A B : - A <<= B -> card A = card B -> A === B. - Proof. - revert B. - induction A as [|x A]; cbn; intros B D E. - - symmetry in E. apply card_0 in E. now rewrite E. - - apply incl_lcons in D as [D D1]. - decide (x el A) as [F|F]. - + rewrite (IHA B); auto. - + rewrite (IHA (rem B x)). - * symmetry. apply rem_reorder, D. - * auto. - * apply card_in_rem in D. omega. - Qed. - - Lemma card_lt A B x : - A <<= B -> x el B -> ~ x el A -> card A < card B. - Proof. - intros D E F. - decide (card A = card B) as [G|G]. - + exfalso. apply F. apply (card_equi D); auto. - + apply card_le in D. omega. - Qed. - - Lemma card_or A B : - A <<= B -> A === B \/ card A < card B. - Proof. - intros D. - decide (card A = card B) as [F|F]. - - left. apply card_equi; auto. - - right. apply card_le in D. omega. - Qed. - -End Cardinality. - -Instance card_equi_proper (X: eqType) : - Proper (@equi X ==> eq) (@card X). -Proof. - hnf. apply card_eq. -Qed. diff --git a/external/base/Lists/Dupfree.v b/external/base/Lists/Dupfree.v deleted file mode 100644 index 40a949c..0000000 --- a/external/base/Lists/Dupfree.v +++ /dev/null @@ -1,128 +0,0 @@ -Require Export BaseLists Filter Lists.Cardinality. - -(** *** Duplicate-free lists *) - -Inductive dupfree (X : Type) : list X -> Prop := -| dupfreeN : dupfree nil -| dupfreeC x A : ~ x el A -> dupfree A -> dupfree (x::A). - -Section Dupfree. - Variable X : Type. - Implicit Types A B : list X. - - Lemma dupfree_cons x A : - dupfree (x::A) <-> ~ x el A /\ dupfree A. - Proof. - split; intros D. - - inv D; auto. - - apply dupfreeC; tauto. - Qed. - - Lemma dupfree_app A B : - disjoint A B -> dupfree A -> dupfree B -> dupfree (A++B). - Proof. - intros D E F. induction E as [|x A E' E]; cbn. - - exact F. - - apply disjoint_cons in D as [D D']. - constructor; [|exact (IHE D')]. - intros G. apply in_app_iff in G; tauto. - Qed. - - Lemma dupfree_map Y A (f : X -> Y) : - (forall x y, x el A -> y el A -> f x = f y -> x=y) -> - dupfree A -> dupfree (map f A). - Proof. - intros D E. induction E as [|x A E' E]; cbn. - - constructor. - - constructor; [|now auto]. - intros F. apply in_map_iff in F as [y [F F']]. - rewrite (D y x) in F'; auto. - Qed. - - Lemma dupfree_filter p A : - dupfree A -> dupfree (filter p A). - Proof. - intros D. induction D as [|x A C D]; cbn. - - left. - - destruct (p x) eqn:E; [|exact IHD]. - right; [|exact IHD]. - rewrite in_filter_iff, E. intuition. - Qed. - -End Dupfree. - -Section Undup. - Variable X : eqType. - Implicit Types A B : list X. - - Lemma dupfree_dec A : - dec (dupfree A). - Proof. - induction A as [|x A]. - - left. left. - - decide (x el A) as [E|E]. - + right. intros F. inv F; tauto. - + destruct (IHA) as [F|F]. - * unfold dec. auto using dupfree. - * right. intros G. inv G; tauto. - Qed. - - Lemma dupfree_card A : - dupfree A -> card A = |A|. - Proof. - induction 1 as [|x A D _ IH]; cbn. - - reflexivity. - - decide (x el A) as [G|]. - + exfalso; auto. - + omega. - Qed. - - Fixpoint undup (A : list X) : list X := - match A with - | nil => nil - | x::A' => if Dec (x el A') then undup A' else x :: undup A' - end. - - Lemma undup_id_equi A : - undup A === A. - Proof. - induction A as [|x A]; cbn. - - reflexivity. - - decide (x el A) as [E|E]; rewrite IHA; auto. - Qed. - - Lemma dupfree_undup A : - dupfree (undup A). - Proof. - induction A as [|x A]; cbn. - - left. - - decide (x el A) as [E|E]; auto. - right; auto. now rewrite undup_id_equi. - Qed. - - Lemma undup_incl A B : - A <<= B <-> undup A <<= undup B. - Proof. - now rewrite !undup_id_equi. - Qed. - - Lemma undup_equi A B : - A === B <-> undup A === undup B. - Proof. - now rewrite !undup_id_equi. - Qed. - - Lemma undup_id A : - dupfree A -> undup A = A. - Proof. - intros E. induction E as [|x A E F]; cbn. - - reflexivity. - - rewrite IHF. decide (x el A) as [G|G]; tauto. - Qed. - - Lemma undup_idempotent A : - undup (undup A) = undup A. - - Proof. apply undup_id, dupfree_undup. Qed. - -End Undup. diff --git a/external/base/Lists/Filter.v b/external/base/Lists/Filter.v deleted file mode 100644 index 675392a..0000000 --- a/external/base/Lists/Filter.v +++ /dev/null @@ -1,103 +0,0 @@ -Require Import BaseLists. - -(** *** Filter *) - -Section Filter. - Variable X : Type. - Implicit Types (x y: X) (A B C: list X) (p q: X -> bool). - - Fixpoint filter p A : list X := - match A with - | nil => nil - | x::A' => if p x then x :: filter p A' else filter p A' - end. - - Lemma in_filter_iff x p A : - x el filter p A <-> x el A /\ p x. - Proof. - induction A as [|y A]; cbn. - - tauto. - - destruct (p y) eqn:E; cbn; - rewrite IHA; intuition; subst; auto. - destruct (p x); auto. - Qed. - - Lemma filter_incl p A : - filter p A <<= A. - Proof. - intros x D. apply in_filter_iff in D. apply D. - Qed. - - Lemma filter_mono p A B : - A <<= B -> filter p A <<= filter p B. - Proof. - intros D x E. apply in_filter_iff in E as [E E']. - apply in_filter_iff. auto. - Qed. - - Lemma filter_id p A : - (forall x, x el A -> p x) -> filter p A = A. - Proof. - intros D. - induction A as [|x A]; cbn. - - reflexivity. - - destruct (p x) eqn:E. - + f_equal; auto. - + exfalso. apply bool_Prop_false in E. auto. - Qed. - - Lemma filter_app p A B : - filter p (A ++ B) = filter p A ++ filter p B. - Proof. - induction A as [|y A]; cbn. - - reflexivity. - - rewrite IHA. destruct (p y); reflexivity. - Qed. - - Lemma filter_fst p x A : - p x -> filter p (x::A) = x::filter p A. - Proof. - cbn. destruct (p x); auto. - Qed. - - Lemma filter_fst' p x A : - ~ p x -> filter p (x::A) = filter p A. - Proof. - cbn. destruct (p x); auto. - Qed. - - Lemma filter_pq_mono p q A : - (forall x, x el A -> p x -> q x) -> filter p A <<= filter q A. - Proof. - intros D x E. apply in_filter_iff in E as [E E']. - apply in_filter_iff. auto. - Qed. - - Lemma filter_pq_eq p q A : - (forall x, x el A -> p x = q x) -> filter p A = filter q A. - Proof. - intros C; induction A as [|x A]; cbn. - - reflexivity. - - destruct (p x) eqn:D, (q x) eqn:E. - + f_equal. auto. - + exfalso. enough (p x = q x) by congruence. auto. - + exfalso. enough (p x = q x) by congruence. auto. - + auto. - Qed. - - Lemma filter_and p q A : - filter p (filter q A) = filter (fun x => p x && q x) A. - Proof. - induction A as [|x A]; cbn. reflexivity. - destruct (p x) eqn:E, (q x); cbn; - try rewrite E; now rewrite IHA. - Qed. - - Lemma filter_comm p q A : - filter p (filter q A) = filter q (filter p A). - Proof. - rewrite !filter_and. apply filter_pq_eq. - intros x _. now destruct (p x), (q x). - Qed. - -End Filter. \ No newline at end of file diff --git a/external/base/Lists/Position.v b/external/base/Lists/Position.v deleted file mode 100644 index 691c219..0000000 --- a/external/base/Lists/Position.v +++ /dev/null @@ -1,145 +0,0 @@ -Require Export BaseLists Dupfree. - -Definition elAt := nth_error. -Notation "A '.[' i ']'" := (elAt A i) (no associativity, at level 50). - -Section Fix_X. - - Variable X : eqType. - - Fixpoint pos (s : X) (A : list X) := - match A with - | nil => None - | a :: A => if Dec (s = a) then Some 0 else match pos s A with None => None | Some n => Some (S n) end - end. - - Lemma el_pos s A : s el A -> exists m, pos s A = Some m. - Proof. - revert s; induction A; simpl; intros s H. - - contradiction. - - decide (s = a) as [D | D]; eauto; - destruct H; try congruence. - destruct (IHA s H) as [n Hn]; eexists; now rewrite Hn. - Qed. - - Lemma pos_elAt s A i : pos s A = Some i -> A .[i] = Some s. - Proof. - revert i s. induction A; intros i s. - - destruct i; inversion 1. - - simpl. decide (s = a). - + inversion 1; subst; reflexivity. - + destruct i; destruct (pos s A) eqn:B; inversion 1; subst; eauto. - Qed. - - Lemma elAt_app (A : list X) i B s : A .[i] = Some s -> (A ++ B).[i] = Some s. - Proof. - revert s B i. induction A; intros s B i H; destruct i; simpl; intuition; inv H. - Qed. - - Lemma elAt_el A (s : X) m : A .[ m ] = Some s -> s el A. - Proof. - revert A. induction m; intros []; inversion 1; eauto. - Qed. - - Lemma el_elAt (s : X) A : s el A -> exists m, A .[ m ] = Some s. - Proof. - intros H; destruct (el_pos H); eexists; eauto using pos_elAt. - Qed. - - Lemma dupfree_elAt (A : list X) n m s : dupfree A -> A.[n] = Some s -> A.[m] = Some s -> n = m. - Proof with try tauto. - intros H; revert n m; induction A; simpl; intros n m H1 H2. - - destruct n; inv H1. - - destruct n, m; inv H... - + inv H1. simpl in H2. eapply elAt_el in H2... - + inv H2. simpl in H1. eapply elAt_el in H1... - + inv H1. inv H2. rewrite IHA with n m... - Qed. - - Lemma nth_error_none A n l : nth_error l n = @None A -> length l <= n. - Proof. revert n; - induction l; intros n. - - simpl; omega. - - simpl. intros. destruct n. inv H. inv H. assert (| l | <= n). eauto. omega. - Qed. - - Lemma pos_None (x : X) l l' : pos x l = None-> pos x l' = None -> pos x (l ++ l') = None. - Proof. - revert x l'; induction l; simpl; intros; eauto. - have (x = a). - destruct (pos x l) eqn:E; try congruence. - rewrite IHl; eauto. - Qed. - - Lemma pos_first_S (x : X) l l' i : pos x l = Some i -> pos x (l ++ l') = Some i. - Proof. - revert x i; induction l; intros; simpl in *. - - inv H. - - decide (x = a); eauto. - destruct (pos x l) eqn:E. - + eapply IHl in E. now rewrite E. - + inv H. - Qed. - - Lemma pos_second_S x l l' i : pos x l = None -> - pos x l' = Some i -> - pos x (l ++ l') = Some ( i + |l| ). - Proof. - revert i l'; induction l; simpl; intros. - - rewrite plus_comm. eauto. - - destruct _; subst; try congruence. - destruct (pos x l) eqn:EE. congruence. - erewrite IHl; eauto. - Qed. - - Lemma pos_length (e : X) n E : pos e E = Some n -> n < |E|. - Proof. - revert e n; induction E; simpl; intros. - - inv H. - - decide (e = a). - + inv H. simpl. omega. - + destruct (pos e E) eqn:EE. - * inv H. assert (n1 < |E|) by eauto. omega. - * inv H. - Qed. - - Fixpoint replace (xs : list X) (y y' : X) := - match xs with - | nil => nil - | x :: xs' => (if Dec (x = y) then y' else x) :: replace xs' y y' - end. - - Lemma replace_same xs x : replace xs x x = xs. - Proof. - revert x; induction xs; intros; simpl; [ | destruct _; subst ]; congruence. - Qed. - - Lemma replace_diff xs x y : x <> y -> ~ x el replace xs x y. - Proof. - revert x y; induction xs; intros; simpl; try destruct _; firstorder. - Qed. - - Lemma replace_pos xs x y y' : x <> y -> x <> y' -> pos x xs = pos x (replace xs y y'). - Proof. - induction xs; intros; simpl. - - reflexivity. - - repeat destruct Dec; try congruence; try omega; subst. - + rewrite IHxs; eauto. + rewrite IHxs; eauto. - Qed. - -End Fix_X. - -Arguments replace {_} _ _ _. - - - -(* Fixpoint getPosition {E: eqType} (A: list E) x := match A with *) -(* | nil => 0 *) -(* | cons x' A' => if Dec (x=x') then 0 else 1 + getPosition A' x end. *) - -(* Lemma getPosition_correct {E: eqType} (x:E) A: if Dec (x el A) then forall z, (nth (getPosition A x) A z) = x else getPosition A x = |A |. *) -(* Proof. *) -(* induction A;cbn. *) -(* -dec;tauto. *) -(* -dec;intuition; congruence. *) -(* Qed. *) diff --git a/external/base/Lists/Power.v b/external/base/Lists/Power.v deleted file mode 100644 index 737f480..0000000 --- a/external/base/Lists/Power.v +++ /dev/null @@ -1,178 +0,0 @@ -Require Import BaseLists Dupfree. - -(** *** Power lists *) - -Section Power. - Variable X : Type. - - Fixpoint power (U: list X ) : list (list X) := - match U with - | nil => [nil] - | x :: U' => power U' ++ map (cons x) (power U') - end. - - Lemma power_incl A U : - A el power U -> A <<= U. - Proof. - revert A; induction U as [|x U]; cbn; intros A D. - - destruct D as [[]|[]]; auto. - - apply in_app_iff in D as [E|E]. now auto. - apply in_map_iff in E as [A' [E F]]. subst A. - auto. - Qed. - - Lemma power_nil U : - nil el power U. - Proof. - induction U; cbn; auto. - Qed. - -End Power. - -Section PowerRep. - Variable X : eqType. - Implicit Types A U : list X. - - Definition rep (A U : list X) : list X := - filter (fun x => Dec (x el A)) U. - - Lemma rep_cons A x U : - x el A -> rep A (x::U) = x :: rep A U. - Proof. - intros H. apply filter_fst. auto. - Qed. - - Lemma rep_cons' A x U : - ~ x el A -> rep A (x::U) = rep A U. - Proof. - intros H. apply filter_fst'. auto. - Qed. - - Lemma rep_cons_eq x A U : - ~ x el U -> rep (x::A) U = rep A U. - Proof. - intros D. apply filter_pq_eq. intros y E. - apply Dec_reflect_eq. split. - - intros [<-|F]; tauto. - - auto. - Qed. - - Lemma rep_power A U : - rep A U el power U. - Proof. - revert A; induction U as [|x U]; intros A. - - cbn; auto. - - decide (x el A) as [H|H]. - + rewrite (rep_cons _ H). cbn. auto using in_map. - + rewrite (rep_cons' _ H). cbn. auto. - Qed. - - Lemma rep_incl A U : - rep A U <<= A. - Proof. - intros x. unfold rep. rewrite in_filter_iff, Dec_reflect. - intuition. - Qed. - - Lemma rep_in x A U : - A <<= U -> x el A -> x el rep A U. - Proof. - intros D E. apply in_filter_iff; auto. - Qed. - - Lemma rep_equi A U : - A <<= U -> rep A U === A. - Proof. - intros D. split. now apply rep_incl. - intros x. apply rep_in, D. - Qed. - - Lemma rep_mono A B U : - A <<= B -> rep A U <<= rep B U. - Proof. - intros D. apply filter_pq_mono. - intros E; rewrite !Dec_reflect; auto. - Qed. - - Lemma rep_eq' A B U : - (forall x, x el U -> (x el A <-> x el B)) -> rep A U = rep B U. - Proof. - intros D. apply filter_pq_eq. intros x E. - apply Dec_reflect_eq. auto. - Qed. - - Lemma rep_eq A B U : - A === B -> rep A U = rep B U. - Proof. - intros D. apply filter_pq_eq. intros x E. - apply Dec_reflect_eq. firstorder. - Qed. - - Lemma rep_injective A B U : - A <<= U -> B <<= U -> rep A U = rep B U -> A === B. - Proof. - intros D E F. transitivity (rep A U). - - symmetry. apply rep_equi, D. - - rewrite F. apply rep_equi, E. - Qed. - - Lemma rep_idempotent A U : - rep (rep A U) U = rep A U. - Proof. - unfold rep at 1 3. apply filter_pq_eq. - intros x D. apply Dec_reflect_eq. split. - + apply rep_incl. - + intros E. apply in_filter_iff. auto. - Qed. - - Lemma dupfree_power U : - dupfree U -> dupfree (power U). - Proof. - intros D. induction D as [|x U E D]; cbn. - - constructor. now auto. constructor. - - apply dupfree_app. - + intros [A [F G]]. apply in_map_iff in G as [A' [G G']]. - subst A. apply E. apply (power_incl F). auto. - + exact IHD. - + apply dupfree_map; congruence. - Qed. - - Lemma dupfree_in_power U A : - A el power U -> dupfree U -> dupfree A. - Proof. - intros E D. revert A E. - induction D as [|x U D D']; cbn; intros A E. - - destruct E as [[]|[]]. constructor. - - apply in_app_iff in E as [E|E]. - + auto. - + apply in_map_iff in E as [A' [E E']]. subst A. - constructor. - * intros F; apply D. apply (power_incl E'), F. - * auto. - Qed. - - Lemma rep_dupfree A U : - dupfree U -> A el power U -> rep A U = A. - Proof. - intros D; revert A. - induction D as [|x U E F]; intros A G. - - destruct G as [[]|[]]; reflexivity. - - cbn in G. apply in_app_iff in G as [G|G]. - + rewrite rep_cons'. now auto. - contradict E. apply (power_incl G), E. - + apply in_map_iff in G as [A' [<- H]]. - specialize (IHF _ H). - rewrite rep_cons. Focus 2. now auto. - rewrite rep_cons_eq. now rewrite IHF. exact E. - Qed. - - Lemma power_extensional A B U : - dupfree U -> A el power U -> B el power U -> A === B -> A = B. - Proof. - intros D E F G. - rewrite <- (rep_dupfree D E). rewrite <- (rep_dupfree D F). - apply rep_eq, G. - Qed. - -End PowerRep. - diff --git a/external/base/Lists/Removal.v b/external/base/Lists/Removal.v deleted file mode 100644 index 2a0277a..0000000 --- a/external/base/Lists/Removal.v +++ /dev/null @@ -1,123 +0,0 @@ -Require Export BaseLists Filter. - -(** *** Element removal *) - -Section Removal. - Variable X : eqType. - Implicit Types (x y: X) (A B: list X). - - Definition rem A x : list X := - filter (fun z => Dec (z <> x)) A. - - Lemma in_rem_iff x A y : - x el rem A y <-> x el A /\ x <> y. - Proof. - unfold rem. rewrite in_filter_iff, Dec_reflect. tauto. - Qed. - - Lemma rem_not_in x y A : - x = y \/ ~ x el A -> ~ x el rem A y. - Proof. - unfold rem. rewrite in_filter_iff, Dec_reflect. tauto. - Qed. - - Lemma rem_incl A x : - rem A x <<= A. - Proof. - apply filter_incl. - Qed. - - Lemma rem_mono A B x : - A <<= B -> rem A x <<= rem B x. - Proof. - apply filter_mono. - Qed. - - Lemma rem_cons A B x : - A <<= B -> rem (x::A) x <<= B. - Proof. - intros E y F. apply E. apply in_rem_iff in F. - destruct F as [[|]]; congruence. - Qed. - - Lemma rem_cons' A B x y : - x el B -> rem A y <<= B -> rem (x::A) y <<= B. - Proof. - intros E F u G. - apply in_rem_iff in G as [[[]|G] H]. exact E. - apply F. apply in_rem_iff. auto. - Qed. - - Lemma rem_in x y A : - x el rem A y -> x el A. - Proof. - apply rem_incl. - Qed. - - Lemma rem_neq x y A : - x <> y -> x el A -> x el rem A y. - Proof. - intros E F. apply in_rem_iff. auto. - Qed. - - Lemma rem_app x A B : - x el A -> B <<= A ++ rem B x. - Proof. - intros E y F. decide (x=y) as [[]|]; auto using rem_neq. - Qed. - - Lemma rem_app' x A B C : - rem A x <<= C -> rem B x <<= C -> rem (A ++ B) x <<= C. - Proof. - unfold rem; rewrite filter_app; auto. - Qed. - - Lemma rem_equi x A : - x::A === x::rem A x. - Proof. - split; intros y; - intros [[]|E]; decide (x=y) as [[]|D]; - eauto using rem_in, rem_neq. - Qed. - - Lemma rem_comm A x y : - rem (rem A x) y = rem (rem A y) x. - Proof. - apply filter_comm. - Qed. - - Lemma rem_fst x A : - rem (x::A) x = rem A x. - Proof. - unfold rem. rewrite filter_fst'; auto. - Qed. - - Lemma rem_fst' x y A : - x <> y -> rem (x::A) y = x::rem A y. - Proof. - intros E. unfold rem. rewrite filter_fst; auto. - Qed. - - Lemma rem_id x A : - ~ x el A -> rem A x = A. - Proof. - intros D. apply filter_id. intros y E. - apply Dec_reflect. congruence. - Qed. - - Lemma rem_reorder x A : - x el A -> A === x :: rem A x. - Proof. - intros D. rewrite <- rem_equi. apply equi_push, D. - Qed. - - Lemma rem_inclr A B x : - A <<= B -> ~ x el A -> A <<= rem B x. - Proof. - intros D E y F. apply in_rem_iff. - intuition; subst; auto. - Qed. - -End Removal. - -Hint Resolve rem_not_in rem_incl rem_mono rem_cons rem_cons' rem_app rem_app' rem_in rem_neq rem_inclr. diff --git a/external/base/Makefile b/external/base/Makefile deleted file mode 100644 index 609c1db..0000000 --- a/external/base/Makefile +++ /dev/null @@ -1,14 +0,0 @@ -all: Makefile.coq - +make -f Makefile.coq all - -html: Makefile.coq - +make -f Makefile.coq html - -clean: Makefile.coq - +make -f Makefile.coq clean - rm -f Makefile.coq - -Makefile.coq: _CoqProject - coq_makefile -f _CoqProject > Makefile.coq - -.PHONY: all html clean diff --git a/external/base/Numbers.v b/external/base/Numbers.v deleted file mode 100644 index 5091d2b..0000000 --- a/external/base/Numbers.v +++ /dev/null @@ -1,74 +0,0 @@ -Require Import Prelim. -Require Import EqDec. - -(** ** Numbers **) - -Lemma complete_induction (p : nat -> Prop) (x : nat) : -(forall x, (forall y, y p y) -> p x) -> p x. - -Proof. intros A. apply A. induction x ; intros y B. -exfalso ; omega. -apply A. intros z C. apply IHx. omega. Qed. - -Lemma size_induction X (f : X -> nat) (p : X -> Prop) : - (forall x, (forall y, f y < f x -> p y) -> p x) -> - forall x, p x. - -Proof. - intros IH x. apply IH. - assert (G: forall n y, f y < n -> p y). - { intros n. induction n. - - intros y B. exfalso. omega. - - intros y B. apply IH. intros z C. apply IHn. omega. } - apply G. -Qed. - -Instance nat_le_dec (x y : nat) : dec (x <= y) := - le_dec x y. - -Lemma size_recursion (X : Type) (sigma : X -> nat) (p : X -> Type) : - (forall x, (forall y, sigma y < sigma x -> p y) -> p x) -> - forall x, p x. -Proof. - intros D x. apply D. revert x. - enough (forall n y, sigma y < n -> p y) by eauto. - intros n. induction n; intros y E. - - exfalso; omega. - - apply D. intros x F. apply IHn. omega. -Qed. - -Arguments size_recursion {X} sigma {p} _ _. - -Section Iteration. - Variables (X: Type) (f: X -> X). - - Fixpoint it (n : nat) (x : X) : X := - match n with - | 0 => x - | S n' => f (it n' x) - end. - - Lemma it_ind (p : X -> Prop) x n : - p x -> (forall z, p z -> p (f z)) -> p (it n x). - Proof. - intros A B. induction n; cbn; auto. - Qed. - - Definition FP (x : X) : Prop := f x = x. - - Lemma it_fp (sigma : X -> nat) x : - (forall n, FP (it n x) \/ sigma (it n x) > sigma (it (S n) x)) -> - FP (it (sigma x) x). - Proof. - intros A. - assert (B: forall n, FP (it n x) \/ sigma x >= n + sigma (it n x)). - { intros n; induction n; cbn. - - auto. - - destruct IHn as [B|B]. - + left. now rewrite B. - + destruct (A n) as [C|C]. - * left. now rewrite C. - * right. cbn in C. omega. } - destruct (A (sigma x)), (B (sigma x)); auto; exfalso; omega. - Qed. -End Iteration. diff --git a/external/base/Prelim.v b/external/base/Prelim.v deleted file mode 100644 index 31a8e53..0000000 --- a/external/base/Prelim.v +++ /dev/null @@ -1,95 +0,0 @@ -(** * Base Library for ICL - - - Version: 3 October 2016 - - Author: Gert Smolka, Saarland University - - Acknowlegments: Sigurd Schneider, Dominik Kirst, Yannick Forster, Fabian Kunze, Maximilian Wuttke - *) - -Require Export Bool Omega List Setoid Morphisms Tactics. - -Global Set Implicit Arguments. -Global Unset Strict Implicit. -Global Unset Printing Records. -Global Unset Printing Implicit Defensive. -Global Set Regular Subst Tactic. - -Hint Extern 4 => exact _. (* makes auto use type class inference *) - -(** De Morgan laws *) - -Lemma DM_or (X Y : Prop) : - ~ (X \/ Y) <-> ~ X /\ ~ Y. -Proof. - tauto. -Qed. - -Lemma DM_exists X (p : X -> Prop) : - ~ (exists x, p x) <-> forall x, ~ p x. -Proof. - firstorder. -Qed. - -(** ** Boolean propositions and decisions *) - -Coercion bool2Prop (b : bool) := if b then True else False. - -Lemma bool_Prop_true b : - b = true -> b. -Proof. - intros A. rewrite A. exact I. -Qed. - -Lemma bool_Prop_false b : - b = false -> ~ b. -Proof. - intros A. rewrite A. cbn. auto. -Qed. - -Lemma bool_Prop_true' (b : bool) : - b -> b = true. -Proof. - intros A. cbv in A. destruct b; tauto. -Qed. - -Lemma bool_Prop_false' (b : bool) : - ~ b -> b = false. -Proof. - intros A. cbv in A. destruct b; tauto. -Qed. - - -Hint Resolve bool_Prop_true bool_Prop_false. -Hint Resolve bool_Prop_true' bool_Prop_false'. - - -Definition bool2nat := fun b : bool => if b then 1 else 0. -Coercion bool2nat : bool >-> nat. -Definition nat2bool := fun n : nat => match n with 0 => false | _ => true end. -Coercion nat2bool : nat >-> bool. -Lemma bool_nat (b : bool) : - 1 = b -> b. -Proof. intros; cbv in *. destruct b. auto. congruence. Qed. -Lemma nat_bool (b : bool) : - b = 1 -> b. -Proof. intros; cbv in *. destruct b. auto. congruence. Qed. -Hint Resolve bool_nat nat_bool. - -Ltac simpl_coerce := - match goal with - | [ H: False |- _ ] => destruct H - | [ H: ~ bool2Prop true |- _ ] => destruct H - | [ H: bool2Prop false |- _ ] => destruct H - end. - - -Ltac simpl_congruence := - match goal with - | [ H : 0 = S _ |- _] => congruence - | [ H : S _ = 0 |- _] => congruence - | [ H : S _ = 0 |- _] => congruence - | [ H : true = false |- _] => congruence - | [ H : false = true |- _] => congruence - end. - -Hint Extern 1 => simpl_coerce. -Hint Extern 1 => simpl_congruence. \ No newline at end of file diff --git a/external/base/README.md b/external/base/README.md deleted file mode 100644 index 481eb88..0000000 --- a/external/base/README.md +++ /dev/null @@ -1,17 +0,0 @@ -# Base-Library -[Coq](https://coq.inria.fr/) library for finite types, vectors, retracts, and inhabited types. - -This library is based on the library for the lecture ["Introduction to Computational Logics"](https://courses.ps.uni-saarland.de/icl_16/) at [Saarland University](https://www.uni-saarland.de/nc/en/home.html). - -## Acknowledments - -- Gert Smolka, Saarland University: wrote the [initial version](http://www.ps.uni-saarland.de/courses/cl-ss16/LectureNotes/html/toc.html) -- Sigurd Schneider -- Dominik Kirst -- Yannick Forster -- Fabian Kunze -- Maximilian Wuttke - -## Further contributions: -- Jan Christian Menz: contributed modules for finite types (See his [Bachelor's Thesis](https://www.ps.uni-saarland.de/~menz/bachelor.php) "A Coq Library for Finite Types") -- Maximilian Wuttke: contributed modules for vectors, retracts, and inhabited types diff --git a/external/base/Retracts.v b/external/base/Retracts.v deleted file mode 100644 index f53b147..0000000 --- a/external/base/Retracts.v +++ /dev/null @@ -1,400 +0,0 @@ -(** * Library for retracts *) - -(* Author: Maximilian Wuttke *) - -Require Import Shared.Base. - - -(* - * A retraction between types [A] and [B] is a tuple of two functions, - * [f : A -> B] (called the injection function) and [g : B -> option A] (called the retract function), - * such that the following triangle shaped diagram commutes: - * - * f - * A -----> B - * | / - * Some | / g - * | / - * \|/ |/_ - * option A - * - * That informally means, that the injective function [f] can be reverted by the retract function [g]. - * Foramlly, for all values [x:A] and [y = f x], then [g y = Some x]. (Or: [forall x, g (f x) = Some x].) - * - * The retracts should also be "tight", which means that the retract function only reverts values in - * the image of [f]. Foramlly this means that whenever [g y = Some x], then also [y = f x] - * - * Altogether, we have that [forall x y, g y = Some x <-> y = f x]. - *) - - -Section Retract. - - Variable X Y : Type. - - Definition retract (f : X -> Y) (g : Y -> option X) := forall x y, g y = Some x <-> y = f x. - - Class Retract := - { - Retr_f : X -> Y; - Retr_g : Y -> option X; - Retr_retr : retract Retr_f Retr_g; - }. - -End Retract. - -Arguments Retr_f { _ _ _ }. -Arguments Retr_g { _ _ _ }. - -Section Retract_Properties. - - Variable X Y : Type. - - Hypothesis I : Retract X Y. - - Definition retract_g_adjoint : forall x, Retr_g (Retr_f x) = Some x. - Proof. intros. pose proof @Retr_retr _ _ I. hnf in H. now rewrite H. Qed. - - Definition retract_g_inv : forall x y, Retr_g y = Some x -> y = Retr_f x. - Proof. intros. now apply Retr_retr. Qed. - - Lemma retract_g_surjective : forall x, { y | Retr_g y = Some x }. - Proof. intros x. pose proof retract_g_adjoint x. cbn in H. eauto. Defined. - - Lemma retract_f_injective : forall x1 x2, Retr_f x1 = Retr_f x2 -> x1 = x2. - Proof. - intros x1 x2 H. - enough (Some x1 = Some x2) by congruence. - erewrite <- !retract_g_adjoint. - now rewrite H. - Qed. - - Lemma retract_g_Some x y : - Retr_g (Retr_f x) = Some y -> - x = y. - Proof. now intros H % retract_g_inv % retract_f_injective. Qed. - - Lemma retract_g_None b : - Retr_g b = None -> - forall a, Retr_f a <> b. - Proof. - intros H a <-. - enough (Retr_g (Retr_f a) = Some a) by congruence. - apply retract_g_adjoint. - Qed. - - -End Retract_Properties. - - -(* This tactic replaces all occurrences of [g (f x)] with [Some x] for retracts. *) -Ltac retract_adjoint := - match goal with - | [ H : context [ Retr_g (Retr_f _) ] |- _ ] => rewrite retract_g_adjoint in H - | [ |- context [ Retr_g (Retr_f _) ] ] => rewrite retract_g_adjoint - end. - - - -(* - * We can compose retractions, as shown in the following commuting diagram - * - * f1 f2 - * A --------> B --------> C - * | / | / - * | / |Some / - * | / | / - * | / | / - * Some | / g1 | / g2 - * | / | / - * \|/ |/_ \|/ |/_ - * option A <--- option B - * map g1 - * - * - * Where [map g1] is the function that takes an option [x : option B] and applys [Some] and [g1] if it is [Some], - * and else returns [None]. - * - * Now [f2 ∘ f1] and [map g1 ∘ g2] gives a retract between [A] and [C]. - *) - -Section ComposeRetracts. - Variable A B C : Type. - - Definition retr_comp_f (f1 : B -> C) (f2 : A -> B) : A -> C := fun a => f1 (f2 a). - Definition retr_comp_g (g1 : C -> option B) (g2 : B -> option A) : C -> option A := - fun c => match g1 c with - | Some b => g2 b - | None => None - end. - - (* No instance (outside of this section), for obvious reasons... *) - Local Instance ComposeRetract (retr1 : Retract B C) (retr2 : Retract A B) : Retract A C := - {| - Retr_f := retr_comp_f Retr_f Retr_f; - Retr_g := retr_comp_g Retr_g Retr_g; - |}. - Proof. - abstract now - unfold retr_comp_f, retr_comp_g; intros a c; split; - [intros H; destruct (Retr_g c) as [ | ] eqn:E; - [ apply retract_g_inv in E as ->; now apply retract_g_inv in H as -> - | congruence - ] - | intros ->; now do 2 retract_adjoint - ]. - Defined. - -End ComposeRetracts. - - -(** We define some useful retracts. *) -Section Usefull_Retracts. - - Variable (A B C D : Type). - - - (** Identity retract *) - Global Instance Retract_id : Retract A A := - {| - Retr_f a := a; - Retr_g b := Some b; - |}. - Proof. abstract now hnf; firstorder congruence. Defined. - - - (** Empty retract *) - Global Instance Retract_Empty : Retract Empty_set A := - {| - Retr_f e := @Empty_set_rect (fun _ => A) e; - Retr_g b := None; - |}. - Proof. abstract now intros x; elim x. Defined. - - (** Eliminate the [Empty_set] from the source sum type *) - Global Instance Retract_Empty_left `{retr: Retract A B} : Retract (A + Empty_set) B := - {| - Retr_f a := match a with - | inl a => Retr_f a - | inr e => @Empty_set_rect (fun _ => B) e - end; - Retr_g b := match Retr_g b with - | Some a => Some (inl a) - | None => None - end; - |}. - Proof. - abstract now intros [ a | [] ] b; split; - [ intros H; destruct (Retr_g b) eqn:E; inv H; now apply retract_g_inv in E - | intros ->; now retract_adjoint - ]. - Defined. - - Global Instance Retract_Empty_right `{retr: Retract A B} : Retract (Empty_set + A) B := - {| - Retr_f a := match a with - | inl e => @Empty_set_rect (fun _ => B) e - | inr a => Retr_f a - end; - Retr_g b := match Retr_g b with - | Some a => Some (inr a) - | None => None - end; - |}. - Proof. - abstract now intros [ [] | a ] b; split; - [ intros H; destruct (Retr_g b) eqn:E; inv H; now apply retract_g_inv in E - | intros ->; now retract_adjoint - ]. - Defined. - - - (** We can introduce an additional [Some] and use the identity as the retract function *) - Global Instance Retract_option `{retr: Retract A B} : Retract A (option B) := - {| - Retr_f a := Some (Retr_f a); - Retr_g ob := match ob with - | Some b => Retr_g b - | None => None - end; - |}. - Proof. - abstract now - split; - [ intros H; destruct y as [b|]; - [ now apply retract_g_inv in H as -> - | inv H - ] - | intros ->; now retract_adjoint - ]. - Defined. - - (** We can introduce an additional [inl] *) - - Definition retract_inl_f (f : A -> B) : A -> (B + C) := fun a => inl (f a). - Definition retract_inl_g (g : B -> option A) : B+C -> option A := - fun x => match x with - | inl b => g b - | inr c => None - end. - - Global Instance Retract_inl (retrAB : Retract A B) : Retract A (B + C) := - {| - Retr_f := retract_inl_f Retr_f; - Retr_g := retract_inl_g Retr_g; - |}. - Proof. - abstract now - unfold retract_inl_f, retract_inl_g; hnf; intros x y; split; - [ destruct y as [a|b]; [ now intros -> % retract_g_inv | congruence ] - | intros ->; now retract_adjoint - ]. - Defined. - - - (** The same for [inr] *) - - Definition retract_inr_f (f : A -> B) : A -> (C + B) := fun a => inr (f a). - Definition retract_inr_g (g : B -> option A) : C+B -> option A := - fun x => match x with - | inr b => g b - | inl c => None - end. - - Global Instance Retract_inr (retrAB : Retract A B) : Retract A (C + B) := - {| - Retr_f := retract_inr_f Retr_f; - Retr_g := retract_inr_g Retr_g; - |}. - Proof. - abstract now - unfold retract_inr_f, retract_inr_g; hnf; intros x y; split; - [ destruct y as [a|b]; [ congruence | now intros -> % retract_g_inv ] - | intros ->; now retract_adjoint - ]. - Defined. - - - - (** We can map retracts over sums, similiary as we have done with inversions *) - - Section Retract_sum. - - Definition retract_sum_f (f1: A -> C) (f2: B -> D) : A+B -> C+D := - fun x => match x with - | inl a => inl (f1 a) - | inr b => inr (f2 b) - end. - - Definition retract_sum_g (g1: C -> option A) (g2: D -> option B) : C+D -> option (A+B) := - fun y => match y with - | inl c => match g1 c with - | Some a => Some (inl a) - | None => None - end - | inr d => match g2 d with - | Some b => Some (inr b) - | None => None - end - end. - - Local Instance Retract_sum (retr1 : Retract A C) (retr2 : Retract B D) : Retract (A+B) (C+D) := - {| - Retr_f := retract_sum_f Retr_f Retr_f; - Retr_g := retract_sum_g Retr_g Retr_g; - |}. - Proof. - abstract now - unfold retract_sum_f, retract_sum_g; intros x y; split; - [ intros H; destruct y as [c|d]; - [ destruct (Retr_g c) eqn:E1; inv H; f_equal; now apply retract_g_inv - | destruct (Retr_g d) eqn:E1; inv H; f_equal; now apply retract_g_inv - ] - | intros ->; destruct x as [a|b]; now retract_adjoint - ]. - Defined. - - End Retract_sum. - -End Usefull_Retracts. - - - -(* If we have a retract from [A] to [Z] and a retract from [B] to Z, in general it is not possible - * to build a retract from [A+B] to [Z]. For example, there can be no retract from [unit+unit] to - * [unit]. However, it is possible when the images of the injections are distint. - *) -Section Join. - - Variable A B Z : Type. - - Variable retr1 : Retract A Z. - Variable retr2 : Retract B Z. - - Local Arguments Retr_f {_ _} (Retract). - Local Arguments Retr_g {_ _} (Retract). - - Definition retract_join_f s := - match s with - | inl a => Retr_f retr1 a - | inr b => Retr_f retr2 b - end. - - Definition retract_join_g z := - match Retr_g retr1 z with - | Some a => Some (inl a) - | None => - match Retr_g retr2 z with - | Some b => Some (inr b) - | None => None - end - end. - - Hypothesis disjoint : forall (a : A) (b : B), Retr_f _ a <> Retr_f _ b. - - Lemma retract_join : retract retract_join_f retract_join_g. - Proof. - unfold retract_join_f, retract_join_g. hnf; intros s z; split. - - destruct s as [a|b]; intros H. - + destruct (Retr_g retr1 z) eqn:E. - * inv H. now apply retract_g_inv in E. - * destruct (Retr_g retr2 z) eqn:E2; inv H. - + destruct (Retr_g retr1 z) eqn:E. - * inv H. - * destruct (Retr_g retr2 z) eqn:E2. - -- inv H. now apply retract_g_inv in E2. - -- inv H. - - intros ->. destruct s as [a|b]; retract_adjoint. reflexivity. - destruct (Retr_g retr1 (Retr_f retr2 b)) eqn:E. - + exfalso. apply retract_g_inv in E. symmetry in E. now apply disjoint in E. - + reflexivity. - Qed. - - Local Instance Retract_join : Retract (A+B) Z := Build_Retract retract_join. - -End Join. - - - - - -(** More instances like [Retract_sum] for bigger sums. *) - -Section MoreSums. - - Local Instance Retract_sum3 (A A' B B' C C' : Type) (retr1 : Retract A A') (retr2 : Retract B B') (retr3 : Retract C C') : - Retract (A+B+C) (A'+B'+C') := Retract_sum (Retract_sum retr1 retr2) retr3. - - Local Instance Retract_sum4 (A A' B B' C C' D D' : Type) (retr1 : Retract A A') (retr2 : Retract B B') (retr3 : Retract C C') (retr4 : Retract D D') : - Retract (A+B+C+D) (A'+B'+C'+D') := Retract_sum (Retract_sum (Retract_sum retr1 retr2) retr3) retr4. - - Local Instance Retract_sum5 (A A' B B' C C' D D' E E' : Type) (retr1 : Retract A A') (retr2 : Retract B B') (retr3 : Retract C C') (retr4 : Retract D D') (retr5 : Retract E E') : - Retract (A+B+C+D+E) (A'+B'+C'+D'+E') := Retract_sum (Retract_sum (Retract_sum (Retract_sum retr1 retr2) retr3) retr4) retr5. - - Local Instance Retract_sum6 (A A' B B' C C' D D' E E' F F' : Type) (retr1 : Retract A A') (retr2 : Retract B B') (retr3 : Retract C C') (retr4 : Retract D D') (retr5 : Retract E E') (retr6 : Retract F F') : - Retract (A+B+C+D+E+F) (A'+B'+C'+D'+E'+F') := Retract_sum (Retract_sum (Retract_sum (Retract_sum (Retract_sum retr1 retr2) retr3) retr4) retr5) retr6. - - Local Instance Retract_sum7 (A A' B B' C C' D D' E E' F F' G G' : Type) (retr1 : Retract A A') (retr2 : Retract B B') (retr3 : Retract C C') (retr4 : Retract D D') (retr5 : Retract E E') (retr6 : Retract F F') (retr7 : Retract G G') : - Retract (A+B+C+D+E+F+G) (A'+B'+C'+D'+E'+F'+G') := Retract_sum (Retract_sum (Retract_sum (Retract_sum (Retract_sum (Retract_sum retr1 retr2) retr3) retr4) retr5) retr6) retr7. - -End MoreSums. diff --git a/external/base/Tactics/AutoIndTac.v b/external/base/Tactics/AutoIndTac.v deleted file mode 100644 index 2daba52..0000000 --- a/external/base/Tactics/AutoIndTac.v +++ /dev/null @@ -1,122 +0,0 @@ - - -(* Mostly taken form https://github.com/sigurdschneider/lvc/blob/23b7fa8cd0640503ff370144fb407192632f9cc6/Infra/AutoIndTac.v *) - -(* fail 1 will break from the 'match H with', and indicate to - the outer match that it should consider finding another - hypothesis, see documentation on match goal and fail - This tactic is a variation of Tobias Tebbi's revert_except_until *) - -Ltac revert_all := - repeat match goal with [ H : _ |- _ ] => revert H end. - -Tactic Notation "revert" "all" := revert_all. - -Ltac revert_except i := - repeat match goal with [ H : _ |- _ ] => tryif unify H i then fail else revert H end. - -Tactic Notation "revert" "all" "except" ident(i) := revert_except i. - -Ltac clear_except i := - repeat match goal with [ H : _ |- _ ] => tryif unify H i then fail else clear H end. - -Tactic Notation "clear" "all" "except" ident(i) := clear_except i. - -Ltac clear_all := - repeat match goal with - [H : _ |- _] => clear H - end. - - -(* -(* succeed if H has a function type, fail otherwise *) -Ltac is_ftype H := - let t := type of H in - let t' := eval cbv in t in - match t' with - | _ -> _ => idtac - end. -*) -(* match on the type of E and remember each of it's arguments - that is not a variable by calling tac. - tac needs to do a remember exactly if x is not a var, and - fail otherwise. (We need to fail, otherwise the repeat will - stop prematurely) - try will silently ignore a fail 0, but will fail if a fail 1 or - above occurs. Sequentialization makes sure fail 1 is executed - if is_var is successful, hence try (is_var x; fail 1) will - fail exactly when x is a var. *) - -Ltac remember_arguments E := - let tac x := (try (is_var x; fail 1); (*try (is_ftype x; fail 1);*) remember (x)) in - repeat (match type of E with - | ?t ?x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ _ => tac x - | ?t ?x _ _ _ _ => tac x - | ?t ?x _ _ _ => tac x - | ?t ?x _ _ => tac x - | ?t ?x _ => tac x - | ?t ?x => tac x - end). - -(* from Coq.Program.Tactics *) -Ltac clear_dup := - match goal with - | [ H : ?X |- _ ] => - match goal with - | [ H' : ?Y |- _ ] => - match H with - | H' => fail 2 - | _ => unify X Y ; (clear H' || clear H) - end - end - end. - -Ltac inv_eqs := - repeat (match goal with - | [ H : @eq _ ?x ?x |- _ ] => fail (* nothing to do on x = x *) - | [ H : @eq _ ?x ?y |- _ ] => progress (inversion H; subst; try clear_dup) - end). - -(* this is a standard tactic *) -Ltac clear_trivial_eqs := - repeat (progress (match goal with - | [ H : @eq _ ?x ?x |- _ ] => clear H - end)). - -Tactic Notation "general" "induction" hyp(H) := - remember_arguments H; revert_except H; - induction H; intros; (try inv_eqs); (try clear_trivial_eqs). - -(* Module Test. *) -(* Require Import List. *) - -(* Inductive decreasing : list nat -> Prop := *) -(* | base : decreasing nil *) -(* | step m n L : decreasing (n::L) -> n <= m -> decreasing (m :: n :: L). *) - -(* Lemma all_zero_by_hand L *) -(* : decreasing (0::L) -> forall x, In x L -> x = 0. *) -(* Proof. *) -(* intros. remember (0::L). *) -(* revert dependent L. revert x. induction H; intros. *) -(* inversion Heql. *) -(* inversion Heql. subst. inversion H0; subst; firstorder. *) -(* Qed. *) - -(* Lemma all_zero L *) -(* : decreasing (0::L) -> forall x, In x L -> x = 0. *) -(* Proof. *) -(* intros. general induction H. *) -(* inversion H0; subst; firstorder. *) -(* Qed. *) -(* End Test. *) diff --git a/external/base/Tactics/Tactics.v b/external/base/Tactics/Tactics.v deleted file mode 100644 index 9730cac..0000000 --- a/external/base/Tactics/Tactics.v +++ /dev/null @@ -1,153 +0,0 @@ -(** ** Inversion *) - -Ltac inv H := inversion H; subst; try clear H. - - -(** ** Destructing *) - -Tactic Notation "destruct" "_":= - match goal with - | [ |- context[match ?X with _ => _ end] ] => destruct X - | [ H : context[match ?X with _ => _ end] |- _ ] => destruct X - end. - -Tactic Notation "destruct" "_" "eqn" ":" ident(E) := - match goal with - | [ |- context[match ?X with _ => _ end] ] => destruct X eqn:E - | [ H : context[match ?X with _ => _ end] |- _ ] => destruct X eqn:E - end. - -Tactic Notation "destruct" "*" := - repeat destruct _. - -Tactic Notation "destruct" "*" "eqn" ":" ident(E) := - repeat (let E := fresh E in destruct _ eqn:E; try progress inv E); try now congruence. - -Tactic Notation "destruct" "*" "eqn" ":" "_" := destruct * eqn:E. - -Tactic Notation "intros" "***" := repeat (intros ?). - -Ltac fstep N := unfold N; fold N. - -(* From Program.Tactics *) -Ltac destruct_one_pair := - match goal with - | [H : (_ /\ _) |- _] => destruct H - | [H : prod _ _ |- _] => destruct H - end. - -Ltac destruct_pairs := repeat (destruct_one_pair). - - - -(** ** Assumption Locking *) - - -(** [lock H] "locks" the goal [H], which syntactically adds [Lock], but it doesn't change the proof script. *) - -Definition Lock (X: Type) : Type := X. -Opaque Lock. Arguments Lock : simpl never. - -Tactic Notation "lock" ident(H) := - lazymatch type of H with - | ?X => change (Lock X) in H - end. - -Tactic Notation "unlock" ident(H) := - lazymatch type of H with - | Lock ?X => change X in H - end. - -Tactic Notation "unlock" "all" := - repeat multimatch goal with - | [ H : Lock ?X |- _ ] => change X in H - end. - -Tactic Notation "is_locked" ident(H) := - lazymatch type of H with - | Lock _ => idtac - | _ => fail "unlocked" - end. - -Tactic Notation "is_unlocked" ident(H) := - lazymatch type of H with - | Lock _ => fail "locked" - | _ => idtac - end. - - -(* -Goal True. - do 2 pose proof I. - lock H. - lock H0. - unlock H0. - do 2 pose proof I. - lock H0; lock H1. - unlock all. - - is_unlocked H. - Fail is_locked H. - - lock H. - is_locked H. - Fail is_unlocked H. - - Show Proof. (* Locking and unlocking is not represented in the proof term. *) -Abort. -*) - - - -(** ** Modus ponens *) - - -(* Prove the non-dependent hypothesis of a hypothesis that is a implication and specialize it *) -Tactic Notation "spec_assert" hyp(H) := - let H' := fresh in - match type of H with - | ?A -> _ => - assert A as H'; [ | specialize (H H'); clear H'] - end. - -Tactic Notation "spec_assert" hyp(H) "as" simple_intropattern(p) := - let H' := fresh in - match type of H with - | ?A -> _ => - assert A as H'; [ | specialize (H H') as p; clear H'] - end. - -Tactic Notation "spec_assert" hyp(H) "by" tactic(T) := - let H' := fresh in - match type of H with - | ?A -> _ => - assert A as H' by T; specialize (H H'); clear H' - end. - - -Tactic Notation "spec_assert" hyp(H) "as" simple_intropattern(p) "by" tactic(T) := - let H' := fresh in - match type of H with - | ?A -> _ => - assert A as H' by T; specialize (H H') as p; clear H' - end. - - - -(** ** Some debug tactics *) - -Ltac print_goal := - match goal with - | [ |- ?H ] => idtac H - end. - -Ltac print_goal_cbn := - match goal with - | [ |- ?H ] => - let H' := eval cbn in H in idtac H' - end. - -Ltac print_type e := first [ let x := type of e in idtac x | idtac "Untyped:" e ]. - - -Require Export AutoIndTac. \ No newline at end of file diff --git a/external/base/Vectors/Fin.v b/external/base/Vectors/Fin.v deleted file mode 100644 index 944c7dd..0000000 --- a/external/base/Vectors/Fin.v +++ /dev/null @@ -1,50 +0,0 @@ -(** * Tactics for [Fin.t] *) - -(* Author: Maximilian Wuttke *) - - -Require Import Shared.Base. -Require Import Coq.Vectors.Fin. - - -Lemma fin_destruct_S (n : nat) (i : Fin.t (S n)) : - { i' | i = Fin.FS i' } + { i = Fin.F1 }. -Proof. - refine (match i in (Fin.t n') - with - | Fin.F1 => _ - | Fin.FS i' => _ - end); eauto. - (* - refine (match i as i0 in (Fin.t n') return - match n' with - | O => fun _ : Fin.t 0 => unit - | S n'' => fun i0 : Fin.t (S n'') => { i' | i0 = Fin.FS i' } + { i0 = Fin0} - end i0 - with - | Fin.F1 => _ - | Fin.FS i' => _ - end); eauto. - *) -Defined. - -Lemma fin_destruct_O (i : Fin.t 0) : Empty_set. -Proof. refine (match i with end). Defined. - -Ltac destruct_fin i := - match type of i with - | Fin.t (S ?n) => - let i' := fresh i in - pose proof fin_destruct_S i as [ (i'&->) | -> ]; - [ destruct_fin i' - | idtac] - | Fin.t O => - pose proof fin_destruct_O i as [] - end. - -Goal True. - assert (i : Fin.t 4) by repeat constructor. - enough (i = i) by tauto. - destruct_fin i. - all: reflexivity. -Qed. \ No newline at end of file diff --git a/external/base/Vectors/FinNotation.v b/external/base/Vectors/FinNotation.v deleted file mode 100644 index 1a327ec..0000000 --- a/external/base/Vectors/FinNotation.v +++ /dev/null @@ -1,128 +0,0 @@ -(** * Notations for [Fin.t] *) -(* Author: Maximilian Wuttke *) - - -Require Import Fin. - -Notation "'Fin0'" := (Fin.F1). -Notation "'Fin1'" := (Fin.FS Fin0). -Notation "'Fin2'" := (Fin.FS Fin1). -Notation "'Fin3'" := (Fin.FS Fin2). -Notation "'Fin4'" := (Fin.FS Fin3). -Notation "'Fin5'" := (Fin.FS Fin4). -Notation "'Fin6'" := (Fin.FS Fin5). -Notation "'Fin7'" := (Fin.FS Fin6). -Notation "'Fin8'" := (Fin.FS Fin7). -Notation "'Fin9'" := (Fin.FS Fin8). -Notation "'Fin10'" := (Fin.FS Fin9). -Notation "'Fin11'" := (Fin.FS Fin10). -Notation "'Fin12'" := (Fin.FS Fin11). -Notation "'Fin13'" := (Fin.FS Fin12). -Notation "'Fin14'" := (Fin.FS Fin13). -Notation "'Fin15'" := (Fin.FS Fin14). -Notation "'Fin16'" := (Fin.FS Fin15). -Notation "'Fin17'" := (Fin.FS Fin16). -Notation "'Fin18'" := (Fin.FS Fin17). -Notation "'Fin19'" := (Fin.FS Fin18). -Notation "'Fin20'" := (Fin.FS Fin19). -Notation "'Fin21'" := (Fin.FS Fin20). -Notation "'Fin22'" := (Fin.FS Fin21). -Notation "'Fin23'" := (Fin.FS Fin22). -Notation "'Fin24'" := (Fin.FS Fin23). -Notation "'Fin25'" := (Fin.FS Fin24). -Notation "'Fin26'" := (Fin.FS Fin25). -Notation "'Fin27'" := (Fin.FS Fin26). -Notation "'Fin28'" := (Fin.FS Fin27). -Notation "'Fin29'" := (Fin.FS Fin28). -Notation "'Fin30'" := (Fin.FS Fin29). -Notation "'Fin31'" := (Fin.FS Fin30). -Notation "'Fin32'" := (Fin.FS Fin31). -Notation "'Fin33'" := (Fin.FS Fin32). -Notation "'Fin34'" := (Fin.FS Fin33). -Notation "'Fin35'" := (Fin.FS Fin34). -Notation "'Fin36'" := (Fin.FS Fin35). -Notation "'Fin37'" := (Fin.FS Fin36). -Notation "'Fin38'" := (Fin.FS Fin37). -Notation "'Fin39'" := (Fin.FS Fin38). -Notation "'Fin40'" := (Fin.FS Fin39). -Notation "'Fin41'" := (Fin.FS Fin40). -Notation "'Fin42'" := (Fin.FS Fin41). -Notation "'Fin43'" := (Fin.FS Fin42). -Notation "'Fin44'" := (Fin.FS Fin43). -Notation "'Fin45'" := (Fin.FS Fin44). -Notation "'Fin46'" := (Fin.FS Fin45). -Notation "'Fin47'" := (Fin.FS Fin46). -Notation "'Fin48'" := (Fin.FS Fin47). -Notation "'Fin49'" := (Fin.FS Fin48). -Notation "'Fin50'" := (Fin.FS Fin49). -Notation "'Fin51'" := (Fin.FS Fin50). -Notation "'Fin52'" := (Fin.FS Fin51). -Notation "'Fin53'" := (Fin.FS Fin52). -Notation "'Fin54'" := (Fin.FS Fin53). -Notation "'Fin55'" := (Fin.FS Fin54). -Notation "'Fin56'" := (Fin.FS Fin55). -Notation "'Fin57'" := (Fin.FS Fin56). -Notation "'Fin58'" := (Fin.FS Fin57). -Notation "'Fin59'" := (Fin.FS Fin58). -Notation "'Fin60'" := (Fin.FS Fin59). -Notation "'Fin61'" := (Fin.FS Fin60). -Notation "'Fin62'" := (Fin.FS Fin61). -Notation "'Fin63'" := (Fin.FS Fin62). -Notation "'Fin64'" := (Fin.FS Fin63). -Notation "'Fin65'" := (Fin.FS Fin64). -Notation "'Fin66'" := (Fin.FS Fin65). -Notation "'Fin67'" := (Fin.FS Fin66). -Notation "'Fin68'" := (Fin.FS Fin67). -Notation "'Fin69'" := (Fin.FS Fin68). -Notation "'Fin70'" := (Fin.FS Fin69). -Notation "'Fin71'" := (Fin.FS Fin70). -Notation "'Fin72'" := (Fin.FS Fin71). -Notation "'Fin73'" := (Fin.FS Fin72). -Notation "'Fin74'" := (Fin.FS Fin73). -Notation "'Fin75'" := (Fin.FS Fin74). -Notation "'Fin76'" := (Fin.FS Fin75). -Notation "'Fin77'" := (Fin.FS Fin76). -Notation "'Fin78'" := (Fin.FS Fin77). -Notation "'Fin79'" := (Fin.FS Fin78). -Notation "'Fin80'" := (Fin.FS Fin79). -Notation "'Fin81'" := (Fin.FS Fin80). -Notation "'Fin82'" := (Fin.FS Fin81). -Notation "'Fin83'" := (Fin.FS Fin82). -Notation "'Fin84'" := (Fin.FS Fin83). -Notation "'Fin85'" := (Fin.FS Fin84). -Notation "'Fin86'" := (Fin.FS Fin85). -Notation "'Fin87'" := (Fin.FS Fin86). -Notation "'Fin88'" := (Fin.FS Fin87). -Notation "'Fin89'" := (Fin.FS Fin88). -Notation "'Fin90'" := (Fin.FS Fin89). -Notation "'Fin91'" := (Fin.FS Fin90). -Notation "'Fin92'" := (Fin.FS Fin91). -Notation "'Fin93'" := (Fin.FS Fin92). -Notation "'Fin94'" := (Fin.FS Fin93). -Notation "'Fin95'" := (Fin.FS Fin94). -Notation "'Fin96'" := (Fin.FS Fin95). -Notation "'Fin97'" := (Fin.FS Fin96). -Notation "'Fin98'" := (Fin.FS Fin97). -Notation "'Fin99'" := (Fin.FS Fin98). - -(* Generate arbitrary big Fin.t's *) - -Ltac getFin i := - match i with - | 0 => - eapply Fin.F1 - | S ?i' => - eapply Fin.FS; - ltac:(getFin i') - end. - -(* -Section Test. - Compute ltac:(getFin 4) : Fin.t 100. - Compute ltac:(getFin 8) : Fin.t 100. - Compute ltac:(getFin 15) : Fin.t 100. - Compute ltac:(getFin 16) : Fin.t 100. - Compute ltac:(getFin 23) : Fin.t 100. - Compute ltac:(getFin 42) : Fin.t 100. -End Test. -*) \ No newline at end of file diff --git a/external/base/Vectors/VectorDupfree.v b/external/base/Vectors/VectorDupfree.v deleted file mode 100644 index 93c1fde..0000000 --- a/external/base/Vectors/VectorDupfree.v +++ /dev/null @@ -1,205 +0,0 @@ -(** * Dupfree vector *) -(* Author: Maximilian Wuttke *) - -Require Import Shared.Prelim. -Require Import Shared.Tactics.Tactics. -Require Import Shared.Vectors.Vectors. -Require Import Shared.FiniteTypes.FinTypes. -Require Shared.Lists.Dupfree. -Require Import Coq.Vectors.Vector. - -Open Scope vector_scope. - -Inductive dupfree X : forall n, Vector.t X n -> Prop := - dupfreeVN : - dupfree (@Vector.nil X) -| dupfreeVC n (x : X) (V : Vector.t X n) : - ~ Vector.In x V -> dupfree V -> dupfree (x ::: V). - - -Ltac vector_dupfree := - match goal with - | [ |- dupfree (Vector.nil _) ] => - constructor - | [ |- dupfree (?a ::: ?bs)] => - constructor; [vector_not_in | vector_dupfree] - end. - -Goal dupfree [| 4; 8; 15; 16; 23; 42 |]. -Proof. vector_dupfree. Qed. - -Goal dupfree [| Fin.F1 (n := 1) |]. -Proof. vector_dupfree. Qed. - -(* -(* This also works, but needs a bit to comile *) -Require Import Shared.Vectors.FinNotation. -Goal dupfree ([| Fin4; Fin8; Fin15; Fin16; Fin23; Fin42 |] : Vector.t (Fin.t 43) _). -Proof. vector_dupfree. Qed. -*) - -Lemma dupfree_cons (X : Type) (n : nat) (x : X) (xs : Vector.t X n) : - dupfree (x ::: xs) -> dupfree xs /\ ~ In x xs. -Proof. - intros H1. inv H1. now existT_eq'. -Qed. - -Lemma dupfree_replace (X : Type) (n : nat) (xs : Vector.t X n) (x : X) : - dupfree xs -> ~ In x xs -> forall i, dupfree (replace xs i x). -Proof. - revert x. induction xs; intros; cbn. - - inv i. - - dependent destruct i; cbn. - + constructor; auto. - * intros H1. contradict H0. now econstructor. - * inv H. existT_eq'. assumption. - + apply dupfree_cons in H as (H&H'). - assert (~In x xs). - { - intros H1. contradict H0. now constructor. - } - specialize (IHxs x H H1 p). constructor. - * intros [ -> | H2] % In_replace. contradict H0. constructor. tauto. - * tauto. -Qed. - - -Lemma dupfree_tabulate_injective (X : Type) (n : nat) (f : Fin.t n -> X) : - (forall x y, f x = f y -> x = y) -> - dupfree (tabulate f). -Proof. - intros H. revert f H. induction n; intros; cbn. - - constructor. - - constructor. - + intros (x & H2 % H) % in_tabulate. congruence. - + eapply IHn. now intros x y -> % H % Fin.FS_inj. -Qed. - -Lemma dupfree_map_injective (X Y : Type) (n : nat) (f : X -> Y) (V : Vector.t X n) : - (forall x y, f x = f y -> x = y) -> - dupfree V -> - dupfree (map f V). -Proof. - intros HInj. induction 1. - - cbn. constructor. - - cbn. constructor; auto. now intros (? & -> % HInj & ?) % vect_in_map_iff. -Qed. - -Lemma tolist_dupfree (X : Type) (n : nat) (xs : Vector.t X n) : - dupfree xs -> Dupfree.dupfree xs. -Proof. - induction 1. - - cbn. constructor. - - cbn. constructor; auto. intros H1. contradict H. now apply tolist_In. -Qed. - -Section Count. - Variable (X : eqType). - - Definition count (n : nat) (x : X) (xs : t X n) := - fold_right (fun y c => if Dec (x = y) then S c else c) xs 0. - - Lemma count0_notIn (n : nat) (x : X) (xs : t X n) : - count x xs = 0 -> ~ In x xs. - Proof. - revert x. induction xs; intros; cbn in *. - - vector_not_in. - - intros H1. decide (x=h); try congruence. - apply In_cons in H1 as [-> | H1]; try tauto. - eapply IHxs; eauto. - Qed. - - Lemma count0_notIn' (n : nat) (x : X) (xs : t X n) : - ~ In x xs -> count x xs = 0. - Proof. - induction xs; intros; cbn in *. - - reflexivity. - - decide (x = h) as [ -> | D ]. - + contradict H. constructor. - + apply IHxs. intros H2. contradict H. now constructor. - Qed. - - Lemma countDupfree (n : nat) (xs : t X n) : - (forall x : X, In x xs -> count x xs = 1) <-> dupfree xs. - Proof. - split; intros H. - { - induction xs; cbn -[count] in *. - - constructor. - - constructor. - + intros H2. specialize (H h ltac:(now constructor)). cbn in H. - decide (h = h); try tauto. inv H. - contradict H2. now eapply count0_notIn. - + apply IHxs. intros x Hx. specialize (H x ltac:(now constructor)). - cbn in H. decide (x = h); inv H; auto. rewrite H1. - contradict Hx. now eapply count0_notIn. - } - { - induction H as [ | n x' xs HIn HDup IH ]; intros; cbn in *. - - inv H. - - decide (x = x') as [ -> | D]. - + f_equal. exact (count0_notIn' HIn). - + apply (IH x). now apply In_cons in H as [ -> | H]. - } - Qed. - - -(* (* Test *) -End Count. -Compute let xs := [|1;2;3;4;5;6|] in - let x := 2 in - let y := 1 in - let i := Fin.F1 in - Dec (x = y) + count x xs = Dec (x = xs[@i]) + count x (replace xs i y). -*) - - Lemma replace_nochange (n : nat) (xs : Vector.t X n) (p : Fin.t n) : - replace xs p xs[@p] = xs. - Proof. - eapply eq_nth_iff. intros ? ? <-. - decide (p = p1) as [ -> | D]. - - now rewrite replace_nth. - - now rewrite replace_nth2. - Qed. - - Lemma count_replace (n : nat) (xs : t X n) (x y : X) (i : Fin.t n) : - Dec (x = y) + count x xs = Dec (x = xs[@i]) + count x (replace xs i y). - Proof. - induction xs; intros; cbn -[nth count] in *. - - inv i. - - dependent destruct i; cbn -[nth count] in *. - + decide (x = y) as [ D | D ]; cbn -[nth count] in *; cbn -[bool2nat dec2bool count]. - * rewrite <- D in *. decide (x = h) as [ -> | D2]; cbn [dec2bool bool2nat plus]; auto. - cbv [count]. cbn. rewrite D. decide (y = y); try tauto. decide (y = h); congruence. - * decide (x = h); subst; cbn [bool2nat dec2bool plus]; cbv [count]; try reflexivity. - -- cbn. decide (h = h); try tauto. decide (h = y); tauto. - -- cbn. decide (x = h); try tauto. decide (x = y); tauto. - + cbn. decide (x = y); cbn. - * decide (x = h); cbn; f_equal. - -- decide (x = xs[@p]); cbn; repeat f_equal; subst. - ++ symmetry. now apply replace_nochange. - ++ cbn in *. specialize (IHxs p). decide (h = xs[@p]); tauto. - -- decide (x = xs[@p]); cbn; repeat f_equal; subst. - ++ symmetry. now apply replace_nochange. - ++ cbn in *. specialize (IHxs p). decide (y = xs[@p]); tauto. - * decide (x = h); cbn; f_equal. - -- decide (x = xs[@p]); cbn; f_equal; subst. - ++ cbn in *. specialize (IHxs p). decide (xs[@p] = xs[@p]); cbn in *; try tauto. - ++ specialize (IHxs p). cbn in *. decide (h = xs[@p]); cbn in *; tauto. - -- decide (x = xs[@p]); cbn; auto. - ++ specialize (IHxs p). cbn in *. decide (x = xs[@p]); cbn in *; tauto. - ++ specialize (IHxs p). cbn in *. decide (x = xs[@p]); cbn in *; tauto. - Qed. - -End Count. - -Lemma dupfree_nth_injective (X : Type) (n : nat) (xs : Vector.t X n) : - dupfree xs -> forall (i j : Fin.t n), xs[@i] = xs[@j] -> i = j. -Proof. - induction 1; intros; cbn -[nth] in *. - - inv i. - - dependent destruct i; dependent destruct j; cbn -[nth] in *; auto. - + cbn in *. contradict H. eapply vect_nth_In; eauto. - + cbn in *. contradict H. eapply vect_nth_In; eauto. - + f_equal. now apply IHdupfree. -Qed. \ No newline at end of file diff --git a/external/base/Vectors/Vectors.v b/external/base/Vectors/Vectors.v deleted file mode 100644 index dab78b3..0000000 --- a/external/base/Vectors/Vectors.v +++ /dev/null @@ -1,384 +0,0 @@ -(** * Addendum for Vectors ([Vector.t]) *) -(* Author: Maximilian Wuttke *) - - -Require Import Shared.Prelim Shared.Tactics.Tactics Shared.EqDec. -Require Import Coq.Vectors.Fin Coq.Vectors.Vector. -Require Import Shared.Vectors.FinNotation. -Require Export Shared.Vectors.Fin. - - -(* Vector.nth should not reduce with simpl, except the index is given with a constructor *) -Arguments Vector.nth {A} {m} (v') !p. -Arguments Vector.map {A B} f {n} !v /. -Arguments Vector.map2 {A B C} g {n} !v1 !v2 /. - -Tactic Notation "dependent" "destruct" constr(V) := - match type of V with - | Vector.t ?Z (S ?n) => - revert all except V; - pattern V; revert n V; - eapply caseS; intros - | Vector.t ?Z 0 => - revert all except V; - pattern V; revert V; - eapply case0; intros - | Fin.t 0 => inv V - | Fin.t (S ?n) => - let pos := V in - revert all except pos; - pattern pos; revert n pos; - eapply Fin.caseS; intros - | _ => fail "Wrong type" - end. - -Delimit Scope vector_scope with vector. -Local Open Scope vector. - -Notation "[||]" := (nil _) : vector_scope. -Notation "h ':::' t" := (cons _ h _ t) (at level 60, right associativity) : vector_scope. - -Notation " [| x |] " := (x ::: [||]) : vector_scope. -Notation " [| x ; y ; .. ; z |] " := (cons _ x _ (cons _ y _ .. (cons _ z _ (nil _)) ..)) : vector_scope. -Notation "v [@ p ]" := (nth v p) (at level 1, format "v [@ p ]") : vector_scope. - - -Ltac existT_eq := - match goal with - | [ H: existT ?X1 ?Y1 ?Z1 = existT ?X2 ?Y2 ?Z2 |- _] => - apply EqdepFacts.eq_sigT_iff_eq_dep in H; inv H - end. - -Ltac existT_eq' := - match goal with - | [ H: existT ?X1 ?Y1 ?Z1 = existT ?X2 ?Y2 ?Z2 |- _] => - apply EqdepFacts.eq_sigT_iff_eq_dep in H; induction H - end. - - -Lemma vect_map_injective X Y n (f : X -> Y) (v1 v2 : Vector.t X n) : - (forall x y, f x = f y -> x = y) -> - map f v1 = map f v2 -> v1 = v2. -Proof. - intros Inj Eq. - induction n; cbn in *. - - dependent destruct v1. dependent destruct v2; reflexivity. - - dependent destruct v1. dependent destruct v2. cbn in *. - eapply cons_inj in Eq as (-> % Inj &?). f_equal. now apply IHn. -Qed. - - - -Lemma replace_nth X n (v : Vector.t X n) i (x : X) : - (Vector.replace v i x) [@i] = x. -Proof. - induction i; dependent destruct v; cbn; auto. -Qed. - -Lemma replace_nth2 X n (v : Vector.t X n) i j (x : X) : - i <> j -> (Vector.replace v i x) [@j] = v[@j]. -Proof. - revert v. pattern i, j. revert n i j. - eapply Fin.rect2; intros; try congruence. - - revert f H. pattern v. revert n v. - eapply Vector.caseS. - cbn. reflexivity. - - revert f H. pattern v. revert n v. - eapply Vector.caseS. - cbn. reflexivity. - - revert g f H H0. pattern v. revert n v. - eapply Vector.caseS. firstorder congruence. -Qed. - -Lemma destruct_vector_nil (X : Type) : - forall v : Vector.t X 0, v = [||]. -Proof. - now apply case0. -Qed. - -Lemma destruct_vector_cons (X : Type) (n : nat) : - forall v : Vector.t X (S n), { h : X & { v' : Vector.t X n | v = h ::: v' }}. -Proof. - revert n. apply caseS. eauto. -Qed. - - -Lemma In_nil (X : Type) (x : X) : - ~ In x [||]. -Proof. intros H. inv H. Qed. - -Lemma In_cons (X : Type) (n : nat) (x y : X) (xs : Vector.t X n) : - In y (x ::: xs) -> x = y \/ In y xs. -Proof. - intros H. inv H; existT_eq'; tauto. -Qed. - -Search Vector.map Vector.In. - -Ltac destruct_vector_in := - match goal with - | [ H: Vector.In _ [||] |- _ ] => now apply In_nil in H - | [ H: Vector.In _ (_ ::: _) |- _ ] => apply In_cons in H as [-> | H] (* Try replacing it first *) - | [ H: Vector.In _ (_ ::: _) |- _ ] => apply In_cons in H as [H | H] - end. - -(* -Goal ~ Vector.In 10 [|1;2;4|]. -Proof. - intros H. repeat destruct_vector_in; congruence. -Qed. -*) - - -Section In_Dec. - Variable X : Type. - Hypothesis X_dec : eq_dec X. - - Fixpoint in_dec (n : nat) (x : X) (xs : Vector.t X n) { struct xs } : bool := - match xs with - | [||] => false - | y ::: xs' => if Dec (x = y) then true else in_dec x xs' - end. - - Lemma in_dec_correct (n : nat) (x : X) (xs : Vector.t X n) : - in_dec x xs = true <-> In x xs. - Proof. - split; intros. - { - induction xs; cbn in *. - - congruence. - - decide (x = h) as [ -> | D]. - + constructor. - + constructor. now apply IHxs. - } - { - induction H; cbn. - - have (x = x). - - decide (x = x0). - + reflexivity. - + apply IHIn. - } - Qed. - - Global Instance In_dec (n : nat) (x : X) (xs : Vector.t X n) : dec (In x xs). - Proof. eapply dec_transfer. eapply in_dec_correct. auto. Defined. - -End In_Dec. - - - -(* Destruct a vector of known size *) -Ltac destruct_vector := - repeat match goal with - | [ v : Vector.t ?X 0 |- _ ] => - let H := fresh "Hvect" in - pose proof (@destruct_vector_nil X v) as H; - subst v - | [ v : Vector.t ?X (S ?n) |- _ ] => - let h := fresh "h" in - let v' := fresh "v'" in - let H := fresh "Hvect" in - pose proof (@destruct_vector_cons X n v) as (h&v'&H); - subst v; rename v' into v - end. - - - -Section In_nth. - Variable (A : Type) (n : nat). - - Lemma vect_nth_In (v : Vector.t A n) (i : Fin.t n) (x : A) : - Vector.nth v i = x -> Vector.In x v. - Proof. - induction n; cbn in *. - - inv i. - - dependent destruct v. dependent destruct i; cbn in *; subst; econstructor; eauto. - Qed. - - Lemma vect_nth_In' (v : Vector.t A n) (x : A) : - Vector.In x v -> exists i : Fin.t n, Vector.nth v i = x. - Proof. - induction n; cbn in *. - - inversion 1. - - dependent destruct v. destruct_vector_in. - + exists Fin.F1. auto. - + specialize (IHn0 _ H) as (i&<-). exists (Fin.FS i). auto. - Qed. - -End In_nth. - - - -Section tabulate_vec. - Variable X : Type. - - Fixpoint tabulate (n : nat) (f : Fin.t n -> X) {struct n} : Vector.t X n. - Proof. - destruct n. - - apply Vector.nil. - - apply Vector.cons. - + apply f, Fin.F1. - + apply tabulate. intros m. apply f, Fin.FS, m. - Defined. - - Lemma nth_tabulate n (f : Fin.t n -> X) (m : Fin.t n) : - Vector.nth (tabulate f) m = f m. - Proof. - induction m. - - cbn. reflexivity. - - cbn. rewrite IHm. reflexivity. - Qed. - - Lemma in_tabulate n (f : Fin.t n -> X) (x : X) : - In x (tabulate (n := n) f) <-> exists i : Fin.t n, x = f i. - Proof. - split. - { - revert f x. induction n; intros f x H. - - cbn in *. inv H. - - cbn in *. apply In_cons in H as [ <- | H ]. - + eauto. - + specialize (IHn (fun m => f (Fin.FS m)) _ H) as (i&IH). eauto. - } - { - intros (i&Hi). induction i; cbn in *; subst; econstructor; eauto. - } - Qed. - -End tabulate_vec. - -(* -Lemma vec_replace_nth X x n (t : Vector.t X n) (i : Fin.t n) : - x = Vector.nth (Vector.replace t i x) i. -Proof. - induction i; dependent destruct t; simpl; auto. -Qed. - -Lemma vec_replace_nth_nochange X x n (t : Vector.t X n) (i j : Fin.t n) : - Fin.to_nat i <> Fin.to_nat j -> Vector.nth t i = Vector.nth (Vector.replace t j x) i. -Proof. - revert j. induction i; dependent destruct t; dependent destruct j; simpl; try tauto. - apply IHi. contradict H. cbn. now rewrite !H. -Qed. - *) - - -Instance Fin_eq_dec n : eq_dec (Fin.t n). -Proof. - intros; hnf. - destruct (Fin.eqb x y) eqn:E. - - left. now eapply Fin.eqb_eq. - - right. intros H. eapply Fin.eqb_eq in H. congruence. -Defined. - - -Lemma vect_in_map (X Y : Type) (n : nat) (f : X -> Y) (V : Vector.t X n) (x : X) : - In x V -> In (f x) (map f V). -Proof. induction 1; cbn; constructor; auto. Qed. - -Lemma vect_in_map_iff (X Y : Type) (n : nat) (f : X -> Y) (V : Vector.t X n) (y : Y) : - In y (map f V) <-> (exists x : X, f x = y /\ In x V). -Proof. - split. - - intros H. induction V; cbn in *. - + inv H. - + apply In_cons in H as [ <- | H]. - * exists h. split; auto. now constructor 1. - * specialize (IHV H) as (x&Hx1&Hx2). exists x. split; auto. now constructor 2. - - intros (x&<-&H). now apply vect_in_map. -Qed. - - -Lemma In_replace (X : Type) (n : nat) (xs : Vector.t X n) (i : Fin.t n) (x y : X) : - In y (replace xs i x) -> (x = y \/ In y xs). -Proof. - revert i x y. induction xs; intros; cbn in *. - - inv i. - - dependent destruct i; cbn in *; apply In_cons in H as [-> | H]; auto; try now (right; constructor). - specialize (IHxs _ _ _ H) as [-> | IH]; [ now left | right; now constructor ]. -Qed. - -Lemma In_replace' (X : Type) (n : nat) (xs : Vector.t X n) (i : Fin.t n) (x y : X) : - In y (replace xs i x) -> x = y \/ exists j, i <> j /\ xs[@j] = y. -Proof. - revert i x y. induction xs; intros; cbn -[nth] in *. - - inv i. - - dependent destruct i; cbn -[nth] in *. - + apply In_cons in H as [->|H]. - * tauto. - * apply vect_nth_In' in H as (j&H). right. exists (Fin.FS j). split. discriminate. cbn. assumption. - + apply In_cons in H as [->|H]. - * right. exists Fin.F1. split. discriminate. cbn. reflexivity. - * specialize (IHxs _ _ _ H) as [-> | (j&IH1&IH2)]; [ tauto | ]. - right. exists (Fin.FS j). split. now intros -> % Fin.FS_inj. cbn. assumption. -Qed. - - - - -(** Tactic for simplifying a hypothesis of the form [In x v] *) - - -Ltac simpl_vector_inv := - repeat match goal with - | [ H : [||] = (_ ::: _) |- _ ] => now inv H - | [ H : (_ ::: _) = [||] |- _ ] => now inv H - | [ H : Fin.F1 = Fin.FS _ |- _] => now inv H - | [ H : Fin.FS _ = Fin.F1 |- _] => now inv H - | [ H : Fin.FS _ = Fin.FS _ |- _] => - first - [ apply Fin.FS_inj in H as -> - | apply Fin.FS_inj in H as <- - | apply Fin.FS_inj in H - ] - end. - - -Ltac simpl_vector_in := - repeat - match goal with - | _ => first - [ progress destruct_vector_in - | progress simpl_vector_inv - | progress auto - | congruence - ] - | [ H : Vector.In _ (Vector.map _ _) |- _] => - let x := fresh "x" in - eapply vect_in_map_iff in H as (x&<-&H) - | [ H : Vector.In _ (Vector.map _ _) |- _] => - let x := fresh "x" in - let H' := fresh H in - eapply vect_in_map_iff in H as (x&H&H') - | [ H : Vector.In _ (tabulate _) |- _ ] => - let i := fresh "i" in - apply in_tabulate in H as (i&->) - | [ H : Vector.In _ (tabulate _) |- _ ] => - let i := fresh "i" in - let H := fresh "H" in - apply in_tabulate in H as (i&H) - end. - -Ltac vector_not_in := - let H := fresh "H" in - intros H; simpl_vector_in. - -Goal Vector.In (Fin.F1 (n := 10)) [|Fin1; Fin2; Fin3 |] -> False. -Proof. intros H. simpl_vector_in. Qed. - -Goal Vector.In (Fin.F1 (n := 10)) (map (Fin.FS) [|Fin0; Fin1; Fin2|]) -> False. -Proof. intros H. simpl_vector_in. Qed. - - - -(** Conversion between vectors and lists *) - -Coercion Vector.to_list : Vector.t >-> list. - -Lemma tolist_In (X : Type) (n : nat) (xs : Vector.t X n) (x : X) : - Vector.In x xs <-> List.In x xs. -Proof. - split; intros H. - - induction H; cbn; auto. - - induction xs; cbn in *; auto. destruct H as [-> | H]; econstructor; eauto. -Qed. \ No newline at end of file diff --git a/external/base/_CoqProject b/external/base/_CoqProject deleted file mode 100644 index 8a1e0b4..0000000 --- a/external/base/_CoqProject +++ /dev/null @@ -1,39 +0,0 @@ --R . "Shared" --install none -COQDOCFLAGS = "--charset utf-8 -s --parse-comments --with-header ../website/resources/header.html --with-footer ../website/resources/footer.html --index indexpage" - -Base.v - -Tactics/Tactics.v -Tactics/AutoIndTac.v -Prelim.v -EqDec.v -Numbers.v -Bijection.v -Retracts.v -Inhabited.v -FCI.v - -Lists/BaseLists.v -Lists/Cardinality.v -Lists/Dupfree.v -Lists/Filter.v -Lists/Position.v -Lists/Power.v -Lists/Removal.v - -Vectors/Fin.v -Vectors/Vectors.v -Vectors/FinNotation.v -Vectors/VectorDupfree.v - -FiniteTypes.v -FiniteTypes/BasicDefinitions.v -FiniteTypes/FinTypes.v -FiniteTypes/BasicFinTypes.v -FiniteTypes/CompoundFinTypes.v -FiniteTypes/FiniteFunction.v -FiniteTypes/Cardinality.v -FiniteTypes/DepPairs.v -FiniteTypes/Arbitrary.v -FiniteTypes/VectorFin.v diff --git a/external/smpl b/external/smpl index ba9b7a0..54a001b 160000 --- a/external/smpl +++ b/external/smpl @@ -1 +1 @@ -Subproject commit ba9b7a023761e4a4fb72dd0eb90b2c7973b7392b +Subproject commit 54a001b798070472c1ce2b0a0d111e4e83689dce diff --git a/theories/TM/Code/CaseFin.v b/theories/TM/Code/CaseFin.v index be29ebc..3ce201d 100644 --- a/theories/TM/Code/CaseFin.v +++ b/theories/TM/Code/CaseFin.v @@ -25,7 +25,7 @@ Section CaseFin. Proof. eapply RealiseIn_monotone. { unfold CaseFin. TM_Correct. } - { Unshelve. 4,8:reflexivity. all:omega. } + { Unshelve. 4,8:reflexivity. all:lia. } { intros tin (yout, tout) H. intros x HEncX. destruct HEncX as (ls&HEncX). diff --git a/theories/TM/Code/CaseList.v b/theories/TM/Code/CaseList.v index 5b6dfc7..72301ad 100644 --- a/theories/TM/Code/CaseList.v +++ b/theories/TM/Code/CaseList.v @@ -182,7 +182,7 @@ Section CaseList. { unfold Skip_cons. TM_Correct. } { intros tin k (ls&rs&x&l&HTin&Hk). TMSimp. clear HTin. - exists 1, (4 + 4 * size cX x). repeat split. 1-2: omega. + exists 1, (4 + 4 * size cX x). repeat split. 1-2: lia. intros tmid () H. TMSimp. clear H. destruct l as [ | x' l]; cbn. - rewrite MoveToSymbol_steps_moveright; cbn; auto. now rewrite !map_length. @@ -203,24 +203,22 @@ Section CaseList. { unfold M1. TM_Correct. eapply Skip_cons_Realise. eapply Skip_cons_Terminates. } { intros tin k (ls&rs&x&l&HTin&Hk). TMSimp. clear HTin. - exists (6 + 4 * size cX x), (16 + 8 * size cX x). repeat split; try omega. eauto 6. + exists (6 + 4 * size cX x), (16 + 8 * size cX x). repeat split; try lia. eauto 6. intros tmid (). intros (H&HInj); TMSimp. specialize H with (1 := eq_refl). destruct l as [ | x' l']; TMSimp. (* Both cases are identical *) - 1-2: exists 1, (14 + 8 * size cX x); repeat split; try omega. + 1-2: exists 1, (14 + 8 * size cX x); repeat split; try lia. - intros tmid2 (). intros (_&HInj2); TMSimp. - exists 3, (10 + 8 * size cX x). repeat split; try omega. + exists 3, (10 + 8 * size cX x). repeat split; try lia. intros tmid3 (). intros (H3&H3'); TMSimp. - exists (8+8*size cX x), 1. repeat split; cbn; try omega. + exists (8+8*size cX x), 1. repeat split; cbn; try lia. + rewrite CopySymbols_L_steps_moveleft; auto. now rewrite rev_length, !map_length. - + intros tmid4 () _. omega. - intros tmid2 (). intros (_&HInj2); TMSimp. - exists 3, (10 + 8 * size cX x). repeat split; try omega. + exists 3, (10 + 8 * size cX x). repeat split; try lia. intros tmid3 (). intros (H3&H3'); TMSimp. - exists (8+8*size cX x), 1. repeat split; cbn; try omega. + exists (8+8*size cX x), 1. repeat split; cbn; try lia. + rewrite CopySymbols_L_steps_moveleft; auto. now rewrite rev_length, !map_length. - + intros tmid4 () _. omega. } Qed. @@ -254,26 +252,26 @@ Section CaseList. destruct HEncL as (ls&HEncL); TMSimp. destruct l as [ | x l']; cbn. { - exists 1, 3. repeat split; try omega. + exists 1, 3. repeat split; try lia. intros tmid (). intros (H1&HInj1); TMSimp. - exists 1, 1. repeat split; try omega. + exists 1, 1. repeat split; try lia. intros tmid2 ymid2 ((H2&H2')&HInj2). apply Vector.cons_inj in H2' as (H2'&_). TMSimp. - omega. + lia. } { - exists 1, (40 + 16 * size cX x). repeat split; try omega. + exists 1, (40 + 16 * size cX x). repeat split; try lia. intros tmid (). intros (H1&HInj1); TMSimp. - exists 1, (38 + 16 * size cX x). repeat split; try omega. + exists 1, (38 + 16 * size cX x). repeat split; try lia. intros tmid2 ymid2 ((H2&H2')&HInj2). apply Vector.cons_inj in H2' as (H2'&_). TMSimp. - exists (23 + 12 * size cX x), (14 + 4 * size cX x). repeat split; try omega. + exists (23 + 12 * size cX x), (14 + 4 * size cX x). repeat split; try lia. { TMSimp_goal. rewrite List.map_app, <- app_assoc. do 4 eexists; eauto. } intros tmid3 () H3'. rewrite map_app, <- app_assoc in H3'. specialize H3' with (1 := HRight) (2 := eq_refl). TMSimp. - exists (6 + 4 * size cX x), 3. repeat split; try omega. eauto 6. + exists (6 + 4 * size cX x), 3. repeat split; try lia. eauto 6. intros tmid4 () (H4&HInj4); TMSimp. specialize H4 with (1 := eq_refl). destruct l' as [ | x' l'']; TMSimp. (* both cases are equal *) - - exists 1, 1. repeat split; try omega. intros ? _ _. omega. - - exists 1, 1. repeat split; try omega. intros ? _ _. omega. + - exists 1, 1. repeat split; try lia. + - exists 1, 1. repeat split; try lia. } } Qed. @@ -309,7 +307,7 @@ Section CaseList. Proof. unfold IsNil_steps. eapply RealiseIn_monotone. { unfold IsNil. TM_Correct. } - { Unshelve. 4-11: reflexivity. omega. } + { Unshelve. 4-11: reflexivity. lia. } { intros tin (yout, tout) H. cbn. intros xs HEncXs. destruct HEncXs as (ls & HEncXs). TMSimp. @@ -402,16 +400,15 @@ Section CaseList. } { intros tin k (l&y&HEncL&HEncY&Hk). cbn. - exists (10 + 4 * size _ y), (12 + 8 * size _ y). repeat split; try omega. - - cbn. exists (8 + 4 * size _ y), 1. repeat split; try omega. - + eexists. split. eauto. unfold MoveRight_steps. now rewrite Encode_map_hasSize. - + now intros _ _ _. + exists (10 + 4 * size _ y), (12 + 8 * size _ y). repeat split; try lia. + - cbn. exists (8 + 4 * size _ y), 1. repeat split; try lia. + + eexists. split. eauto. unfold MoveRight_steps. now rewrite Encode_map_hasSize. - intros tmid () (H&HInj). TMSimp. specialize (H _ HEncY) as (ls&HEncY'). TMSimp. - exists (8 + 8 * size _ y), 3. repeat split; try omega. + exists (8 + 8 * size _ y), 3. repeat split; try lia. + erewrite CopySymbols_L_steps_moveleft; eauto. now rewrite map_length, rev_length, map_length. + intros tmid2 (). intros (H2&HInj2). TMSimp. - exists 1, 1. repeat split; try omega. intros ? _ _. omega. + exists 1, 1. repeat split; try lia. } Qed. diff --git a/theories/TM/Code/CaseNat.v b/theories/TM/Code/CaseNat.v index ad2a98b..bfbc37d 100644 --- a/theories/TM/Code/CaseNat.v +++ b/theories/TM/Code/CaseNat.v @@ -32,7 +32,7 @@ Section CaseNat. Proof. unfold CaseNat_steps. eapply RealiseIn_monotone. { unfold CaseNat. TM_Correct. } - { Unshelve. 4,8: reflexivity. all: omega. } + { Unshelve. 4,8: reflexivity. all: lia. } { intros tin (yout&tout) H. intros n HEncN. TMSimp. destruct HEncN as (r1&HEncN). TMSimp. @@ -59,7 +59,7 @@ Section CaseNat. Proof. unfold Constr_S_steps. eapply RealiseIn_monotone. { unfold Constr_S. TM_Correct. } - { cbn. omega. } + { cbn. lia. } { intros tin (yout, tout) H. intros n HEncN. TMSimp. clear all except HEncN. diff --git a/theories/TM/Code/CasePair.v b/theories/TM/Code/CasePair.v index aa247ae..1013429 100644 --- a/theories/TM/Code/CasePair.v +++ b/theories/TM/Code/CasePair.v @@ -101,18 +101,18 @@ Section CasePair. { unfold CasePair. TM_Correct. } { intros tin k ((x&y)&HEncP&Hk). unfold CasePair_steps in *. cbn in *. - exists 1, (32 + 16 * size _ x). repeat split; try omega. + exists 1, (32 + 16 * size _ x). repeat split; try lia. intros tmid () ?; TMSimp. - exists (10 + 4 * size _ x), (21 + 12 * size _ x). repeat split; try omega. + exists (10 + 4 * size _ x), (21 + 12 * size _ x). repeat split; try lia. { - exists (8 + 4 * size _ x), 1. repeat split; try omega. 2: now intros _ _ _. + exists (8 + 4 * size _ x), 1. repeat split; try lia. destruct HEncP as (ls&->). cbn. destruct (cY y) eqn:EY. - rewrite app_nil_r. rewrite MoveToSymbol_steps_midtape; cbn; auto. now rewrite !map_length. - rewrite map_app, <- app_assoc. cbn. rewrite MoveToSymbol_steps_midtape; cbn; auto. now rewrite !map_length. } intros tmid1 (). intros ?; TMSimp. - exists (8 + 8 * size _ x), (12 + 4 * size _ x). repeat split; try omega. + exists (8 + 8 * size _ x), (12 + 4 * size _ x). repeat split; try lia. { destruct HEncP as (ls&->). cbn. destruct (cY y) eqn:EY. - rewrite app_nil_r. rewrite MoveToSymbol_correct_midtape; cbn; auto. @@ -124,7 +124,7 @@ Section CasePair. + rewrite List.map_map. now intros ? (?&<-&?) % in_map_iff. } intros tmid2 () HCopy. - exists (8 + 4 * size _ x), 3. repeat split; try omega. + exists (8 + 4 * size _ x), 3. repeat split; try lia. { destruct HEncP as (ls&HEncP); TMSimp. cbn in *. destruct (cY y) eqn:EY. - rewrite app_nil_r in HCopy. rewrite MoveToSymbol_correct_midtape in HCopy; cbn in *; auto. @@ -138,11 +138,9 @@ Section CasePair. * rewrite List.map_map. now intros ? (?&<-&?) % in_rev % in_map_iff. + rewrite List.map_map. now intros ? (?&<-&?) % in_map_iff. } - intros tmid3 _ _. exists 1, 1. split. omega. split. omega. intros _ _ _. omega. + intros tmid3 _ _. exists 1, 1. split. lia. split. lia. intros _ _ _. lia. } Qed. - - (** ** Constructor *) @@ -198,9 +196,9 @@ Section CasePair. } { intros tin k (x & HEncX & Hk). unfold Constr_pair_steps in *. cbn in *. - exists (10 + 4 * size _ x), (8 + 8 * size _ x). repeat split; try omega. + exists (10 + 4 * size _ x), (8 + 8 * size _ x). repeat split; try lia. { - exists (8 + 4 * size _ x), 1. repeat split; try omega. 2: now intros _ _ _. + exists (8 + 4 * size _ x), 1. repeat split; try lia. eexists. repeat split; eauto. unfold MoveRight_steps. now rewrite Encode_map_hasSize. } intros tmid () ?; TMSimp. modpon H. destruct H as (ls&->). cbn. @@ -252,11 +250,11 @@ Section CasePair. { unfold Snd. TM_Correct. } { intros tin k ((x,y)&HEncP&Hk). unfold Snd_steps in *; cbn in *. - exists (8+4*size _ x), 3. repeat split; try omega. + exists (8+4*size _ x), 3. repeat split; try lia. { destruct HEncP as (ls&->). destruct (cY y) eqn:EY; cbn in *. - rewrite MoveToSymbol_steps_midtape; cbn; auto. rewrite EY. cbn. - rewrite map_length, app_length, map_length. cbn. unfold size. omega. + rewrite map_length, app_length, map_length. cbn. unfold size. lia. - rewrite map_app, <- app_assoc, EY. cbn. rewrite MoveToSymbol_steps_midtape; cbn; auto. now rewrite !map_length. } diff --git a/theories/TM/Code/CaseSum.v b/theories/TM/Code/CaseSum.v index 5f4220c..4d0630c 100644 --- a/theories/TM/Code/CaseSum.v +++ b/theories/TM/Code/CaseSum.v @@ -38,7 +38,7 @@ Section CaseSum. Proof. unfold CaseSum_steps. eapply RealiseIn_monotone. { unfold CaseSum. TM_Correct. } - { Unshelve. 4,10,11: constructor. all: cbn. all: omega. } + { Unshelve. 4,10,11: constructor. all: cbn. all: lia. } { intros tin (yout&tout) H. intros s HEncS. destruct HEncS as (ls&HEncS). TMSimp; clear_trivial_eqs. clear HEncS tin. @@ -146,7 +146,7 @@ Section CaseOption. | _, _ => False end). - Local Instance Retract_sigOption_sigSum : + #[refine] Local Instance Retract_sigOption_sigSum : Retract (sigSum sigX Empty_set) (sigOption sigX) := {| Retr_f x := match x : (sigSum sigX (FinType (EqType Empty_set))) with diff --git a/theories/TM/Code/ChangeAlphabet.v b/theories/TM/Code/ChangeAlphabet.v index cd70faa..40d1c20 100644 --- a/theories/TM/Code/ChangeAlphabet.v +++ b/theories/TM/Code/ChangeAlphabet.v @@ -199,7 +199,7 @@ Section MapCode. End MapCode. -Hint Unfold surjectTape surjectTapes injectTape : tape. +#[export] Hint Unfold surjectTape surjectTapes injectTape : tape. (** This makes sure that we can apply the above lemmas ([contains_translate_sig], [contains_translate_tau1], [contains_translate_tau2]), even after [cbn] *) Arguments Retract_plus : simpl never. diff --git a/theories/TM/Code/Code.v b/theories/TM/Code/Code.v index 9d933ad..134f6a2 100644 --- a/theories/TM/Code/Code.v +++ b/theories/TM/Code/Code.v @@ -10,7 +10,7 @@ Class codable (sig: Type) (X: Type) := { }. Arguments encode {sig} {X} {_}. -Hint Extern 4 (codable (FinType(EqType ?sigX)) ?X) => cbn : typeclass_instances. +#[export] Hint Extern 4 (codable (FinType(EqType ?sigX)) ?X) => cbn : typeclass_instances. (** We often use the above coercion to write [cX x] instead of [encode x], because [encode x] can be ambigious, see [Encode_map] *) Coercion encode : codable >-> Funclass. @@ -20,7 +20,7 @@ Arguments size {sig X} (cX x). -Instance Encode_unit : codable Empty_set unit := +#[export] Instance Encode_unit : codable Empty_set unit := {| encode x := nil |}. @@ -30,7 +30,7 @@ Lemma Encode_unit_hasSize t : Proof. cbn. reflexivity. Qed. -Instance Encode_bool : codable bool bool:= +#[export] Instance Encode_bool : codable bool bool:= {| encode x := [x] |}. @@ -39,7 +39,7 @@ Lemma Encode_bool_hasSize b : size Encode_bool b = 1. Proof. cbn. reflexivity. Qed. -Instance Encode_Fin n : codable (Fin.t n) (Fin.t n):= +#[export] Instance Encode_Fin n : codable (Fin.t n) (Fin.t n):= {| encode i := [i] |}. @@ -190,14 +190,14 @@ Section Encode_sum. split with (enum := sigSum_inl :: sigSum_inr :: map sigSum_X enum ++ map sigSum_Y enum). intros [x|y| | ]; cbn; f_equal. - rewrite <- !countSplit. erewrite countMap_injective. - + rewrite enum_ok. rewrite countMap_zero. omega. congruence. + + rewrite enum_ok. rewrite countMap_zero. lia. congruence. + eapply (retract_f_injective) with (I := Retract_sigSum_X sigY (Retract_id _)). - rewrite <- !countSplit. erewrite countMap_injective. - + rewrite enum_ok. rewrite countMap_zero. omega. congruence. + + rewrite enum_ok. rewrite countMap_zero. lia. congruence. + eapply (retract_f_injective) with (I := Retract_sigSum_Y sigX (Retract_id _)). - - rewrite <- !countSplit. rewrite !countMap_zero. omega. all: congruence. - - rewrite <- !countSplit. rewrite !countMap_zero. omega. all: congruence. + - rewrite <- !countSplit. rewrite !countMap_zero. lia. all: congruence. + - rewrite <- !countSplit. rewrite !countMap_zero. lia. all: congruence. Qed. @@ -225,9 +225,14 @@ Section Encode_sum. End Encode_sum. -Arguments sigSum_inl {sigX sigY}. Arguments sigSum_inr {sigX sigY}. Arguments sigSum_X {sigX sigY}. Arguments sigSum_Y {sigX sigY}. -Hint Extern 4 (finTypeC (EqType (sigSum _ _))) => eapply sigSum_fin : typeclass_instances. -Check FinType (EqType (sigSum bool bool)). +Arguments sigSum_inl {sigX sigY}. +Arguments sigSum_inr {sigX sigY}. +Arguments sigSum_X {sigX sigY}. +Arguments sigSum_Y {sigX sigY}. + +#[export] Hint Extern 4 (finTypeC (EqType (sigSum _ _))) => eapply sigSum_fin : typeclass_instances. + +(* Check FinType (EqType (sigSum bool bool)). *) @@ -255,11 +260,11 @@ Section Encode_pair. split with (enum := map sigPair_X enum ++ map sigPair_Y enum). intros [x|y]; cbn; f_equal. - rewrite <- !countSplit. erewrite countMap_injective. - + rewrite enum_ok. rewrite countMap_zero. omega. congruence. + + rewrite enum_ok. rewrite countMap_zero. lia. congruence. + eapply (retract_f_injective) with (I := Retract_sigPair_X sigY (Retract_id _)). - rewrite <- !countSplit. erewrite countMap_injective. - + rewrite enum_ok. rewrite countMap_zero. omega. congruence. + + rewrite enum_ok. rewrite countMap_zero. lia. congruence. + eapply (retract_f_injective) with (I := Retract_sigPair_Y sigX (Retract_id _)). Qed. @@ -279,13 +284,13 @@ End Encode_pair. Arguments sigPair_X {sigX sigY}. Arguments sigPair_Y {sigX sigY}. -Hint Extern 4 (finTypeC (EqType (sigPair _ _))) => eapply sigPair_fin : typeclass_instances. -Check FinType (EqType (sigPair bool bool)). +#[export] Hint Extern 4 (finTypeC (EqType (sigPair _ _))) => eapply sigPair_fin : typeclass_instances. +(* Check FinType (EqType (sigPair bool bool)). *) Compute Encode_pair Encode_bool (Encode_sum Encode_unit Encode_bool) (true, inl tt). -Check _ : codable (sigPair bool (sigSum Empty_set bool)) unit. +(* Check _ : codable (sigPair bool (sigSum Empty_set bool)) unit. *) @@ -312,8 +317,8 @@ Section Encode_option. intros [x| | ]; cbn; f_equal. - rewrite countMap_injective. 2: apply retract_f_injective with (I := Retract_sigOption_X (Retract_id _)). now apply enum_ok. - - rewrite countMap_zero. omega. congruence. - - rewrite countMap_zero. omega. congruence. + - rewrite countMap_zero. lia. congruence. + - rewrite countMap_zero. lia. congruence. Qed. @@ -341,8 +346,8 @@ End Encode_option. Arguments sigOption_Some {sigX}. Arguments sigOption_None {sigX}. Arguments sigOption_X {sigX}. -Hint Extern 4 (finTypeC (EqType (sigOption _))) => eapply sigOption_fin : typeclass_instances. -Check FinType (EqType (sigOption bool)). +#[export] Hint Extern 4 (finTypeC (EqType (sigOption _))) => eapply sigOption_fin : typeclass_instances. +(* Check FinType (EqType (sigOption bool)). *) Compute Encode_option Encode_bool None. @@ -372,8 +377,8 @@ Section Encode_list. intros [x| | ]; cbn; f_equal. - rewrite countMap_injective. 2: apply retract_f_injective with (I := Retract_sigList_X (Retract_id _)). now apply enum_ok. - - rewrite countMap_zero. omega. congruence. - - rewrite countMap_zero. omega. congruence. + - rewrite countMap_zero. lia. congruence. + - rewrite countMap_zero. lia. congruence. Qed. @@ -434,8 +439,8 @@ End Encode_list. Arguments sigList_nil {sigX}. Arguments sigList_cons {sigX}. Arguments sigList_X {sigX}. -Hint Extern 4 (finTypeC (EqType (sigList _))) => eapply sigList_fin : typeclass_instances. -Check FinType(EqType (sigList bool)). +#[export] Hint Extern 4 (finTypeC (EqType (sigList _))) => eapply sigList_fin : typeclass_instances. +(* Check FinType(EqType (sigList bool)). *) Compute Encode_list Encode_bool (nil). @@ -463,15 +468,15 @@ Section Encode_nat. Lemma Encode_nat_hasSize n : size _ n = S n. - Proof. cbn. rewrite app_length, repeat_length. cbn. omega. Qed. + Proof. cbn. rewrite app_length, repeat_length. cbn. lia. Qed. Corollary Encode_nat_eq_nil n : Encode_nat n <> nil. - Proof. intros H % length_zero_iff_nil. fold (size _ n) in H. rewrite Encode_nat_hasSize in H. omega. Qed. + Proof. intros H % length_zero_iff_nil. fold (size _ n) in H. rewrite Encode_nat_hasSize in H. lia. Qed. End Encode_nat. -Check FinType(EqType sigNat). +(* Check FinType(EqType sigNat). *) diff --git a/theories/TM/Code/CodeTM.v b/theories/TM/Code/CodeTM.v index d2b9c10..2ef7391 100644 --- a/theories/TM/Code/CodeTM.v +++ b/theories/TM/Code/CodeTM.v @@ -26,7 +26,7 @@ Section IsRight. Lemma isRight_size_monotone (sig : Type) (t : tape sig) (s1 s2 : nat) : isRight_size t s1 -> s1 <= s2 -> isRight_size t s2. - Proof. intros (x&rs&->&Hr) Hs. exists x, rs. split. eauto. omega. Qed. + Proof. intros (x&rs&->&Hr) Hs. exists x, rs. split. eauto. lia. Qed. Lemma mapTape_isRight (sig tau : Type) (t : tape sig) (f : sig -> tau) : isRight (mapTape f t) <-> isRight t. @@ -63,11 +63,11 @@ Inductive boundary : Type := | UNKNOWN : boundary. (** Declare discreteness of [boundary] *) -Instance boundary_eq : eq_dec boundary. +#[export] Instance boundary_eq : eq_dec boundary. Proof. unfold dec. decide equality. Defined. (** Declare finiteness of [boundary] *) -Instance boundary_fin : finTypeC (EqType boundary). +#[export] Instance boundary_fin : finTypeC (EqType boundary). Proof. split with (enum := [START; STOP; UNKNOWN]). cbn. intros []; cbn; reflexivity. Defined. diff --git a/theories/TM/Code/Copy.v b/theories/TM/Code/Copy.v index 61184d2..cee50d5 100644 --- a/theories/TM/Code/Copy.v +++ b/theories/TM/Code/Copy.v @@ -230,11 +230,11 @@ Section Copy. MoveToSymbol_steps stop f t <= 4 + 4 * length r1. Proof. revert t sym r2. induction r1; intros t sym r2 HEnc HStop; cbn -[plus mult] in *. - - destruct t; cbn in HEnc; inv HEnc. rewrite MoveToSymbol_steps_equation. cbn. rewrite HStop. cbn. omega. + - destruct t; cbn in HEnc; inv HEnc. rewrite MoveToSymbol_steps_equation. cbn. rewrite HStop. cbn. lia. - destruct t; cbn in HEnc; try congruence. inv HEnc. rewrite MoveToSymbol_steps_equation. cbn. destruct (stop a). - + omega. - + apply Nat.add_le_mono_l. replace (4 * S (|r1|)) with (4 + 4 * |r1|) by omega. + + lia. + + apply Nat.add_le_mono_l. replace (4 * S (|r1|)) with (4 + 4 * |r1|) by lia. eapply IHr1; eauto. cbn. now simpl_tape. Qed. @@ -244,7 +244,7 @@ Section Copy. Proof. intros. rewrite MoveToSymbol_steps_local with (r1 := m::rs) (sym := x) (r2 := rs'); auto. - cbn [length]. omega. + cbn [length]. lia. Qed. Corollary MoveToSymbol_steps_moveright ls m rs x rs' : @@ -252,8 +252,8 @@ Section Copy. MoveToSymbol_steps stop f (tape_move_right' ls m (rs ++ x :: rs')) <= 4 + 4 * length rs. Proof. intros HStop. destruct rs as [ | s s'] eqn:E; cbn. - - rewrite MoveToSymbol_steps_equation. cbn. rewrite HStop; cbn. omega. - - rewrite MoveToSymbol_steps_midtape; auto. omega. + - rewrite MoveToSymbol_steps_equation. cbn. rewrite HStop; cbn. lia. + - rewrite MoveToSymbol_steps_midtape; auto. lia. Qed. @@ -263,11 +263,11 @@ Section Copy. MoveToSymbol_L_steps stop f t <= 4 + 4 * length r1. Proof. revert t sym r2. induction r1; intros t sym r2 HEnc HStop; cbn -[plus mult] in *. - - destruct t; cbn in HEnc; inv HEnc. rewrite MoveToSymbol_L_steps_equation. cbn. rewrite HStop. cbn. omega. + - destruct t; cbn in HEnc; inv HEnc. rewrite MoveToSymbol_L_steps_equation. cbn. rewrite HStop. cbn. lia. - destruct t; cbn in HEnc; try congruence. inv HEnc. rewrite MoveToSymbol_L_steps_equation. cbn. destruct (stop a). - + omega. - + apply Nat.add_le_mono_l. replace (4 * S (|r1|)) with (4 + 4 * |r1|) by omega. + + lia. + + apply Nat.add_le_mono_l. replace (4 * S (|r1|)) with (4 + 4 * |r1|) by lia. eapply IHr1; eauto. cbn. now simpl_tape. Qed. @@ -277,7 +277,7 @@ Section Copy. Proof. intros. rewrite MoveToSymbol_L_steps_local with (r1 := m::ls) (sym := x) (r2 := ls'); auto. - cbn [length]. omega. + cbn [length]. lia. Qed. Corollary MoveToSymbol_L_steps_moveleft ls ls' x m rs : @@ -285,8 +285,8 @@ Section Copy. MoveToSymbol_L_steps stop f (tape_move_left' (ls ++ x :: ls') m rs) <= 4 + 4 * length ls. Proof. intros HStop. destruct ls as [ | s s'] eqn:E; cbn. - - rewrite MoveToSymbol_L_steps_equation. cbn. rewrite HStop; cbn. omega. - - rewrite MoveToSymbol_L_steps_midtape; auto. omega. + - rewrite MoveToSymbol_L_steps_equation. cbn. rewrite HStop; cbn. lia. + - rewrite MoveToSymbol_L_steps_midtape; auto. lia. Qed. @@ -296,11 +296,11 @@ Section Copy. CopySymbols_steps stop t <= 8 + 8 * length r1. Proof. revert t sym r2. induction r1; intros t sym r2 HEnc HStop; cbn -[plus mult] in *. - - destruct t; cbn in HEnc; inv HEnc. rewrite CopySymbols_steps_equation. cbn. rewrite HStop. cbn. omega. + - destruct t; cbn in HEnc; inv HEnc. rewrite CopySymbols_steps_equation. cbn. rewrite HStop. cbn. lia. - destruct t; cbn in HEnc; try congruence. inv HEnc. rewrite CopySymbols_steps_equation. cbn. destruct (stop a). - + omega. - + apply Nat.add_le_mono_l. replace (8 * S (|r1|)) with (8 + 8 * |r1|) by omega. + + lia. + + apply Nat.add_le_mono_l. replace (8 * S (|r1|)) with (8 + 8 * |r1|) by lia. eapply IHr1; eauto. cbn. now simpl_tape. Qed. @@ -308,7 +308,7 @@ Section Copy. stop x = true -> CopySymbols_steps stop (midtape ls m (rs ++ x :: rs')) <= 16 + 8 * length rs. Proof. - intros. erewrite CopySymbols_steps_local with (r1 := m :: rs); cbn -[plus mult]; eauto. omega. + intros. erewrite CopySymbols_steps_local with (r1 := m :: rs); cbn -[plus mult]; eauto. lia. Qed. Corollary CopySymbols_steps_moveright ls m rs x rs' : @@ -316,8 +316,8 @@ Section Copy. CopySymbols_steps stop (tape_move_right' ls m (rs ++ x :: rs')) <= 8 + 8 * length rs. Proof. intros HStop. destruct rs as [ | s s'] eqn:E; cbn. - - rewrite CopySymbols_steps_equation. cbn. rewrite HStop; cbn. omega. - - rewrite CopySymbols_steps_midtape; auto. omega. + - rewrite CopySymbols_steps_equation. cbn. rewrite HStop; cbn. lia. + - rewrite CopySymbols_steps_midtape; auto. lia. Qed. Lemma CopySymbols_L_steps_local t r1 sym r2 : @@ -326,11 +326,11 @@ Section Copy. CopySymbols_L_steps stop t <= 8 + 8 * length r1. Proof. revert t sym r2. induction r1; intros t sym r2 HEnc HStop; cbn -[plus mult] in *. - - destruct t; cbn in HEnc; inv HEnc. rewrite CopySymbols_L_steps_equation. cbn. rewrite HStop. cbn. omega. + - destruct t; cbn in HEnc; inv HEnc. rewrite CopySymbols_L_steps_equation. cbn. rewrite HStop. cbn. lia. - destruct t; cbn in HEnc; try congruence. inv HEnc. rewrite CopySymbols_L_steps_equation. cbn. destruct (stop a). - + omega. - + apply Nat.add_le_mono_l. replace (8 * S (|r1|)) with (8 + 8 * |r1|) by omega. + + lia. + + apply Nat.add_le_mono_l. replace (8 * S (|r1|)) with (8 + 8 * |r1|) by lia. eapply IHr1; eauto. cbn. now simpl_tape. Qed. @@ -338,7 +338,7 @@ Section Copy. stop x = true -> CopySymbols_L_steps stop (midtape (ls ++ x :: ls') m rs) <= 16 + 8 * length ls. Proof. - intros. erewrite CopySymbols_L_steps_local with (r1 := m :: ls); cbn -[plus mult]; eauto. omega. + intros. erewrite CopySymbols_L_steps_local with (r1 := m :: ls); cbn -[plus mult]; eauto. lia. Qed. Corollary CopySymbols_L_steps_moveleft ls ls' x m rs : @@ -346,8 +346,8 @@ Section Copy. CopySymbols_L_steps stop (tape_move_left' (ls ++ x :: ls') m rs) <= 8 + 8 * length ls. Proof. intros HStop. destruct ls as [ | s s'] eqn:E; cbn. - - rewrite CopySymbols_L_steps_equation. cbn. rewrite HStop; cbn. omega. - - rewrite CopySymbols_L_steps_midtape; auto. omega. + - rewrite CopySymbols_L_steps_equation. cbn. rewrite HStop; cbn. lia. + - rewrite CopySymbols_L_steps_midtape; auto. lia. Qed. @@ -576,7 +576,7 @@ Section CopyValue. { intros tin k (x&HEncX&Hk). exists (8 + 4 * length (encode x : list sig)), (16 + 8 * length (encode x : list sig)). repeat split; cbn; eauto. - - unfold size in *. omega. + - unfold size in *. lia. - intros tmid () (H1&HInj). TMSimp. apply H1 in HEncX as (r1&->). rewrite CopySymbols_L_steps_midtape; eauto. @@ -653,11 +653,11 @@ Section MoveValue. { intros tin k (x&y&HEncX&HEncY&Hk). exists (8 + 4 * length (cY y)), (34 + 16 * length (cX x)). repeat split; cbn; eauto. - - unfold size in *. omega. + - unfold size in *. lia. - intros tmid1 () (H1&HInj1). TMSimp. specialize H1 with (1 := HEncY). exists (25 + 12 * length (cX x)), (8 + 4 * length (cX x)). repeat split; cbn; eauto. - + omega. + + lia. + intros tmid2 () H2. specialize H2 with (1 := HEncX) (2 := H1) as (H2&H2'). exists x. split; eauto. @@ -773,7 +773,7 @@ Section Translate. } { intros tin k (x&HEncX&Hk). unfold Translate_steps in *. - exists (8 + 4 * size cX x), (8 + 4 * size cX x). repeat split; try omega. + exists (8 + 4 * size cX x), (8 + 4 * size cX x). repeat split; try lia. eexists. repeat split; eauto. intros tmid () H. cbn in H. specialize H with (1 := HEncX). exists x. split. eauto. unfold MoveLeft_steps. now rewrite Encode_map_hasSize. diff --git a/theories/TM/Code/ListTM.v b/theories/TM/Code/ListTM.v index ed6e99e..f0710e4 100644 --- a/theories/TM/Code/ListTM.v +++ b/theories/TM/Code/ListTM.v @@ -316,7 +316,7 @@ Section Nth'. intros tin k. intros (l&n&HEncL&HEncN&HRight2&Hk). unfold Nth'_Step_steps in Hk. destruct n as [ | n'] eqn:E1, l as [ | x l'] eqn:E2; cbn. - (* [n = 0] and [l = nil] *) - exists (CaseNat_steps), (CaseList_steps_nil). repeat split; auto; try omega. + exists (CaseNat_steps), (CaseList_steps_nil). repeat split; auto; try lia. intros tmid b (HCaseNat&HCaseNatInj); TMSimp. modpon HCaseNat. destruct b; auto; simpl_surject. { eexists; repeat split; simpl_surject; eauto. } - (* [n = 0] and [l = x :: l'] *) @@ -324,15 +324,15 @@ Section Nth'. intros tmid b (H&HInj1); TMSimp. modpon H. destruct b; cbn in *; auto; simpl_surject. { eexists; repeat split; simpl_surject; eauto. } - (* [n = S n'] and [l = nil] *) - exists (CaseNat_steps), (S (CaseList_steps_nil)). repeat split; try omega. + exists (CaseNat_steps), (S (CaseList_steps_nil)). repeat split; try lia. intros tmid b (HCaseNat&HCaseNatInj); TMSimp. modpon HCaseNat. destruct b; auto. simpl_surject. - exists (CaseList_steps_nil), 0. repeat split; try omega. + exists (CaseList_steps_nil), 0. repeat split; try lia. { eexists; repeat split; simpl_surject; eauto. } intros tmid0 b (HCaseList&HCaseListInj); TMSimp. modpon HCaseList. destruct b; auto. - (* [n = S n'] and [l = x :: l'] *) exists CaseNat_steps, (S (CaseList_steps_cons _ x + Reset_steps _ x)). repeat split; cbn; auto. intros tmid b (H&HInj1); TMSimp. modpon H. destruct b; cbn in *; auto; simpl_surject. - exists (CaseList_steps_cons _ x), (Reset_steps _ x). repeat split; cbn; try omega. + exists (CaseList_steps_cons _ x), (Reset_steps _ x). repeat split; cbn; try lia. { exists (x :: l'). repeat split; simpl_surject; auto. } intros tmid2 b (H2&HInj2); TMSimp. modpon H2. destruct b; cbn in *; auto; simpl_surject; modpon H2. exists x. repeat split; eauto. contains_ext. unfold Reset_steps. now rewrite Encode_map_hasSize. @@ -427,7 +427,7 @@ Section Nth'. exists (Nth'_Step_steps (x::l') (S n')). repeat split. { hnf. exists (x :: l'), (S n'). auto. } intros b tmid H1. modpon H1. destruct b; auto; modpon H1. now destruct b. - exists (Nth'_Loop_steps l' n'). repeat split; auto; try omega. + exists (Nth'_Loop_steps l' n'). repeat split; auto; try lia. hnf. exists l', n'. auto. } Qed. @@ -523,17 +523,17 @@ Section Nth'. { intros tin k (l&n&HEncL&HEncN&HRigh2&HRight3&Hk). unfold Nth'_steps in *. exists (CopyValue_steps _ l), (1 + Nth'_Loop_steps l n + 1 + Reset_steps _ (skipn (S n) l) + Reset_steps _ (n - S (length l))). - repeat split; cbn; try omega. + repeat split; cbn; try lia. exists l. repeat split; eauto. unfold CopyValue_steps. now rewrite Encode_map_hasSize. intros tmid () (HCopy&HInjCopy); TMSimp. modpon HCopy. exists (Nth'_Loop_steps l n), (1 + Reset_steps _ (skipn (S n) l) + Reset_steps _ (n - S (length l))). - repeat split; cbn; try omega. 2: now rewrite !Nat.add_assoc. + repeat split; cbn; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn. eauto 6. } intros tmid2 b (HLoop&HInjLoop); TMSimp. modpon HLoop. destruct b. { destruct HLoop as (x&HLoop); modpon HLoop. exists (Reset_steps _ (skipn (S n) l)), (Reset_steps _ (n - S (length l))). - repeat split; cbn; try omega. 2: reflexivity. + repeat split; cbn; try lia. 2: reflexivity. do 1 eexists. repeat split; eauto. unfold Reset_steps. now rewrite Encode_map_hasSize. intros tmid3 () (HReset&HInjReset); TMSimp. modpon HReset. do 1 eexists. repeat split; eauto. unfold Reset_steps. now rewrite Encode_map_hasSize. @@ -541,7 +541,7 @@ Section Nth'. { modpon HLoop. exists (Reset_steps _ (skipn (S n) l)), (Reset_steps _ (n - S (length l))). - repeat split; cbn; try omega. 2: reflexivity. + repeat split; cbn; try lia. 2: reflexivity. do 1 eexists. repeat split; eauto. unfold Reset_steps. now rewrite Encode_map_hasSize. intros tmid3 () (HReset&HInjReset); TMSimp. modpon HReset. eexists; repeat split; eauto. now setoid_rewrite Reset_steps_comp. @@ -599,7 +599,7 @@ Section ListStuff. Proof. destruct (app_or_nil xs) as [ -> | (x&xs'&->)]. - cbn. reflexivity. - - rewrite removelast_app_singleton. rewrite app_length. cbn. omega. + - rewrite removelast_app_singleton. rewrite app_length. cbn. lia. Qed. End ListStuff. @@ -691,23 +691,23 @@ Section Append. } { intros tin k (xs&ys&HEncXS&HEncYs&Hk). unfold App'_steps in *. - exists (12+4*size _ xs), (16+8*size _ xs). repeat split; cbn; try omega. - exists (8+4*size _ xs), 3. repeat split; cbn; try omega. eauto. + exists (12+4*size _ xs), (16+8*size _ xs). repeat split; cbn; try lia. + exists (8+4*size _ xs), 3. repeat split; cbn; try lia. eauto. intros tmid1 () H. modpon H. - exists 1, 1. repeat split; try omega. eauto. + exists 1, 1. repeat split; try lia. eauto. intros tmid (). intros H; TMSimp; clear_trivial_eqs. modpon H. destruct H as (ls&HEncXs); TMSimp. cbv [Encode_list]; cbn in *. destruct (app_or_nil xs) as [-> | (xs'&x&->)]; cbn in *. { (* [xs = nil] *) - rewrite CopySymbols_L_steps_equation. cbn. omega. + rewrite CopySymbols_L_steps_equation. cbn. lia. } { (* [xs = xs' ++ [x]] *) rewrite encode_list_app. rewrite rev_app_distr. cbn. rewrite <- app_assoc, rev_app_distr, <- app_assoc. cbn. rewrite CopySymbols_L_steps_moveleft; cbn; auto. rewrite map_length, !app_length, rev_length. cbn. rewrite map_length, rev_length, !app_length, !map_length. cbn. - rewrite removelast_length. omega. + rewrite removelast_length. lia. } } Qed. @@ -754,7 +754,7 @@ Section Append. { intros tin k (xs&ys&HEncXs&HEnYs&HRigh2&Hk). exists (25 + 12 * size _ ys), (App'_steps xs). repeat split; cbn; eauto. - unfold App'_steps, App_steps in *. omega. + unfold App'_steps, App_steps in *. lia. intros tmid () (HApp'&HInjApp'); TMSimp. modpon HApp'. hnf. cbn. do 2 eexists. repeat split; eauto. } @@ -841,15 +841,14 @@ Section Lenght. { intros tin k (xs&n&HEncXs&HEncN&HRight2&Hk). unfold Length_Step_steps in Hk. destruct xs as [ | x xs']. - - exists CaseList_steps_nil, 0. repeat split; cbn in *; try omega. + - exists CaseList_steps_nil, 0. repeat split; cbn in *; try lia. eexists; repeat split; simpl_surject; eauto; cbn; eauto. intros tmid b (HCaseList&HInjCaseList); TMSimp. modpon HCaseList. destruct b; cbn in *; auto. - - exists (CaseList_steps_cons _ x), (1 + Reset_steps _ x + Constr_S_steps). repeat split; cbn in *; try omega. + - exists (CaseList_steps_cons _ x), (1 + Reset_steps _ x + Constr_S_steps). repeat split; cbn in *; try lia. eexists; repeat split; simpl_surject; eauto; cbn; eauto. intros tmid b (HCaseList&HInjCaseList); TMSimp. modpon HCaseList. destruct b; cbn in *; auto; modpon HCaseList. - exists (Reset_steps _ x), Constr_S_steps. repeat split; cbn; try omega. + exists (Reset_steps _ x), Constr_S_steps. repeat split; cbn; try lia. eexists; repeat split; simpl_surject; eauto; cbn; eauto. unfold Reset_steps. now rewrite !Encode_map_hasSize. - now intros _ _ _. } Qed. @@ -912,7 +911,7 @@ Section Lenght. apply WhileCoInduction. intros tin k (xs&n&HEncXs&HEncN&HRight2&Hk). exists (Length_Step_steps xs). repeat split. - hnf. do 2 eexists. repeat split; eauto. - intros b tmid HStep. hnf in HStep. modpon HStep. destruct b as [ () | ], xs as [ | x xs']; cbn in *; auto; modpon HStep. - eexists (Length_Loop_steps xs'). repeat split; try omega. hnf. exists xs', (S n). repeat split; eauto. + eexists (Length_Loop_steps xs'). repeat split; try lia. hnf. exists xs', (S n). repeat split; eauto. } Qed. @@ -957,12 +956,12 @@ Section Lenght. } { intros tin k (xs&HEncXs&HRight1&HRight2&HRigth3&Hk). unfold Length_steps in *. - exists (25 + 12 * size _ xs), (10 + Length_Loop_steps xs). repeat split; cbn; try omega. + exists (25 + 12 * size _ xs), (10 + Length_Loop_steps xs). repeat split; cbn; try lia. eexists. repeat split; eauto. unfold CopyValue_steps. now rewrite Encode_map_hasSize. intros tmid () (HO&HOInj); TMSimp. modpon HO. - exists 5, (4 + Length_Loop_steps xs). unfold Constr_O_steps. repeat split; cbn; try omega. + exists 5, (4 + Length_Loop_steps xs). unfold Constr_O_steps. repeat split; cbn; try lia. intros tmid0 () (HLoop&HLoopInj); TMSimp. modpon HLoop. - exists (Length_Loop_steps xs), 3. repeat split; cbn; try omega. + exists (Length_Loop_steps xs), 3. repeat split; cbn; try lia. hnf. cbn. do 2 eexists. repeat split; eauto. now intros _ _ _. } diff --git a/theories/TM/Code/NatTM.v b/theories/TM/Code/NatTM.v index 9527784..ea299c7 100644 --- a/theories/TM/Code/NatTM.v +++ b/theories/TM/Code/NatTM.v @@ -17,15 +17,15 @@ Proof. induction n; cbn; auto. Qed. Lemma max_plus_minus_le (m n : nat) : n + (m - n) <= max m n. Proof. - assert (m <= n \/ n <= m) as [H|H] by omega. - - rewrite <- Nat.le_max_r. omega. - - rewrite <- Nat.le_max_l. omega. + assert (m <= n \/ n <= m) as [H|H] by lia. + - rewrite <- Nat.le_max_r. lia. + - rewrite <- Nat.le_max_l. lia. Qed. Lemma max_max_le (m n : nat) : max (max m n) n = max m n. Proof. - assert (m <= n \/ n <= m) as [H|H] by omega. + assert (m <= n \/ n <= m) as [H|H] by lia. - erewrite Nat.max_r. + symmetry. now eapply max_r. + eapply Nat.eq_le_incl. now eapply max_r. @@ -233,28 +233,28 @@ Proof. destruct b. (* (* In case I want to use the [WhileInduction] principle without [match] *) - exists 11. repeat split. - + omega. - + intros () ? _. omega. + + lia. + + intros () ? _. lia. + intros tmid H. cbn in *. specialize (H _ _ HEncA HEncB). cbn in *. auto. - exists 11. repeat split. - + omega. + + lia. + intros () tmid H. cbn in H. specialize (H _ _ HEncA HEncB). now cbn in *. + intros tmid H. cbn in H. specialize (H _ _ HEncA HEncB). cbn in *. destruct H as (H1&H2). exists (11 + b * 12). repeat split. - * exists (S a), b. repeat split; eauto. omega. - * omega. + * exists (S a), b. repeat split; eauto. lia. + * lia. *) - exists 9. repeat split. - + omega. + + lia. + intros o tmid H. cbn in H. specialize (H _ _ HEncA HEncB). cbn in *. destruct o; auto. - exists 9. repeat split. - + omega. + + lia. + intros o tmid H. cbn in H. specialize (H _ _ HEncA HEncB). cbn -[plus mult] in *. destruct o as [ () | ]; auto. destruct H. exists (9 + b * 10). repeat split. - * do 2 eexists. repeat split; eauto. omega. - * omega. + * do 2 eexists. repeat split; eauto. lia. + * lia. } Qed. @@ -279,14 +279,14 @@ Proof. { intros tin k (m&n&HEncM&HEncN&HOut&HInt&Hk). exists (37 + 12 * n), (47 + 22 * m). repeat split; cbn. - - cbn. exists n. split; eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize. omega. - - omega. + - cbn. exists n. split; eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize. lia. + - lia. - intros tmid ymid. intros (H1&H2). TMSimp. specialize (H1 _ HEncN HOut). TMSimp. specialize (HInt Fin0). exists (37 + 12 * m), (Add_Loop_steps m). repeat split. - + exists m. split. eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize. omega. - + unfold Add_Loop_steps. omega. + + exists m. split. eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize. lia. + + unfold Add_Loop_steps. lia. + intros tmid2 () (HComp & HInj). TMSimp. specialize (HComp _ HEncM HInt) as (HComp&HComp'). do 2 eexists; repeat split; eauto; do 2 eexists; eassumption. @@ -311,7 +311,7 @@ Proof. intros tin k (m&n&HEncM&HEncN&HOut&HInt&Hk). exists (Add_Main_steps m n), 12. repeat split. - cbn. exists m, n. repeat split; eauto. - - unfold Add_Main_steps. omega. + - unfold Add_Main_steps. lia. - intros tmid () HComp. cbn in *. specialize (HInt Fin0). specialize (HComp _ _ HEncM HEncN HOut HInt) as (HComp1&HComp2&HComp3&HComp4). @@ -481,8 +481,8 @@ Proof. - specialize (HStar _ _ _ HEncM' HEncN HEncC HInt3 HInt4). destruct m' as [ | m']; auto. destruct HStar as (HStar1&HStar2&HStar3&HStar4&HStar5). specialize (HLastStep _ _ _ ltac:(eauto) ltac:(eauto) ltac:(eauto) ltac:(eauto) ltac:(eauto)) as (HL1&HL2&HL3&HL4&HL). - rewrite Nat.add_assoc in HL3. replace (n + m' * n + c) with (m' * n + n + c) by omega. - repeat split; auto. apply tape_contains_ext with (1 := HL3). f_equal. rewrite Nat.mul_succ_l. omega. + rewrite Nat.add_assoc in HL3. replace (n + m' * n + c) with (m' * n + n + c) by lia. + repeat split; auto. apply tape_contains_ext with (1 := HL3). f_equal. rewrite Nat.mul_succ_l. lia. } Qed. @@ -613,19 +613,19 @@ Proof. specialize (HComp _ HEncM'). cbn in *. destruct y; auto. exists (Add_steps n c), (63 + 21 * c + 17 * n); cbn in *; repeat split. do 2 eexists. repeat split; eauto. intros i; destruct_fin i; cbn. eauto. - unfold Add_steps. omega. + unfold Add_steps. lia. intros tmid0 () (HComp2&HInj). TMSimp. specialize HComp2 with (1 := HEncN) (2 := HEncC) (3 := HInt3). spec_assert HComp2 as (HComp2&HComp3&HComp4&HComp5) by (intros i; destruct_fin i; cbn; auto). specialize (HComp5 Fin0). cbn in *. TMSimp. - exists (12 + 4 * c), (50 + 17 * (c + n)). repeat split; try omega. - eexists. repeat split. eauto. unfold Reset_steps. rewrite Encode_nat_hasSize. omega. + exists (12 + 4 * c), (50 + 17 * (c + n)). repeat split; try lia. + eexists. repeat split. eauto. unfold Reset_steps. rewrite Encode_nat_hasSize. lia. intros tmid1 () (HComp6&HInj). TMSimp. specialize HComp6 with (1 := HComp3). - exists (37 + 12 * (c + n)), (12 + 4 * (c + n)). repeat split; try omega. - eexists. repeat split. eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize. omega. + exists (37 + 12 * (c + n)), (12 + 4 * (c + n)). repeat split; try lia. + eexists. repeat split. eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize. lia. intros tmid2 () (HComp7&HInj7); TMSimp. specialize HComp7 with (1 := HComp4) (2 := HComp6) as (HComp7&HComp8). - eexists. repeat split. eauto. unfold Reset_steps. rewrite Encode_nat_hasSize. omega. + eexists. repeat split. eauto. unfold Reset_steps. rewrite Encode_nat_hasSize. lia. } Qed. @@ -656,21 +656,21 @@ Proof. destruct m' as [ | m''] eqn:E; cbn in *; exists (Mult_Step_steps m' n c). { repeat split. - - do 3 eexists. repeat split; eauto. cbn. unfold Mult_Step_steps. destruct m'; omega. + - do 3 eexists. repeat split; eauto. cbn. unfold Mult_Step_steps. destruct m'; lia. - intros o tmid H1. specialize H1 with (1 := HEncM') (2 := HEncN) (3 := HEncC) (4 := HRight3) (5 := HRight4). destruct o as [ () | ]; auto. destruct H1 as (HComp1&HComp2&HComp3&HComp4&HComp5). - subst. cbn. omega. + subst. cbn. lia. } { repeat split. - - do 3 eexists. repeat split; eauto. cbn. unfold Mult_Step_steps. destruct m'; omega. + - do 3 eexists. repeat split; eauto. cbn. unfold Mult_Step_steps. destruct m'; lia. - intros o tmid H1. specialize H1 with (1 := HEncM') (2 := HEncN) (3 := HEncC) (4 := HRight3) (5 := HRight4). destruct o as [ () | ]; auto. destruct H1 as (HComp1&HComp2&HComp3&HComp4&HComp5). cbn. eexists. repeat split. + do 3 eexists. repeat split; eauto. - + cbn. rewrite <- Hk. subst. clear_all. unfold Mult_Step_steps. omega. + + cbn. rewrite <- Hk. subst. clear_all. unfold Mult_Step_steps. lia. } } Qed. @@ -693,11 +693,11 @@ Proof. } { intros tin k (m&n&HEncM&HEncN&HOut&HInt&Hk). cbn in *. unfold Mult_Main_steps in Hk. - exists (37 + 12 * m), (6 + Mult_Loop_steps m n 0). repeat split; try omega. - eexists. repeat split; eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize; cbn. omega. + exists (37 + 12 * m), (6 + Mult_Loop_steps m n 0). repeat split; try lia. + eexists. repeat split; eauto. unfold CopyValue_steps. rewrite Encode_nat_hasSize; cbn. lia. intros tmid () (H1&H2); TMSimp. specialize H1 with (1 := HEncM) (2 := HInt _) as (H1&H1'). - exists 5, (Mult_Loop_steps m n 0). repeat split; try omega. - unfold Constr_O_steps. omega. + exists 5, (Mult_Loop_steps m n 0). repeat split; try lia. + unfold Constr_O_steps. lia. intros tmid2 () (H2&HInj2); TMSimp. specialize H2 with (1 := HOut). do 3 eexists. repeat split; eauto. } @@ -716,7 +716,7 @@ Proof. } { intros tin k (m&n&HEncM&HEncN&HOut&HInt&Hk). cbn in *. unfold Mult_steps in Hk. - exists (Mult_Main_steps m n), 12. repeat split; try omega. + exists (Mult_Main_steps m n), 12. repeat split; try lia. do 2 eexists; repeat split; eauto. intros tmid () H1; TMSimp. specialize H1 with (1 := HEncM) (2 := HEncN) (3 := HOut) (4 := HInt _) (5 := HInt _) (6 := HInt _) as (H1&H2&H3&H4&H5&H6). diff --git a/theories/TM/Code/SumTM.v b/theories/TM/Code/SumTM.v index 0b02e39..2d0f135 100644 --- a/theories/TM/Code/SumTM.v +++ b/theories/TM/Code/SumTM.v @@ -158,14 +158,14 @@ Section MapSum. destruct s as [x|y]; cbn in *. { (* s = inl x *) exists (CaseSum_steps), (3 + Translate_steps _ x + M1_steps x + Translate_steps _ x + Constr_inl_steps). - repeat split; try omega. + repeat split; try lia. intros tmid b (HCaseSum&HCaseSumInj). specialize (HCaseSum (inl x)). modpon HCaseSum. destruct b; auto. simpl_surject. exists (Translate_steps _ x), (2 + M1_steps x + Translate_steps _ x + Constr_inl_steps). - repeat split; try omega. + repeat split; try lia. { hnf. cbn. exists x. split; auto. contains_ext. } intros tmid2 () (HTranslate1&HTranslateInj1). modpon HTranslate1. exists (M1_steps x), (1 + Translate_steps _ x + Constr_inl_steps). - repeat split; try omega. + repeat split; try lia. { exists x. repeat split; auto. - contains_ext. - now rewrite HTranslateInj1, HCaseSumInj by vector_not_in. @@ -175,21 +175,19 @@ Section MapSum. { now rewrite HTranslateInj1, HCaseSumInj by vector_not_in. } { intros i. now rewrite HTranslateInj1, HCaseSumInj by vector_not_in. } exists (Translate_steps _ x), (Constr_inl_steps). - repeat split; try omega. + repeat split; try lia. { hnf. cbn. exists x. repeat split; eauto. contains_ext. } - intros tmid4 () (HTranslate2&HTranslateInj2). modpon HTranslate2. - reflexivity. } { (* s = inl y, completely symmetric *) exists (CaseSum_steps), (3 + Translate_steps _ y + M2_steps y + Translate_steps _ y + Constr_inr_steps). - repeat split; try omega. + repeat split; try lia. intros tmid b (HCaseSum&HCaseSumInj). specialize (HCaseSum (inr y)). modpon HCaseSum. destruct b; auto. simpl_surject. exists (Translate_steps _ y), (2 + M2_steps y + Translate_steps _ y + Constr_inr_steps). - repeat split; try omega. + repeat split; try lia. { hnf. cbn. exists y. split; auto. contains_ext. } intros tmid2 () (HTranslate1&HTranslateInj1). modpon HTranslate1. exists (M2_steps y), (1 + Translate_steps _ y + Constr_inr_steps). - repeat split; try omega. + repeat split; try lia. { exists y. repeat split; auto. - contains_ext. - now rewrite HTranslateInj1, HCaseSumInj by vector_not_in. @@ -199,7 +197,7 @@ Section MapSum. { now rewrite HTranslateInj1, HCaseSumInj by vector_not_in. } { intros i. now rewrite HTranslateInj1, HCaseSumInj by vector_not_in. } exists (Translate_steps _ y), (Constr_inr_steps). - repeat split; try omega. + repeat split; try lia. { hnf. cbn. exists y. repeat split; eauto. contains_ext. } intros tmid4 () (HTranslate2&HTranslateInj2). modpon HTranslate2. reflexivity. diff --git a/theories/TM/Code/WriteValue.v b/theories/TM/Code/WriteValue.v index a9b3ec5..bbd2a32 100644 --- a/theories/TM/Code/WriteValue.v +++ b/theories/TM/Code/WriteValue.v @@ -40,7 +40,7 @@ Section WriteValue. unfold WriteValue_steps. eapply RealiseIn_monotone. { unfold WriteValue. eapply WriteString_Sem. } { unfold WriteString_steps. rewrite !rev_length. cbn [length]. rewrite app_length. - unfold size. cbn. rewrite map_length. omega. } + unfold size. cbn. rewrite map_length. lia. } { intros tin ((), tout) H. intros x <- HRight. TMSimp; clear_trivial_eqs. eapply tape_local_contains. rewrite WriteString_L_local. diff --git a/theories/TM/Combinators/Combinators.v b/theories/TM/Combinators/Combinators.v index e212c19..68755b6 100644 --- a/theories/TM/Combinators/Combinators.v +++ b/theories/TM/Combinators/Combinators.v @@ -92,7 +92,7 @@ Arguments Return : simpl never. (** Helper tactics for match *) (** This tactic destructs a variable recursivle and shelves each goal where it couldn't destruct the variable further. The purpose of this tactic is to pre-instantiate functions to relations with holes of the form [Param -> Rel _ _]. We need this for the [Switch] Machine. -The implementation of this tactic is quiete uggly but works for parameters with up to 9 constructor arguments. This tactic may generates a lot of warnings, which can be ignored. *) +The implementation of this tactic is quite ugly but works for parameters with up to 9 constructor arguments. This tactic may generates a lot of warnings, which can be ignored. *) Ltac destruct_shelve e := cbn in e; idtac "Input:"; diff --git a/theories/TM/Combinators/If.v b/theories/TM/Combinators/If.v index 3f52807..ec23452 100644 --- a/theories/TM/Combinators/If.v +++ b/theories/TM/Combinators/If.v @@ -56,10 +56,10 @@ Section If. eapply RealiseIn_monotone. eapply Switch_RealiseIn; eauto. - intros. cbn in f. destruct f. - + eapply RealiseIn_monotone. destruct pM2. eassumption. instantiate (1 := Nat.max k2 k3); firstorder. + + eapply RealiseIn_monotone. destruct pM2. eassumption. instantiate (1 := Nat.max k2 k3). apply Nat.le_max_l. instantiate (1 := fun t => match t with true => R2 | _ => R3 end). reflexivity. - + eapply RealiseIn_monotone. destruct pM3. eassumption. firstorder. reflexivity. - - omega. + + eapply RealiseIn_monotone. destruct pM3. eassumption. apply Nat.le_max_r. reflexivity. + - lia. - hnf. intros H2 (f& t). intros ([ | ]& (y & H3&H3')). left. hnf. eauto. right. hnf. eauto. Qed. diff --git a/theories/TM/Combinators/SequentialComposition.v b/theories/TM/Combinators/SequentialComposition.v index 6cafbdc..5b11404 100644 --- a/theories/TM/Combinators/SequentialComposition.v +++ b/theories/TM/Combinators/SequentialComposition.v @@ -50,7 +50,7 @@ Section Composition. eapply (Switch_RealiseIn). - eapply H1. - intros f. eapply H2. - - omega. + - lia. - firstorder. Qed. diff --git a/theories/TM/Combinators/Switch.v b/theories/TM/Combinators/Switch.v index 8236fa2..cc2979b 100644 --- a/theories/TM/Combinators/Switch.v +++ b/theories/TM/Combinators/Switch.v @@ -1,5 +1,5 @@ Require Export TM.TM. -Require Import Shared.FiniteTypes.DepPairs EqdepFacts. +Require Import PslBase.FiniteTypes.DepPairs EqdepFacts. (** * Switch Combinator *) @@ -217,7 +217,7 @@ Section Switch. specialize H with (1 := HRel1). specialize (HTerm2 _ _ _ H) as (c2&HLoop2). pose proof Switch_merge HLoop1 HLoop2 as HLoop. - exists (lift_confR c2). eapply loop_monotone; eauto. omega. + exists (lift_confR c2). eapply loop_monotone; eauto. lia. Qed. diff --git a/theories/TM/Combinators/While.v b/theories/TM/Combinators/While.v index 7d3036b..2b7a12e 100644 --- a/theories/TM/Combinators/While.v +++ b/theories/TM/Combinators/While.v @@ -1,5 +1,5 @@ Require Export TM.TM. -Require Import Shared.FiniteTypes.DepPairs EqdepFacts. +Require Import PslBase.FiniteTypes.DepPairs EqdepFacts. Section While. @@ -136,7 +136,7 @@ Section While. eapply loop_lift with (lift := id) (f' := step (WhileTM)) (h' := haltConf (M := projT1 pM)) in HLoop; cbv [id] in *; cbn; auto; cycle 1. { intros. symmetry. now apply step_comp. } unfold loopM. - replace k1 with (k1 + 0) by omega. + replace k1 with (k1 + 0) by lia. apply loop_merge with (h := haltConf (M := projT1 pM)) (a2 := c2). - apply halt_comp. - apply HLoop. @@ -167,7 +167,7 @@ Section While. - apply While_split_term with (f := f) in HLoop2 as ->; auto. 2: apply (loop_fulfills HLoop1). unfold While_part. rewrite E. constructor 1. specialize HRel with (1 := HLoop1). now rewrite E in HRel. - apply While_split_repeat in HLoop2 as (k2'&->&HLoop2); auto. 2: apply (loop_fulfills HLoop1). - specialize IH with (2 := HLoop2); spec_assert IH by omega. + specialize IH with (2 := HLoop2); spec_assert IH by lia. econstructor 2. + specialize HRel with (1 := HLoop1). rewrite E in HRel. eassumption. + apply IH. @@ -197,8 +197,8 @@ Section While. - specialize HT2 with (1 := Realise_M). exists oconf. eapply loop_monotone; eauto. eapply While_merge_term; eauto. - specialize HT3 with (1 := Realise_M) as (i2&HT3&Hi). - specialize (IH i2 ltac:(omega) _ HT3) as (oconf2&Hloop2). - exists oconf2. apply loop_monotone with (k1 := i1 + (1 + i2)). 2: omega. + specialize (IH i2 ltac:(lia) _ HT3) as (oconf2&Hloop2). + exists oconf2. apply loop_monotone with (k1 := i1 + (1 + i2)). 2: lia. eapply While_merge_repeat; eauto. Qed. diff --git a/theories/TM/Compound/CopySymbols.v b/theories/TM/Compound/CopySymbols.v index 295cf8e..dcd068b 100644 --- a/theories/TM/Compound/CopySymbols.v +++ b/theories/TM/Compound/CopySymbols.v @@ -59,7 +59,7 @@ Section CopySymbols. - destruct (f e); swap 1 2. + apply Return_RealiseIn. eapply Seq_RealiseIn. eapply LiftTapes_RealiseIn; [vector_dupfree | eapply Write_Sem]. eapply MovePar_Sem. + apply Return_RealiseIn, LiftTapes_RealiseIn; [vector_dupfree | eapply Write_Sem]. - - cbn. eapply RealiseIn_monotone'. apply Return_RealiseIn. eapply Nop_Sem. omega. + - cbn. eapply RealiseIn_monotone'. apply Return_RealiseIn. eapply Nop_Sem. lia. } { cbn. reflexivity. } { @@ -88,7 +88,7 @@ Section CopySymbols. end. Proof. intros (t1,t2) m HC Hs. unfold rlength', rlength. cbn. - destruct t1; cbn in *; inv HC. simpl_tape. omega. + destruct t1; cbn in *; inv HC. simpl_tape. lia. Qed. @@ -148,7 +148,7 @@ Section CopySymbols. end. Proof. intros tin m HC Hs. unfold rlength', rlength. cbn. - destruct tin; cbn in *; inv HC. simpl_tape. omega. + destruct tin; cbn in *; inv HC. simpl_tape. lia. Qed. @@ -164,8 +164,8 @@ Section CopySymbols. - reflexivity. - intros ymid tmid H. cbn in *. destruct ymid as [()| ]; cbn in *. + destruct (current tin[@Fin0]) eqn:E; TMSimp. - * destruct (f e) eqn:Ef; TMSimp. rewrite CopySymbols_steps_equation, E, Ef in HT. omega. - * rewrite CopySymbols_steps_equation, E in HT. omega. + * destruct (f e) eqn:Ef; TMSimp. rewrite CopySymbols_steps_equation, E, Ef in HT. lia. + * rewrite CopySymbols_steps_equation, E in HT. lia. + destruct (current tin[@Fin0]) eqn:E; TMSimp. destruct (f e) eqn:Ef; TMSimp. rewrite CopySymbols_steps_equation, E, Ef in HT. exists (CopySymbols_steps (tape_move_right tin[@Fin0])). split; auto. @@ -191,7 +191,7 @@ Section CopySymbols. end. Proof. intros (t1,t2) m HC Hs. unfold llength', llength. cbn. - destruct t1; cbn in *; inv HC. simpl_tape. omega. + destruct t1; cbn in *; inv HC. simpl_tape. lia. Qed. Lemma CopySymbols_mirror t t1' t2' : @@ -251,7 +251,7 @@ Section CopySymbols. end. Proof. intros tin m HC Hs. unfold llength', llength. cbn. - destruct tin; cbn in *; inv HC. simpl_tape. omega. + destruct tin; cbn in *; inv HC. simpl_tape. lia. Qed. @@ -262,7 +262,7 @@ Section CopySymbols. simpl_tape in *; cbn in *; rewrite CopySymbols_steps_equation; simpl_tape. - now rewrite e, e0. - - rewrite e, e0. omega. + - rewrite e, e0. lia. - destruct (current t); cbn; auto. Qed. diff --git a/theories/TM/Compound/MoveToSymbol.v b/theories/TM/Compound/MoveToSymbol.v index 27d2883..390f9a9 100644 --- a/theories/TM/Compound/MoveToSymbol.v +++ b/theories/TM/Compound/MoveToSymbol.v @@ -74,7 +74,7 @@ Section MoveToSymbol. - apply Return_RealiseIn. eapply Nop_Sem. } { - (cbn; omega). + (cbn; lia). } { unfold MoveToSymbol_Step_Rel, MoveToSymbol_Step_Fun. intros tin (yout, tout) H. @@ -100,7 +100,7 @@ Section MoveToSymbol. end. Proof. intros. cbn. unfold rlength. simpl_tape. - destruct t eqn:E; cbn in *; try now inv teq. omega. + destruct t eqn:E; cbn in *; try now inv teq. lia. Qed. Lemma MoveToSymbol_Step_Fun_M2_None t : @@ -202,14 +202,14 @@ Section MoveToSymbol. - reflexivity. - intros ymid tmid. intros H. destruct ymid as [()| ]; TMSimp. + destruct (current tin[@Fin0]) eqn:E; TMSimp; auto. - * destruct (f e) eqn:Ef; inv H0. rewrite MoveToSymbol_steps_equation in HT. rewrite E, Ef in HT. omega. - * rewrite MoveToSymbol_steps_equation in HT. rewrite E in HT. omega. + * destruct (f e) eqn:Ef; inv H0. rewrite MoveToSymbol_steps_equation in HT. rewrite E, Ef in HT. lia. + * rewrite MoveToSymbol_steps_equation in HT. rewrite E in HT. lia. + destruct (current tin[@Fin0]) eqn:E. * destruct (f e) eqn:Ef; inv H0. rewrite MoveToSymbol_steps_equation in HT. rewrite E, Ef in HT. exists (MoveToSymbol_steps (doAct tin[@Fin0] (Some (g e), R))). cbn. split. -- unfold MoveToSymbol_Step_Fun. rewrite E, Ef. cbn. reflexivity. - -- rewrite <- HT. cbn. omega. + -- rewrite <- HT. cbn. lia. * congruence. } Qed. @@ -230,7 +230,7 @@ Section MoveToSymbol. else MoveToSymbol_L_Fun (doAct t (Some (g s), L)) | _ => t end. - Proof. intros. unfold llength. cbn. simpl_tape. destruct t; cbn in *; inv teq. omega. Qed. + Proof. intros. unfold llength. cbn. simpl_tape. destruct t; cbn in *; inv teq. lia. Qed. Lemma MoveToSymbol_mirror t t' : MoveToSymbol_Fun (mirror_tape t) = mirror_tape t' -> MoveToSymbol_L_Fun t = t'. @@ -272,7 +272,7 @@ Section MoveToSymbol. | Some s => if f s then 4 else 4 + (MoveToSymbol_L_steps (doAct t (Some (g s), L))) | _ => 4 end. - Proof. intros. unfold llength. cbn. simpl_tape. destruct t; cbn in *; inv teq. omega. Qed. + Proof. intros. unfold llength. cbn. simpl_tape. destruct t; cbn in *; inv teq. lia. Qed. Lemma MoveToSymbol_steps_mirror t : MoveToSymbol_L_steps t = MoveToSymbol_steps (mirror_tape t). diff --git a/theories/TM/Compound/Multi.v b/theories/TM/Compound/Multi.v index 3f07e0b..3a71c90 100644 --- a/theories/TM/Compound/Multi.v +++ b/theories/TM/Compound/Multi.v @@ -125,9 +125,9 @@ Section Copy. - instantiate (2 := fun o : option sig => match o with Some s => _ | None => _ end). intros [ s | ]; cbn. + eapply LiftTapes_RealiseIn. vector_dupfree. apply Write_Sem. - + eapply RealiseIn_monotone'. apply Nop_Sem. omega. + + eapply RealiseIn_monotone'. apply Nop_Sem. lia. } - { omega. } + { lia. } { intros tin ((), tout) H. cbn in *. TMSimp. destruct (current tin[@Fin0]) eqn:E; TMSimp; auto. diff --git a/theories/TM/Compound/WriteString.v b/theories/TM/Compound/WriteString.v index f34bae2..1f6edd8 100644 --- a/theories/TM/Compound/WriteString.v +++ b/theories/TM/Compound/WriteString.v @@ -51,7 +51,7 @@ Section Write_String. - change (WriteString (s :: s' :: str')) with (WriteMove s D;; WriteString (s' :: str')). eapply RealiseIn_monotone. { TM_Correct. TM_Correct. apply IH. } - { unfold WriteString_steps. cbn. omega. } + { unfold WriteString_steps. cbn. lia. } { intros t1 t3 H. destruct H as (()&t2&H1&H2). change (WriteString_sem_fix (s :: s' :: str')) with (WriteMove_Rel s D |_tt ∘ WriteString_sem_fix (s' :: str')). exists t2. split; auto. diff --git a/theories/TM/LM/Alphabets.v b/theories/TM/LM/Alphabets.v index f92dec8..8424acc 100644 --- a/theories/TM/LM/Alphabets.v +++ b/theories/TM/LM/Alphabets.v @@ -14,15 +14,15 @@ Coercion ACom2Com (a : ACom) : Com := end. -Instance ACom_eq_dec : eq_dec ACom. +#[export] Instance ACom_eq_dec : eq_dec ACom. Proof. intros x y; hnf. decide equality. Defined. -Instance ACom_finType : finTypeC (EqType ACom). +#[export] Instance ACom_finType : finTypeC (EqType ACom). Proof. split with (enum := [retAT; lamAT; appAT]). intros [ | | ]; cbn; reflexivity. Defined. -Instance ACom_inhab : inhabitedC ACom := ltac:(repeat constructor). +#[export] Instance ACom_inhab : inhabitedC ACom := ltac:(repeat constructor). -Instance Encode_ACom : codable ACom ACom := Encode_Finite (FinType(EqType ACom)). +#[export] Instance Encode_ACom : codable ACom ACom := Encode_Finite (FinType(EqType ACom)). Coercion Com_to_sum (t : Com) : (nat + ACom) := @@ -36,7 +36,7 @@ Coercion Com_to_sum (t : Com) : (nat + ACom) := Definition sigCom := sigSum sigNat ACom. Definition sigCom_fin := FinType (EqType sigCom). -Instance Encode_Com : codable sigCom Com := +#[export] Instance Encode_Com : codable sigCom Com := {| encode x := encode (Com_to_sum x) |}. @@ -53,21 +53,21 @@ Definition sigHAdd := sigNat. Definition sigHAdd_fin := FinType(EqType sigHAdd). Definition sigPro := sigList sigCom. -Instance Encode_Prog : codable sigPro Pro := _. +#[export] Instance Encode_Prog : codable sigPro Pro := _. Definition sigPro_fin := FinType(EqType sigPro). Definition sigHClos := sigPair sigHAdd sigPro. Definition sigHClos_fin := FinType(EqType sigHClos). -Instance Encode_HClos : codable sigHClos HClos := _. +#[export] Instance Encode_HClos : codable sigHClos HClos := _. Definition sigHEntr' := sigPair sigHClos sigHAdd. -Instance Encode_HEntr' : codable (sigHEntr') (HClos*HAdd) := _. +#[export] Instance Encode_HEntr' : codable (sigHEntr') (HClos*HAdd) := _. Definition sigHEntr'_fin := FinType(EqType sigHEntr'). Definition sigHEntr := sigOption sigHEntr'. -Instance Encode_HEntr : codable (sigHEntr) HEntr := _. +#[export] Instance Encode_HEntr : codable (sigHEntr) HEntr := _. Definition sigHEntr_fin := FinType(EqType sigHEntr). Definition sigHeap := sigList sigHEntr. -Instance Encode_Heap : codable (sigHeap) Heap := _. +#[export] Instance Encode_Heap : codable (sigHeap) Heap := _. Definition sigHeap_fin := FinType(EqType sigHeap). diff --git a/theories/TM/LM/HaltingProblem.v b/theories/TM/LM/HaltingProblem.v index 3e311e7..5ccfe5e 100644 --- a/theories/TM/LM/HaltingProblem.v +++ b/theories/TM/LM/HaltingProblem.v @@ -107,10 +107,10 @@ Proof. * apply is_halt_state_correct in EHalt. pose proof (halt_state_steps_k EHalt HSteps) as (H&->); inv H. exists (Step_steps T1 V1 Heap1). split. -- do 3 eexists. eexists 0. cbn -[step_fun]. repeat split; hnf; eauto. - -- omega. + -- lia. * exists (Loop_steps T1 V1 Heap1 k). split. -- do 3 eexists. exists k. repeat split; hnf; eauto. - -- omega. + -- lia. } Qed. diff --git a/theories/TM/LM/JumpTargetTM.v b/theories/TM/LM/JumpTargetTM.v index 1179ebd..20312ac 100644 --- a/theories/TM/LM/JumpTargetTM.v +++ b/theories/TM/LM/JumpTargetTM.v @@ -59,7 +59,7 @@ Proof. } { intros tin k (Q&Q'&HEncQ&HEncQ'&Hk). - exists (App'_steps _ Q), (MoveValue_steps _ _ (Q++Q') Q); cbn; repeat split; try omega. + exists (App'_steps _ Q), (MoveValue_steps _ _ (Q++Q') Q); cbn; repeat split; try lia. hnf; cbn. eauto. now rewrite Hk. intros tmid () (HApp&HInjApp); TMSimp. modpon HApp. exists (Q++Q'), Q. repeat split; eauto. @@ -107,7 +107,7 @@ Proof. } { intros tin k. intros (Q&HEncQ&HRight&Hk). - exists (WriteValue_steps (size _ [ACom2Com t])), (App_Comens_steps Q [ACom2Com t]). cbn; repeat split; try omega. + exists (WriteValue_steps (size _ [ACom2Com t])), (App_Comens_steps Q [ACom2Com t]). cbn; repeat split; try lia. now rewrite Hk. intros tmid () (HWrite&HInjWrite); hnf; cbn; TMSimp. specialize (HWrite [ACom2Com t] eq_refl). modpon HWrite. eauto. } @@ -165,12 +165,12 @@ Proof. } { intros tin k (Q&t&HEncQ&HEncT&HRight&Hk). unfold App_Com_steps in Hk. - exists (Constr_nil_steps), (1 + Constr_cons_steps _ t + 1 + App_Comens_steps Q [t] + Reset_steps _ t). cbn. repeat split; try omega. + exists (Constr_nil_steps), (1 + Constr_cons_steps _ t + 1 + App_Comens_steps Q [t] + Reset_steps _ t). cbn. repeat split; try lia. intros tmid () (HNil&HInjNil); TMSimp. modpon HNil. - exists (Constr_cons_steps _ t), (1 + App_Comens_steps Q [t] + Reset_steps _ t). cbn. repeat split; try omega. + exists (Constr_cons_steps _ t), (1 + App_Comens_steps Q [t] + Reset_steps _ t). cbn. repeat split; try lia. eauto. now rewrite !Nat.add_assoc. unfold sigPro in *. intros tmid0 () (HCons&HInjCons); TMSimp. modpon HCons. - exists (App_Comens_steps Q [t]), (Reset_steps _ t). cbn. repeat split; try omega. + exists (App_Comens_steps Q [t]), (Reset_steps _ t). cbn. repeat split; try lia. hnf; cbn. do 2 eexists; repeat split; eauto. reflexivity. intros tmid1 _ (HApp&HInjApp); TMSimp. modpon HApp. eexists. split; eauto. now setoid_rewrite Reset_steps_comp. @@ -350,30 +350,30 @@ Proof. { intros tin steps (P&Q&k&HEncP&HEncQ&HEncK&HRight3&HRight4&Hk). unfold JumpTarget_Step_steps in Hk. cbn in *. unfold sigPro in *. - exists (CaseList_steps _ P), (JumpTarget_Step_steps_CaseList P Q k). cbn; repeat split; try omega. eauto. + exists (CaseList_steps _ P), (JumpTarget_Step_steps_CaseList P Q k). cbn; repeat split; try lia. eauto. intros tmid bmatchlist (HCaseList&HCaseListInj); TMSimp. modpon HCaseList. destruct bmatchlist, P as [ | t P']; auto; modpon HCaseList. { (* P = t :: P' (* other case is done by auto *) *) - exists (CaseCom_steps), (JumpTarget_Step_steps_CaseCom Q k t). cbn; repeat split; try omega. + exists (CaseCom_steps), (JumpTarget_Step_steps_CaseCom Q k t). cbn; repeat split; try lia. intros tmid1 ytok (HCaseCom&HCaseComInj); TMSimp. modpon HCaseCom. destruct ytok as [ [ | | ] | ]; destruct t; auto; simpl_surject; TMSimp. { (* t = retT *) exists CaseNat_steps. destruct k as [ | k']. - (* k = 0 *) - exists ResetEmpty1_steps. repeat split; try omega. + exists ResetEmpty1_steps. repeat split; try lia. intros tmid2 bCaseNat (HCaseNat&HCaseNatInj); TMSimp. modpon HCaseNat. destruct bCaseNat; auto. - (* k = S k' *) - exists (App_ACom_steps Q retAT). repeat split; try omega. + exists (App_ACom_steps Q retAT). repeat split; try lia. intros tmid2 bCaseNat (HCaseNat&HCaseNatInj); TMSimp. modpon HCaseNat. destruct bCaseNat; auto. hnf; cbn. eauto. } { (* t = lamT *) - exists (Constr_S_steps), (App_ACom_steps Q lamAT). repeat split; try omega. + exists (Constr_S_steps), (App_ACom_steps Q lamAT). repeat split; try lia. intros tmid2 () (HS&HSInj); TMSimp. modpon HS. hnf; cbn. eauto. } { (* t = appT *) hnf; cbn; eauto. } { (* t = varT n *) - exists (Constr_varT_steps), (App_Com_steps Q (varT n)). repeat split; try omega. + exists (Constr_varT_steps), (App_Com_steps Q (varT n)). repeat split; try lia. intros tmid2 H (HVarT&HVarTInj); TMSimp. modpon HVarT. hnf; cbn. eauto 6. } } @@ -396,12 +396,12 @@ Fixpoint jumpTarget_k (k:nat) (P:Pro) : nat := Goal forall k P, jumpTarget_k k P <= k + |P|. Proof. intros k P. revert k. induction P as [ | t P IH]; intros; cbn in *. - - omega. + - lia. - destruct t; cbn. - + rewrite IH. omega. - + rewrite IH. omega. - + rewrite IH. omega. - + destruct k. omega. rewrite IH. omega. + + rewrite IH. lia. + + rewrite IH. lia. + + rewrite IH. lia. + + destruct k. lia. rewrite IH. lia. Qed. @@ -584,10 +584,10 @@ Proof. { intros tin k (P&HEncP&Hout&HInt&Hk). unfold JumpTarget_steps in Hk. exists (Constr_nil_steps), (1 + Constr_O_steps + 1 + JumpTarget_Loop_steps P nil 0). - cbn; repeat split; try omega. + cbn; repeat split; try lia. intros tmid () (HWrite&HWriteInj); TMSimp. modpon HWrite. exists (Constr_O_steps), (1 + JumpTarget_Loop_steps P nil 0). - cbn; repeat split; try omega. + cbn; repeat split; try lia. cbn in *. unfold sigPro in *. intros tmid1 () (HWrite'&HWriteInj'); TMSimp. modpon HWrite'. hnf. do 3 eexists; repeat split; cbn in *; unfold sigPro in *; cbn in *; TMSimp_goal; eauto. } diff --git a/theories/TM/LM/LookupTM.v b/theories/TM/LM/LookupTM.v index aedb893..85f8355 100644 --- a/theories/TM/LM/LookupTM.v +++ b/theories/TM/LM/LookupTM.v @@ -224,45 +224,45 @@ There are (more than) three possible ways how to encode [nat] on the [Heap] alph { intros tin k. cbn. intros (H&a&n&HEncH&HEncA&HEncN&HRight3&HRight4&Hk). unfold Lookup_Step_steps in Hk. exists (Nth'_steps _ H a), (Lookup_Step_steps_Nth' H a n). - repeat split; try omega. + repeat split; try lia. { hnf; cbn; eauto 7. } unfold Lookup_Step_steps_Nth' in *. intros tmid b (HNth&HNthInj); TMSimp. modpon HNth. destruct b; modpon HNth. { (* nth_error H a = Some e *) destruct HNth as (e&HNth); modpon HNth. rewrite HNth in *. exists (CaseOption_steps), (Lookup_Step_steps_CaseOption n e). - repeat split; try omega. unfold Lookup_Step_steps_CaseOption in *. + repeat split; try lia. unfold Lookup_Step_steps_CaseOption in *. intros tmid0 b (HCaseOption&HCaseOptionInj); TMSimp. modpon HCaseOption. destruct b; auto. { (* e = Some e', where e' = (g,b) *) destruct e as [ e' | ]; auto; simpl_surject. destruct e' as [g b] eqn:Ee'. exists (CasePair_steps _ g), (1 + CaseNat_steps + Lookup_Step_steps_CaseNat n e'); subst. - repeat split; try omega. 2: now rewrite !Nat.add_assoc. + repeat split; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn. exists (g,b). repeat split; simpl_surject; eauto. contains_ext. } intros tmid1 () (HCasePair&HCasePairInj). specialize (HCasePair (g,b)); modpon HCasePair. exists (CaseNat_steps), (Lookup_Step_steps_CaseNat n (g,b)). - repeat split; try omega. + repeat split; try lia. intros tmid2 bif (HCaseNat&HCaseNatInj); TMSimp. modpon HCaseNat. destruct bif, n as [ | n']; auto; simpl_surject. { (* n = S n' *) exists (CopyValue_steps _ b), (1 + Translate_steps _ b + 1 + Reset_steps _ b + Reset_steps _ g). - repeat split; try omega. 2: now rewrite !Nat.add_assoc. + repeat split; try lia. 2: now rewrite !Nat.add_assoc. { eexists; repeat split; eauto. contains_ext. now setoid_rewrite CopyValue_steps_comp. } intros tmid3 () (HCopyValue&HCopyValueInj); TMSimp. modpon HCopyValue. exists (Translate_steps _ b), (1 + Reset_steps _ b + Reset_steps _ g). - repeat split; try omega. 2: now rewrite !Nat.add_assoc. + repeat split; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn. eauto. } intros tmid4 () (HTranslate&HTranslateInj); TMSimp. modpon HTranslate. exists (Reset_steps _ b), (Reset_steps _ g). - repeat split; try omega. 2: reflexivity. + repeat split; try lia. 2: reflexivity. { hnf; cbn. eexists; repeat split; eauto. now setoid_rewrite Reset_steps_comp. } intros tmid5 () (HReset&HResetInj); TMSimp. modpon HReset. { hnf; cbn. eexists; repeat split; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. } } { (* n = 0 *) exists (Reset_steps _ b), (1 + Reset_steps _ 0 + Translate_steps _ g). - repeat split; try omega. 2: now rewrite !Nat.add_assoc. + repeat split; try lia. 2: now rewrite !Nat.add_assoc. { eexists; split; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. } intros tmid3 () (HReset&HResetInj); TMSimp. modpon HReset. exists (Reset_steps _ 0), (Translate_steps _ g). - repeat split; try omega. 2: reflexivity. + repeat split; try lia. 2: reflexivity. { eexists; split; eauto. } intros tmid4 () (HReset'&HResetInj'); TMSimp. modpon HReset'. { hnf; cbn. eexists; split; eauto. contains_ext. } @@ -350,7 +350,7 @@ There are (more than) three possible ways how to encode [nat] on the [Heap] alph - intros ymid tmid HStep. cbn in *. modpon HStep. destruct ymid as [ [ | ] | ], n as [ | n']; cbn in *; auto. + destruct HStep as (g&b&HStep); modpon HStep. rewrite HStep in Hk. auto. + destruct (nth_error Heap a) as [ [ (g&b) | ] | ] eqn:E; auto. - + destruct (nth_error Heap a) as [ [ (g&b) | ] | ] eqn:E; auto. omega. + + destruct (nth_error Heap a) as [ [ (g&b) | ] | ] eqn:E; auto. lia. + destruct HStep as (g&b&HStep); modpon HStep. rewrite HStep in Hk. eexists; repeat split; eauto. hnf. do 3 eexists; repeat split; eauto. } diff --git a/theories/TM/LM/StepTM.v b/theories/TM/LM/StepTM.v index c47ed83..9486f5e 100644 --- a/theories/TM/LM/StepTM.v +++ b/theories/TM/LM/StepTM.v @@ -113,16 +113,16 @@ Section StepMachine. { intros tin k (T&P&a&HEncT&HEncP&HEncA&Hk). unfold TailRec_steps in Hk. destruct P as [ | t P]; cbn. - - exists (IsNil_steps), (Reset_steps _ nil). repeat split; try omega. + - exists (IsNil_steps), (Reset_steps _ nil). repeat split; try lia. intros tmid b (HIsNil&IsNilInj); TMSimp. modpon HIsNil. destruct b; auto; modpon HIsNil. eauto. - exists (IsNil_steps), (1 + Constr_pair_steps _ a + 1 + Constr_cons_steps _ (a,t::P) + Reset_steps _ (a, (t::P))). - repeat split; try omega. + repeat split; try lia. intros tmid b (HIsNil&IsNilInj); TMSimp. modpon HIsNil. destruct b; auto; modpon HIsNil. - exists (Constr_pair_steps _ a), (1 + Constr_cons_steps _ (a,t::P) + Reset_steps _ (a,t::P)). repeat split; try omega. + exists (Constr_pair_steps _ a), (1 + Constr_cons_steps _ (a,t::P) + Reset_steps _ (a,t::P)). repeat split; try lia. { hnf; cbn. eexists; split. simpl_surject; contains_ext. reflexivity. } now rewrite !Nat.add_assoc. intros tmid0 () (HPair&HPairInj); TMSimp. specialize (HPair a (t::P)); modpon HPair. - exists (Constr_cons_steps _ (a,t::P)), (Reset_steps _ (a,t::P)). repeat split; try omega. + exists (Constr_cons_steps _ (a,t::P)), (Reset_steps _ (a,t::P)). repeat split; try lia. { hnf; cbn. do 2 eexists; repeat split; simpl_surject; eauto. contains_ext. } reflexivity. intros tmid1 () (HCons&HConsInj); TMSimp. specialize (HCons T (a,t::P)). modpon HCons. exists (a, t :: P). split; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. @@ -190,15 +190,15 @@ Section StepMachine. { intros tin k. intros (T&Q&a&HEncT&HEnca&HEncQ&Hk). unfold ConsClos_steps in Hk. exists (Constr_pair_steps _ a), (1 + Constr_cons_steps _ (a,Q) + 1 + Reset_steps _ (a,Q) + Reset_steps _ a). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { hnf; cbn. exists a. repeat split; simpl_surject; eauto. contains_ext. } intros tmid () (HPair&HPairInj); TMSimp. modpon HPair. exists (Constr_cons_steps _ (a,Q)), (1 + Reset_steps _ (a,Q) + Reset_steps _ a). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { hnf; cbn. exists T, (a, Q). repeat split; simpl_surject; eauto. contains_ext. } now rewrite !Nat.add_assoc. intros tmid0 () (HCons&HConsInj); TMSimp. specialize (HCons T (a,Q)); modpon HCons. exists (Reset_steps _ (a,Q)), (Reset_steps _ a). - cbn; repeat split; try omega; eauto. + cbn; repeat split; try lia; eauto. { hnf; cbn. exists (a, Q). repeat split; simpl_surject; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. } intros tmid1 () (HReset&HResetInj); TMSimp. clear HReset. exists a. split; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. @@ -296,7 +296,7 @@ Section StepMachine. } { intros tin k. intros (T&V&H&a&P&HEncT&HEncV&HEncH&HEncP&HEncA&HInt&Hk). unfold Step_lam_steps in Hk. - exists (JumpTarget_steps P), (Step_lam_steps_JumpTarget P a). cbn; repeat split; try omega. + exists (JumpTarget_steps P), (Step_lam_steps_JumpTarget P a). cbn; repeat split; try lia. { hnf; cbn. do 1 eexists; repeat split; simpl_surject; eauto. - apply HInt. - intros i; destruct_fin i; cbn; simpl_surject; TMSimp_goal; eauto; apply HInt. } @@ -306,11 +306,11 @@ Section StepMachine. { destruct HJump as (P'&Q'&HJump); modpon HJump. unfold Step_lam_steps_JumpTarget. rewrite HJump. - exists (TailRec_steps P' a), (ConsClos_steps Q' a). cbn; repeat split; try omega. hnf; cbn; eauto 7. + exists (TailRec_steps P' a), (ConsClos_steps Q' a). cbn; repeat split; try lia. hnf; cbn; eauto 7. intros tmid0 () (HTailRec&HTailRecInj); TMSimp. modpon HTailRec. hnf; cbn. eauto 7. } - { omega. } + { lia. } } Qed. @@ -426,52 +426,52 @@ Section StepMachine. (1 + Constr_nil_steps + 1 + Translate_steps _ b + 1 + Translate_steps _ g + 1 + Constr_pair_steps _ g + 1 + Constr_Some_steps + 1 + Constr_cons_steps _ (Some (g, b)) + 1 + App'_steps _ H + 1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. now hnf; cbn; eauto 10. + cbn; repeat split; try lia. now hnf; cbn; eauto 10. intros tmid () (HLength&HLengthInj); TMSimp. modpon HLength. 1: now intros i; destruct_fin i; cbn; auto. exists (Constr_nil_steps), (1 + Translate_steps _ b + 1 + Translate_steps _ g + 1 + Constr_pair_steps _ g + 1 + Constr_Some_steps + 1 + Constr_cons_steps _ (Some (g, b)) + 1 + App'_steps _ H + 1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. now rewrite !Nat.add_assoc. intros tmid0 () (HNil&HNilInj); TMSimp. modpon HNil. simpl_surject. exact (HLength1 Fin0). exists (Translate_steps _ b), (1 + Translate_steps _ g + 1 + Constr_pair_steps _ g + 1 + Constr_Some_steps + 1 + Constr_cons_steps _ (Some (g, b)) + 1 + App'_steps _ H + 1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. now hnf; cbn; eexists; split; eauto. now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. now hnf; cbn; eexists; split; eauto. now rewrite !Nat.add_assoc. intros tmid1 () (HTranslate&HTranslateInj); TMSimp. modpon HTranslate. exists (Translate_steps _ g), (1 + Constr_pair_steps _ g + 1 + Constr_Some_steps + 1 + Constr_cons_steps _ (Some (g, b)) + 1 + App'_steps _ H + 1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. now hnf; cbn; eauto. now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. now hnf; cbn; eauto. now rewrite !Nat.add_assoc. intros tmid2 () (HTranslate'&HTranslateInj'); TMSimp. modpon HTranslate'. exists (Constr_pair_steps _ g), (1 + Constr_Some_steps + 1 + Constr_cons_steps _ (Some (g, b)) + 1 + App'_steps _ H + 1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. 2: now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn; eexists; split; simpl_surject; eauto; contains_ext. } intros tmid3 () (HPair&HPairInj); TMSimp. modpon HPair. exists (Constr_Some_steps), (1 + Constr_cons_steps _ (Some (g, b)) + 1 + App'_steps _ H + 1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. now rewrite !Nat.add_assoc. intros tmid4 () (HSome&HSomeInj); TMSimp. specialize (HSome (g,b)); modpon HSome. exists (Constr_cons_steps _ (Some (g, b))), (1 + App'_steps _ H + 1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. 2: now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. 2: now rewrite !Nat.add_assoc. { do 2 eexists; repeat split; simpl_surject; eauto. contains_ext. } intros tmid5 () (HCons&HConsInj); TMSimp. specialize (HCons [] (Some (g,b))); modpon HCons. exists (App'_steps _ H), (1 + MoveValue_steps _ _ (H++[Some(g,b)]) H + 1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. 2: now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn. do 2 eexists; repeat split; simpl_surject; eauto. } intros tmid6 () (HApp&HAppInj); TMSimp. modpon HApp. exists (MoveValue_steps _ _ (H++[Some(g,b)]) H), (1 + Reset_steps _ (Some (g, b)) + Reset_steps _ g). - cbn; repeat split; try omega. 2: now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn. do 2 eexists; repeat split; simpl_surject; eauto. now rewrite (MoveValue_steps_comp Encode_Heap Encode_Heap retr_heap_step retr_heap_step). } intros tmid7 () (HMove&HMoveInj); TMSimp. modpon HMove. exists (Reset_steps _ (Some (g, b))), (Reset_steps _ g). - cbn; repeat split; try omega. - { hnf; cbn. exists (Some (g, b)). split; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. } reflexivity. (* oh omega... *) + cbn; repeat split; try lia. + { hnf; cbn. exists (Some (g, b)). split; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. } reflexivity. (* oh lia... *) intros tmid8 () (HReset&HResetInj); TMSimp. specialize (HReset (Some (g,b))); modpon HReset. { hnf; cbn. exists g. repeat split; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. } } @@ -590,33 +590,33 @@ Section StepMachine. { intros tin k. intros (T&V&H&P&a&HEncT&HEncV&HEncH&HEncP&HEncA&HInt&Hk). unfold Step_app_steps in Hk. exists (CaseList_steps _ V), (Step_app_steps_CaseList T V H P a). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { exists V. repeat split; simpl_surject; eauto. apply HInt. } intros tmid bml1 (HCaseList&HCaseListInj); TMSimp. modpon HCaseList. destruct bml1, V as [ | g V']; auto; modpon HCaseList. { unfold Step_app_steps_CaseList. exists (CaseList_steps _ V'), (Step_app_steps_CaseList' T g V' H P a). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { exists V'. repeat split; simpl_surject; eauto. } intros tmid1 bml2 (HCaseList'&HCaseListInj'); TMSimp. modpon HCaseList'. destruct bml2, V' as [ | (b, Q) V'']; auto; modpon HCaseList'. { unfold Step_app_steps_CaseList'. exists (CasePair_steps _ b), (1 + TailRec_steps P a + 1 + Reset_steps _ a + 1 + Put_steps H g b + ConsClos_steps Q (length H)). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { hnf; cbn. exists (b, Q). repeat split; simpl_surject; eauto. contains_ext. } intros tmid2 () (HCasePair&HCasePairInj); TMSimp. specialize (HCasePair (b,Q)); modpon HCasePair. exists (TailRec_steps P a), (1 + Reset_steps _ a + 1 + Put_steps H g b + ConsClos_steps Q (length H)). - cbn; repeat split; try omega. 2: now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn. do 3 eexists. repeat split; simpl_surject; eauto. } intros tmid3 () (HTailRec&HTailRecInj); TMSimp. modpon HTailRec. exists (Reset_steps _ a), (1 + Put_steps H g b + ConsClos_steps Q (length H)). - cbn; repeat split; try omega. 2: now rewrite !Nat.add_assoc. + cbn; repeat split; try lia. 2: now rewrite !Nat.add_assoc. { hnf; cbn. do 1 eexists. repeat split; simpl_surject; eauto. now setoid_rewrite Reset_steps_comp. } intros tmid4 () (HReset&HResetInj); TMSimp. modpon HReset. exists (Put_steps H g b), (ConsClos_steps Q (length H)). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { hnf; cbn. do 3 eexists. repeat split; simpl_surject; eauto; contains_ext. } intros tmid5 () (HPut&HInjPut); TMSimp. modpon HPut. { hnf; cbn. do 3 eexists. repeat split; simpl_surject; eauto; contains_ext. } @@ -715,11 +715,11 @@ Section StepMachine. { intros tin k. intros (T&V&H&a&n&P&HEncT&HEncV&HEncH&HEncP&HEncA&HEncN&HRight6&HRigth7&Hk). unfold Step_var_steps in Hk. exists (TailRec_steps P a), (1 + Lookup_steps H a n + Step_var_steps_Lookup P V H a n). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { hnf; cbn. do 3 eexists; repeat split; eauto. } intros tmid () (HTailRec&HTailRecInj); TMSimp. modpon HTailRec. exists (Lookup_steps H a n), (Step_var_steps_Lookup P V H a n). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { hnf; cbn. do 3 eexists; repeat split; eauto. } intros tmid0 ymid (HLookup&HLookupInj); TMSimp. modpon HLookup. destruct ymid. @@ -727,12 +727,12 @@ Section StepMachine. destruct HLookup as (g&HLookup); modpon HLookup. unfold Step_var_steps_Lookup. rewrite HLookup. exists (Constr_cons_steps _ g), (Reset_steps _ g). - cbn; repeat split; try omega. + cbn; repeat split; try lia. { hnf; cbn. do 2 eexists; repeat split; simpl_surject; eauto. contains_ext. } intros tmid1 () (HCons&HConsInj); TMSimp. modpon HCons. { hnf; cbn. do 1 eexists; repeat split; simpl_surject; eauto. contains_ext. now setoid_rewrite Reset_steps_comp. } } - { omega. } + { lia. } } Qed. @@ -904,18 +904,18 @@ Section StepMachine. } { intros tin k (T&V&H&HEncT&HEncV&HEncH&HInt&Hk). unfold Step_steps in Hk. - exists (CaseList_steps _ T), (Step_steps_CaseList T V H). cbn; repeat split; try omega. + exists (CaseList_steps _ T), (Step_steps_CaseList T V H). cbn; repeat split; try lia. { do 1 eexists; repeat split; simpl_surject; eauto. apply HInt. } intros tmid bif (HCaseList&HCaseListInj); TMSimp. modpon HCaseList. destruct bif, T as [ | (a,P) T']; cbn; auto; modpon HCaseList. - exists (CasePair_steps _ a), (1 + CaseList_steps _ P + Step_steps_CaseList' a P T' V H). cbn; repeat split; try omega. + exists (CasePair_steps _ a), (1 + CaseList_steps _ P + Step_steps_CaseList' a P T' V H). cbn; repeat split; try lia. { hnf; cbn. exists (a, P); repeat split; simpl_surject; eauto. contains_ext. } intros tmid0 () (HCasePair&HCasePairInj); TMSimp. specialize (HCasePair (a,P)). modpon HCasePair. cbn in *. - exists (CaseList_steps _ P), (Step_steps_CaseList' a P T' V H). cbn; repeat split; try omega. 2: reflexivity. + exists (CaseList_steps _ P), (Step_steps_CaseList' a P T' V H). cbn; repeat split; try lia. 2: reflexivity. { hnf; cbn. exists P; repeat split; simpl_surject; eauto. contains_ext. } intros tmid1 bif (HCaseList'&HCaseListInj'); TMSimp. modpon HCaseList'. destruct bif, P as [ | t P']; auto; modpon HCaseList'. cbn. - exists (CaseCom_steps), (Step_steps_CaseCom a t P' T' V H). cbn; repeat split; try omega. + exists (CaseCom_steps), (Step_steps_CaseCom a t P' T' V H). cbn; repeat split; try lia. intros tmid2 ymid (HCaseCom&HCaseComInj); TMSimp. modpon HCaseCom. destruct ymid as [ [ | | ] | ]; destruct t; cbn; auto; simpl_surject. - hnf; cbn. do 5 eexists; repeat split; TMSimp_goal; eauto. contains_ext. intros i; destruct_fin i; cbn; TMSimp_goal; auto. diff --git a/theories/TM/Lifting/LiftAlphabet.v b/theories/TM/Lifting/LiftAlphabet.v index aec289d..c49fccc 100644 --- a/theories/TM/Lifting/LiftAlphabet.v +++ b/theories/TM/Lifting/LiftAlphabet.v @@ -13,7 +13,7 @@ Section SujectTape. End SujectTape. -Hint Unfold surjectTape : tape. +#[export] Hint Unfold surjectTape : tape. Section lift_sigma_tau. @@ -41,7 +41,7 @@ Section lift_sigma_tau. End lift_sigma_tau. Arguments surjectTapes {n sig tau} (g) def !t. -Hint Rewrite surjectTapes_nth : tape. +#[export] Hint Rewrite surjectTapes_nth : tape. Arguments lift_sigma_tau_Rel {n sig tau} (g def) {F} (R) x y /. diff --git a/theories/TM/Prelim.v b/theories/TM/Prelim.v index bf73061..d40e1b0 100644 --- a/theories/TM/Prelim.v +++ b/theories/TM/Prelim.v @@ -1,14 +1,14 @@ -Require Export Shared.FiniteTypes.FinTypes Shared.FiniteTypes.BasicFinTypes Shared.FiniteTypes.CompoundFinTypes Shared.FiniteTypes.VectorFin. -Require Export Shared.Vectors.FinNotation. -Require Export Shared.Retracts. -Require Export Shared.Inhabited. -Require Export Shared.Base. -Require Export Shared.Vectors.Vectors Shared.Vectors.VectorDupfree. +Require Export PslBase.FiniteTypes.FinTypes PslBase.FiniteTypes.BasicFinTypes PslBase.FiniteTypes.CompoundFinTypes PslBase.FiniteTypes.VectorFin. +Require Export PslBase.Vectors.FinNotation. +Require Export PslBase.Retracts. +Require Export PslBase.Inhabited. +Require Export PslBase.Base. +Require Export PslBase.Vectors.Vectors PslBase.Vectors.VectorDupfree. Require Export smpl.Smpl. Global Open Scope vector_scope. - +Export VectorNotations2. Section Loop. Variable (A : Type) (f : A -> A) (p : A -> bool). @@ -68,8 +68,8 @@ Section Loop. - destruct (p a) eqn:E. + inv HLoop. now apply loop_0. + destruct k2 as [ | k2']; cbn in *; rewrite E. - * exfalso. omega. - * apply IH. assumption. omega. + * exfalso. lia. + * apply IH. assumption. lia. Qed. End Loop. @@ -130,7 +130,7 @@ Section LoopMerge. revert a1 a2 a3. induction k1 as [ | k1' IH]; intros a1 a2 a3 HLoop1 HLoop2; cbn in HLoop1. - now destruct (h a1); inv HLoop1. - destruct (h a1) eqn:E. - + inv HLoop1. eapply loop_monotone; eauto. omega. + + inv HLoop1. eapply loop_monotone; eauto. lia. + cbn. rewrite (halt_comp E). eapply IH; eauto. Qed. @@ -151,8 +151,8 @@ Section LoopMerge. - destruct (h a1) eqn:E. + exists 0, a1, (S k'). cbn. rewrite E. auto. + rewrite (halt_comp E) in HLoop. - apply IH in HLoop as (k1&c2&k2&IH1&IH2&IH3); [ | omega]. - exists (S k1), c2, k2. cbn. rewrite E. repeat split; auto. omega. + apply IH in HLoop as (k1&c2&k2&IH1&IH2&IH3); [ | lia]. + exists (S k1), c2, k2. cbn. rewrite E. repeat split; auto. lia. Qed. End LoopMerge. diff --git a/theories/TM/Relations.v b/theories/TM/Relations.v index 181de12..8abcffb 100644 --- a/theories/TM/Relations.v +++ b/theories/TM/Relations.v @@ -1,5 +1,5 @@ -Require Import Shared.Base Shared.FiniteTypes TM.Prelim. -Require Import Shared.Vectors.Vectors. +Require Import PslBase.Base PslBase.FiniteTypes TM.Prelim. +Require Import PslBase.Vectors.Vectors. (** * Relations *) @@ -46,7 +46,7 @@ Definition functional X Z (R : Rel X Z) := Definition subrel X Y (R S: Rel X Y) := (forall x y, R x y -> S x y). Notation "R1 <<=2 R2" := (subrel R1 R2) (at level 60). -Instance eqrel_pre X Y : PreOrder (subrel (X := X) (Y := Y)). +#[export] Instance eqrel_pre X Y : PreOrder (subrel (X := X) (Y := Y)). Proof. constructor; firstorder. Qed. Fact subrel_and X Y (R1 R2 R3 : Rel X Y) : @@ -69,7 +69,7 @@ Definition eqrel X Y (R S: Rel X Y) := (R <<=2 S /\ S <<=2 R) . Notation "R '=2' S" := (eqrel R S) (at level 70). -Instance eqrel_eq X Y : Equivalence (eqrel (X := X) (Y := Y)). +#[export] Instance eqrel_eq X Y : Equivalence (eqrel (X := X) (Y := Y)). Proof. constructor; firstorder. Qed. (** ** Relational operators on labelled relations *) @@ -97,8 +97,8 @@ Section Fix_X2. Definition Eq_in (f : Fin.t n -> Prop) : Rel (V X) (V X) := fun vx vy => forall i : Fin.t n, f i -> vy[@i] = vx[@i]. - Instance Eq_in_equivalence X (f : Fin.t n -> Prop) : - Equivalence (@Eq_in X). + Instance Eq_in_equivalence (f : Fin.t n -> Prop) : + Equivalence (@Eq_in f). Proof. econstructor. - econstructor. diff --git a/theories/TM/TM.v b/theories/TM/TM.v index 3d0a272..a74086f 100644 --- a/theories/TM/TM.v +++ b/theories/TM/TM.v @@ -3,7 +3,7 @@ (** Definitions of tapes and (unlabelled) multi-tape Turing machines from Asperti, Riciotti "A formalization of multi-tape Turing machines" (2015) and the accompanying Matita code. *) Require Export TM.Prelim TM.Relations. -Require Import Shared.Vectors.Vectors. +Require Import PslBase.Vectors.Vectors. Section Fix_Sigma. @@ -229,14 +229,14 @@ Tactic Notation "simpl_vector" "in" "*" := simpl_vector. -Hint Rewrite tapeToList_move : tape. -Hint Rewrite tapeToList_move_R : tape. -Hint Rewrite tapeToList_move_L : tape. -Hint Rewrite tape_move_right_left using eauto : tape. -Hint Rewrite tape_move_left_right using eauto : tape. +#[export] Hint Rewrite tapeToList_move : tape. +#[export] Hint Rewrite tapeToList_move_R : tape. +#[export] Hint Rewrite tapeToList_move_L : tape. +#[export] Hint Rewrite tape_move_right_left using eauto : tape. +#[export] Hint Rewrite tape_move_left_right using eauto : tape. Arguments current_chars : simpl never. -Hint Unfold current_chars : tape. +#[export] Hint Unfold current_chars : tape. @@ -248,10 +248,10 @@ Lemma nth_map2' (A B C : Type) (f : A -> B -> C) (n : nat) (v1 : Vector.t A n) ( (VectorDef.map2 f v1 v2)[@k] = f v1[@k] v2[@k]. Proof. erewrite VectorSpec.nth_map2; eauto. Qed. -Hint Rewrite @nth_map' : vector. -Hint Rewrite @nth_map2' : vector. -Hint Rewrite @nth_tabulate : vector. -Hint Rewrite VectorSpec.const_nth : vector. +#[export] Hint Rewrite @nth_map' : vector. +#[export] Hint Rewrite @nth_map2' : vector. +#[export] Hint Rewrite @nth_tabulate : vector. +#[export] Hint Rewrite VectorSpec.const_nth : vector. @@ -394,16 +394,16 @@ Section MirrorTape. End MirrorTape. Arguments mirror_tapes : simpl never. -Hint Unfold mirror_tapes : tape. +#[export] Hint Unfold mirror_tapes : tape. -Hint Rewrite mirror_tape_left : tape. -Hint Rewrite mirror_tape_right : tape. -Hint Rewrite mirror_tape_current : tape. -Hint Rewrite mirror_tape_involution : tape. -Hint Rewrite mirror_tape_move_left : tape. -Hint Rewrite mirror_tape_move_right : tape. -Hint Rewrite mirror_tapes_involution : tape. -Hint Rewrite mirror_tapes_nth : tape. +#[export] Hint Rewrite mirror_tape_left : tape. +#[export] Hint Rewrite mirror_tape_right : tape. +#[export] Hint Rewrite mirror_tape_current : tape. +#[export] Hint Rewrite mirror_tape_involution : tape. +#[export] Hint Rewrite mirror_tape_move_left : tape. +#[export] Hint Rewrite mirror_tape_move_right : tape. +#[export] Hint Rewrite mirror_tapes_involution : tape. +#[export] Hint Rewrite mirror_tapes_nth : tape. @@ -527,14 +527,14 @@ Section Tape_Local. End Tape_Local. -Hint Rewrite tape_local_mirror : tape. -Hint Rewrite tape_local_mirror' : tape. -Hint Rewrite tape_local_current_cons using auto : tape. -Hint Rewrite tape_local_l_current_cons using auto : tape. -Hint Rewrite tape_local_right using auto : tape. -Hint Rewrite tape_local_l_left using auto : tape. -Hint Rewrite tape_left_move_right using auto : tape. -Hint Rewrite tape_right_move_left using auto : tape. +#[export] Hint Rewrite tape_local_mirror : tape. +#[export] Hint Rewrite tape_local_mirror' : tape. +#[export] Hint Rewrite tape_local_current_cons using auto : tape. +#[export] Hint Rewrite tape_local_l_current_cons using auto : tape. +#[export] Hint Rewrite tape_local_right using auto : tape. +#[export] Hint Rewrite tape_local_l_left using auto : tape. +#[export] Hint Rewrite tape_left_move_right using auto : tape. +#[export] Hint Rewrite tape_right_move_left using auto : tape. (** ** Mapping tapes *) @@ -614,13 +614,13 @@ End MapTape. (** Rewriting Hints *) -Hint Rewrite mapTape_current : tape. -Hint Rewrite mapTape_left : tape. -Hint Rewrite mapTape_right : tape. -Hint Rewrite mapTape_move_left : tape. -Hint Rewrite mapTape_move_right : tape. +#[export] Hint Rewrite mapTape_current : tape. +#[export] Hint Rewrite mapTape_left : tape. +#[export] Hint Rewrite mapTape_right : tape. +#[export] Hint Rewrite mapTape_move_left : tape. +#[export] Hint Rewrite mapTape_move_right : tape. (* Hint Rewrite mapTapes_nth : tape. *) -Hint Unfold mapTapes : tape. +#[export] Hint Unfold mapTapes : tape. Lemma mapTape_mapTape (sig tau gamma : Type) (f : sig -> tau) (g : tau -> gamma) (t : tape sig) : @@ -634,14 +634,14 @@ Proof. intros H. destruct t; cbn; auto; simpl_tape; rewrite H; f_equal; eapply m Lemma mapTape_id (sig : Type) (t : tape sig) : mapTape (fun x => x) t = t. Proof. destruct t; cbn; auto; f_equal; apply map_id. Qed. -Hint Rewrite mapTape_mapTape : tape. -Hint Rewrite mapTape_id : tape. +#[export] Hint Rewrite mapTape_mapTape : tape. +#[export] Hint Rewrite mapTape_id : tape. Lemma mapTape_local (sig tau : Type) (f : sig -> tau) t : tape_local (mapTape f t) = List.map f (tape_local t). Proof. destruct t; cbn; reflexivity. Qed. -Hint Rewrite mapTape_local : tape. +#[export] Hint Rewrite mapTape_local : tape. @@ -684,14 +684,14 @@ Section MatchTapes. End MatchTapes. -Hint Rewrite tape_right_move_left' : tape. -Hint Rewrite tape_left_move_right' : tape. -Hint Rewrite tape_right_move_right' : tape. -Hint Rewrite tape_left_move_left' : tape. -Hint Rewrite tape_local_move_right' : tape. -Hint Rewrite tape_local_l_move_left' : tape. -Hint Rewrite mirror_tape_move_left' : tape. -Hint Rewrite mirror_tape_move_right' : tape. +#[export] Hint Rewrite tape_right_move_left' : tape. +#[export] Hint Rewrite tape_left_move_right' : tape. +#[export] Hint Rewrite tape_right_move_right' : tape. +#[export] Hint Rewrite tape_left_move_left' : tape. +#[export] Hint Rewrite tape_local_move_right' : tape. +#[export] Hint Rewrite tape_local_l_move_left' : tape. +#[export] Hint Rewrite mirror_tape_move_left' : tape. +#[export] Hint Rewrite mirror_tape_move_right' : tape. @@ -821,12 +821,12 @@ Section Semantics. pM ⊨ R /\ projT1 pM ↓ (fun _ i => k <= i) <-> pM ⊨c(k) R. Proof. split. - - intros (HR & Ht) t. edestruct (Ht t k). cbn; omega. eauto. + - intros (HR & Ht) t. edestruct (Ht t k). cbn; lia. eauto. - intros H. split. + intros t i cout Hc. destruct (H t) as (? & ? & ?). - cutrewrite (cout = x). + replace cout with x. eassumption. unfold loopM in *. eapply loop_injective; eauto.