diff options
| author |  glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-09-17 15:58:14 +0000 |
|---|---|---|
| committer | glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-09-17 15:58:14 +0000 |
| commit | 61ccbc81a2f3b4662ed4a2bad9d07d2003dda3a2 (patch) | |
| tree | 961cc88c714aa91a0276ea9fbf8bc53b2b9d5c28 /theories | |
| parent | 6d3fbdf36c6a47b49c2a4b16f498972c93c07574 (diff) | |
Delete trailing whitespaces in all *.{v,ml*} files
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12337 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'theories')
242 files changed, 7040 insertions, 7040 deletions
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v index 3f96d4341..208c25789 100644 --- a/theories/Arith/Between.v +++ b/theories/Arith/Between.v @@ -17,11 +17,11 @@ Implicit Types k l p q r : nat. Section Between. Variables P Q : nat -> Prop. - + Inductive between k : nat -> Prop := | bet_emp : between k k | bet_S : forall l, between k l -> P l -> between k (S l). - + Hint Constructors between: arith v62. Lemma bet_eq : forall k l, l = k -> between k l. @@ -185,5 +185,5 @@ Section Between. End Between. Hint Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le - in_int_S in_int_intro: arith v62. + in_int_S in_int_intro: arith v62. Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62. diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v index 573f54e9f..a684d5a10 100644 --- a/theories/Arith/Compare_dec.v +++ b/theories/Arith/Compare_dec.v @@ -107,7 +107,7 @@ Qed. Theorem not_lt : forall n m, ~ n < m -> n >= m. Proof. - intros x y H; exact (not_gt y x H). + intros x y H; exact (not_gt y x H). Qed. diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index 4c3b2ff84..999a64544 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -36,7 +36,7 @@ Proof. intros P H0 H1 Hn. cut (forall n, P n /\ P (S n)). intros H'n n. elim (H'n n). auto with arith. - + induction n. auto with arith. intros. elim IHn; auto with arith. Qed. @@ -150,7 +150,7 @@ Proof fun n => proj2 (proj2 (even_odd_double n)). Hint Resolve even_double double_even odd_double double_odd: arith. -(** Application: +(** Application: - if [n] is even then there is a [p] such that [n = 2p] - if [n] is odd then there is a [p] such that [n = 2p+1] diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v index d2a4006a0..eaa1bb2d6 100644 --- a/theories/Arith/Even.v +++ b/theories/Arith/Even.v @@ -17,7 +17,7 @@ Open Local Scope nat_scope. Implicit Types m n : nat. -(** * Definition of [even] and [odd], and basic facts *) +(** * Definition of [even] and [odd], and basic facts *) Inductive even : nat -> Prop := | even_O : even 0 @@ -52,9 +52,9 @@ Qed. (** * Facts about [even] & [odd] wrt. [plus] *) -Lemma even_plus_split : forall n m, +Lemma even_plus_split : forall n m, (even (n + m) -> even n /\ even m \/ odd n /\ odd m) -with odd_plus_split : forall n m, +with odd_plus_split : forall n m, odd (n + m) -> odd n /\ even m \/ even n /\ odd m. Proof. intros. clear even_plus_split. destruct n; simpl in *. @@ -95,7 +95,7 @@ Proof. intros n m H; destruct (even_plus_split n m) as [[]|[]]; auto. intro; destruct (not_even_and_odd n); auto. Qed. - + Lemma even_plus_even_inv_l : forall n m, even (n + m) -> even m -> even n. Proof. intros n m H; destruct (even_plus_split n m) as [[]|[]]; auto. @@ -120,13 +120,13 @@ Proof. intros n m H; destruct (odd_plus_split n m) as [[]|[]]; auto. intro; destruct (not_even_and_odd m); auto. Qed. - + Lemma odd_plus_even_inv_r : forall n m, odd (n + m) -> odd n -> even m. Proof. intros n m H; destruct (odd_plus_split n m) as [[]|[]]; auto. intro; destruct (not_even_and_odd n); auto. Qed. - + Lemma odd_plus_odd_inv_l : forall n m, odd (n + m) -> even m -> odd n. Proof. intros n m H; destruct (odd_plus_split n m) as [[]|[]]; auto. @@ -203,7 +203,7 @@ Proof. intros n m; case (even_mult_aux n m); auto. intros H H0; case H0; auto. Qed. - + Lemma even_mult_r : forall n m, even m -> even (n * m). Proof. intros n m; case (even_mult_aux n m); auto. @@ -219,7 +219,7 @@ Proof. intros H'3; elim H'3; auto. intros H; case (not_even_and_odd n); auto. Qed. - + Lemma even_mult_inv_l : forall n m, even (n * m) -> odd m -> even n. Proof. intros n m H' H'0. @@ -228,13 +228,13 @@ Proof. intros H'3; elim H'3; auto. intros H; case (not_even_and_odd m); auto. Qed. - + Lemma odd_mult : forall n m, odd n -> odd m -> odd (n * m). Proof. intros n m; case (even_mult_aux n m); intros H; case H; auto. Qed. Hint Resolve even_mult_l even_mult_r odd_mult: arith. - + Lemma odd_mult_inv_l : forall n m, odd (n * m) -> odd n. Proof. intros n m H'. diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v index 5d6e231c5..1fb5b3e55 100644 --- a/theories/Arith/Lt.v +++ b/theories/Arith/Lt.v @@ -26,7 +26,7 @@ Theorem lt_irrefl : forall n, ~ n < n. Proof le_Sn_n. Hint Resolve lt_irrefl: arith v62. -(** * Relationship between [le] and [lt] *) +(** * Relationship between [le] and [lt] *) Theorem lt_le_S : forall n m, n < m -> S n <= m. Proof. diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v index e43b804e5..dcc973a96 100644 --- a/theories/Arith/Max.v +++ b/theories/Arith/Max.v @@ -25,7 +25,7 @@ Fixpoint max n m {struct n} : nat := (** * Inductive characterization of [max] *) -Lemma max_case_strong : forall n m (P:nat -> Type), +Lemma max_case_strong : forall n m (P:nat -> Type), (m<=n -> P n) -> (n<=m -> P m) -> P (max n m). Proof. induction n; destruct m; simpl in *; auto with arith. @@ -63,7 +63,7 @@ Qed. Lemma plus_max_distr_l : forall n m p, max (p + n) (p + m) = p + max n m. Proof. - induction p; simpl; auto. + induction p; simpl; auto. Qed. Lemma plus_max_distr_r : forall n m p, max (n + p) (m + p) = max n m + p. diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v index 7654c856c..503029015 100644 --- a/theories/Arith/Min.v +++ b/theories/Arith/Min.v @@ -27,7 +27,7 @@ Fixpoint min n m {struct n} : nat := Lemma min_0_l : forall n : nat, min 0 n = 0. Proof. - trivial. + trivial. Qed. Lemma min_0_r : forall n : nat, min n 0 = 0. diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v index 1bf6102e9..b6ea04c01 100644 --- a/theories/Arith/Minus.v +++ b/theories/Arith/Minus.v @@ -120,10 +120,10 @@ Proof. intros n m Hnm; apply le_elim_rel with (n:=n) (m:=m); trivial. intros q; destruct q; auto with arith. - simpl. + simpl. apply le_trans with (m := p - 0); [apply HI | rewrite <- minus_n_O]; auto with arith. - + intros q r Hqr _. simpl. auto using HI. Qed. diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v index 1183dc2ee..7b48ffe05 100644 --- a/theories/Arith/Mult.v +++ b/theories/Arith/Mult.v @@ -43,7 +43,7 @@ Hint Resolve mult_1_l: arith v62. Lemma mult_1_r : forall n, n * 1 = n. Proof. - induction n; [ trivial | + induction n; [ trivial | simpl; rewrite IHn; reflexivity]. Qed. Hint Resolve mult_1_r: arith v62. @@ -118,7 +118,7 @@ Proof. edestruct O_S; eauto. destruct plus_is_one with (1:=H) as [[-> Hnm] | [-> Hnm]]. simpl in H; rewrite mult_0_r in H; elim (O_S _ H). - rewrite mult_1_r in Hnm; auto. + rewrite mult_1_r in Hnm; auto. Qed. (** ** Multiplication and successor *) @@ -176,7 +176,7 @@ Qed. Lemma mult_S_lt_compat_l : forall n m p, m < p -> S n * m < S n * p. Proof. - induction n; intros; simpl in *. + induction n; intros; simpl in *. rewrite <- 2! plus_n_O; assumption. auto using plus_lt_compat. Qed. @@ -219,8 +219,8 @@ Qed. (** * Tail-recursive mult *) -(** [tail_mult] is an alternative definition for [mult] which is - tail-recursive, whereas [mult] is not. This can be useful +(** [tail_mult] is an alternative definition for [mult] which is + tail-recursive, whereas [mult] is not. This can be useful when extracting programs. *) Fixpoint mult_acc (s:nat) m n {struct n} : nat := @@ -244,7 +244,7 @@ Proof. intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto. Qed. -(** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] +(** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] and [mult] and simplify *) Ltac tail_simpl := diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v index 5f7517c75..cba87f9e5 100644 --- a/theories/Arith/Plus.v +++ b/theories/Arith/Plus.v @@ -65,7 +65,7 @@ Qed. Hint Resolve plus_assoc: arith v62. Lemma plus_permute : forall n m p, n + (m + p) = m + (n + p). -Proof. +Proof. intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith. Qed. @@ -179,7 +179,7 @@ Definition plus_is_one : Proof. intro m; destruct m as [| n]; auto. destruct n; auto. - intros. + intros. simpl in H. discriminate H. Defined. @@ -187,14 +187,14 @@ Defined. Lemma plus_permute_2_in_4 : forall n m p q, n + m + (p + q) = n + p + (m + q). Proof. - intros m n p q. + intros m n p q. rewrite <- (plus_assoc m n (p + q)). rewrite (plus_assoc n p q). rewrite (plus_comm n p). rewrite <- (plus_assoc p n q). apply plus_assoc. Qed. (** * Tail-recursive plus *) -(** [tail_plus] is an alternative definition for [plus] which is +(** [tail_plus] is an alternative definition for [plus] which is tail-recursive, whereas [plus] is not. This can be useful when extracting programs. *) @@ -215,7 +215,7 @@ Lemma succ_plus_discr : forall n m, n <> S (plus m n). Proof. intros n m; induction n as [|n IHn]. discriminate. - intro H; apply IHn; apply eq_add_S; rewrite H; rewrite <- plus_n_Sm; + intro H; apply IHn; apply eq_add_S; rewrite H; rewrite <- plus_n_Sm; reflexivity. Qed. diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v index e87901080..d142cb77f 100644 --- a/theories/Arith/Wf_nat.v +++ b/theories/Arith/Wf_nat.v @@ -46,9 +46,9 @@ Defined. (** It is possible to directly prove the induction principle going back to primitive recursion on natural numbers ([induction_ltof1]) or to use the previous lemmas to extract a program with a fixpoint - ([induction_ltof2]) + ([induction_ltof2]) -the ML-like program for [induction_ltof1] is : +the ML-like program for [induction_ltof1] is : [[ let induction_ltof1 f F a = let rec indrec n k = @@ -58,7 +58,7 @@ let induction_ltof1 f F a = in indrec (f a + 1) a ]] -the ML-like program for [induction_ltof2] is : +the ML-like program for [induction_ltof2] is : [[ let induction_ltof2 F a = indrec a where rec indrec a = F a indrec;; @@ -78,7 +78,7 @@ Proof. unfold ltof in |- *; intros b ltfafb. apply IHn. apply lt_le_trans with (f a); auto with arith. -Defined. +Defined. Theorem induction_gtof1 : forall P:A -> Set, @@ -271,8 +271,8 @@ Fixpoint iter_nat (n:nat) (A:Type) (f:A -> A) (x:A) {struct n} : A := Theorem iter_nat_plus : forall (n m:nat) (A:Type) (f:A -> A) (x:A), iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x). -Proof. +Proof. simple induction n; [ simpl in |- *; auto with arith - | intros; simpl in |- *; apply f_equal with (f := f); apply H ]. + | intros; simpl in |- *; apply f_equal with (f := f); apply H ]. Qed. diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v index dcb10f3cf..bc42c6564 100644 --- a/theories/Bool/Bool.v +++ b/theories/Bool/Bool.v @@ -39,7 +39,7 @@ Qed. Hint Resolve diff_true_false : bool v62. Lemma diff_false_true : false <> true. -Proof. +Proof. red in |- *; intros H; apply diff_true_false. symmetry in |- *. assumption. @@ -129,7 +129,7 @@ Qed. (************************) (** * A synonym of [if] on [bool] *) (************************) - + Definition ifb (b1 b2 b3:bool) : bool := match b1 with | true => b2 @@ -186,7 +186,7 @@ Proof. trivial with bool. trivial with bool. Qed. - + Lemma eqb_negb2 : forall b:bool, eqb b (negb b) = false. Proof. destruct b. @@ -318,7 +318,7 @@ Hint Resolve orb_comm orb_assoc: bool v62. (** * Properties of [andb] *) (*******************************) -Lemma andb_true_iff : +Lemma andb_true_iff : forall b1 b2:bool, b1 && b2 = true <-> b1 = true /\ b2 = true. Proof. destruct b1; destruct b2; intuition. @@ -382,7 +382,7 @@ Hint Resolve andb_false_elim: bool v62. Lemma andb_negb_r : forall b:bool, b && negb b = false. Proof. destruct b; reflexivity. -Qed. +Qed. Hint Resolve andb_negb_r: bool v62. Notation andb_neg_b := andb_negb_r (only parsing). @@ -542,8 +542,8 @@ Qed. (** Lemmas about the [b = true] embedding of [bool] to [Prop] *) -Lemma eq_true_iff_eq : forall b1 b2, (b1 = true <-> b2 = true) -> b1 = b2. -Proof. +Lemma eq_true_iff_eq : forall b1 b2, (b1 = true <-> b2 = true) -> b1 = b2. +Proof. intros b1 b2; case b1; case b2; intuition. Qed. @@ -556,7 +556,7 @@ Qed. Notation bool_3 := eq_true_negb_classical (only parsing). (* Compatibility *) -Lemma eq_true_not_negb : forall b:bool, b <> true -> negb b = true. +Lemma eq_true_not_negb : forall b:bool, b <> true -> negb b = true. Proof. destruct b; intuition. Qed. @@ -628,7 +628,7 @@ Qed. (** [Is_true] and connectives *) -Lemma orb_prop_elim : +Lemma orb_prop_elim : forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b. Proof. destruct a; destruct b; simpl; tauto. @@ -636,7 +636,7 @@ Qed. Notation orb_prop2 := orb_prop_elim (only parsing). -Lemma orb_prop_intro : +Lemma orb_prop_intro : forall a b:bool, Is_true a \/ Is_true b -> Is_true (a || b). Proof. destruct a; destruct b; simpl; tauto. @@ -663,16 +663,16 @@ Hint Resolve andb_prop_elim: bool v62. Notation andb_prop2 := andb_prop_elim (only parsing). -Lemma eq_bool_prop_intro : - forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2. -Proof. +Lemma eq_bool_prop_intro : + forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2. +Proof. destruct b1; destruct b2; simpl in *; intuition. Qed. Lemma eq_bool_prop_elim : forall b1 b2, b1 = b2 -> (Is_true b1 <-> Is_true b2). -Proof. +Proof. intros b1 b2; case b1; case b2; intuition. -Qed. +Qed. Lemma negb_prop_elim : forall b, Is_true (negb b) -> ~ Is_true b. Proof. @@ -696,26 +696,26 @@ Qed. (** Rewrite rules about andb, orb and if (used in romega) *) -Lemma andb_if : forall (A:Type)(a a':A)(b b' : bool), - (if b && b' then a else a') = +Lemma andb_if : forall (A:Type)(a a':A)(b b' : bool), + (if b && b' then a else a') = (if b then if b' then a else a' else a'). Proof. destruct b; destruct b'; auto. Qed. -Lemma negb_if : forall (A:Type)(a a':A)(b:bool), - (if negb b then a else a') = +Lemma negb_if : forall (A:Type)(a a':A)(b:bool), + (if negb b then a else a') = (if b then a' else a). Proof. destruct b; auto. Qed. (*****************************************) -(** * Alternative versions of [andb] and [orb] +(** * Alternative versions of [andb] and [orb] with lazy behavior (for vm_compute) *) (*****************************************) -Notation "a &&& b" := (if a then b else false) +Notation "a &&& b" := (if a then b else false) (at level 40, left associativity) : lazy_bool_scope. Notation "a ||| b" := (if a then true else b) (at level 50, left associativity) : lazy_bool_scope. diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v index 9dbd90f05..2682a8848 100644 --- a/theories/Bool/Bvector.v +++ b/theories/Bool/Bvector.v @@ -16,7 +16,7 @@ Require Import Arith. Open Local Scope nat_scope. -(** +(** On s'inspire de List.v pour fabriquer les vecteurs de bits. La dimension du vecteur est un paramètre trop important pour se contenter de la fonction "length". @@ -27,22 +27,22 @@ La seconde idée est de faire un type dépendant dans lequel la longueur est un paramètre de construction. Cela complique un peu les inductions structurelles et dans certains cas on utilisera un terme de preuve comme définition, car le -mécanisme d'inférence du type du filtrage n'est pas toujours +mécanisme d'inférence du type du filtrage n'est pas toujours aussi puissant que celui implanté par les tactiques d'élimination. *) Section VECTORS. -(** +(** Un vecteur est une liste de taille n d'éléments d'un ensemble A. -Si la taille est non nulle, on peut extraire la première composante et -le reste du vecteur, la dernière composante ou rajouter ou enlever +Si la taille est non nulle, on peut extraire la première composante et +le reste du vecteur, la dernière composante ou rajouter ou enlever une composante (carry) ou repeter la dernière composante en fin de vecteur. On peut aussi tronquer le vecteur de ses p dernières composantes ou au contraire l'étendre (concaténer) d'un vecteur de longueur p. Une fonction unaire sur A génère une fonction des vecteurs de taille n dans les vecteurs de taille n en appliquant f terme à terme. -Une fonction binaire sur A génère une fonction des couples de vecteurs +Une fonction binaire sur A génère une fonction des couples de vecteurs de taille n dans les vecteurs de taille n en appliquant f terme à terme. *) @@ -93,7 +93,7 @@ Lemma Vshiftin : forall n:nat, A -> vector n -> vector (S n). Proof. induction n as [| n f]; intros a v. exact (Vcons a 0 v). - + inversion v as [| a0 n0 H0 H1 ]. exact (Vcons a (S n) (f a H0)). Defined. @@ -103,7 +103,7 @@ Proof. induction n as [| n f]; intro v. inversion v. exact (Vcons a 1 v). - + inversion v as [| a n0 H0 H1 ]. exact (Vcons a (S (S n)) (f H0)). Defined. @@ -113,9 +113,9 @@ Proof. induction p as [| p f]; intros H v. rewrite <- minus_n_O. exact v. - + apply (Vshiftout (n - S p)). - + rewrite minus_Sn_m. apply f. auto with *. @@ -147,7 +147,7 @@ Lemma Vbinary : forall n:nat, vector n -> vector n -> vector n. Proof. induction n as [| n h]; intros v v0. exact Vnil. - + inversion v as [| a n0 H0 H1]; inversion v0 as [| a0 n1 H2 H3]. exact (Vcons (g a a0) n (h H0 H2)). Defined. @@ -180,7 +180,7 @@ Qed. End VECTORS. -(* suppressed: incompatible with Coq-Art book +(* suppressed: incompatible with Coq-Art book Implicit Arguments Vnil [A]. Implicit Arguments Vcons [A n]. *) @@ -188,12 +188,12 @@ Implicit Arguments Vcons [A n]. Section BOOLEAN_VECTORS. (** -Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. +Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. ATTENTION : le stockage s'effectue poids FAIBLE en tête. On en extrait le bit de poids faible (head) et la fin du vecteur (tail). On calcule la négation d'un vecteur, le et, le ou et le xor bit à bit de 2 vecteurs. On calcule les décalages d'une position vers la gauche (vers les poids forts, on -utilise donc Vshiftout, vers la droite (vers les poids faibles, on utilise Vshiftin) en +utilise donc Vshiftout, vers la droite (vers les poids faibles, on utilise Vshiftin) en insérant un bit 'carry' (logique) ou en répétant le bit de poids fort (arithmétique). ATTENTION : Tous les décalages prennent la taille moins un comme paramètre (ils ne travaillent que sur des vecteurs au moins de longueur un). diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v index 03aa8baeb..06ab77cfb 100644 --- a/theories/Bool/Sumbool.v +++ b/theories/Bool/Sumbool.v @@ -39,18 +39,18 @@ Defined. Section connectives. Variables A B C D : Prop. - + Hypothesis H1 : {A} + {B}. Hypothesis H2 : {C} + {D}. - + Definition sumbool_and : {A /\ C} + {B \/ D}. case H1; case H2; auto. Defined. - + Definition sumbool_or : {A \/ C} + {B /\ D}. case H1; case H2; auto. Defined. - + Definition sumbool_not : {B} + {A}. case H1; auto. Defined. diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v index 6ce34535e..4b9b26384 100644 --- a/theories/Classes/EquivDec.v +++ b/theories/Classes/EquivDec.v @@ -18,7 +18,7 @@ Require Export Coq.Classes.Equivalence. -(** The [DecidableSetoid] class asserts decidability of a [Setoid]. It can be useful in proofs to reason more +(** The [DecidableSetoid] class asserts decidability of a [Setoid]. It can be useful in proofs to reason more classically. *) Require Import Coq.Logic.Decidable. @@ -43,8 +43,8 @@ Notation " x == y " := (equiv_dec (x :>) (y :>)) (no associativity, at level 70) Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } := match x with - | left H => @right _ _ H - | right H => @left _ _ H + | left H => @right _ _ H + | right H => @left _ _ H end. Open Local Scope program_scope. @@ -89,34 +89,34 @@ Obligation Tactic := unfold complement, equiv ; program_simpl. Program Instance prod_eqdec `(EqDec A eq, EqDec B eq) : ! EqDec (prod A B) eq := { equiv_dec x y := - let '(x1, x2) := x in - let '(y1, y2) := y in - if x1 == y1 then + let '(x1, x2) := x in + let '(y1, y2) := y in + if x1 == y1 then if x2 == y2 then in_left else in_right else in_right }. Program Instance sum_eqdec `(EqDec A eq, EqDec B eq) : EqDec (sum A B) eq := { - equiv_dec x y := + equiv_dec x y := match x, y with | inl a, inl b => if a == b then in_left else in_right | inr a, inr b => if a == b then in_left else in_right | inl _, inr _ | inr _, inl _ => in_right end }. -(** Objects of function spaces with countable domains like bool have decidable equality. +(** Objects of function spaces with countable domains like bool have decidable equality. Proving the reflection requires functional extensionality though. *) Program Instance bool_function_eqdec `(EqDec A eq) : ! EqDec (bool -> A) eq := - { equiv_dec f g := + { equiv_dec f g := if f true == g true then if f false == g false then in_left else in_right else in_right }. Next Obligation. - Proof. + Proof. extensionality x. destruct x ; auto. Qed. @@ -124,11 +124,11 @@ Program Instance bool_function_eqdec `(EqDec A eq) : ! EqDec (bool -> A) eq := Require Import List. Program Instance list_eqdec `(eqa : EqDec A eq) : ! EqDec (list A) eq := - { equiv_dec := + { equiv_dec := fix aux (x : list A) y { struct x } := match x, y with | nil, nil => in_left - | cons hd tl, cons hd' tl' => + | cons hd tl, cons hd' tl' => if hd == hd' then if aux tl tl' then in_left else in_right else in_right diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v index 100ddbe3e..aa20ebd49 100644 --- a/theories/Classes/Equivalence.v +++ b/theories/Classes/Equivalence.v @@ -7,10 +7,10 @@ (************************************************************************) (* Typeclass-based setoids. Definitions on [Equivalence]. - + Author: Matthieu Sozeau Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud - 91405 Orsay, France *) + 91405 Orsay, France *) (* $Id$ *) @@ -34,7 +34,7 @@ Definition equiv `{Equivalence A R} : relation A := R. Notation " x === y " := (equiv x y) (at level 70, no associativity) : equiv_scope. Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity) : equiv_scope. - + Open Local Scope equiv_scope. (** Overloading for [PER]. *) @@ -60,7 +60,7 @@ Program Instance equiv_transitive `(sa : Equivalence A) : Transitive equiv. (** Use the [substitute] command which substitutes an equivalence in every hypothesis. *) -Ltac setoid_subst H := +Ltac setoid_subst H := match type of H with ?x === ?y => substitute H ; clear H x end. @@ -70,7 +70,7 @@ Ltac setoid_subst_nofail := | [ H : ?x === ?y |- _ ] => setoid_subst H ; setoid_subst_nofail | _ => idtac end. - + (** [subst*] will try its best at substituting every equality in the goal. *) Tactic Notation "subst" "*" := subst_no_fail ; setoid_subst_nofail. @@ -100,19 +100,19 @@ Ltac equivify := repeat equivify_tac. Section Respecting. - (** Here we build an equivalence instance for functions which relates respectful ones only, + (** Here we build an equivalence instance for functions which relates respectful ones only, we do not export it. *) - Definition respecting `(eqa : Equivalence A (R : relation A), eqb : Equivalence B (R' : relation B)) : Type := + Definition respecting `(eqa : Equivalence A (R : relation A), eqb : Equivalence B (R' : relation B)) : Type := { morph : A -> B | respectful R R' morph morph }. - + Program Instance respecting_equiv `(eqa : Equivalence A R, eqb : Equivalence B R') : Equivalence (fun (f g : respecting eqa eqb) => forall (x y : A), R x y -> R' (proj1_sig f x) (proj1_sig g y)). - + Solve Obligations using unfold respecting in * ; simpl_relation ; program_simpl. Next Obligation. - Proof. + Proof. unfold respecting in *. program_simpl. transitivity (y y0); auto. apply H0. reflexivity. Qed. diff --git a/theories/Classes/Functions.v b/theories/Classes/Functions.v index b92e4d174..80d60d658 100644 --- a/theories/Classes/Functions.v +++ b/theories/Classes/Functions.v @@ -7,7 +7,7 @@ (************************************************************************) (* Functional morphisms. - + Author: Matthieu Sozeau Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud 91405 Orsay, France *) diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v index 3e2eb4f40..7be92139e 100644 --- a/theories/Classes/Init.v +++ b/theories/Classes/Init.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* Initialization code for typeclasses, setting up the default tactic +(* Initialization code for typeclasses, setting up the default tactic for instance search. Author: Matthieu Sozeau @@ -25,7 +25,7 @@ Typeclasses Opaque id const flip compose arrow impl iff not all. Ltac class_apply c := autoapply c using typeclass_instances. -(** The unconvertible typeclass, to test that two objects of the same type are +(** The unconvertible typeclass, to test that two objects of the same type are actually different. *) Class Unconvertible (A : Type) (a b : A) := unconvertible : unit. diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v index 595ad1297..55aad6e73 100644 --- a/theories/Classes/Morphisms.v +++ b/theories/Classes/Morphisms.v @@ -8,7 +8,7 @@ (************************************************************************) (* Typeclass-based morphism definition and standard, minimal instances. - + Author: Matthieu Sozeau Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud 91405 Orsay, France *) @@ -22,11 +22,11 @@ Require Export Coq.Classes.RelationClasses. (** * Morphisms. - We now turn to the definition of [Proper] and declare standard instances. + We now turn to the definition of [Proper] and declare standard instances. These will be used by the [setoid_rewrite] tactic later. *) (** A morphism for a relation [R] is a proper element of the relation. - The relation [R] will be instantiated by [respectful] and [A] by an arrow type + The relation [R] will be instantiated by [respectful] and [A] by an arrow type for usual morphisms. *) Class Proper {A} (R : relation A) (m : A) : Prop := @@ -36,12 +36,12 @@ Class Proper {A} (R : relation A) (m : A) : Prop := (** The fully dependent version, not used yet. *) -Definition respectful_hetero - (A B : Type) - (C : A -> Type) (D : B -> Type) - (R : A -> B -> Prop) - (R' : forall (x : A) (y : B), C x -> D y -> Prop) : - (forall x : A, C x) -> (forall x : B, D x) -> Prop := +Definition respectful_hetero + (A B : Type) + (C : A -> Type) (D : B -> Type) + (R : A -> B -> Prop) + (R' : forall (x : A) (y : B), C x -> D y -> Prop) : + (forall x : A, C x) -> (forall x : B, D x) -> Prop := fun f g => forall x y, R x y -> R' x y (f x) (g y). (** The non-dependent version is an instance where we forget dependencies. *) @@ -59,12 +59,12 @@ Arguments Scope respectful [type_scope type_scope signature_scope signature_scop Module ProperNotations. - Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature)) + Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature)) (right associativity, at level 55) : signature_scope. - + Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature)) (right associativity, at level 55) : signature_scope. - + Notation " R --> R' " := (@respectful _ _ (inverse (R%signature)) (R'%signature)) (right associativity, at level 55) : signature_scope. @@ -74,7 +74,7 @@ Export ProperNotations. Open Local Scope signature_scope. -(** Dependent pointwise lifting of a relation on the range. *) +(** Dependent pointwise lifting of a relation on the range. *) Definition forall_relation {A : Type} {B : A -> Type} (sig : Î a : A, relation (B a)) : relation (Î x : A, B x) := λ f g, Î a : A, sig a (f a) (g a). @@ -83,10 +83,10 @@ Arguments Scope forall_relation [type_scope type_scope signature_scope]. (** Non-dependent pointwise lifting *) -Definition pointwise_relation (A : Type) {B : Type} (R : relation B) : relation (A -> B) := +Definition pointwise_relation (A : Type) {B : Type} (R : relation B) : relation (A -> B) := Eval compute in forall_relation (B:=λ _, B) (λ _, R). -Lemma pointwise_pointwise A B (R : relation B) : +Lemma pointwise_pointwise A B (R : relation B) : relation_equivalence (pointwise_relation A R) (@eq A ==> R). Proof. intros. split. simpl_relation. firstorder. Qed. @@ -124,7 +124,7 @@ Proof. simpl_relation. apply subr. apply H. apply subl. apply H0. Qed. Lemma subrelation_refl A R : @subrelation A R R. Proof. simpl_relation. Qed. -Ltac subrelation_tac T U := +Ltac subrelation_tac T U := (is_ground T ; is_ground U ; class_apply @subrelation_refl) || class_apply @subrelation_respectful || class_apply @subrelation_refl. @@ -141,13 +141,13 @@ Qed. CoInductive apply_subrelation : Prop := do_subrelation. Ltac proper_subrelation := - match goal with + match goal with [ H : apply_subrelation |- _ ] => clear H ; class_apply @subrelation_proper end. Hint Extern 5 (@Proper _ ?H _) => proper_subrelation : typeclass_instances. -Instance proper_subrelation_proper : +Instance proper_subrelation_proper : Proper (subrelation ++> @eq _ ==> impl) (@Proper A). Proof. reduce. subst. firstorder. Qed. @@ -176,7 +176,7 @@ Program Instance complement_proper intuition. Qed. -(** The [inverse] too, actually the [flip] instance is a bit more general. *) +(** The [inverse] too, actually the [flip] instance is a bit more general. *) Program Instance flip_proper `(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) : @@ -187,7 +187,7 @@ Program Instance flip_proper apply mor ; auto. Qed. -(** Every Transitive relation gives rise to a binary morphism on [impl], +(** Every Transitive relation gives rise to a binary morphism on [impl], contravariant in the first argument, covariant in the second. *) Program Instance trans_contra_co_morphism @@ -263,13 +263,13 @@ Program Instance PER_morphism `(PER A R) : Proper (R ==> R ==> iff) R | 1. Proof with auto. split ; intros. transitivity x0... transitivity x... symmetry... - + transitivity y... transitivity y0... symmetry... Qed. Lemma symmetric_equiv_inverse `(Symmetric A R) : relation_equivalence R (flip R). Proof. firstorder. Qed. - + Program Instance compose_proper A B C Râ‚€ Râ‚ Râ‚‚ : Proper ((Râ‚ ==> Râ‚‚) ==> (Râ‚€ ==> Râ‚) ==> (Râ‚€ ==> Râ‚‚)) (@compose A B C). @@ -279,7 +279,7 @@ Program Instance compose_proper A B C Râ‚€ Râ‚ Râ‚‚ : unfold compose. apply H. apply H0. apply H1. Qed. -(** Coq functions are morphisms for leibniz equality, +(** Coq functions are morphisms for leibniz equality, applied only if really needed. *) Instance reflexive_eq_dom_reflexive (A : Type) `(Reflexive B R') : @@ -288,13 +288,13 @@ Proof. simpl_relation. Qed. (** [respectful] is a morphism for relation equivalence. *) -Instance respectful_morphism : +Instance respectful_morphism : Proper (relation_equivalence ++> relation_equivalence ++> relation_equivalence) (@respectful A B). Proof. reduce. unfold respectful, relation_equivalence, predicate_equivalence in * ; simpl in *. split ; intros. - + rewrite <- H0. apply H1. rewrite H. @@ -308,10 +308,10 @@ Qed. (** Every element in the carrier of a reflexive relation is a morphism for this relation. We use a proxy class for this case which is used internally to discharge reflexivity constraints. - The [Reflexive] instance will almost always be used, but it won't apply in general to any kind of + The [Reflexive] instance will almost always be used, but it won't apply in general to any kind of [Proper (A -> B) _ _] goal, making proof-search much slower. A cleaner solution would be to be able to set different priorities in different hint bases and select a particular hint database for - resolution of a type class constraint.*) + resolution of a type class constraint.*) Class ProperProxy {A} (R : relation A) (m : A) : Prop := proper_proxy : R m m. @@ -340,7 +340,7 @@ Class PartialApplication. CoInductive normalization_done : Prop := did_normalization. -Ltac partial_application_tactic := +Ltac partial_application_tactic := let rec do_partial_apps H m := match m with | ?m' ?x => class_apply @Reflexive_partial_app_morphism ; [do_partial_apps H m'|clear H] @@ -350,7 +350,7 @@ Ltac partial_application_tactic := let rec do_partial H ar m := match ar with | 0 => do_partial_apps H m - | S ?n' => + | S ?n' => match m with ?m' ?x => do_partial H n' m' end @@ -362,18 +362,18 @@ Ltac partial_application_tactic := let v := eval compute in n in clear n ; let H := fresh in assert(H:Params m' v) by typeclasses eauto ; - let v' := eval compute in v in + let v' := eval compute in v in do_partial H v' m in match goal with | [ _ : normalization_done |- _ ] => fail 1 | [ _ : @Params _ _ _ |- _ ] => fail 1 - | [ |- @Proper ?T _ (?m ?x) ] => - match goal with - | [ _ : PartialApplication |- _ ] => + | [ |- @Proper ?T _ (?m ?x) ] => + match goal with + | [ _ : PartialApplication |- _ ] => class_apply @Reflexive_partial_app_morphism - | _ => - on_morphism (m x) || + | _ => + on_morphism (m x) || (class_apply @Reflexive_partial_app_morphism ; [ pose Build_PartialApplication | idtac ]) end @@ -391,7 +391,7 @@ Qed. (** Special-purpose class to do normalization of signatures w.r.t. inverse. *) -Class Normalizes (A : Type) (m : relation A) (m' : relation A) : Prop := +Class Normalizes (A : Type) (m : relation A) (m' : relation A) : Prop := normalizes : relation_equivalence m m'. (** Current strategy: add [inverse] everywhere and reduce using [subrelation] @@ -408,7 +408,7 @@ Proof. unfold Normalizes. intros. rewrite NA, NB. firstorder. Qed. -Ltac inverse := +Ltac inverse := match goal with | [ |- Normalizes _ (respectful _ _) _ ] => class_apply @inverse_arrow | _ => class_apply @inverse_atom @@ -416,7 +416,7 @@ Ltac inverse := Hint Extern 1 (Normalizes _ _ _) => inverse : typeclass_instances. -(** Treating inverse: can't make them direct instances as we +(** Treating inverse: can't make them direct instances as we need at least a [flip] present in the goal. *) Lemma inverse1 `(subrelation A R' R) : subrelation (inverse (inverse R')) R. @@ -477,7 +477,7 @@ Lemma reflexive_proper `{Reflexive A R} (x : A) : Proper R x. Proof. firstorder. Qed. -Lemma proper_eq A (x : A) : Proper (@eq A) x. +Lemma proper_eq A (x : A) : Proper (@eq A) x. Proof. intros. apply reflexive_proper. Qed. Ltac proper_reflexive := diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v index b672651b9..5b61e2c07 100644 --- a/theories/Classes/Morphisms_Prop.v +++ b/theories/Classes/Morphisms_Prop.v @@ -7,7 +7,7 @@ (************************************************************************) (* [Proper] instances for propositional connectives. - + Author: Matthieu Sozeau Institution: LRI, CNRS UMR 8623 - Université Paris Sud 91405 Orsay, France *) @@ -25,7 +25,7 @@ Obligation Tactic := simpl_relation. Program Instance not_impl_morphism : Proper (impl --> impl) not | 1. -Program Instance not_iff_morphism : +Program Instance not_iff_morphism : Proper (iff ++> iff) not. (** Logical conjunction. *) @@ -33,15 +33,15 @@ Program Instance not_iff_morphism : Program Instance and_impl_morphism : Proper (impl ==> impl ==> impl) and | 1. -Program Instance and_iff_morphism : +Program Instance and_iff_morphism : Proper (iff ==> iff ==> iff) and. (** Logical disjunction. *) -Program Instance or_impl_morphism : +Program Instance or_impl_morphism : Proper (impl ==> impl ==> impl) or | 1. -Program Instance or_iff_morphism : +Program Instance or_iff_morphism : Proper (iff ==> iff ==> iff) or. (** Logical implication [impl] is a morphism for logical equivalence. *) @@ -54,11 +54,11 @@ Program Instance ex_iff_morphism {A : Type} : Proper (pointwise_relation A iff = Next Obligation. Proof. - unfold pointwise_relation in H. + unfold pointwise_relation in H. split ; intros. destruct H0 as [xâ‚ Hâ‚]. exists xâ‚. rewrite H in Hâ‚. assumption. - + destruct H0 as [xâ‚ Hâ‚]. exists xâ‚. rewrite H. assumption. Qed. @@ -68,20 +68,20 @@ Program Instance ex_impl_morphism {A : Type} : Next Obligation. Proof. - unfold pointwise_relation in H. + unfold pointwise_relation in H. exists H0. apply H. assumption. Qed. -Program Instance ex_inverse_impl_morphism {A : Type} : +Program Instance ex_inverse_impl_morphism {A : Type} : Proper (pointwise_relation A (inverse impl) ==> inverse impl) (@ex A) | 1. Next Obligation. Proof. - unfold pointwise_relation in H. + unfold pointwise_relation in H. exists H0. apply H. assumption. Qed. -Program Instance all_iff_morphism {A : Type} : +Program Instance all_iff_morphism {A : Type} : Proper (pointwise_relation A iff ==> iff) (@all A). Next Obligation. @@ -90,18 +90,18 @@ Program Instance all_iff_morphism {A : Type} : intuition ; specialize (H x0) ; intuition. Qed. -Program Instance all_impl_morphism {A : Type} : +Program Instance all_impl_morphism {A : Type} : Proper (pointwise_relation A impl ==> impl) (@all A) | 1. - + Next Obligation. Proof. unfold pointwise_relation, all in *. intuition ; specialize (H x0) ; intuition. Qed. -Program Instance all_inverse_impl_morphism {A : Type} : +Program Instance all_inverse_impl_morphism {A : Type} : Proper (pointwise_relation A (inverse impl) ==> inverse impl) (@all A) | 1. - + Next Obligation. Proof. unfold pointwise_relation, all in *. diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v index b603a2e41..e9301298e 100644 --- a/theories/Classes/Morphisms_Relations.v +++ b/theories/Classes/Morphisms_Relations.v @@ -7,7 +7,7 @@ (************************************************************************) (* Morphism instances for relations. - + Author: Matthieu Sozeau Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud 91405 Orsay, France *) @@ -50,6 +50,6 @@ Instance subrelation_pointwise : Proof. intro. apply (predicate_implication_pointwise (cons A (cons A nil))). Qed. -Lemma inverse_pointwise_relation A (R : relation A) : +Lemma inverse_pointwise_relation A (R : relation A) : relation_equivalence (pointwise_relation A (inverse R)) (inverse (pointwise_relation A R)). Proof. intros. split; firstorder. Qed. diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v index 5c6524481..b2f62cb87 100644 --- a/theories/Classes/RelationClasses.v +++ b/theories/Classes/RelationClasses.v @@ -8,7 +8,7 @@ (* Typeclass-based relations, tactics and standard instances. This is the basic theory needed to formalize morphisms and setoids. - + Author: Matthieu Sozeau Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud 91405 Orsay, France *) @@ -42,18 +42,18 @@ Unset Strict Implicit. Class Reflexive {A} (R : relation A) := reflexivity : forall x, R x x. -Class Irreflexive {A} (R : relation A) := +Class Irreflexive {A} (R : relation A) := irreflexivity : Reflexive (complement R). Hint Extern 1 (Reflexive (complement _)) => class_apply @irreflexivity : typeclasses_instances. -Class Symmetric {A} (R : relation A) := +Class Symmetric {A} (R : relation A) := symmetry : forall x y, R x y -> R y x. -Class Asymmetric {A} (R : relation A) := +Class Asymmetric {A} (R : relation A) := asymmetry : forall x y, R x y -> R y x -> False. -Class Transitive {A} (R : relation A) := +Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. Hint Resolve @irreflexivity : ord. @@ -63,7 +63,7 @@ Unset Implicit Arguments. (** A HintDb for relations. *) Ltac solve_relation := - match goal with + match goal with | [ |- ?R ?x ?x ] => reflexivity | [ H : ?R ?x ?y |- ?R ?y ?x ] => symmetry ; exact H end. @@ -85,7 +85,7 @@ Program Definition flip_Symmetric `(Symmetric A R) : Symmetric (flip R) := Program Definition flip_Asymmetric `(Asymmetric A R) : Asymmetric (flip R) := fun x y H H' => asymmetry (R:=R) H H'. - + Program Definition flip_Transitive `(Transitive A R) : Transitive (flip R) := fun x y z H H' => transitivity (R:=R) H' H. @@ -122,7 +122,7 @@ Tactic Notation "reduce" "in" hyp(Hid) := reduce_hyp Hid. Ltac reduce := reduce_goal. -Tactic Notation "apply" "*" constr(t) := +Tactic Notation "apply" "*" constr(t) := first [ refine t | refine (t _) | refine (t _ _) | refine (t _ _ _) | refine (t _ _ _ _) | refine (t _ _ _ _ _) | refine (t _ _ _ _ _ _) | refine (t _ _ _ _ _ _ _) ]. @@ -186,7 +186,7 @@ Program Definition flip_antiSymmetric `(Antisymmetric A eqA R) : Proof. firstorder. Qed. (** Leibinz equality [eq] is an equivalence relation. - The instance has low priority as it is always applicable + The instance has low priority as it is always applicable if only the type is constrained. *) Program Instance eq_equivalence : Equivalence (@eq A) | 10. @@ -208,8 +208,8 @@ Require Import Coq.Lists.List. (** A compact representation of non-dependent arities, with the codomain singled-out. *) -Fixpoint arrows (l : list Type) (r : Type) : Type := - match l with +Fixpoint arrows (l : list Type) (r : Type) : Type := + match l with | nil => r | A :: l' => A -> arrows l' r end. @@ -232,7 +232,7 @@ Definition unary_predicate A := predicate (cons A nil). Definition binary_relation A := predicate (cons A (cons A nil)). -(** We can close a predicate by universal or existential quantification. *) +(** We can close a predicate by universal or existential quantification. *) Fixpoint predicate_all (l : list Type) : predicate l -> Prop := match l with @@ -246,7 +246,7 @@ Fixpoint predicate_exists (l : list Type) : predicate l -> Prop := | A :: tl => fun f => exists x : A, predicate_exists tl (f x) end. -(** Pointwise extension of a binary operation on [T] to a binary operation +(** Pointwise extension of a binary operation on [T] to a binary operation on functions whose codomain is [T]. For an operator on [Prop] this lifts the operator to a binary operation. *) @@ -254,7 +254,7 @@ Fixpoint pointwise_extension {T : Type} (op : binary_operation T) (l : list Type) : binary_operation (arrows l T) := match l with | nil => fun R R' => op R R' - | A :: tl => fun R R' => + | A :: tl => fun R R' => fun x => pointwise_extension op tl (R x) (R' x) end. @@ -263,7 +263,7 @@ Fixpoint pointwise_extension {T : Type} (op : binary_operation T) Fixpoint pointwise_lifting (op : binary_relation Prop) (l : list Type) : binary_relation (predicate l) := match l with | nil => fun R R' => op R R' - | A :: tl => fun R R' => + | A :: tl => fun R R' => forall x, pointwise_lifting op tl (R x) (R' x) end. @@ -295,7 +295,7 @@ Infix "\∙/" := predicate_union (at level 85, right associativity) : predicate_ (** The always [True] and always [False] predicates. *) -Fixpoint true_predicate {l : list Type} : predicate l := +Fixpoint true_predicate {l : list Type} : predicate l := match l with | nil => True | A :: tl => fun _ => @true_predicate tl @@ -313,7 +313,7 @@ Notation "∙⊥∙" := false_predicate : predicate_scope. (** Predicate equivalence is an equivalence, and predicate implication defines a preorder. *) Program Instance predicate_equivalence_equivalence : Equivalence (@predicate_equivalence l). - Next Obligation. + Next Obligation. induction l ; firstorder. Qed. Next Obligation. @@ -333,11 +333,11 @@ Program Instance predicate_implication_preorder : Qed. Next Obligation. induction l. firstorder. - unfold predicate_implication in *. simpl in *. + unfold predicate_implication in *. simpl in *. intro. pose (IHl (x x0) (y x0) (z x0)). firstorder. Qed. -(** We define the various operations which define the algebra on binary relations, +(** We define the various operations which define the algebra on binary relations, from the general ones. *) Definition relation_equivalence {A : Type} : relation (relation A) := @@ -365,20 +365,20 @@ Proof. intro A. exact (@predicate_implication_preorder (cons A (cons A nil))). Q (** *** Partial Order. A partial order is a preorder which is additionally antisymmetric. - We give an equivalent definition, up-to an equivalence relation + We give an equivalent definition, up-to an equivalence relation on the carrier. *) Class PartialOrder {A} eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} := partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (inverse R)). -(** The equivalence proof is sufficient for proving that [R] must be a morphism +(** The equivalence proof is sufficient for proving that [R] must be a morphism for equivalence (see Morphisms). It is also sufficient to show that [R] is antisymmetric w.r.t. [eqA] *) Instance partial_order_antisym `(PartialOrder A eqA R) : ! Antisymmetric A eqA R. Proof with auto. - reduce_goal. - pose proof partial_order_equivalence as poe. do 3 red in poe. + reduce_goal. + pose proof partial_order_equivalence as poe. do 3 red in poe. apply <- poe. firstorder. Qed. @@ -392,7 +392,7 @@ Program Instance subrelation_partial_order : unfold relation_equivalence in *. firstorder. Qed. -Typeclasses Opaque arrows predicate_implication predicate_equivalence +Typeclasses Opaque arrows predicate_implication predicate_equivalence relation_equivalence pointwise_lifting. (** Rewrite relation on a given support: declares a relation as a rewrite @@ -409,7 +409,7 @@ Instance: RewriteRelation impl. Instance: RewriteRelation iff. Instance: RewriteRelation (@relation_equivalence A). -(** Any [Equivalence] declared in the context is automatically considered +(** Any [Equivalence] declared in the context is automatically considered a rewrite relation. *) Instance equivalence_rewrite_relation `(Equivalence A eqA) : RewriteRelation eqA. diff --git a/theories/Classes/SetoidAxioms.v b/theories/Classes/SetoidAxioms.v index 469b9eae6..ebc1d7be9 100644 --- a/theories/Classes/SetoidAxioms.v +++ b/theories/Classes/SetoidAxioms.v @@ -21,7 +21,7 @@ Unset Strict Implicit. Require Export Coq.Classes.SetoidClass. -(* Application of the extensionality axiom to turn a goal on +(* Application of the extensionality axiom to turn a goal on Leibniz equality to a setoid equivalence (use with care!). *) Axiom setoideq_eq : forall `{sa : Setoid a} (x y : a), x == y -> x = y. diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v index 055f02f8b..6af4b5ffe 100644 --- a/theories/Classes/SetoidClass.v +++ b/theories/Classes/SetoidClass.v @@ -7,7 +7,7 @@ (************************************************************************) (* Typeclass-based setoids, tactics and standard instances. - + Author: Matthieu Sozeau Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud 91405 Orsay, France *) @@ -55,7 +55,7 @@ Existing Instance setoid_trans. (* Program Instance eq_setoid : Setoid A := *) (* equiv := eq ; setoid_equiv := eq_equivalence. *) -Program Instance iff_setoid : Setoid Prop := +Program Instance iff_setoid : Setoid Prop := { equiv := iff ; setoid_equiv := iff_equivalence }. (** Overloaded notations for setoid equivalence and inequivalence. Not to be confused with [eq] and [=]. *) @@ -69,7 +69,7 @@ Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity) : (** Use the [clsubstitute] command which substitutes an equality in every hypothesis. *) -Ltac clsubst H := +Ltac clsubst H := match type of H with ?x == ?y => substitute H ; clear H x end. @@ -79,7 +79,7 @@ Ltac clsubst_nofail := | [ H : ?x == ?y |- _ ] => clsubst H ; clsubst_nofail | _ => idtac end. - + (** [subst*] will try its best at substituting every equality in the goal. *) Tactic Notation "clsubst" "*" := clsubst_nofail. @@ -94,7 +94,7 @@ Qed. Lemma equiv_nequiv_trans : forall `{Setoid A} (x y z : A), x == y -> y =/= z -> x =/= z. Proof. - intros; intro. + intros; intro. assert(y == x) by (symmetry ; auto). assert(y == z) by (transitivity x ; eauto). contradiction. @@ -127,7 +127,7 @@ Program Instance setoid_partial_app_morphism `(sa : Setoid A) (x : A) : Proper ( (** Partial setoids don't require reflexivity so we can build a partial setoid on the function space. *) -Class PartialSetoid (A : Type) := +Class PartialSetoid (A : Type) := { pequiv : relation A ; pequiv_prf :> PER pequiv }. (** Overloaded notation for partial setoid equivalence. *) diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v index d68e3fd22..71d80c959 100644 --- a/theories/Classes/SetoidDec.v +++ b/theories/Classes/SetoidDec.v @@ -21,7 +21,7 @@ Unset Strict Implicit. Require Export Coq.Classes.SetoidClass. -(** The [DecidableSetoid] class asserts decidability of a [Setoid]. It can be useful in proofs to reason more +(** The [DecidableSetoid] class asserts decidability of a [Setoid]. It can be useful in proofs to reason more classically. *) Require Import Coq.Logic.Decidable. @@ -41,8 +41,8 @@ Notation " x == y " := (equiv_dec (x :>) (y :>)) (no associativity, at level 70) Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } := match x with - | left H => @right _ _ H - | right H => @left _ _ H + | left H => @right _ _ H + | right H => @left _ _ H end. Require Import Coq.Program.Program. @@ -96,9 +96,9 @@ Program Instance unit_eqdec : EqDec (eq_setoid unit) := Program Instance prod_eqdec `(! EqDec (eq_setoid A), ! EqDec (eq_setoid B)) : EqDec (eq_setoid (prod A B)) := λ x y, - let '(x1, x2) := x in - let '(y1, y2) := y in - if x1 == y1 then + let '(x1, x2) := x in + let '(y1, y2) := y in + if x1 == y1 then if x2 == y2 then in_left else in_right else in_right. diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v index f58f227e5..12356385c 100644 --- a/theories/Classes/SetoidTactics.v +++ b/theories/Classes/SetoidTactics.v @@ -24,8 +24,8 @@ Set Implicit Arguments. Unset Strict Implicit. (** Default relation on a given support. Can be used by tactics - to find a sensible default relation on any carrier. Users can - declare an [Instance def : DefaultRelation A RA] anywhere to + to find a sensible default relation on any carrier. Users can + declare an [Instance def : DefaultRelation A RA] anywhere to declare default relations. *) Class DefaultRelation A (R : relation A). @@ -60,80 +60,80 @@ Ltac setoidreplaceat H t occs := Tactic Notation "setoid_replace" constr(x) "with" constr(y) := setoidreplace (default_relation x y) idtac. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "at" int_or_var_list(o) := setoidreplaceat (default_relation x y) idtac o. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "in" hyp(id) := setoidreplacein (default_relation x y) id idtac. Tactic Notation "setoid_replace" constr(x) "with" constr(y) - "in" hyp(id) + "in" hyp(id) "at" int_or_var_list(o) := setoidreplaceinat (default_relation x y) id idtac o. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "by" tactic3(t) := setoidreplace (default_relation x y) ltac:t. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) - "at" int_or_var_list(o) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) + "at" int_or_var_list(o) "by" tactic3(t) := setoidreplaceat (default_relation x y) ltac:t o. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) - "in" hyp(id) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) + "in" hyp(id) "by" tactic3(t) := setoidreplacein (default_relation x y) id ltac:t. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) - "in" hyp(id) - "at" int_or_var_list(o) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) + "in" hyp(id) + "at" int_or_var_list(o) "by" tactic3(t) := setoidreplaceinat (default_relation x y) id ltac:t o. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "using" "relation" constr(rel) := setoidreplace (rel x y) idtac. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "using" "relation" constr(rel) "at" int_or_var_list(o) := setoidreplaceat (rel x y) idtac o. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) - "using" "relation" constr(rel) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) + "using" "relation" constr(rel) "by" tactic3(t) := setoidreplace (rel x y) ltac:t. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) - "using" "relation" constr(rel) - "at" int_or_var_list(o) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) + "using" "relation" constr(rel) + "at" int_or_var_list(o) "by" tactic3(t) := setoidreplaceat (rel x y) ltac:t o. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "using" "relation" constr(rel) "in" hyp(id) := setoidreplacein (rel x y) id idtac. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "using" "relation" constr(rel) - "in" hyp(id) + "in" hyp(id) "at" int_or_var_list(o) := setoidreplaceinat (rel x y) id idtac o. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) "using" "relation" constr(rel) "in" hyp(id) "by" tactic3(t) := setoidreplacein (rel x y) id ltac:t. -Tactic Notation "setoid_replace" constr(x) "with" constr(y) - "using" "relation" constr(rel) +Tactic Notation "setoid_replace" constr(x) "with" constr(y) + "using" "relation" constr(rel) "in" hyp(id) - "at" int_or_var_list(o) + "at" int_or_var_list(o) "by" tactic3(t) := setoidreplaceinat (rel x y) id ltac:t o. diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v index bf10728c8..189cf88ad 100644 --- a/theories/FSets/FMapAVL.v +++ b/theories/FSets/FMapAVL.v @@ -14,8 +14,8 @@ (** * FMapAVL *) (** This module implements maps using AVL trees. - It follows the implementation from Ocaml's standard library. - + It follows the implementation from Ocaml's standard library. + See the comments at the beginning of FSetAVL for more details. *) @@ -30,8 +30,8 @@ Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope. Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope. (** * The Raw functor - - Functor of pure functions + separate proofs of invariant + + Functor of pure functions + separate proofs of invariant preservation *) Module Raw (Import I:Int)(X: OrderedType). @@ -85,20 +85,20 @@ Definition is_empty m := match m with Leaf => true | _ => false end. to achieve logarithmic complexity. *) Fixpoint mem x m : bool := - match m with - | Leaf => false - | Node l y _ r _ => match X.compare x y with - | LT _ => mem x l + match m with + | Leaf => false + | Node l y _ r _ => match X.compare x y with + | LT _ => mem x l | EQ _ => true | GT _ => mem x r end end. -Fixpoint find x m : option elt := - match m with - | Leaf => None - | Node l y d r _ => match X.compare x y with - | LT _ => find x l +Fixpoint find x m : option elt := + match m with + | Leaf => None + | Node l y d r _ => match X.compare x y with + | LT _ => find x l | EQ _ => Some d | GT _ => find x r end @@ -109,7 +109,7 @@ Fixpoint find x m : option elt := (** [create l x r] creates a node, assuming [l] and [r] to be balanced and [|height l - height r| <= 2]. *) -Definition create l x e r := +Definition create l x e r := Node l x e r (max (height l) (height r) + 1). (** [bal l x e r] acts as [create], but performs one step of @@ -117,45 +117,45 @@ Definition create l x e r := Definition assert_false := create. -Fixpoint bal l x d r := - let hl := height l in +Fixpoint bal l x d r := + let hl := height l in let hr := height r in - if gt_le_dec hl (hr+2) then - match l with + if gt_le_dec hl (hr+2) then + match l with | Leaf => assert_false l x d r - | Node ll lx ld lr _ => - if ge_lt_dec (height ll) (height lr) then + | Node ll lx ld lr _ => + if ge_lt_dec (height ll) (height lr) then create ll lx ld (create lr x d r) - else - match lr with + else + match lr with | Leaf => assert_false l x d r - | Node lrl lrx lrd lrr _ => + | Node lrl lrx lrd lrr _ => create (create ll lx ld lrl) lrx lrd (create lrr x d r) end end - else - if gt_le_dec hr (hl+2) then + else + if gt_le_dec hr (hl+2) then match r with | Leaf => assert_false l x d r | Node rl rx rd rr _ => - if ge_lt_dec (height rr) (height rl) then + if ge_lt_dec (height rr) (height rl) then create (create l x d rl) rx rd rr - else + else match rl with | Leaf => assert_false l x d r - | Node rll rlx rld rlr _ => - create (create l x d rll) rlx rld (create rlr rx rd rr) + | Node rll rlx rld rlr _ => + create (create l x d rll) rlx rld (create rlr rx rd rr) end end - else + else create l x d r. (** * Insertion *) -Fixpoint add x d m := - match m with +Fixpoint add x d m := + match m with | Leaf => Node Leaf x d Leaf 1 - | Node l y d' r h => + | Node l y d' r h => match X.compare x y with | LT _ => bal (add x d l) y d' r | EQ _ => Node l y d r h @@ -165,16 +165,16 @@ Fixpoint add x d m := (** * Extraction of minimum binding - Morally, [remove_min] is to be applied to a non-empty tree - [t = Node l x e r h]. Since we can't deal here with [assert false] - for [t=Leaf], we pre-unpack [t] (and forget about [h]). + Morally, [remove_min] is to be applied to a non-empty tree + [t = Node l x e r h]. Since we can't deal here with [assert false] + for [t=Leaf], we pre-unpack [t] (and forget about [h]). *) - -Fixpoint remove_min l x d r : t*(key*elt) := + +Fixpoint remove_min l x d r : t*(key*elt) := match l with | Leaf => (r,(x,d)) - | Node ll lx ld lr lh => - let (l',m) := remove_min ll lx ld lr in + | Node ll lx ld lr lh => + let (l',m) := remove_min ll lx ld lr in (bal l' x d r, m) end. @@ -185,18 +185,18 @@ Fixpoint remove_min l x d r : t*(key*elt) := [|height t1 - height t2| <= 2]. *) -Fixpoint merge s1 s2 := match s1,s2 with - | Leaf, _ => s2 +Fixpoint merge s1 s2 := match s1,s2 with + | Leaf, _ => s2 | _, Leaf => s1 - | _, Node l2 x2 d2 r2 h2 => - match remove_min l2 x2 d2 r2 with + | _, Node l2 x2 d2 r2 h2 => + match remove_min l2 x2 d2 r2 with (s2',(x,d)) => bal s1 x d s2' end end. (** * Deletion *) -Fixpoint remove x m := match m with +Fixpoint remove x m := match m with | Leaf => Leaf | Node l y d r h => match X.compare x y with @@ -206,26 +206,26 @@ Fixpoint remove x m := match m with end end. -(** * join - - Same as [bal] but does not assume anything regarding heights of [l] +(** * join + + Same as [bal] but does not assume anything regarding heights of [l] and [r]. *) Fixpoint join l : key -> elt -> t -> t := match l with | Leaf => add - | Node ll lx ld lr lh => fun x d => - fix join_aux (r:t) : t := match r with + | Node ll lx ld lr lh => fun x d => + fix join_aux (r:t) : t := match r with | Leaf => add x d l - | Node rl rx rd rr rh => + | Node rl rx rd rr rh => if gt_le_dec lh (rh+2) then bal ll lx ld (join lr x d r) - else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rd rr + else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rd rr else create l x d r end end. -(** * Splitting +(** * Splitting [split x m] returns a triple [(l, o, r)] where - [l] is the set of elements of [m] that are [< x] @@ -236,17 +236,17 @@ Fixpoint join l : key -> elt -> t -> t := Record triple := mktriple { t_left:t; t_opt:option elt; t_right:t }. Notation "<< l , b , r >>" := (mktriple l b r) (at level 9). -Fixpoint split x m : triple := match m with +Fixpoint split x m : triple := match m with | Leaf => << Leaf, None, Leaf >> - | Node l y d r h => - match X.compare x y with + | Node l y d r h => + match X.compare x y with | LT _ => let (ll,o,rl) := split x l in << ll, o, join rl y d r >> | EQ _ => << l, Some d, r >> | GT _ => let (rl,o,rr) := split x r in << join l y d rl, o, rr >> end end. -(** * Concatenation +(** * Concatenation Same as [merge] but does not assume anything about heights. *) @@ -256,7 +256,7 @@ Definition concat m1 m2 := | Leaf, _ => m2 | _ , Leaf => m1 | _, Node l2 x2 d2 r2 _ => - let (m2',xd) := remove_min l2 x2 d2 r2 in + let (m2',xd) := remove_min l2 x2 d2 r2 in join m1 xd#1 xd#2 m2' end. @@ -277,7 +277,7 @@ Definition elements := elements_aux nil. (** * Fold *) -Fixpoint fold (A : Type) (f : key -> elt -> A -> A) (m : t) : A -> A := +Fixpoint fold (A : Type) (f : key -> elt -> A -> A) (m : t) : A -> A := fun a => match m with | Leaf => a | Node l x d r _ => fold f r (f x d (fold f l a)) @@ -293,11 +293,11 @@ Inductive enumeration := | End : enumeration | More : key -> elt -> t -> enumeration -> enumeration. -(** [cons m e] adds the elements of tree [m] on the head of +(** [cons m e] adds the elements of tree [m] on the head of enumeration [e]. *) -Fixpoint cons m e : enumeration := - match m with +Fixpoint cons m e : enumeration := + match m with | Leaf => e | Node l x d r h => cons l (More x d r e) end. @@ -316,7 +316,7 @@ Definition equal_more x1 d1 (cont:enumeration->bool) e2 := (** Comparison of left tree, middle element, then right tree *) -Fixpoint equal_cont m1 (cont:enumeration->bool) e2 := +Fixpoint equal_cont m1 (cont:enumeration->bool) e2 := match m1 with | Leaf => cont e2 | Node l1 x1 d1 r1 _ => @@ -341,8 +341,8 @@ Notation "t #r" := (t_right t) (at level 9, format "t '#r'"). (** * Map *) -Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' := - match m with +Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' := + match m with | Leaf => Leaf _ | Node l x d r h => Node (map f l) x (f d) (map f r) h end. @@ -350,7 +350,7 @@ Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' := (* * Mapi *) Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' := - match m with + match m with | Leaf => Leaf _ | Node l x d r h => Node (mapi f l) x (f x d) (mapi f r) h end. @@ -358,28 +358,28 @@ Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' := (** * Map with removal *) Fixpoint map_option (elt elt' : Type)(f : key -> elt -> option elt')(m : t elt) - : t elt' := - match m with + : t elt' := + match m with | Leaf => Leaf _ - | Node l x d r h => - match f x d with + | Node l x d r h => + match f x d with | Some d' => join (map_option f l) x d' (map_option f r) | None => concat (map_option f l) (map_option f r) end end. (** * Optimized map2 - - Suggestion by B. Gregoire: a [map2] function with specialized - arguments allowing to bypass some tree traversal. Instead of one - [f0] of type [key -> option elt -> option elt' -> option elt''], - we ask here for: + + Suggestion by B. Gregoire: a [map2] function with specialized + arguments allowing to bypass some tree traversal. Instead of one + [f0] of type [key -> option elt -> option elt' -> option elt''], + we ask here for: - [f] which is a specialisation of [f0] when first option isn't [None] - [mapl] treats a [tree elt] with [f0] when second option is [None] - [mapr] treats a [tree elt'] with [f0] when first option is [None] - The idea is that [mapl] and [mapr] can be instantaneous (e.g. - the identity or some constant function). + The idea is that [mapl] and [mapr] can be instantaneous (e.g. + the identity or some constant function). *) Section Map2_opt. @@ -388,13 +388,13 @@ Variable f : key -> elt -> option elt' -> option elt''. Variable mapl : t elt -> t elt''. Variable mapr : t elt' -> t elt''. -Fixpoint map2_opt m1 m2 := - match m1, m2 with - | Leaf, _ => mapr m2 +Fixpoint map2_opt m1 m2 := + match m1, m2 with + | Leaf, _ => mapr m2 | _, Leaf => mapl m1 - | Node l1 x1 d1 r1 h1, _ => + | Node l1 x1 d1 r1 h1, _ => let (l2',o2,r2') := split x1 m2 in - match f x1 d1 o2 with + match f x1 d1 o2 with | Some e => join (map2_opt l1 l2') x1 e (map2_opt r1 r2') | None => concat (map2_opt l1 l2') (map2_opt r1 r2') end @@ -403,8 +403,8 @@ Fixpoint map2_opt m1 m2 := End Map2_opt. (** * Map2 - - The [map2] function of the Map interface can be implemented + + The [map2] function of the Map interface can be implemented via [map2_opt] and [map_option]. *) @@ -412,8 +412,8 @@ Section Map2. Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. -Definition map2 : t elt -> t elt' -> t elt'' := - map2_opt +Definition map2 : t elt -> t elt' -> t elt'' := + map2_opt (fun _ d o => f (Some d) o) (map_option (fun _ d => f (Some d) None)) (map_option (fun _ d' => f None (Some d'))). @@ -432,24 +432,24 @@ Variable elt : Type. Inductive MapsTo (x : key)(e : elt) : t elt -> Prop := | MapsRoot : forall l r h y, X.eq x y -> MapsTo x e (Node l y e r h) - | MapsLeft : forall l r h y e', + | MapsLeft : forall l r h y e', MapsTo x e l -> MapsTo x e (Node l y e' r h) - | MapsRight : forall l r h y e', + | MapsRight : forall l r h y e', MapsTo x e r -> MapsTo x e (Node l y e' r h). Inductive In (x : key) : t elt -> Prop := | InRoot : forall l r h y e, X.eq x y -> In x (Node l y e r h) - | InLeft : forall l r h y e', + | InLeft : forall l r h y e', In x l -> In x (Node l y e' r h) - | InRight : forall l r h y e', + | InRight : forall l r h y e', In x r -> In x (Node l y e' r h). Definition In0 k m := exists e:elt, MapsTo k e m. (** ** Binary search trees *) -(** [lt_tree x s]: all elements in [s] are smaller than [x] +(** [lt_tree x s]: all elements in [s] are smaller than [x] (resp. greater for [gt_tree]) *) Definition lt_tree x m := forall y, In y m -> X.lt y x. @@ -459,7 +459,7 @@ Definition gt_tree x m := forall y, In y m -> X.lt x y. Inductive bst : t elt -> Prop := | BSLeaf : bst (Leaf _) - | BSNode : forall x e l r h, bst l -> bst r -> + | BSNode : forall x e l r h, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node l x e r h). End Invariants. @@ -474,10 +474,10 @@ Module Proofs. Functional Scheme mem_ind := Induction for mem Sort Prop. Functional Scheme find_ind := Induction for find Sort Prop. -Functional Scheme bal_ind := Induction for bal Sort Prop. +Functional Scheme bal_ind := Induction for bal Sort Prop. Functional Scheme add_ind := Induction for add Sort Prop. Functional Scheme remove_min_ind := Induction for remove_min Sort Prop. -Functional Scheme merge_ind := Induction for merge Sort Prop. +Functional Scheme merge_ind := Induction for merge Sort Prop. Functional Scheme remove_ind := Induction for remove Sort Prop. Functional Scheme concat_ind := Induction for concat Sort Prop. Functional Scheme split_ind := Induction for split Sort Prop. @@ -489,24 +489,24 @@ Functional Scheme map2_opt_ind := Induction for map2_opt Sort Prop. Hint Constructors tree MapsTo In bst. Hint Unfold lt_tree gt_tree. -Tactic Notation "factornode" ident(l) ident(x) ident(d) ident(r) ident(h) - "as" ident(s) := +Tactic Notation "factornode" ident(l) ident(x) ident(d) ident(r) ident(h) + "as" ident(s) := set (s:=Node l x d r h) in *; clearbody s; clear l x d r h. (** A tactic for cleaning hypothesis after use of functional induction. *) Ltac clearf := - match goal with + match goal with | H : (@Logic.eq (Compare _ _ _ _) _ _) |- _ => clear H; clearf | H : (@Logic.eq (sumbool _ _) _ _) |- _ => clear H; clearf | _ => idtac end. -(** A tactic to repeat [inversion_clear] on all hyps of the +(** A tactic to repeat [inversion_clear] on all hyps of the form [(f (Node ...))] *) Ltac inv f := - match goal with + match goal with | H:f (Leaf _) |- _ => inversion_clear H; inv f | H:f _ (Leaf _) |- _ => inversion_clear H; inv f | H:f _ _ (Leaf _) |- _ => inversion_clear H; inv f @@ -518,8 +518,8 @@ Ltac inv f := | _ => idtac end. -Ltac inv_all f := - match goal with +Ltac inv_all f := + match goal with | H: f _ |- _ => inversion_clear H; inv f | H: f _ _ |- _ => inversion_clear H; inv f | H: f _ _ _ |- _ => inversion_clear H; inv f @@ -529,7 +529,7 @@ Ltac inv_all f := (** Helper tactic concerning order of elements. *) -Ltac order := match goal with +Ltac order := match goal with | U: lt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | U: gt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | _ => MX.order @@ -537,21 +537,21 @@ end. Ltac intuition_in := repeat progress (intuition; inv In; inv MapsTo). -(* Function/Functional Scheme can't deal with internal fix. +(* Function/Functional Scheme can't deal with internal fix. Let's do its job by hand: *) -Ltac join_tac := - intros l; induction l as [| ll _ lx ld lr Hlr lh]; +Ltac join_tac := + intros l; induction l as [| ll _ lx ld lr Hlr lh]; [ | intros x d r; induction r as [| rl Hrl rx rd rr _ rh]; unfold join; - [ | destruct (gt_le_dec lh (rh+2)); + [ | destruct (gt_le_dec lh (rh+2)); [ match goal with |- context [ bal ?u ?v ?w ?z ] => - replace (bal u v w z) + replace (bal u v w z) with (bal ll lx ld (join lr x d (Node rl rx rd rr rh))); [ | auto] - end - | destruct (gt_le_dec rh (lh+2)); - [ match goal with |- context [ bal ?u ?v ?w ?z ] => - replace (bal u v w z) - with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ | auto] + end + | destruct (gt_le_dec rh (lh+2)); + [ match goal with |- context [ bal ?u ?v ?w ?z ] => + replace (bal u v w z) + with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ | auto] end | ] ] ] ]; intros. @@ -575,7 +575,7 @@ Proof. Qed. Lemma In_alt : forall k m, In0 k m <-> In k m. -Proof. +Proof. split. intros (e,H); eauto. unfold In0; apply In_MapsTo; auto. @@ -588,14 +588,14 @@ Proof. Qed. Hint Immediate MapsTo_1. -Lemma In_1 : +Lemma In_1 : forall m x y, X.eq x y -> In x m -> In y m. Proof. intros m x y; induction m; simpl; intuition_in; eauto. Qed. -Lemma In_node_iff : - forall l x e r h y, +Lemma In_node_iff : + forall l x e r h y, In y (Node l x e r h) <-> In y l \/ X.eq y x \/ In y r. Proof. intuition_in. @@ -613,7 +613,7 @@ Proof. unfold gt_tree in |- *; intros; intuition_in. Qed. -Lemma lt_tree_node : forall x y l r e h, +Lemma lt_tree_node : forall x y l r e h, lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node l y e r h). Proof. unfold lt_tree in *; intuition_in; order. @@ -627,25 +627,25 @@ Qed. Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node. -Lemma lt_left : forall x y l r e h, +Lemma lt_left : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x l. Proof. intuition_in. Qed. -Lemma lt_right : forall x y l r e h, +Lemma lt_right : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x r. Proof. intuition_in. Qed. -Lemma gt_left : forall x y l r e h, +Lemma gt_left : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x l. Proof. intuition_in. Qed. -Lemma gt_right : forall x y l r e h, +Lemma gt_right : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x r. Proof. intuition_in. @@ -695,39 +695,39 @@ Qed. (** * Emptyness test *) -Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. +Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. Proof. destruct m as [|r x e l h]; simpl; auto. intro H; elim (H x e); auto. Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. -Proof. +Proof. destruct m; simpl; intros; try discriminate; red; intuition_in. Qed. (** * Appartness *) Lemma mem_1 : forall m x, bst m -> In x m -> mem x m = true. -Proof. +Proof. intros m x; functional induction (mem x m); auto; intros; clearf; inv bst; intuition_in; order. Qed. -Lemma mem_2 : forall m x, mem x m = true -> In x m. -Proof. +Lemma mem_2 : forall m x, mem x m = true -> In x m. +Proof. intros m x; functional induction (mem x m); auto; intros; discriminate. Qed. Lemma find_1 : forall m x e, bst m -> MapsTo x e m -> find x m = Some e. -Proof. +Proof. intros m x; functional induction (find x m); auto; intros; clearf; - inv bst; intuition_in; simpl; auto; + inv bst; intuition_in; simpl; auto; try solve [order | absurd (X.lt x y); eauto | absurd (X.lt y x); eauto]. Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. -Proof. +Proof. intros m x; functional induction (find x m); subst; intros; clearf; try discriminate. constructor 2; auto. @@ -735,7 +735,7 @@ Proof. constructor 3; auto. Qed. -Lemma find_iff : forall m x e, bst m -> +Lemma find_iff : forall m x e, bst m -> (find x m = Some e <-> MapsTo x e m). Proof. split; auto using find_1, find_2. @@ -745,7 +745,7 @@ Lemma find_in : forall m x, find x m <> None -> In x m. Proof. intros. case_eq (find x m); [intros|congruence]. - apply MapsTo_In with e; apply find_2; auto. + apply MapsTo_In with e; apply find_2; auto. Qed. Lemma in_find : forall m x, bst m -> In x m -> find x m <> None. @@ -755,7 +755,7 @@ Proof. rewrite (find_1 H Hd); discriminate. Qed. -Lemma find_in_iff : forall m x, bst m -> +Lemma find_in_iff : forall m x, bst m -> (find x m <> None <-> In x m). Proof. split; auto using find_in, in_find. @@ -771,11 +771,11 @@ Proof. elim H0; apply find_in; congruence. Qed. -Lemma find_find : forall m m' x, - find x m = find x m' <-> +Lemma find_find : forall m m' x, + find x m = find x m' <-> (forall d, find x m = Some d <-> find x m' = Some d). Proof. - intros; destruct (find x m); destruct (find x m'); split; intros; + intros; destruct (find x m); destruct (find x m'); split; intros; try split; try congruence. rewrite H; auto. symmetry; rewrite <- H; auto. @@ -783,7 +783,7 @@ Proof. Qed. Lemma find_mapsto_equiv : forall m m' x, bst m -> bst m' -> - (find x m = find x m' <-> + (find x m = find x m' <-> (forall d, MapsTo x d m <-> MapsTo x d m')). Proof. intros m m' x Hm Hm'. @@ -793,8 +793,8 @@ Proof. rewrite 2 find_iff; auto. Qed. -Lemma find_in_equiv : forall m m' x, bst m -> bst m' -> - find x m = find x m' -> +Lemma find_in_equiv : forall m m' x, bst m -> bst m' -> + find x m = find x m' -> (In x m <-> In x m'). Proof. split; intros; apply find_in; [ rewrite <- H1 | rewrite H1 ]; @@ -803,27 +803,27 @@ Qed. (** * Helper functions *) -Lemma create_bst : - forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> +Lemma create_bst : + forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (create l x e r). Proof. unfold create; auto. Qed. Hint Resolve create_bst. -Lemma create_in : - forall l x e r y, +Lemma create_in : + forall l x e r y, In y (create l x e r) <-> X.eq y x \/ In y l \/ In y r. Proof. unfold create; split; [ inversion_clear 1 | ]; intuition. Qed. -Lemma bal_bst : forall l x e r, bst l -> bst r -> +Lemma bal_bst : forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (bal l x e r). Proof. intros l x e r; functional induction (bal l x e r); intros; clearf; inv bst; repeat apply create_bst; auto; unfold create; try constructor; - (apply lt_tree_node || apply gt_tree_node); auto; + (apply lt_tree_node || apply gt_tree_node); auto; (eapply lt_tree_trans || eapply gt_tree_trans); eauto. Qed. Hint Resolve bal_bst. @@ -842,7 +842,7 @@ Proof. unfold assert_false, create; intuition_in. Qed. -Lemma bal_find : forall l x e r y, +Lemma bal_find : forall l x e r y, bst l -> bst r -> lt_tree x l -> gt_tree x r -> find y (bal l x e r) = find y (create l x e r). Proof. @@ -870,32 +870,32 @@ Qed. Hint Resolve add_bst. Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m). -Proof. - intros m x y e; functional induction (add x e m); +Proof. + intros m x y e; functional induction (add x e m); intros; inv bst; try rewrite bal_mapsto; unfold create; eauto. Qed. -Lemma add_2 : forall m x y e e', ~X.eq x y -> +Lemma add_2 : forall m x y e e', ~X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; induction m; simpl; auto. destruct (X.compare x k); - intros; inv bst; try rewrite bal_mapsto; unfold create; auto; + intros; inv bst; try rewrite bal_mapsto; unfold create; auto; inv MapsTo; auto; order. Qed. -Lemma add_3 : forall m x y e e', ~X.eq x y -> +Lemma add_3 : forall m x y e e', ~X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. - intros m x y e e'; induction m; simpl; auto. + intros m x y e e'; induction m; simpl; auto. intros; inv MapsTo; auto; order. - destruct (X.compare x k); intro; - try rewrite bal_mapsto; auto; unfold create; intros; inv MapsTo; auto; + destruct (X.compare x k); intro; + try rewrite bal_mapsto; auto; unfold create; intros; inv MapsTo; auto; order. Qed. -Lemma add_find : forall m x y e, bst m -> - find y (add x e m) = +Lemma add_find : forall m x y e, bst m -> + find y (add x e m) = match X.compare y x with EQ _ => Some e | _ => find y m end. Proof. intros. @@ -909,7 +909,7 @@ Qed. (** * Extraction of minimum binding *) Lemma remove_min_in : forall l x e r h y, - In y (Node l x e r h) <-> + In y (Node l x e r h) <-> X.eq y (remove_min l x e r)#2#1 \/ In y (remove_min l x e r)#1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -919,7 +919,7 @@ Proof. Qed. Lemma remove_min_mapsto : forall l x e r h y e', - MapsTo y e' (Node l x e r h) <-> + MapsTo y e' (Node l x e r h) <-> ((X.eq y (remove_min l x e r)#2#1) /\ e' = (remove_min l x e r)#2#2) \/ MapsTo y e' (remove_min l x e r)#1. Proof. @@ -933,7 +933,7 @@ Proof. inversion_clear H3; intuition. Qed. -Lemma remove_min_bst : forall l x e r h, +Lemma remove_min_bst : forall l x e r h, bst (Node l x e r h) -> bst (remove_min l x e r)#1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -949,8 +949,8 @@ Proof. Qed. Hint Resolve remove_min_bst. -Lemma remove_min_gt_tree : forall l x e r h, - bst (Node l x e r h) -> +Lemma remove_min_gt_tree : forall l x e r h, + bst (Node l x e r h) -> gt_tree (remove_min l x e r)#2#1 (remove_min l x e r)#1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -968,10 +968,10 @@ Proof. Qed. Hint Resolve remove_min_gt_tree. -Lemma remove_min_find : forall l x e r h y, - bst (Node l x e r h) -> - find y (Node l x e r h) = - match X.compare y (remove_min l x e r)#2#1 with +Lemma remove_min_find : forall l x e r h y, + bst (Node l x e r h) -> + find y (Node l x e r h) = + match X.compare y (remove_min l x e r)#2#1 with | LT _ => None | EQ _ => Some (remove_min l x e r)#2#2 | GT _ => find y (remove_min l x e r)#1 @@ -990,9 +990,9 @@ Qed. (** * Merging two trees *) -Lemma merge_in : forall m1 m2 y, bst m1 -> bst m2 -> +Lemma merge_in : forall m1 m2 y, bst m1 -> bst m2 -> (In y (merge m1 m2) <-> In y m1 \/ In y m2). -Proof. +Proof. intros m1 m2; functional induction (merge m1 m2);intros; try factornode _x _x0 _x1 _x2 _x3 as m1. intuition_in. @@ -1000,10 +1000,10 @@ Proof. rewrite bal_in, remove_min_in, e1; simpl; intuition. Qed. -Lemma merge_mapsto : forall m1 m2 y e, bst m1 -> bst m2 -> +Lemma merge_mapsto : forall m1 m2 y e, bst m1 -> bst m2 -> (MapsTo y e (merge m1 m2) <-> MapsTo y e m1 \/ MapsTo y e m2). Proof. - intros m1 m2; functional induction (merge m1 m2); intros; + intros m1 m2; functional induction (merge m1 m2); intros; try factornode _x _x0 _x1 _x2 _x3 as m1. intuition_in. intuition_in. @@ -1013,12 +1013,12 @@ Proof. inversion_clear H1; intuition. Qed. -Lemma merge_bst : forall m1 m2, bst m1 -> bst m2 -> - (forall y1 y2 : key, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> - bst (merge m1 m2). +Lemma merge_bst : forall m1 m2, bst m1 -> bst m2 -> + (forall y1 y2 : key, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> + bst (merge m1 m2). Proof. intros m1 m2; functional induction (merge m1 m2); intros; auto; - try factornode _x _x0 _x1 _x2 _x3 as m1. + try factornode _x _x0 _x1 _x2 _x3 as m1. apply bal_bst; auto. generalize (remove_min_bst H0); rewrite e1; simpl in *; auto. intro; intro. @@ -1029,7 +1029,7 @@ Qed. (** * Deletion *) -Lemma remove_in : forall m x y, bst m -> +Lemma remove_in : forall m x y, bst m -> (In y (remove x m) <-> ~ X.eq y x /\ In y m). Proof. intros m x; functional induction (remove x m); simpl; intros. @@ -1049,7 +1049,7 @@ Proof. Qed. Lemma remove_bst : forall m x, bst m -> bst (remove x m). -Proof. +Proof. intros m x; functional induction (remove x m); simpl; intros. auto. (* LT *) @@ -1061,7 +1061,7 @@ Proof. (* EQ *) inv bst. apply merge_bst; eauto. - (* GT *) + (* GT *) inv bst. apply bal_bst; auto. intro; intro. @@ -1070,16 +1070,16 @@ Proof. Qed. Lemma remove_1 : forall m x y, bst m -> X.eq x y -> ~ In y (remove x m). -Proof. +Proof. intros; rewrite remove_in; intuition. Qed. -Lemma remove_2 : forall m x y e, bst m -> ~X.eq x y -> +Lemma remove_2 : forall m x y e, bst m -> ~X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m x y e; induction m; simpl; auto. - destruct (X.compare x k); - intros; inv bst; try rewrite bal_mapsto; unfold create; auto; + destruct (X.compare x k); + intros; inv bst; try rewrite bal_mapsto; unfold create; auto; try solve [inv MapsTo; auto]. rewrite merge_mapsto; auto. inv MapsTo; auto; order. @@ -1089,7 +1089,7 @@ Lemma remove_3 : forall m x y e, bst m -> MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m x y e; induction m; simpl; auto. - destruct (X.compare x k); intros Bs; inv bst; + destruct (X.compare x k); intros Bs; inv bst; try rewrite bal_mapsto; auto; unfold create. intros; inv MapsTo; auto. rewrite merge_mapsto; intuition. @@ -1098,7 +1098,7 @@ Qed. (** * join *) -Lemma join_in : forall l x d r y, +Lemma join_in : forall l x d r y, In y (join l x d r) <-> X.eq y x \/ In y l \/ In y r. Proof. join_tac. @@ -1110,23 +1110,23 @@ Proof. apply create_in. Qed. -Lemma join_bst : forall l x d r, bst l -> bst r -> +Lemma join_bst : forall l x d r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (join l x d r). Proof. - join_tac; auto; try (simpl; auto; fail); inv bst; apply bal_bst; auto; + join_tac; auto; try (simpl; auto; fail); inv bst; apply bal_bst; auto; clear Hrl Hlr z; intro; intros; rewrite join_in in *. intuition; [ apply MX.lt_eq with x | ]; eauto. intuition; [ apply MX.eq_lt with x | ]; eauto. Qed. Hint Resolve join_bst. -Lemma join_find : forall l x d r y, - bst l -> bst r -> lt_tree x l -> gt_tree x r -> +Lemma join_find : forall l x d r y, + bst l -> bst r -> lt_tree x l -> gt_tree x r -> find y (join l x d r) = find y (create l x d r). Proof. join_tac; auto; inv bst; - simpl (join (Leaf elt)); - try (assert (X.lt lx x) by auto); + simpl (join (Leaf elt)); + try (assert (X.lt lx x) by auto); try (assert (X.lt x rx) by auto); rewrite ?add_find, ?bal_find; auto. @@ -1150,10 +1150,10 @@ Qed. (** * split *) -Lemma split_in_1 : forall m x, bst m -> forall y, +Lemma split_in_1 : forall m x, bst m -> forall y, (In y (split x m)#l <-> In y m /\ X.lt y x). Proof. - intros m x; functional induction (split x m); simpl; intros; + intros m x; functional induction (split x m); simpl; intros; inv bst; try clear e0. intuition_in. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. @@ -1162,10 +1162,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_2 : forall m x, bst m -> forall y, +Lemma split_in_2 : forall m x, bst m -> forall y, (In y (split x m)#r <-> In y m /\ X.lt x y). -Proof. - intros m x; functional induction (split x m); subst; simpl; intros; +Proof. + intros m x; functional induction (split x m); subst; simpl; intros; inv bst; try clear e0. intuition_in. rewrite join_in. @@ -1174,18 +1174,18 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_3 : forall m x, bst m -> +Lemma split_in_3 : forall m x, bst m -> (split x m)#o = find x m. Proof. intros m x; functional induction (split x m); subst; simpl; auto; - intros; inv bst; try clear e0; + intros; inv bst; try clear e0; destruct X.compare; try (order;fail); rewrite <-IHt, e1; auto. Qed. -Lemma split_bst : forall m x, bst m -> +Lemma split_bst : forall m x, bst m -> bst (split x m)#l /\ bst (split x m)#r. -Proof. - intros m x; functional induction (split x m); subst; simpl; intros; +Proof. + intros m x; functional induction (split x m); subst; simpl; intros; inv bst; try clear e0; try rewrite e1 in *; simpl in *; intuition; apply join_bst; auto. intros y0. @@ -1204,17 +1204,17 @@ Proof. intros m x B y Hy; rewrite split_in_2 in Hy; intuition. Qed. -Lemma split_find : forall m x y, bst m -> - find y m = match X.compare y x with +Lemma split_find : forall m x y, bst m -> + find y m = match X.compare y x with | LT _ => find y (split x m)#l | EQ _ => (split x m)#o | GT _ => find y (split x m)#r end. Proof. - intros m x; functional induction (split x m); subst; simpl; intros; - inv bst; try clear e0; try rewrite e1 in *; simpl in *; + intros m x; functional induction (split x m); subst; simpl; intros; + inv bst; try clear e0; try rewrite e1 in *; simpl in *; [ destruct X.compare; auto | .. ]; - try match goal with E:split ?x ?t = _, B:bst ?t |- _ => + try match goal with E:split ?x ?t = _, B:bst ?t |- _ => generalize (split_in_1 x B)(split_in_2 x B)(split_bst x B); rewrite E; simpl; destruct 3 end. @@ -1231,7 +1231,7 @@ Qed. (** * Concatenation *) -Lemma concat_in : forall m1 m2 y, +Lemma concat_in : forall m1 m2 y, In y (concat m1 m2) <-> In y m1 \/ In y m2. Proof. intros m1 m2; functional induction (concat m1 m2); intros; @@ -1241,11 +1241,11 @@ Proof. rewrite join_in, remove_min_in, e1; simpl; intuition. Qed. -Lemma concat_bst : forall m1 m2, bst m1 -> bst m2 -> - (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> +Lemma concat_bst : forall m1 m2, bst m1 -> bst m2 -> + (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> bst (concat m1 m2). Proof. - intros m1 m2; functional induction (concat m1 m2); intros; auto; + intros m1 m2; functional induction (concat m1 m2); intros; auto; try factornode _x _x0 _x1 _x2 _x3 as m1. apply join_bst; auto. change (bst (m2',xd)#1); rewrite <-e1; eauto. @@ -1256,19 +1256,19 @@ Proof. Qed. Hint Resolve concat_bst. -Lemma concat_find : forall m1 m2 y, bst m1 -> bst m2 -> - (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> - find y (concat m1 m2) = +Lemma concat_find : forall m1 m2 y, bst m1 -> bst m2 -> + (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> + find y (concat m1 m2) = match find y m2 with Some d => Some d | None => find y m1 end. Proof. - intros m1 m2; functional induction (concat m1 m2); intros; auto; + intros m1 m2; functional induction (concat m1 m2); intros; auto; try factornode _x _x0 _x1 _x2 _x3 as m1. simpl; destruct (find y m2); auto. generalize (remove_min_find y H0)(remove_min_in l2 x2 d2 r2 _x4) - (remove_min_bst H0)(remove_min_gt_tree H0); + (remove_min_bst H0)(remove_min_gt_tree H0); rewrite e1; simpl fst; simpl snd; intros. - + inv bst. rewrite H2, join_find; auto; clear H2. simpl; destruct X.compare; simpl; auto. @@ -1286,7 +1286,7 @@ Notation eqk := (PX.eqk (elt:= elt)). Notation eqke := (PX.eqke (elt:= elt)). Notation ltk := (PX.ltk (elt:= elt)). -Lemma elements_aux_mapsto : forall (s:t elt) acc x e, +Lemma elements_aux_mapsto : forall (s:t elt) acc x e, InA eqke (x,e) (elements_aux acc s) <-> MapsTo x e s \/ InA eqke (x,e) acc. Proof. induction s as [ | l Hl x e r Hr h ]; simpl; auto. @@ -1299,8 +1299,8 @@ Proof. destruct H0; simpl in *; subst; intuition. Qed. -Lemma elements_mapsto : forall (s:t elt) x e, InA eqke (x,e) (elements s) <-> MapsTo x e s. -Proof. +Lemma elements_mapsto : forall (s:t elt) x e, InA eqke (x,e) (elements s) <-> MapsTo x e s. +Proof. intros; generalize (elements_aux_mapsto s nil x e); intuition. inversion_clear H0. Qed. @@ -1324,7 +1324,7 @@ Proof. induction s as [ | l Hl y e r Hr h]; simpl; intuition. inv bst. apply Hl; auto. - constructor. + constructor. apply Hr; eauto. apply (InA_InfA (PX.eqke_refl (elt:=elt))); intros (y',e') H6. destruct (elements_aux_mapsto r acc y' e'); intuition. @@ -1382,7 +1382,7 @@ Qed. (** * Fold *) -Definition fold' (A : Type) (f : key -> elt -> A -> A)(s : t elt) := +Definition fold' (A : Type) (f : key -> elt -> A -> A)(s : t elt) := L.fold f (elements s). Lemma fold_equiv_aux : @@ -1401,14 +1401,14 @@ Lemma fold_equiv : forall (A : Type) (s : t elt) (f : key -> elt -> A -> A) (a : A), fold f s a = fold' f s a. Proof. - unfold fold', elements in |- *. + unfold fold', elements in |- *. simple induction s; simpl in |- *; auto; intros. rewrite fold_equiv_aux. rewrite H0. simpl in |- *; auto. Qed. -Lemma fold_1 : +Lemma fold_1 : forall (s:t elt)(Hs:bst s)(A : Type)(i:A)(f : key -> elt -> A -> A), fold f s i = fold_left (fun a p => f p#1 p#2 a) (elements s) i. Proof. @@ -1421,9 +1421,9 @@ Qed. (** * Comparison *) -(** [flatten_e e] returns the list of elements of the enumeration [e] +(** [flatten_e e] returns the list of elements of the enumeration [e] i.e. the list of elements actually compared *) - + Fixpoint flatten_e (e : enumeration elt) : list (key*elt) := match e with | End => nil | More x e t r => (x,e) :: elements t ++ flatten_e r @@ -1431,13 +1431,13 @@ Fixpoint flatten_e (e : enumeration elt) : list (key*elt) := match e with Lemma flatten_e_elements : forall (l:t elt) r x d z e, - elements l ++ flatten_e (More x d r e) = + elements l ++ flatten_e (More x d r e) = elements (Node l x d r z) ++ flatten_e e. Proof. intros; simpl; apply elements_node. Qed. -Lemma cons_1 : forall (s:t elt) e, +Lemma cons_1 : forall (s:t elt) e, flatten_e (cons s e) = elements s ++ flatten_e e. Proof. induction s; simpl; auto; intros. @@ -1450,24 +1450,24 @@ Variable cmp : elt->elt->bool. Definition IfEq b l1 l2 := L.equal cmp l1 l2 = b. -Lemma cons_IfEq : forall b x1 x2 d1 d2 l1 l2, - X.eq x1 x2 -> cmp d1 d2 = true -> - IfEq b l1 l2 -> +Lemma cons_IfEq : forall b x1 x2 d1 d2 l1 l2, + X.eq x1 x2 -> cmp d1 d2 = true -> + IfEq b l1 l2 -> IfEq b ((x1,d1)::l1) ((x2,d2)::l2). Proof. - unfold IfEq; destruct b; simpl; intros; destruct X.compare; simpl; + unfold IfEq; destruct b; simpl; intros; destruct X.compare; simpl; try rewrite H0; auto; order. Qed. -Lemma equal_end_IfEq : forall e2, +Lemma equal_end_IfEq : forall e2, IfEq (equal_end e2) nil (flatten_e e2). Proof. destruct e2; red; auto. Qed. -Lemma equal_more_IfEq : - forall x1 d1 (cont:enumeration elt -> bool) x2 d2 r2 e2 l, - IfEq (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> +Lemma equal_more_IfEq : + forall x1 d1 (cont:enumeration elt -> bool) x2 d2 r2 e2 l, + IfEq (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> IfEq (equal_more cmp x1 d1 cont (More x2 d2 r2 e2)) ((x1,d1)::l) (flatten_e (More x2 d2 r2 e2)). Proof. @@ -1475,7 +1475,7 @@ Proof. rewrite <-andb_lazy_alt; f_equal; auto. Qed. -Lemma equal_cont_IfEq : forall m1 cont e2 l, +Lemma equal_cont_IfEq : forall m1 cont e2 l, (forall e, IfEq (cont e) l (flatten_e e)) -> IfEq (equal_cont cmp m1 cont e2) (elements m1 ++ l) (flatten_e e2). Proof. @@ -1493,18 +1493,18 @@ Lemma equal_IfEq : forall (m1 m2:t elt), Proof. intros; unfold equal. rewrite (app_nil_end (elements m1)). - replace (elements m2) with (flatten_e (cons m2 (End _))) + replace (elements m2) with (flatten_e (cons m2 (End _))) by (rewrite cons_1; simpl; rewrite <-app_nil_end; auto). apply equal_cont_IfEq. intros. apply equal_end_IfEq; auto. Qed. -Definition Equivb m m' := - (forall k, In k m <-> In k m') /\ +Definition Equivb m m' := + (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Lemma Equivb_elements : forall s s', +Lemma Equivb_elements : forall s s', Equivb s s' <-> L.Equivb cmp (elements s) (elements s'). Proof. unfold Equivb, L.Equivb; split; split; intros. @@ -1516,7 +1516,7 @@ destruct H. apply (H2 k); unfold L.PX.MapsTo; rewrite elements_mapsto; auto. Qed. -Lemma equal_Equivb : forall (s s': t elt), bst s -> bst s' -> +Lemma equal_Equivb : forall (s s': t elt), bst s -> bst s' -> (equal cmp s s' = true <-> Equivb s s'). Proof. intros s s' B B'. @@ -1526,17 +1526,17 @@ Qed. End Elt. -Section Map. +Section Map. Variable elt elt' : Type. -Variable f : elt -> elt'. +Variable f : elt -> elt'. -Lemma map_1 : forall (m: t elt)(x:key)(e:elt), +Lemma map_1 : forall (m: t elt)(x:key)(e:elt), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. induction m; simpl; inversion_clear 1; auto. Qed. -Lemma map_2 : forall (m: t elt)(x:key), +Lemma map_2 : forall (m: t elt)(x:key), In x (map f m) -> In x m. Proof. induction m; simpl; inversion_clear 1; auto. @@ -1545,7 +1545,7 @@ Qed. Lemma map_bst : forall m, bst m -> bst (map f m). Proof. induction m; simpl; auto. -inversion_clear 1; constructor; auto; +inversion_clear 1; constructor; auto; red; auto using map_2. Qed. @@ -1554,7 +1554,7 @@ Section Mapi. Variable elt elt' : Type. Variable f : key -> elt -> elt'. -Lemma mapi_1 : forall (m: tree elt)(x:key)(e:elt), +Lemma mapi_1 : forall (m: tree elt)(x:key)(e:elt), MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. induction m; simpl; inversion_clear 1; auto. @@ -1565,7 +1565,7 @@ destruct (IHm2 _ _ H0). exists x0; intuition. Qed. -Lemma mapi_2 : forall (m: t elt)(x:key), +Lemma mapi_2 : forall (m: t elt)(x:key), In x (mapi f m) -> In x m. Proof. induction m; simpl; inversion_clear 1; auto. @@ -1574,7 +1574,7 @@ Qed. Lemma mapi_bst : forall m, bst m -> bst (mapi f m). Proof. induction m; simpl; auto. -inversion_clear 1; constructor; auto; +inversion_clear 1; constructor; auto; red; auto using mapi_2. Qed. @@ -1585,7 +1585,7 @@ Variable elt elt' : Type. Variable f : key -> elt -> option elt'. Hypothesis f_compat : forall x x' d, X.eq x x' -> f x d = f x' d. -Lemma map_option_2 : forall (m:t elt)(x:key), +Lemma map_option_2 : forall (m:t elt)(x:key), In x (map_option f m) -> exists d, MapsTo x d m /\ f x d <> None. Proof. intros m; functional induction (map_option f m); simpl; auto; intros. @@ -1601,9 +1601,9 @@ Qed. Lemma map_option_bst : forall m, bst m -> bst (map_option f m). Proof. -intros m; functional induction (map_option f m); simpl; auto; intros; +intros m; functional induction (map_option f m); simpl; auto; intros; inv bst. -apply join_bst; auto; intros y H; +apply join_bst; auto; intros y H; destruct (map_option_2 H) as (d0 & ? & ?); eauto using MapsTo_In. apply concat_bst; auto; intros y y' H H'. destruct (map_option_2 H) as (d0 & ? & ?). @@ -1612,22 +1612,22 @@ eapply X.lt_trans with x; eauto using MapsTo_In. Qed. Hint Resolve map_option_bst. -Ltac nonify e := - replace e with (@None elt) by +Ltac nonify e := + replace e with (@None elt) by (symmetry; rewrite not_find_iff; auto; intro; order). -Lemma map_option_find : forall (m:t elt)(x:key), - bst m -> - find x (map_option f m) = +Lemma map_option_find : forall (m:t elt)(x:key), + bst m -> + find x (map_option f m) = match (find x m) with Some d => f x d | None => None end. Proof. intros m; functional induction (map_option f m); simpl; auto; intros; - inv bst; rewrite join_find || rewrite concat_find; auto; simpl; + inv bst; rewrite join_find || rewrite concat_find; auto; simpl; try destruct X.compare; simpl; auto. rewrite (f_compat d e); auto. intros y H; destruct (map_option_2 H) as (? & ? & ?); eauto using MapsTo_In. -intros y H; +intros y H; destruct (map_option_2 H) as (? & ? & ?); eauto using MapsTo_In. rewrite <- IHt, IHt0; auto; nonify (find x0 r); auto. @@ -1653,21 +1653,21 @@ Variable mapr : t elt' -> t elt''. Hypothesis f0_f : forall x d o, f x d o = f0 x (Some d) o. Hypothesis mapl_bst : forall m, bst m -> bst (mapl m). Hypothesis mapr_bst : forall m', bst m' -> bst (mapr m'). -Hypothesis mapl_f0 : forall x m, bst m -> - find x (mapl m) = +Hypothesis mapl_f0 : forall x m, bst m -> + find x (mapl m) = match find x m with Some d => f0 x (Some d) None | None => None end. -Hypothesis mapr_f0 : forall x m', bst m' -> - find x (mapr m') = +Hypothesis mapr_f0 : forall x m', bst m' -> + find x (mapr m') = match find x m' with Some d' => f0 x None (Some d') | None => None end. Hypothesis f0_compat : forall x x' o o', X.eq x x' -> f0 x o o' = f0 x' o o'. Notation map2_opt := (map2_opt f mapl mapr). -Lemma map2_opt_2 : forall m m' y, bst m -> bst m' -> +Lemma map2_opt_2 : forall m m' y, bst m -> bst m' -> In y (map2_opt m m') -> In y m \/ In y m'. Proof. intros m m'; functional induction (map2_opt m m'); intros; - auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; + auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; try (generalize (split_in_1 x1 H0 y)(split_in_2 x1 H0 y) (split_bst x1 H0); rewrite e1; simpl; destruct 3; inv bst). @@ -1689,12 +1689,12 @@ destruct (IHt1 y H6 H4 H'); intuition. destruct (IHt0 y H7 H5 H'); intuition. Qed. -Lemma map2_opt_bst : forall m m', bst m -> bst m' -> +Lemma map2_opt_bst : forall m m', bst m -> bst m' -> bst (map2_opt m m'). Proof. intros m m'; functional induction (map2_opt m m'); intros; - auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; inv bst; - generalize (split_in_1 x1 H0)(split_in_2 x1 H0)(split_bst x1 H0); + auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; inv bst; + generalize (split_in_1 x1 H0)(split_in_2 x1 H0)(split_bst x1 H0); rewrite e1; simpl in *; destruct 3. apply join_bst; auto. @@ -1711,31 +1711,31 @@ destruct (map2_opt_2 H2 H7 Hy'); intuition. Qed. Hint Resolve map2_opt_bst. -Ltac map2_aux := +Ltac map2_aux := match goal with - | H : In ?x _ \/ In ?x ?m, - H' : find ?x ?m = find ?x ?m', B:bst ?m, B':bst ?m' |- _ => - destruct H; [ intuition_in; order | + | H : In ?x _ \/ In ?x ?m, + H' : find ?x ?m = find ?x ?m', B:bst ?m, B':bst ?m' |- _ => + destruct H; [ intuition_in; order | rewrite <-(find_in_equiv B B' H'); auto ] end. -Ltac nonify t := - match t with (find ?y (map2_opt ?m ?m')) => +Ltac nonify t := + match t with (find ?y (map2_opt ?m ?m')) => replace t with (@None elt''); [ | symmetry; rewrite not_find_iff; auto; intro; destruct (@map2_opt_2 m m' y); auto; order ] end. -Lemma map2_opt_1 : forall m m' y, bst m -> bst m' -> +Lemma map2_opt_1 : forall m m' y, bst m -> bst m' -> In y m \/ In y m' -> find y (map2_opt m m') = f0 y (find y m) (find y m'). Proof. intros m m'; functional induction (map2_opt m m'); intros; - auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; + auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; try (generalize (split_in_1 x1 H0)(split_in_2 x1 H0) (split_in_3 x1 H0)(split_bst x1 H0)(split_find x1 y H0) (split_lt_tree (x:=x1) H0)(split_gt_tree (x:=x1) H0); - rewrite e1; simpl in *; destruct 4; intros; inv bst; + rewrite e1; simpl in *; destruct 4; intros; inv bst; subst o2; rewrite H7, ?join_find, ?concat_find; auto). simpl; destruct H1; [ inversion_clear H1 | ]. @@ -1777,19 +1777,19 @@ Variable f : option elt -> option elt' -> option elt''. Lemma map2_bst : forall m m', bst m -> bst m' -> bst (map2 f m m'). Proof. unfold map2; intros. -apply map2_opt_bst with (fun _ => f); auto using map_option_bst; +apply map2_opt_bst with (fun _ => f); auto using map_option_bst; intros; rewrite map_option_find; auto. Qed. -Lemma map2_1 : forall m m' y, bst m -> bst m' -> +Lemma map2_1 : forall m m' y, bst m -> bst m' -> In y m \/ In y m' -> find y (map2 f m m') = f (find y m) (find y m'). Proof. unfold map2; intros. -rewrite (map2_opt_1 (f0:=fun _ => f)); +rewrite (map2_opt_1 (f0:=fun _ => f)); auto using map_option_bst; intros; rewrite map_option_find; auto. Qed. -Lemma map2_2 : forall m m' y, bst m -> bst m' -> +Lemma map2_2 : forall m m' y, bst m -> bst m' -> In y (map2 f m m') -> In y m \/ In y m'. Proof. unfold map2; intros. @@ -1806,38 +1806,38 @@ End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we + Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of balanced binary search trees. *) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Module E := X. - Module Raw := Raw I X. + Module Raw := Raw I X. Import Raw.Proofs. - Record bst (elt:Type) := + Record bst (elt:Type) := Bst {this :> Raw.tree elt; is_bst : Raw.bst this}. - - Definition t := bst. + + Definition t := bst. Definition key := E.t. - - Section Elt. + + Section Elt. Variable elt elt' elt'': Type. Implicit Types m : t elt. - Implicit Types x y : key. - Implicit Types e : elt. + Implicit Types x y : key. + Implicit Types e : elt. Definition empty : t elt := Bst (empty_bst elt). Definition is_empty m : bool := Raw.is_empty m.(this). Definition add x e m : t elt := Bst (add_bst x e m.(is_bst)). - Definition remove x m : t elt := Bst (remove_bst x m.(is_bst)). + Definition remove x m : t elt := Bst (remove_bst x m.(is_bst)). Definition mem x m : bool := Raw.mem x m.(this). Definition find x m : option elt := Raw.find x m.(this). Definition map f m : t elt' := Bst (map_bst f m.(is_bst)). - Definition mapi (f:key->elt->elt') m : t elt' := + Definition mapi (f:key->elt->elt') m : t elt' := Bst (mapi_bst f m.(is_bst)). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Bst (map2_bst f m.(is_bst) m'.(is_bst)). Definition elements m : list (key*elt) := Raw.elements m.(this). Definition cardinal m := Raw.cardinal m.(this). @@ -1854,14 +1854,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@MapsTo_1 _ m.(this)). Qed. - + Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_1; auto. apply m.(is_bst). Qed. - - Lemma mem_2 : forall m x, mem x m = true -> In x m. + + Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_2; auto. Qed. @@ -1892,7 +1892,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros m x y e; exact (@remove_3 elt _ x y e m.(is_bst)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m x e; exact (@find_1 elt _ x e m.(is_bst)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@find_2 elt m.(this)). Qed. @@ -1901,36 +1901,36 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@fold_1 elt m.(this) m.(is_bst)). Qed. - Lemma elements_1 : forall m x e, + Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite elements_mapsto; auto. Qed. - Lemma elements_2 : forall m x e, + Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite <- elements_mapsto; auto. Qed. - Lemma elements_3 : forall m, sort lt_key (elements m). + Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@elements_sort elt m.(this) m.(is_bst)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@elements_nodup elt m.(this) m.(is_bst)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intro m; exact (@elements_cardinal elt m.(this)). Qed. Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp := Equiv (Cmp cmp). - Lemma Equivb_Equivb : forall cmp m m', + Lemma Equivb_Equivb : forall cmp m m', Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'. - Proof. + Proof. intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. @@ -1938,23 +1938,23 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. generalize (H0 k); do 2 rewrite <- In_alt; intuition. Qed. - Lemma equal_1 : forall m m' cmp, - Equivb cmp m m' -> equal cmp m m' = true. - Proof. - unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; + Lemma equal_1 : forall m m' cmp, + Equivb cmp m m' -> equal cmp m m' = true. + Proof. + unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite equal_Equivb; auto. - Qed. + Qed. - Lemma equal_2 : forall m m' cmp, + Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. - Proof. - unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; + Proof. + unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite <-equal_Equivb; auto. Qed. End Elt. - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m x e f; exact (@map_1 elt elt' f m.(this) x e). Qed. @@ -1962,10 +1962,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros elt elt' m x f; do 2 unfold In in *; do 2 rewrite In_alt; simpl. apply map_2; auto. - Qed. + Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m x e f; exact (@mapi_1 elt elt' f m.(this) x e). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -1975,10 +1975,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. unfold find, map2, In; intros elt elt' elt'' m m' x f. do 2 rewrite In_alt; intros; simpl; apply map2_1; auto. apply m.(is_bst). @@ -1986,9 +1986,9 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. + Proof. unfold In, map2; intros elt elt' elt'' m m' x f. do 3 rewrite In_alt; intros; simpl in *; eapply map2_2; eauto. apply m.(is_bst). @@ -1998,19 +1998,19 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. End IntMake. -Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: - Sord with Module Data := D +Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: + Sord with Module Data := D with Module MapS.E := X. Module Data := D. - Module Import MapS := IntMake(I)(X). + Module Import MapS := IntMake(I)(X). Module LO := FMapList.Make_ord(X)(D). Module R := Raw. Module P := Raw.Proofs. Definition t := MapS.t D.t. - Definition cmp e e' := + Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. (** One step of comparison of elements *) @@ -2020,9 +2020,9 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: | R.End => Gt | R.More x2 d2 r2 e2 => match X.compare x1 x2 with - | EQ _ => match D.compare d1 d2 with + | EQ _ => match D.compare d1 d2 with | EQ _ => cont (R.cons r2 e2) - | LT _ => Lt + | LT _ => Lt | GT _ => Gt end | LT _ => Lt @@ -2046,7 +2046,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: (** The complete comparison *) - Definition compare_pure s1 s2 := + Definition compare_pure s1 s2 := compare_cont s1 compare_end (R.cons s2 (Raw.End _)). (** Correctness of this comparison *) @@ -2058,7 +2058,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: | Gt => (fun l1 l2 => LO.lt_list l2 l1) end. - Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, + Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, X.eq x1 x2 -> D.eq d1 d2 -> Cmp c l1 l2 -> Cmp c ((x1,d1)::l1) ((x2,d2)::l2). Proof. @@ -2077,10 +2077,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Cmp (compare_more x1 d1 cont (R.More x2 d2 r2 e2)) ((x1,d1)::l) (P.flatten_e (R.More x2 d2 r2 e2)). Proof. - simpl; intros; destruct X.compare; simpl; + simpl; intros; destruct X.compare; simpl; try destruct D.compare; simpl; auto; P.MX.elim_comp; auto. Qed. - + Lemma compare_cont_Cmp : forall s1 cont e2 l, (forall e, Cmp (cont e) l (P.flatten_e e)) -> Cmp (compare_cont s1 cont e2) (R.elements s1 ++ l) (P.flatten_e e2). @@ -2114,10 +2114,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: generalize (compare_Cmp s s'). destruct compare_pure; intros; [apply EQ|apply LT|apply GT]; red; auto. Defined. - + (* Proofs about [eq] and [lt] *) - Definition selements (m1 : t) := + Definition selements (m1 : t) := LO.MapS.Build_slist (P.elements_sort m1.(is_bst)). Definition seq (m1 m2 : t) := LO.eq (selements m1) (selements m2). @@ -2154,7 +2154,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Qed. Lemma eq_refl : forall m : t, eq m m. - Proof. + Proof. intros; rewrite eq_seq; unfold seq; intros; apply LO.eq_refl. Qed. @@ -2171,13 +2171,13 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. - intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; + intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; intros; eapply LO.lt_trans; eauto. Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. - intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; + intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; intros; apply LO.lt_not_eq; auto. Qed. @@ -2188,8 +2188,8 @@ End IntMake_ord. Module Make (X: OrderedType) <: S with Module E := X :=IntMake(Z_as_Int)(X). -Module Make_ord (X: OrderedType)(D: OrderedType) - <: Sord with Module Data := D +Module Make_ord (X: OrderedType)(D: OrderedType) + <: Sord with Module Data := D with Module MapS.E := X :=IntMake_ord(Z_as_Int)(X)(D). diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v index e09db9b6e..88ca717e2 100644 --- a/theories/FSets/FMapFacts.v +++ b/theories/FSets/FMapFacts.v @@ -11,12 +11,12 @@ (** * Finite maps library *) (** This functor derives additional facts from [FMapInterface.S]. These - facts are mainly the specifications of [FMapInterface.S] written using - different styles: equivalence and boolean equalities. + facts are mainly the specifications of [FMapInterface.S] written using + different styles: equivalence and boolean equalities. *) Require Import Bool DecidableType DecidableTypeEx OrderedType Morphisms. -Require Export FMapInterface. +Require Export FMapInterface. Set Implicit Arguments. Unset Strict Implicit. @@ -46,7 +46,7 @@ destruct o; destruct o'; try rewrite H; auto. symmetry; rewrite <- H; auto. Qed. -Lemma MapsTo_fun : forall (elt:Type) m x (e e':elt), +Lemma MapsTo_fun : forall (elt:Type) m x (e e':elt), MapsTo x e m -> MapsTo x e' m -> e=e'. Proof. intros. @@ -56,7 +56,7 @@ Qed. (** ** Specifications written using equivalences *) -Section IffSpec. +Section IffSpec. Variable elt elt' elt'': Type. Implicit Type m: t elt. Implicit Type x y z: key. @@ -112,7 +112,7 @@ destruct mem; intuition. Qed. Lemma equal_iff : forall m m' cmp, Equivb cmp m m' <-> equal cmp m m' = true. -Proof. +Proof. split; [apply equal_1|apply equal_2]. Qed. @@ -127,16 +127,16 @@ unfold In. split; [intros (e,H); rewrite empty_mapsto_iff in H|]; intuition. Qed. -Lemma is_empty_iff : forall m, Empty m <-> is_empty m = true. -Proof. +Lemma is_empty_iff : forall m, Empty m <-> is_empty m = true. +Proof. split; [apply is_empty_1|apply is_empty_2]. Qed. -Lemma add_mapsto_iff : forall m x y e e', - MapsTo y e' (add x e m) <-> - (E.eq x y /\ e=e') \/ +Lemma add_mapsto_iff : forall m x y e e', + MapsTo y e' (add x e m) <-> + (E.eq x y /\ e=e') \/ (~E.eq x y /\ MapsTo y e' m). -Proof. +Proof. intros. intuition. destruct (eq_dec x y); [left|right]. @@ -147,7 +147,7 @@ subst; auto with map. Qed. Lemma add_in_iff : forall m x y e, In y (add x e m) <-> E.eq x y \/ In y m. -Proof. +Proof. unfold In; split. intros (e',H). destruct (eq_dec x y) as [E|E]; auto. @@ -161,13 +161,13 @@ destruct E; auto. exists e'; apply add_2; auto. Qed. -Lemma add_neq_mapsto_iff : forall m x y e e', +Lemma add_neq_mapsto_iff : forall m x y e e', ~ E.eq x y -> (MapsTo y e' (add x e m) <-> MapsTo y e' m). Proof. split; [apply add_3|apply add_2]; auto. Qed. -Lemma add_neq_in_iff : forall m x y e, +Lemma add_neq_in_iff : forall m x y e, ~ E.eq x y -> (In y (add x e m) <-> In y m). Proof. split; intros (e',H0); exists e'. @@ -175,9 +175,9 @@ apply (add_3 H H0). apply add_2; auto. Qed. -Lemma remove_mapsto_iff : forall m x y e, +Lemma remove_mapsto_iff : forall m x y e, MapsTo y e (remove x m) <-> ~E.eq x y /\ MapsTo y e m. -Proof. +Proof. intros. split; intros. split. @@ -188,7 +188,7 @@ apply remove_2; intuition. Qed. Lemma remove_in_iff : forall m x y, In y (remove x m) <-> ~E.eq x y /\ In y m. -Proof. +Proof. unfold In; split. intros (e,H). split. @@ -198,13 +198,13 @@ exists e; apply remove_3 with x; auto. intros (H,(e,H0)); exists e; apply remove_2; auto. Qed. -Lemma remove_neq_mapsto_iff : forall m x y e, +Lemma remove_neq_mapsto_iff : forall m x y e, ~ E.eq x y -> (MapsTo y e (remove x m) <-> MapsTo y e m). Proof. split; [apply remove_3|apply remove_2]; auto. Qed. -Lemma remove_neq_in_iff : forall m x y, +Lemma remove_neq_in_iff : forall m x y, ~ E.eq x y -> (In y (remove x m) <-> In y m). Proof. split; intros (e',H0); exists e'. @@ -212,19 +212,19 @@ apply (remove_3 H0). apply remove_2; auto. Qed. -Lemma elements_mapsto_iff : forall m x e, +Lemma elements_mapsto_iff : forall m x e, MapsTo x e m <-> InA (@eq_key_elt _) (x,e) (elements m). -Proof. +Proof. split; [apply elements_1 | apply elements_2]. Qed. -Lemma elements_in_iff : forall m x, +Lemma elements_in_iff : forall m x, In x m <-> exists e, InA (@eq_key_elt _) (x,e) (elements m). -Proof. +Proof. unfold In; split; intros (e,H); exists e; [apply elements_1 | apply elements_2]; auto. Qed. -Lemma map_mapsto_iff : forall m x b (f : elt -> elt'), +Lemma map_mapsto_iff : forall m x b (f : elt -> elt'), MapsTo x b (map f m) <-> exists a, b = f a /\ MapsTo x a m. Proof. split. @@ -240,7 +240,7 @@ intros (a,(H,H0)). subst b; auto with map. Qed. -Lemma map_in_iff : forall m x (f : elt -> elt'), +Lemma map_in_iff : forall m x (f : elt -> elt'), In x (map f m) <-> In x m. Proof. split; intros; eauto with map. @@ -257,11 +257,11 @@ destruct (mapi_1 f H) as (y,(H0,H1)). exists (f y a); auto. Qed. -(** Unfortunately, we don't have simple equivalences for [mapi] - and [MapsTo]. The only correct one needs compatibility of [f]. *) +(** Unfortunately, we don't have simple equivalences for [mapi] + and [MapsTo]. The only correct one needs compatibility of [f]. *) -Lemma mapi_inv : forall m x b (f : key -> elt -> elt'), - MapsTo x b (mapi f m) -> +Lemma mapi_inv : forall m x b (f : key -> elt -> elt'), + MapsTo x b (mapi f m) -> exists a, exists y, E.eq y x /\ b = f y a /\ MapsTo x a m. Proof. intros; case_eq (find x m); intros. @@ -275,8 +275,8 @@ destruct (mapi_2 H1) as (a,H2). rewrite (find_1 H2) in H0; discriminate. Qed. -Lemma mapi_1bis : forall m x e (f:key->elt->elt'), - (forall x y e, E.eq x y -> f x e = f y e) -> +Lemma mapi_1bis : forall m x e (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> MapsTo x e m -> MapsTo x (f x e) (mapi f m). Proof. intros. @@ -286,7 +286,7 @@ auto. Qed. Lemma mapi_mapsto_iff : forall m x b (f:key->elt->elt'), - (forall x y e, E.eq x y -> f x e = f y e) -> + (forall x y e, E.eq x y -> f x e = f y e) -> (MapsTo x b (mapi f m) <-> exists a, b = f x a /\ MapsTo x a m). Proof. split. @@ -299,14 +299,14 @@ subst b. apply mapi_1bis; auto. Qed. -(** Things are even worse for [map2] : we don't try to state any +(** Things are even worse for [map2] : we don't try to state any equivalence, see instead boolean results below. *) End IffSpec. (** Useful tactic for simplifying expressions like [In y (add x e (remove z m))] *) - -Ltac map_iff := + +Ltac map_iff := repeat (progress ( rewrite add_mapsto_iff || rewrite add_in_iff || rewrite remove_mapsto_iff || rewrite remove_in_iff || @@ -318,7 +318,7 @@ Ltac map_iff := Section BoolSpec. -Lemma mem_find_b : forall (elt:Type)(m:t elt)(x:key), mem x m = if find x m then true else false. +Lemma mem_find_b : forall (elt:Type)(m:t elt)(x:key), mem x m = if find x m then true else false. Proof. intros. generalize (find_mapsto_iff m x)(mem_in_iff m x); unfold In. @@ -336,7 +336,7 @@ Implicit Types x y z : key. Implicit Types e : elt. Lemma mem_b : forall m x y, E.eq x y -> mem x m = mem y m. -Proof. +Proof. intros. generalize (mem_in_iff m x) (mem_in_iff m y)(In_iff m H). destruct (mem x m); destruct (mem y m); intuition. @@ -362,14 +362,14 @@ generalize (mem_2 H). rewrite empty_in_iff; intuition. Qed. -Lemma add_eq_o : forall m x y e, +Lemma add_eq_o : forall m x y e, E.eq x y -> find y (add x e m) = Some e. Proof. auto with map. Qed. -Lemma add_neq_o : forall m x y e, - ~ E.eq x y -> find y (add x e m) = find y m. +Lemma add_neq_o : forall m x y e, + ~ E.eq x y -> find y (add x e m) = find y m. Proof. intros. rewrite eq_option_alt. intro e'. rewrite <- 2 find_mapsto_iff. apply add_neq_mapsto_iff; auto. @@ -382,26 +382,26 @@ Proof. intros; destruct (eq_dec x y); auto with map. Qed. -Lemma add_eq_b : forall m x y e, +Lemma add_eq_b : forall m x y e, E.eq x y -> mem y (add x e m) = true. Proof. intros; rewrite mem_find_b; rewrite add_eq_o; auto. Qed. -Lemma add_neq_b : forall m x y e, +Lemma add_neq_b : forall m x y e, ~E.eq x y -> mem y (add x e m) = mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite add_neq_o; auto. Qed. -Lemma add_b : forall m x y e, - mem y (add x e m) = eqb x y || mem y m. +Lemma add_b : forall m x y e, + mem y (add x e m) = eqb x y || mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite add_o; unfold eqb. destruct (eq_dec x y); simpl; auto. Qed. -Lemma remove_eq_o : forall m x y, +Lemma remove_eq_o : forall m x y, E.eq x y -> find y (remove x m) = None. Proof. intros. rewrite eq_option_alt. intro e. @@ -442,14 +442,14 @@ intros; do 2 rewrite mem_find_b; rewrite remove_o; unfold eqb. destruct (eq_dec x y); auto. Qed. -Definition option_map (A B:Type)(f:A->B)(o:option A) : option B := - match o with +Definition option_map (A B:Type)(f:A->B)(o:option A) : option B := + match o with | Some a => Some (f a) | None => None end. -Lemma map_o : forall m x (f:elt->elt'), - find x (map f m) = option_map f (find x m). +Lemma map_o : forall m x (f:elt->elt'), + find x (map f m) = option_map f (find x m). Proof. intros. generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x) @@ -463,14 +463,14 @@ rewrite H0 in H2; discriminate. rewrite <- H; rewrite H1; exists e; rewrite H0; auto. Qed. -Lemma map_b : forall m x (f:elt->elt'), +Lemma map_b : forall m x (f:elt->elt'), mem x (map f m) = mem x m. Proof. intros; do 2 rewrite mem_find_b; rewrite map_o. destruct (find x m); simpl; auto. Qed. -Lemma mapi_b : forall m x (f:key->elt->elt'), +Lemma mapi_b : forall m x (f:key->elt->elt'), mem x (mapi f m) = mem x m. Proof. intros. @@ -480,12 +480,12 @@ symmetry; rewrite <- H0; rewrite <- H1; rewrite H; auto. rewrite <- H; rewrite H1; rewrite H0; auto. Qed. -Lemma mapi_o : forall m x (f:key->elt->elt'), - (forall x y e, E.eq x y -> f x e = f y e) -> +Lemma mapi_o : forall m x (f:key->elt->elt'), + (forall x y e, E.eq x y -> f x e = f y e) -> find x (mapi f m) = option_map (f x) (find x m). Proof. intros. -generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) +generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) (fun b => mapi_mapsto_iff m x b H). destruct (find x (mapi f m)); destruct (find x m); simpl; auto; intros. rewrite <- H0; rewrite H2; exists e0; rewrite H1; auto. @@ -496,9 +496,9 @@ rewrite H1 in H3; discriminate. rewrite <- H0; rewrite H2; exists e; rewrite H1; auto. Qed. -Lemma map2_1bis : forall (m: t elt)(m': t elt') x - (f:option elt->option elt'->option elt''), - f None None = None -> +Lemma map2_1bis : forall (m: t elt)(m': t elt') x + (f:option elt->option elt'->option elt''), + f None None = None -> find x (map2 f m m') = f (find x m) (find x m'). Proof. intros. @@ -598,7 +598,7 @@ Section Cmp. Variable eq_elt : elt->elt->Prop. Variable cmp : elt->elt->bool. -Definition compat_cmp := +Definition compat_cmp := forall e e', cmp e e' = true <-> eq_elt e e'. Lemma Equiv_Equivb : compat_cmp -> @@ -613,17 +613,17 @@ End Cmp. (** Composition of the two last results: relation between [Equal] and [Equivb]. *) -Lemma Equal_Equivb : forall cmp, - (forall e e', cmp e e' = true <-> e = e') -> +Lemma Equal_Equivb : forall cmp, + (forall e e', cmp e e' = true <-> e = e') -> forall (m m':t elt), Equal m m' <-> Equivb cmp m m'. Proof. intros; rewrite Equal_Equiv. apply Equiv_Equivb; auto. Qed. -Lemma Equal_Equivb_eqdec : +Lemma Equal_Equivb_eqdec : forall eq_elt_dec : (forall e e', { e = e' } + { e <> e' }), - let cmp := fun e e' => if eq_elt_dec e e' then true else false in + let cmp := fun e e' => if eq_elt_dec e e' then true else false in forall (m m':t elt), Equal m m' <-> Equivb cmp m m'. Proof. intros; apply Equal_Equivb. @@ -638,11 +638,11 @@ End Equalities. Lemma Equal_refl : forall (elt:Type)(m : t elt), Equal m m. Proof. red; reflexivity. Qed. -Lemma Equal_sym : forall (elt:Type)(m m' : t elt), +Lemma Equal_sym : forall (elt:Type)(m m' : t elt), Equal m m' -> Equal m' m. Proof. unfold Equal; auto. Qed. -Lemma Equal_trans : forall (elt:Type)(m m' m'' : t elt), +Lemma Equal_trans : forall (elt:Type)(m m' m'' : t elt), Equal m m' -> Equal m' m'' -> Equal m m''. Proof. unfold Equal; congruence. Qed. @@ -651,15 +651,15 @@ Proof. constructor; red; [apply Equal_refl | apply Equal_sym | apply Equal_trans]. Qed. -Add Relation key E.eq - reflexivity proved by E.eq_refl +Add Relation key E.eq + reflexivity proved by E.eq_refl symmetry proved by E.eq_sym - transitivity proved by E.eq_trans + transitivity proved by E.eq_trans as KeySetoid. Implicit Arguments Equal [[elt]]. -Add Parametric Relation (elt : Type) : (t elt) Equal +Add Parametric Relation (elt : Type) : (t elt) Equal reflexivity proved by (@Equal_refl elt) symmetry proved by (@Equal_sym elt) transitivity proved by (@Equal_trans elt) @@ -762,7 +762,7 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E). Notation eqke := (@eq_key_elt elt). Notation eqk := (@eq_key elt). - + (** Complements about InA, NoDupA and findA *) Lemma InA_eqke_eqk : forall k1 k2 e1 e2 l, @@ -1205,19 +1205,19 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E). apply fold_Add with (eqA:=Leibniz); compute; auto. Qed. - Lemma cardinal_inv_1 : forall m : t elt, + Lemma cardinal_inv_1 : forall m : t elt, cardinal m = 0 -> Empty m. Proof. - intros; rewrite cardinal_Empty; auto. + intros; rewrite cardinal_Empty; auto. Qed. Hint Resolve cardinal_inv_1 : map. Lemma cardinal_inv_2 : forall m n, cardinal m = S n -> { p : key*elt | MapsTo (fst p) (snd p) m }. - Proof. + Proof. intros; rewrite M.cardinal_1 in *. generalize (elements_mapsto_iff m). - destruct (elements m); try discriminate. + destruct (elements m); try discriminate. exists p; auto. rewrite H0; destruct p; simpl; auto. constructor; red; auto. @@ -1243,16 +1243,16 @@ Module WProperties_fun (E:DecidableType)(M:WSfun E). (** * Emulation of some functions lacking in the interface *) - Definition filter (f : key -> elt -> bool)(m : t elt) := + Definition filter (f : key -> elt -> bool)(m : t elt) := fold (fun k e m => if f k e then add k e m else m) m (empty _). - Definition for_all (f : key -> elt -> bool)(m : t elt) := + Definition for_all (f : key -> elt -> bool)(m : t elt) := fold (fun k e b => if f k e then b else false) m true. - Definition exists_ (f : key -> elt -> bool)(m : t elt) := + Definition exists_ (f : key -> elt -> bool)(m : t elt) := fold (fun k e b => if f k e then true else b) m false. - Definition partition (f : key -> elt -> bool)(m : t elt) := + Definition partition (f : key -> elt -> bool)(m : t elt) := (filter f m, filter (fun k e => negb (f k e)) m). (** [update] adds to [m1] all the bindings of [m2]. It can be seen as @@ -1762,7 +1762,7 @@ Module OrdProperties (M:S). Import F. Import M. - Section Elt. + Section Elt. Variable elt:Type. Notation eqke := (@eqke elt). @@ -1780,7 +1780,7 @@ Module OrdProperties (M:S). Lemma sort_equivlistA_eqlistA : forall l l' : list (key*elt), sort ltk l -> sort ltk l' -> equivlistA eqke l l' -> eqlistA eqke l l'. Proof. - apply SortA_equivlistA_eqlistA; eauto; + apply SortA_equivlistA_eqlistA; eauto; unfold O.eqke, O.ltk; simpl; intuition; eauto. Qed. @@ -1788,7 +1788,7 @@ Module OrdProperties (M:S). Definition gtb (p p':key*elt) := match E.compare (fst p) (fst p') with GT _ => true | _ => false end. - Definition leb p := fun p' => negb (gtb p p'). + Definition leb p := fun p' => negb (gtb p p'). Definition elements_lt p m := List.filter (gtb p) (elements m). Definition elements_ge p m := List.filter (leb p) (elements m). @@ -1808,7 +1808,7 @@ Module OrdProperties (M:S). Lemma gtb_compat : forall p, compat_bool eqke (gtb p). Proof. red; intros (x,e) (a,e') (b,e'') H; red in H; simpl in *; destruct H. - generalize (gtb_1 (x,e) (a,e'))(gtb_1 (x,e) (b,e'')); + generalize (gtb_1 (x,e) (a,e'))(gtb_1 (x,e) (b,e'')); destruct (gtb (x,e) (a,e')); destruct (gtb (x,e) (b,e'')); auto. unfold O.ltk in *; simpl in *; intros. symmetry; rewrite H2. @@ -1828,7 +1828,7 @@ Module OrdProperties (M:S). Hint Resolve gtb_compat leb_compat elements_3 : map. - Lemma elements_split : forall p m, + Lemma elements_split : forall p m, elements m = elements_lt p m ++ elements_ge p m. Proof. unfold elements_lt, elements_ge, leb; intros. @@ -1841,8 +1841,8 @@ Module OrdProperties (M:S). unfold O.ltk in *; simpl in *; ME.order. Qed. - Lemma elements_Add : forall m m' x e, ~In x m -> Add x e m m' -> - eqlistA eqke (elements m') + Lemma elements_Add : forall m m' x e, ~In x m -> Add x e m m' -> + eqlistA eqke (elements m') (elements_lt (x,e) m ++ (x,e):: elements_ge (x,e) m). Proof. intros; unfold elements_lt, elements_ge. @@ -1890,8 +1890,8 @@ Module OrdProperties (M:S). right; split; auto; ME.order. Qed. - Lemma elements_Add_Above : forall m m' x e, - Above x m -> Add x e m m' -> + Lemma elements_Add_Above : forall m m' x e, + Above x m -> Add x e m m' -> eqlistA eqke (elements m') (elements m ++ (x,e)::nil). Proof. intros. @@ -1919,8 +1919,8 @@ Module OrdProperties (M:S). ME.order. Qed. - Lemma elements_Add_Below : forall m m' x e, - Below x m -> Add x e m m' -> + Lemma elements_Add_Below : forall m m' x e, + Below x m -> Add x e m m' -> eqlistA eqke (elements m') ((x,e)::elements m). Proof. intros. @@ -1949,7 +1949,7 @@ Module OrdProperties (M:S). ME.order. Qed. - Lemma elements_Equal_eqlistA : forall (m m': t elt), + Lemma elements_Equal_eqlistA : forall (m m': t elt), Equal m m' -> eqlistA eqke (elements m) (elements m'). Proof. intros. @@ -1964,15 +1964,15 @@ Module OrdProperties (M:S). Section Min_Max_Elt. (** We emulate two [max_elt] and [min_elt] functions. *) - - Fixpoint max_elt_aux (l:list (key*elt)) := match l with - | nil => None + + Fixpoint max_elt_aux (l:list (key*elt)) := match l with + | nil => None | (x,e)::nil => Some (x,e) | (x,e)::l => max_elt_aux l end. Definition max_elt m := max_elt_aux (elements m). - Lemma max_elt_Above : + Lemma max_elt_Above : forall m x e, max_elt m = Some (x,e) -> Above x (remove x m). Proof. red; intros. @@ -2011,8 +2011,8 @@ Module OrdProperties (M:S). red; eauto. inversion H2; auto. Qed. - - Lemma max_elt_MapsTo : + + Lemma max_elt_MapsTo : forall m x e, max_elt m = Some (x,e) -> MapsTo x e m. Proof. intros. @@ -2025,7 +2025,7 @@ Module OrdProperties (M:S). constructor 2; auto. Qed. - Lemma max_elt_Empty : + Lemma max_elt_Empty : forall m, max_elt m = None -> Empty m. Proof. intros. @@ -2036,12 +2036,12 @@ Module OrdProperties (M:S). assert (H':=IHl H); discriminate. Qed. - Definition min_elt m : option (key*elt) := match elements m with + Definition min_elt m : option (key*elt) := match elements m with | nil => None | (x,e)::_ => Some (x,e) end. - Lemma min_elt_Below : + Lemma min_elt_Below : forall m x e, min_elt m = Some (x,e) -> Below x (remove x m). Proof. unfold min_elt, Below; intros. @@ -2061,8 +2061,8 @@ Module OrdProperties (M:S). intros (x1,x2) (y1,y2) (z1,z2); compute; intuition; eauto. intros (x1,x2) (y1,y2) (z1,z2); compute; intuition; eauto. Qed. - - Lemma min_elt_MapsTo : + + Lemma min_elt_MapsTo : forall m x e, min_elt m = Some (x,e) -> MapsTo x e m. Proof. intros. @@ -2074,7 +2074,7 @@ Module OrdProperties (M:S). injection H; intros; subst; constructor; red; auto. Qed. - Lemma min_elt_Empty : + Lemma min_elt_Empty : forall m, min_elt m = None -> Empty m. Proof. intros. @@ -2109,7 +2109,7 @@ Module OrdProperties (M:S). assert (S n = S (cardinal (remove k m))). rewrite Heqn. eapply cardinal_2; eauto with map. - inversion H1; auto. + inversion H1; auto. eapply max_elt_Above; eauto. apply X; apply max_elt_Empty; auto. @@ -2136,7 +2136,7 @@ Module OrdProperties (M:S). assert (S n = S (cardinal (remove k m))). rewrite Heqn. eapply cardinal_2; eauto with map. - inversion H1; auto. + inversion H1; auto. eapply min_elt_Below; eauto. apply X; apply min_elt_Empty; auto. diff --git a/theories/FSets/FMapFullAVL.v b/theories/FSets/FMapFullAVL.v index 3ebb0c1af..52766bf96 100644 --- a/theories/FSets/FMapFullAVL.v +++ b/theories/FSets/FMapFullAVL.v @@ -12,18 +12,18 @@ (* $Id$ *) (** * FMapFullAVL - + This file contains some complements to [FMapAVL]. - - Functor [AvlProofs] proves that trees of [FMapAVL] are not only + - Functor [AvlProofs] proves that trees of [FMapAVL] are not only binary search trees, but moreover well-balanced ones. This is done by proving that all operations preserve the balancing. - - - We then pack the previous elements in a [IntMake] functor + + - We then pack the previous elements in a [IntMake] functor similar to the one of [FMapAVL], but richer. - - In final [IntMake_ord] functor, the [compare] function is - different from the one in [FMapAVL]: this non-structural + - In final [IntMake_ord] functor, the [compare] function is + different from the one in [FMapAVL]: this non-structural version is closer to the original Ocaml code. *) @@ -54,11 +54,11 @@ Implicit Types m r : t elt. Inductive avl : t elt -> Prop := | RBLeaf : avl (Leaf _) - | RBNode : forall x e l r h, + | RBNode : forall x e l r h, avl l -> avl r -> -(2) <= height l - height r <= 2 -> - h = max (height l) (height r) + 1 -> + h = max (height l) (height r) + 1 -> avl (Node l x e r h). @@ -66,28 +66,28 @@ Inductive avl : t elt -> Prop := Hint Constructors avl. -Lemma height_non_negative : forall (s : t elt), avl s -> +Lemma height_non_negative : forall (s : t elt), avl s -> height s >= 0. Proof. induction s; simpl; intros; auto with zarith. inv avl; intuition; omega_max. Qed. -Ltac avl_nn_hyp H := +Ltac avl_nn_hyp H := let nz := fresh "nz" in assert (nz := height_non_negative H). -Ltac avl_nn h := - let t := type of h in - match type of t with +Ltac avl_nn h := + let t := type of h in + match type of t with | Prop => avl_nn_hyp h | _ => match goal with H : avl h |- _ => avl_nn_hyp H end end. -(* Repeat the previous tactic. +(* Repeat the previous tactic. Drawback: need to clear the [avl _] hyps ... Thank you Ltac *) Ltac avl_nns := - match goal with + match goal with | H:avl _ |- _ => avl_nn_hyp H; clear H; avl_nns | _ => idtac end. @@ -105,7 +105,7 @@ Hint Resolve avl_node. (** Results about [height] *) -Lemma height_0 : forall l, avl l -> height l = 0 -> +Lemma height_0 : forall l, avl l -> height l = 0 -> l = Leaf _. Proof. destruct 1; intuition; simpl in *. @@ -116,38 +116,38 @@ Qed. (** * Empty map *) Lemma empty_avl : avl (empty elt). -Proof. +Proof. unfold empty; auto. Qed. (** * Helper functions *) -Lemma create_avl : - forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_avl : + forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (create l x e r). Proof. unfold create; auto. Qed. -Lemma create_height : - forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_height : + forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (create l x e r) = max (height l) (height r) + 1. Proof. unfold create; intros; auto. Qed. -Lemma bal_avl : forall l x e r, avl l -> avl r -> +Lemma bal_avl : forall l x e r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> avl (bal l x e r). Proof. intros l x e r; functional induction (bal l x e r); intros; clearf; - inv avl; simpl in *; + inv avl; simpl in *; match goal with |- avl (assert_false _ _ _ _) => avl_nns | _ => repeat apply create_avl; simpl in *; auto end; omega_max. Qed. -Lemma bal_height_1 : forall l x e r, avl l -> avl r -> +Lemma bal_height_1 : forall l x e r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> 0 <= height (bal l x e r) - max (height l) (height r) <= 1. Proof. @@ -155,25 +155,25 @@ Proof. inv avl; avl_nns; simpl in *; omega_max. Qed. -Lemma bal_height_2 : - forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma bal_height_2 : + forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (bal l x e r) == max (height l) (height r) +1. Proof. intros l x e r; functional induction (bal l x e r); intros; clearf; inv avl; avl_nns; simpl in *; omega_max. Qed. -Ltac omega_bal := match goal with - | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?e ?r ] => - generalize (bal_height_1 x e H H') (bal_height_2 x e H H'); +Ltac omega_bal := match goal with + | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?e ?r ] => + generalize (bal_height_1 x e H H') (bal_height_2 x e H H'); omega_max end. (** * Insertion *) -Lemma add_avl_1 : forall m x e, avl m -> +Lemma add_avl_1 : forall m x e, avl m -> avl (add x e m) /\ 0 <= height (add x e m) - height m <= 1. -Proof. +Proof. intros m x e; functional induction (add x e m); intros; inv avl; simpl in *. intuition; try constructor; simpl; auto; try omega_max. (* LT *) @@ -198,8 +198,8 @@ Hint Resolve add_avl. (** * Extraction of minimum binding *) -Lemma remove_min_avl_1 : forall l x e r h, avl (Node l x e r h) -> - avl (remove_min l x e r)#1 /\ +Lemma remove_min_avl_1 : forall l x e r h, avl (Node l x e r h) -> + avl (remove_min l x e r)#1 /\ 0 <= height (Node l x e r h) - height (remove_min l x e r)#1 <= 1. Proof. intros l x e r; functional induction (remove_min l x e r); simpl in *; intros. @@ -212,20 +212,20 @@ Proof. omega_bal. Qed. -Lemma remove_min_avl : forall l x e r h, avl (Node l x e r h) -> - avl (remove_min l x e r)#1. +Lemma remove_min_avl : forall l x e r h, avl (Node l x e r h) -> + avl (remove_min l x e r)#1. Proof. intros; generalize (remove_min_avl_1 H); intuition. Qed. (** * Merging two trees *) -Lemma merge_avl_1 : forall m1 m2, avl m1 -> avl m2 -> - -(2) <= height m1 - height m2 <= 2 -> - avl (merge m1 m2) /\ +Lemma merge_avl_1 : forall m1 m2, avl m1 -> avl m2 -> + -(2) <= height m1 - height m2 <= 2 -> + avl (merge m1 m2) /\ 0<= height (merge m1 m2) - max (height m1) (height m2) <=1. Proof. - intros m1 m2; functional induction (merge m1 m2); intros; + intros m1 m2; functional induction (merge m1 m2); intros; try factornode _x _x0 _x1 _x2 _x3 as m1. simpl; split; auto; avl_nns; omega_max. simpl; split; auto; avl_nns; omega_max. @@ -237,16 +237,16 @@ Proof. omega_bal. Qed. -Lemma merge_avl : forall m1 m2, avl m1 -> avl m2 -> +Lemma merge_avl : forall m1 m2, avl m1 -> avl m2 -> -(2) <= height m1 - height m2 <= 2 -> avl (merge m1 m2). -Proof. +Proof. intros; generalize (merge_avl_1 H H0 H1); intuition. Qed. (** * Deletion *) -Lemma remove_avl_1 : forall m x, avl m -> +Lemma remove_avl_1 : forall m x, avl m -> avl (remove x m) /\ 0 <= height m - height (remove x m) <= 1. Proof. intros m x; functional induction (remove x m); intros. @@ -254,25 +254,25 @@ Proof. (* LT *) inv avl. destruct (IHt H0). - split. + split. apply bal_avl; auto. omega_max. omega_bal. (* EQ *) - inv avl. + inv avl. generalize (merge_avl_1 H0 H1 H2). intuition omega_max. (* GT *) inv avl. destruct (IHt H1). - split. + split. apply bal_avl; auto. omega_max. omega_bal. Qed. Lemma remove_avl : forall m x, avl m -> avl (remove x m). -Proof. +Proof. intros; generalize (remove_avl_1 x H); intuition. Qed. Hint Resolve remove_avl. @@ -280,7 +280,7 @@ Hint Resolve remove_avl. (** * Join *) -Lemma join_avl_1 : forall l x d r, avl l -> avl r -> +Lemma join_avl_1 : forall l x d r, avl l -> avl r -> avl (join l x d r) /\ 0<= height (join l x d r) - max (height l) (height r) <= 1. Proof. @@ -346,9 +346,9 @@ Hint Resolve concat_avl. (** split *) -Lemma split_avl : forall m x, avl m -> +Lemma split_avl : forall m x, avl m -> avl (split x m)#l /\ avl (split x m)#r. -Proof. +Proof. intros m x; functional induction (split x m); simpl; auto. rewrite e1 in IHt;simpl in IHt;inversion_clear 1; intuition. simpl; inversion_clear 1; auto. @@ -358,12 +358,12 @@ Qed. End Elt. Hint Constructors avl. -Section Map. +Section Map. Variable elt elt' : Type. -Variable f : elt -> elt'. +Variable f : elt -> elt'. Lemma map_height : forall m, height (map f m) = height m. -Proof. +Proof. destruct m; simpl; auto. Qed. @@ -377,10 +377,10 @@ End Map. Section Mapi. Variable elt elt' : Type. -Variable f : key -> elt -> elt'. +Variable f : key -> elt -> elt'. Lemma mapi_height : forall m, height (mapi f m) = height m. -Proof. +Proof. destruct m; simpl; auto. Qed. @@ -392,7 +392,7 @@ Qed. End Mapi. -Section Map_option. +Section Map_option. Variable elt elt' : Type. Variable f : key -> elt -> option elt'. @@ -414,12 +414,12 @@ Hypothesis mapr_avl : forall m', avl m' -> avl (mapr m'). Notation map2_opt := (map2_opt f mapl mapr). -Lemma map2_opt_avl : forall m1 m2, avl m1 -> avl m2 -> +Lemma map2_opt_avl : forall m1 m2, avl m1 -> avl m2 -> avl (map2_opt m1 m2). Proof. -intros m1 m2; functional induction (map2_opt m1 m2); auto; -factornode _x0 _x1 _x2 _x3 _x4 as r2; intros; -destruct (split_avl x1 H0); rewrite e1 in *; simpl in *; inv avl; +intros m1 m2; functional induction (map2_opt m1 m2); auto; +factornode _x0 _x1 _x2 _x3 _x4 as r2; intros; +destruct (split_avl x1 H0); rewrite e1 in *; simpl in *; inv avl; auto using join_avl, concat_avl. Qed. @@ -439,11 +439,11 @@ End AvlProofs. (** * Encapsulation - We can implement [S] with balanced binary search trees. + We can implement [S] with balanced binary search trees. When compared to [FMapAVL], we maintain here two invariants (bst and avl) instead of only bst, which is enough for fulfilling the FMap interface. -*) +*) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. @@ -452,32 +452,32 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Import Raw. Import Raw.Proofs. - Record bbst (elt:Type) := + Record bbst (elt:Type) := Bbst {this :> tree elt; is_bst : bst this; is_avl: avl this}. - + Definition t := bbst. Definition key := E.t. - + Section Elt. Variable elt elt' elt'': Type. Implicit Types m : t elt. - Implicit Types x y : key. - Implicit Types e : elt. + Implicit Types x y : key. + Implicit Types e : elt. Definition empty : t elt := Bbst (empty_bst elt) (empty_avl elt). Definition is_empty m : bool := is_empty m.(this). - Definition add x e m : t elt := + Definition add x e m : t elt := Bbst (add_bst x e m.(is_bst)) (add_avl x e m.(is_avl)). - Definition remove x m : t elt := + Definition remove x m : t elt := Bbst (remove_bst x m.(is_bst)) (remove_avl x m.(is_avl)). Definition mem x m : bool := mem x m.(this). Definition find x m : option elt := find x m.(this). - Definition map f m : t elt' := + Definition map f m : t elt' := Bbst (map_bst f m.(is_bst)) (map_avl f m.(is_avl)). - Definition mapi (f:key->elt->elt') m : t elt' := + Definition mapi (f:key->elt->elt') m : t elt' := Bbst (mapi_bst f m.(is_bst)) (mapi_avl f m.(is_avl)). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Bbst (map2_bst f m.(is_bst) m'.(is_bst)) (map2_avl f m.(is_avl) m'.(is_avl)). Definition elements m : list (key*elt) := elements m.(this). Definition cardinal m := cardinal m.(this). @@ -494,14 +494,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@MapsTo_1 _ m.(this)). Qed. - + Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_1; auto. apply m.(is_bst). Qed. - - Lemma mem_2 : forall m x, mem x m = true -> In x m. + + Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_2; auto. Qed. @@ -532,7 +532,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros m x y e; exact (@remove_3 elt _ x y e m.(is_bst)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m x e; exact (@find_1 elt _ x e m.(is_bst)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@find_2 elt m.(this)). Qed. @@ -541,36 +541,36 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@fold_1 elt m.(this) m.(is_bst)). Qed. - Lemma elements_1 : forall m x e, + Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite elements_mapsto; auto. Qed. - Lemma elements_2 : forall m x e, + Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite <- elements_mapsto; auto. Qed. - Lemma elements_3 : forall m, sort lt_key (elements m). + Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@elements_sort elt m.(this) m.(is_bst)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@elements_nodup elt m.(this) m.(is_bst)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intro m; exact (@elements_cardinal elt m.(this)). Qed. Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp := Equiv (Cmp cmp). - Lemma Equivb_Equivb : forall cmp m m', + Lemma Equivb_Equivb : forall cmp m m', Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'. - Proof. + Proof. intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. generalize (H0 k); do 2 rewrite In_alt; intuition. @@ -578,23 +578,23 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. generalize (H0 k); do 2 rewrite <- In_alt; intuition. Qed. - Lemma equal_1 : forall m m' cmp, - Equivb cmp m m' -> equal cmp m m' = true. - Proof. - unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; + Lemma equal_1 : forall m m' cmp, + Equivb cmp m m' -> equal cmp m m' = true. + Proof. + unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite equal_Equivb; auto. - Qed. + Qed. - Lemma equal_2 : forall m m' cmp, + Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. - Proof. - unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; + Proof. + unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite <-equal_Equivb; auto. Qed. End Elt. - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m x e f; exact (@map_1 elt elt' f m.(this) x e). Qed. @@ -602,10 +602,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. intros elt elt' m x f; do 2 unfold In in *; do 2 rewrite In_alt; simpl. apply map_2; auto. - Qed. + Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m x e f; exact (@mapi_1 elt elt' f m.(this) x e). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -615,10 +615,10 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. unfold find, map2, In; intros elt elt' elt'' m m' x f. do 2 rewrite In_alt; intros; simpl; apply map2_1; auto. apply m.(is_bst). @@ -626,9 +626,9 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. + Proof. unfold In, map2; intros elt elt' elt'' m m' x f. do 3 rewrite In_alt; intros; simpl in *; eapply map2_2; eauto. apply m.(is_bst). @@ -638,54 +638,54 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. End IntMake. -Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: - Sord with Module Data := D +Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: + Sord with Module Data := D with Module MapS.E := X. Module Data := D. - Module Import MapS := IntMake(I)(X). + Module Import MapS := IntMake(I)(X). Import AvlProofs. Import Raw.Proofs. Module Import MD := OrderedTypeFacts(D). Module LO := FMapList.Make_ord(X)(D). - Definition t := MapS.t D.t. + Definition t := MapS.t D.t. - Definition cmp e e' := + Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. - Definition elements (m:t) := + Definition elements (m:t) := LO.MapS.Build_slist (Raw.Proofs.elements_sort m.(is_bst)). - (** * As comparison function, we propose here a non-structural - version faithful to the code of Ocaml's Map library, instead of + (** * As comparison function, we propose here a non-structural + version faithful to the code of Ocaml's Map library, instead of the structural version of FMapAVL *) - Fixpoint cardinal_e (e:Raw.enumeration D.t) := - match e with + Fixpoint cardinal_e (e:Raw.enumeration D.t) := + match e with | Raw.End => 0%nat | Raw.More _ _ r e => S (Raw.cardinal r + cardinal_e e) end. - Lemma cons_cardinal_e : forall m e, + Lemma cons_cardinal_e : forall m e, cardinal_e (Raw.cons m e) = (Raw.cardinal m + cardinal_e e)%nat. Proof. induction m; simpl; intros; auto. rewrite IHm1; simpl; rewrite <- plus_n_Sm; auto with arith. Qed. - Definition cardinal_e_2 ee := + Definition cardinal_e_2 ee := (cardinal_e (fst ee) + cardinal_e (snd ee))%nat. - Function compare_aux (ee:Raw.enumeration D.t * Raw.enumeration D.t) - { measure cardinal_e_2 ee } : comparison := - match ee with + Function compare_aux (ee:Raw.enumeration D.t * Raw.enumeration D.t) + { measure cardinal_e_2 ee } : comparison := + match ee with | (Raw.End, Raw.End) => Eq | (Raw.End, Raw.More _ _ _ _) => Lt | (Raw.More _ _ _ _, Raw.End) => Gt | (Raw.More x1 d1 r1 e1, Raw.More x2 d2 r2 e2) => match X.compare x1 x2 with - | EQ _ => match D.compare d1 d2 with + | EQ _ => match D.compare d1 d2 with | EQ _ => compare_aux (Raw.cons r1 e1, Raw.cons r2 e2) | LT _ => Lt | GT _ => Gt @@ -695,10 +695,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: end end. Proof. - intros; unfold cardinal_e_2; simpl; + intros; unfold cardinal_e_2; simpl; abstract (do 2 rewrite cons_cardinal_e; romega with * ). Defined. - + Definition Cmp c := match c with | Eq => LO.eq_list @@ -706,7 +706,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: | Gt => (fun l1 l2 => LO.lt_list l2 l1) end. - Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, + Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, X.eq x1 x2 -> D.eq d1 d2 -> Cmp c l1 l2 -> Cmp c ((x1,d1)::l1) ((x2,d2)::l2). Proof. @@ -714,23 +714,23 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Qed. Hint Resolve cons_Cmp. - Lemma compare_aux_Cmp : forall e, + Lemma compare_aux_Cmp : forall e, Cmp (compare_aux e) (flatten_e (fst e)) (flatten_e (snd e)). Proof. - intros e; functional induction (compare_aux e); simpl in *; + intros e; functional induction (compare_aux e); simpl in *; auto; intros; try clear e0; try clear e3; try MX.elim_comp; auto. rewrite 2 cons_1 in IHc; auto. Qed. - Lemma compare_Cmp : forall m1 m2, - Cmp (compare_aux (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))) + Lemma compare_Cmp : forall m1 m2, + Cmp (compare_aux (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))) (Raw.elements m1) (Raw.elements m2). Proof. - intros. + intros. assert (H1:=cons_1 m1 (Raw.End _)). assert (H2:=cons_1 m2 (Raw.End _)). simpl in *; rewrite <- app_nil_end in *; rewrite <-H1,<-H2. - apply (@compare_aux_Cmp (Raw.cons m1 (Raw.End _), + apply (@compare_aux_Cmp (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))). Qed. @@ -744,10 +744,10 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: destruct compare_aux; intros; [apply EQ|apply LT|apply GT]; red; auto. Defined. - + (* Proofs about [eq] and [lt] *) - Definition selements (m1 : t) := + Definition selements (m1 : t) := LO.MapS.Build_slist (elements_sort m1.(is_bst)). Definition seq (m1 m2 : t) := LO.eq (selements m1) (selements m2). @@ -784,7 +784,7 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Qed. Lemma eq_refl : forall m : t, eq m m. - Proof. + Proof. intros; rewrite eq_seq; unfold seq; intros; apply LO.eq_refl. Qed. @@ -801,13 +801,13 @@ Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. - intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; + intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; intros; eapply LO.lt_trans; eauto. Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. - intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; + intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; intros; apply LO.lt_not_eq; auto. Qed. @@ -818,8 +818,8 @@ End IntMake_ord. Module Make (X: OrderedType) <: S with Module E := X :=IntMake(Z_as_Int)(X). -Module Make_ord (X: OrderedType)(D: OrderedType) - <: Sord with Module Data := D +Module Make_ord (X: OrderedType)(D: OrderedType) + <: Sord with Module Data := D with Module MapS.E := X :=IntMake_ord(Z_as_Int)(X)(D). diff --git a/theories/FSets/FMapInterface.v b/theories/FSets/FMapInterface.v index ebc99933b..cd51b2aff 100644 --- a/theories/FSets/FMapInterface.v +++ b/theories/FSets/FMapInterface.v @@ -8,7 +8,7 @@ (* $Id$ *) -(** * Finite map library *) +(** * Finite map library *) (** This file proposes interfaces for finite maps *) @@ -16,8 +16,8 @@ Require Export Bool DecidableType OrderedType. Set Implicit Arguments. Unset Strict Implicit. -(** When compared with Ocaml Map, this signature has been split in - several parts : +(** When compared with Ocaml Map, this signature has been split in + several parts : - The first parts [WSfun] and [WS] propose signatures for weak maps, which are maps with no ordering on the key type nor the @@ -29,18 +29,18 @@ Unset Strict Implicit. (add, find, ...). The only function that asks for more is [equal], whose first argument should be a comparison on data. - - Then comes [Sfun] and [S], that extend [WSfun] and [WS] to the - case where the key type is ordered. The main novelty is that + - Then comes [Sfun] and [S], that extend [WSfun] and [WS] to the + case where the key type is ordered. The main novelty is that [elements] is required to produce sorted lists. - - Finally, [Sord] extends [S] with a complete comparison function. For - that, the data type should have a decidable total ordering as well. + - Finally, [Sord] extends [S] with a complete comparison function. For + that, the data type should have a decidable total ordering as well. If unsure, what you're looking for is probably [S]: apart from [Sord], - all other signatures are subsets of [S]. + all other signatures are subsets of [S]. + + Some additional differences with Ocaml: - Some additional differences with Ocaml: - - no [iter] function, useless since Coq is purely functional - [option] types are used instead of [Not_found] exceptions - more functions are provided: [elements] and [cardinal] and [map2] @@ -51,7 +51,7 @@ Unset Strict Implicit. Definition Cmp (elt:Type)(cmp:elt->elt->bool) e1 e2 := cmp e1 e2 = true. (** ** Weak signature for maps - + No requirements for an ordering on keys nor elements, only decidability of equality on keys. First, a functorial signature: *) @@ -61,8 +61,8 @@ Module Type WSfun (E : DecidableType). Parameter t : Type -> Type. (** the abstract type of maps *) - - Section Types. + + Section Types. Variable elt:Type. @@ -73,61 +73,61 @@ Module Type WSfun (E : DecidableType). (** Test whether a map is empty or not. *) Parameter add : key -> elt -> t elt -> t elt. - (** [add x y m] returns a map containing the same bindings as [m], - plus a binding of [x] to [y]. If [x] was already bound in [m], + (** [add x y m] returns a map containing the same bindings as [m], + plus a binding of [x] to [y]. If [x] was already bound in [m], its previous binding disappears. *) - Parameter find : key -> t elt -> option elt. - (** [find x m] returns the current binding of [x] in [m], + Parameter find : key -> t elt -> option elt. + (** [find x m] returns the current binding of [x] in [m], or [None] if no such binding exists. *) Parameter remove : key -> t elt -> t elt. - (** [remove x m] returns a map containing the same bindings as [m], + (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) Parameter mem : key -> t elt -> bool. - (** [mem x m] returns [true] if [m] contains a binding for [x], + (** [mem x m] returns [true] if [m] contains a binding for [x], and [false] otherwise. *) Variable elt' elt'' : Type. Parameter map : (elt -> elt') -> t elt -> t elt'. - (** [map f m] returns a map with same domain as [m], where the associated + (** [map f m] returns a map with same domain as [m], where the associated value a of all bindings of [m] has been replaced by the result of the application of [f] to [a]. Since Coq is purely functional, the order in which the bindings are passed to [f] is irrelevant. *) Parameter mapi : (key -> elt -> elt') -> t elt -> t elt'. - (** Same as [map], but the function receives as arguments both the + (** Same as [map], but the function receives as arguments both the key and the associated value for each binding of the map. *) - Parameter map2 : + Parameter map2 : (option elt -> option elt' -> option elt'') -> t elt -> t elt' -> t elt''. - (** [map2 f m m'] creates a new map whose bindings belong to the ones - of either [m] or [m']. The presence and value for a key [k] is - determined by [f e e'] where [e] and [e'] are the (optional) bindings + (** [map2 f m m'] creates a new map whose bindings belong to the ones + of either [m] or [m']. The presence and value for a key [k] is + determined by [f e e'] where [e] and [e'] are the (optional) bindings of [k] in [m] and [m']. *) Parameter elements : t elt -> list (key*elt). - (** [elements m] returns an assoc list corresponding to the bindings + (** [elements m] returns an assoc list corresponding to the bindings of [m], in any order. *) - Parameter cardinal : t elt -> nat. + Parameter cardinal : t elt -> nat. (** [cardinal m] returns the number of bindings in [m]. *) Parameter fold : forall A: Type, (key -> elt -> A -> A) -> t elt -> A -> A. - (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], - where [k1] ... [kN] are the keys of all bindings in [m] + (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + where [k1] ... [kN] are the keys of all bindings in [m] (in any order), and [d1] ... [dN] are the associated data. *) Parameter equal : (elt -> elt -> bool) -> t elt -> t elt -> bool. - (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, - that is, contain equal keys and associate them with equal data. - [cmp] is the equality predicate used to compare the data associated + (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, + that is, contain equal keys and associate them with equal data. + [cmp] is the equality predicate used to compare the data associated with the keys. *) - Section Spec. - + Section Spec. + Variable m m' m'' : t elt. Variable x y z : key. Variable e e' : elt. @@ -139,24 +139,24 @@ Module Type WSfun (E : DecidableType). Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m. Definition eq_key (p p':key*elt) := E.eq (fst p) (fst p'). - - Definition eq_key_elt (p p':key*elt) := + + Definition eq_key_elt (p p':key*elt) := E.eq (fst p) (fst p') /\ (snd p) = (snd p'). (** Specification of [MapsTo] *) Parameter MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m. - + (** Specification of [mem] *) Parameter mem_1 : In x m -> mem x m = true. - Parameter mem_2 : mem x m = true -> In x m. - + Parameter mem_2 : mem x m = true -> In x m. + (** Specification of [empty] *) Parameter empty_1 : Empty empty. (** Specification of [is_empty] *) - Parameter is_empty_1 : Empty m -> is_empty m = true. + Parameter is_empty_1 : Empty m -> is_empty m = true. Parameter is_empty_2 : is_empty m = true -> Empty m. - + (** Specification of [add] *) Parameter add_1 : E.eq x y -> MapsTo y e (add x e m). Parameter add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). @@ -168,50 +168,50 @@ Module Type WSfun (E : DecidableType). Parameter remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. (** Specification of [find] *) - Parameter find_1 : MapsTo x e m -> find x m = Some e. + Parameter find_1 : MapsTo x e m -> find x m = Some e. Parameter find_2 : find x m = Some e -> MapsTo x e m. (** Specification of [elements] *) - Parameter elements_1 : + Parameter elements_1 : MapsTo x e m -> InA eq_key_elt (x,e) (elements m). - Parameter elements_2 : + Parameter elements_2 : InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. - (** When compared with ordered maps, here comes the only + (** When compared with ordered maps, here comes the only property that is really weaker: *) - Parameter elements_3w : NoDupA eq_key (elements m). + Parameter elements_3w : NoDupA eq_key (elements m). (** Specification of [cardinal] *) Parameter cardinal_1 : cardinal m = length (elements m). - (** Specification of [fold] *) + (** Specification of [fold] *) Parameter fold_1 : forall (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. (** Equality of maps *) - + (** Caveat: there are at least three distinct equality predicates on maps. - - The simpliest (and maybe most natural) way is to consider keys up to - their equivalence [E.eq], but elements up to Leibniz equality, in + - The simpliest (and maybe most natural) way is to consider keys up to + their equivalence [E.eq], but elements up to Leibniz equality, in the spirit of [eq_key_elt] above. This leads to predicate [Equal]. - Unfortunately, this [Equal] predicate can't be used to describe - the [equal] function, since this function (for compatibility with - ocaml) expects a boolean comparison [cmp] that may identify more - elements than Leibniz. So logical specification of [equal] is done + the [equal] function, since this function (for compatibility with + ocaml) expects a boolean comparison [cmp] that may identify more + elements than Leibniz. So logical specification of [equal] is done via another predicate [Equivb] - This predicate [Equivb] is quite ad-hoc with its boolean [cmp], it can be generalized in a [Equiv] expecting a more general (possibly non-decidable) equality predicate on elements *) Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb (cmp: elt->elt->bool) := Equiv (Cmp cmp). (** Specification of [equal] *) - Variable cmp : elt -> elt -> bool. + Variable cmp : elt -> elt -> bool. Parameter equal_1 : Equivb cmp m m' -> equal cmp m m' = true. Parameter equal_2 : equal cmp m m' = true -> Equivb cmp m m'. @@ -220,26 +220,26 @@ Module Type WSfun (E : DecidableType). End Types. (** Specification of [map] *) - Parameter map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Parameter map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). - Parameter map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + Parameter map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. - + (** Specification of [mapi] *) Parameter mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Parameter mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) (f:key->elt->elt'), In x (mapi f m) -> In x m. (** Specification of [map2] *) Parameter map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). Parameter map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Hint Immediate MapsTo_1 mem_2 is_empty_2 @@ -252,11 +252,11 @@ Module Type WSfun (E : DecidableType). End WSfun. -(** ** Static signature for Weak Maps +(** ** Static signature for Weak Maps Similar to [WSfun] but expressed in a self-contained way. *) -Module Type WS. +Module Type WS. Declare Module E : DecidableType. Include Type WSfun E. End WS. @@ -274,7 +274,7 @@ Module Type Sfun (E : OrderedType). Parameter elements_3 : forall m, sort lt_key (elements m). (** Remark: since [fold] is specified via [elements], this stronger specification of [elements] has an indirect impact on [fold], - which can now be proved to receive elements in increasing order. *) + which can now be proved to receive elements in increasing order. *) End elt. End Sfun. @@ -282,7 +282,7 @@ End Sfun. (** ** Maps on ordered keys, self-contained signature *) -Module Type S. +Module Type S. Declare Module E : OrderedType. Include Type Sfun E. End S. @@ -293,28 +293,28 @@ End S. Module Type Sord. - Declare Module Data : OrderedType. - Declare Module MapS : S. + Declare Module Data : OrderedType. + Declare Module MapS : S. Import MapS. - - Definition t := MapS.t Data.t. + + Definition t := MapS.t Data.t. Parameter eq : t -> t -> Prop. - Parameter lt : t -> t -> Prop. - + Parameter lt : t -> t -> Prop. + Axiom eq_refl : forall m : t, eq m m. Axiom eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Axiom eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. Axiom lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Axiom lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. - Definition cmp e e' := match Data.compare e e' with EQ _ => true | _ => false end. + Definition cmp e e' := match Data.compare e e' with EQ _ => true | _ => false end. Parameter eq_1 : forall m m', Equivb cmp m m' -> eq m m'. Parameter eq_2 : forall m m', eq m m' -> Equivb cmp m m'. Parameter compare : forall m1 m2, Compare lt eq m1 m2. - (** Total ordering between maps. [Data.compare] is a total ordering + (** Total ordering between maps. [Data.compare] is a total ordering used to compare data associated with equal keys in the two maps. *) End Sord. diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v index a99c6a908..4c21e1738 100644 --- a/theories/FSets/FMapList.v +++ b/theories/FSets/FMapList.v @@ -30,7 +30,7 @@ Definition t (elt:Type) := list (X.t * elt). Section Elt. Variable elt : Type. -Notation eqk := (eqk (elt:=elt)). +Notation eqk := (eqk (elt:=elt)). Notation eqke := (eqke (elt:=elt)). Notation ltk := (ltk (elt:=elt)). Notation MapsTo := (MapsTo (elt:=elt)). @@ -45,7 +45,7 @@ Definition empty : t elt := nil. Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m. Lemma empty_1 : Empty empty. -Proof. +Proof. unfold Empty,empty. intros a e. intro abs. @@ -54,7 +54,7 @@ Qed. Hint Resolve empty_1. Lemma empty_sorted : Sort empty. -Proof. +Proof. unfold empty; auto. Qed. @@ -62,7 +62,7 @@ Qed. Definition is_empty (l : t elt) : bool := if l then true else false. -Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. +Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. Proof. unfold Empty, PX.MapsTo. intros m. @@ -72,7 +72,7 @@ Proof. Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. -Proof. +Proof. intros m. case m;auto. intros p l abs. @@ -93,12 +93,12 @@ Function mem (k : key) (s : t elt) {struct s} : bool := end. Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true. -Proof. - intros m Hm x; generalize Hm; clear Hm. +Proof. + intros m Hm x; generalize Hm; clear Hm. functional induction (mem x m);intros sorted belong1;trivial. - + inversion belong1. inversion H. - + absurd (In x ((k', _x) :: l));try assumption. apply Sort_Inf_NotIn with _x;auto. @@ -107,13 +107,13 @@ Proof. elim (In_inv belong1);auto. intro abs. absurd (X.eq x k');auto. -Qed. +Qed. -Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m. +Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m. Proof. intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo. functional induction (mem x m); intros sorted hyp;try ((inversion hyp);fail). - exists _x; auto. + exists _x; auto. induction IHb; auto. exists x0; auto. inversion_clear sorted; auto. @@ -124,7 +124,7 @@ Qed. Function find (k:key) (s: t elt) {struct s} : option elt := match s with | nil => None - | (k',x)::s' => + | (k',x)::s' => match X.compare k k' with | LT _ => None | EQ _ => Some x @@ -138,7 +138,7 @@ Proof. functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto. Qed. -Lemma find_1 : forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e. +Lemma find_1 : forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e. Proof. intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo. functional induction (find x m);simpl; subst; try clear H_eq_1. @@ -150,9 +150,9 @@ Proof. clear e1;generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order. clear e1;inversion_clear 2. - compute in H0; destruct H0; intuition congruence. + compute in H0; destruct H0; intuition congruence. generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order. - + clear e1; do 2 inversion_clear 1; auto. compute in H2; destruct H2; order. Qed. @@ -177,10 +177,10 @@ Proof. functional induction (add x e m);simpl;auto. Qed. -Lemma add_2 : forall m x y e e', +Lemma add_2 : forall m x y e e', ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. - intros m x y e e'. + intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo. functional induction (add x e' m) ;simpl;auto; clear e0. subst;auto. @@ -191,7 +191,7 @@ Proof. auto. intros y' e'' eqky'; inversion_clear 1; intuition. Qed. - + Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. @@ -200,15 +200,15 @@ Proof. functional induction (add x e' m);simpl; intros. apply (In_inv_3 H0); compute; auto. apply (In_inv_3 H0); compute; auto. - constructor 2; apply (In_inv_3 H0); compute; auto. + constructor 2; apply (In_inv_3 H0); compute; auto. inversion_clear H0; auto. Qed. -Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt), +Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt), Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m). Proof. - induction m. + induction m. simpl; intuition. intros. destruct a as (x'',e''). @@ -227,7 +227,7 @@ Proof. simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto. constructor; auto. apply Inf_eq with (x',e'); auto. -Qed. +Qed. (** * [remove] *) @@ -240,48 +240,48 @@ Function remove (k : key) (s : t elt) {struct s} : t elt := | EQ _ => l | GT _ => (k',x) :: remove k l end - end. + end. Lemma remove_1 : forall m (Hm:Sort m) x y, X.eq x y -> ~ In y (remove x m). Proof. intros m Hm x y; generalize Hm; clear Hm. functional induction (remove x m);simpl;intros;subst. - + red; inversion 1; inversion H1. apply Sort_Inf_NotIn with x0; auto. clear e0;constructor; compute; order. - + clear e0;inversion_clear Hm. - apply Sort_Inf_NotIn with x0; auto. + apply Sort_Inf_NotIn with x0; auto. apply Inf_eq with (k',x0);auto; compute; apply X.eq_trans with x; auto. clear e0;inversion_clear Hm. assert (notin:~ In y (remove x l)) by auto. intros (x1,abs). - inversion_clear abs. + inversion_clear abs. compute in H2; destruct H2; order. apply notin; exists x1; auto. Qed. -Lemma remove_2 : forall m (Hm:Sort m) x y e, +Lemma remove_2 : forall m (Hm:Sort m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. - functional induction (remove x m);subst;auto; - match goal with + functional induction (remove x m);subst;auto; + match goal with | [H: X.compare _ _ = _ |- _ ] => clear H | _ => idtac end. inversion_clear 3; auto. compute in H1; destruct H1; order. - + inversion_clear 1; inversion_clear 2; auto. Qed. -Lemma remove_3 : forall m (Hm:Sort m) x y e, +Lemma remove_3 : forall m (Hm:Sort m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -289,10 +289,10 @@ Proof. inversion_clear 1; inversion_clear 1; auto. Qed. -Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt), +Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt), Inf (x',e') m -> Inf (x',e') (remove x m). Proof. - induction m. + induction m. simpl; intuition. intros. destruct a as (x'',e''). @@ -311,31 +311,31 @@ Proof. intros. destruct a as (x',e'). simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto. -Qed. +Qed. (** * [elements] *) Definition elements (m: t elt) := m. -Lemma elements_1 : forall m x e, +Lemma elements_1 : forall m x e, MapsTo x e m -> InA eqke (x,e) (elements m). Proof. auto. Qed. -Lemma elements_2 : forall m x e, +Lemma elements_2 : forall m x e, InA eqke (x,e) (elements m) -> MapsTo x e m. -Proof. +Proof. auto. Qed. -Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m). -Proof. +Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m). +Proof. auto. Qed. -Lemma elements_3w : forall m (Hm:Sort m), NoDupA eqk (elements m). -Proof. +Lemma elements_3w : forall m (Hm:Sort m), NoDupA eqk (elements m). +Proof. intros. apply Sort_NoDupA. apply elements_3; auto. @@ -351,30 +351,30 @@ Function fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc:A) {struct m} : A := Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. -Proof. +Proof. intros; functional induction (fold f m i); auto. Qed. (** * [equal] *) -Function equal (cmp:elt->elt->bool)(m m' : t elt) { struct m } : bool := - match m, m' with +Function equal (cmp:elt->elt->bool)(m m' : t elt) { struct m } : bool := + match m, m' with | nil, nil => true - | (x,e)::l, (x',e')::l' => - match X.compare x x' with + | (x,e)::l, (x',e')::l' => + match X.compare x x' with | EQ _ => cmp e e' && equal cmp l l' | _ => false - end - | _, _ => false + end + | _, _ => false end. -Definition Equivb cmp m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). +Definition Equivb cmp m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp, - Equivb cmp m m' -> equal cmp m m' = true. -Proof. +Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp, + Equivb cmp m m' -> equal cmp m m' = true. +Proof. intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'. functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb; intuition; subst. @@ -407,7 +407,7 @@ Proof. destruct (X.compare x x'); try contradiction; clear y. destruct (H0 x). - assert (In x ((x',e')::l')). + assert (In x ((x',e')::l')). apply H; auto. exists e; auto. destruct (In_inv H3). @@ -418,7 +418,7 @@ Proof. elim (Sort_Inf_NotIn H5 H7 H4). destruct (H0 x'). - assert (In x' ((x,e)::l)). + assert (In x' ((x,e)::l)). apply H2; auto. exists e'; auto. destruct (In_inv H3). @@ -430,7 +430,7 @@ Proof. destruct m; destruct m';try contradiction. - + clear H1;destruct p as (k,e). destruct (H0 k). destruct H1. @@ -447,18 +447,18 @@ Proof. Qed. -Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp, +Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'. - functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb; - intuition; try discriminate; subst; + functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb; + intuition; try discriminate; subst; try match goal with H: X.compare _ _ = _ |- _ => clear H end. inversion H0. inversion_clear Hm;inversion_clear Hm'. - destruct (andb_prop _ _ H); clear H. + destruct (andb_prop _ _ H); clear H. destruct (IHb H1 H3 H6). destruct (In_inv H0). exists e'; constructor; split; trivial; apply X.eq_trans with x; auto. @@ -467,7 +467,7 @@ Proof. exists e''; auto. inversion_clear Hm;inversion_clear Hm'. - destruct (andb_prop _ _ H); clear H. + destruct (andb_prop _ _ H); clear H. destruct (IHb H1 H3 H6). destruct (In_inv H0). exists e; constructor; split; trivial; apply X.eq_trans with x'; auto. @@ -476,15 +476,15 @@ Proof. exists e''; auto. inversion_clear Hm;inversion_clear Hm'. - destruct (andb_prop _ _ H); clear H. + destruct (andb_prop _ _ H); clear H. destruct (IHb H2 H4 H7). inversion_clear H0. destruct H9; simpl in *; subst. - inversion_clear H1. + inversion_clear H1. destruct H9; simpl in *; subst; auto. elim (Sort_Inf_NotIn H4 H5). exists e'0; apply MapsTo_eq with k; auto; order. - inversion_clear H1. + inversion_clear H1. destruct H0; simpl in *; subst; auto. elim (Sort_Inf_NotIn H2 H3). exists e0; apply MapsTo_eq with k; auto; order. @@ -494,7 +494,7 @@ Qed. (** This lemma isn't part of the spec of [Equivb], but is used in [FMapAVL] *) Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) -> - eqk x y -> cmp (snd x) (snd y) = true -> + eqk x y -> cmp (snd x) (snd y) = true -> (Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)). Proof. intros. @@ -517,7 +517,7 @@ Qed. Variable elt':Type. (** * [map] and [mapi] *) - + Fixpoint map (f:elt -> elt') (m:t elt) {struct m} : t elt' := match m with | nil => nil @@ -531,24 +531,24 @@ Fixpoint mapi (f: key -> elt -> elt') (m:t elt) {struct m} : t elt' := end. End Elt. -Section Elt2. -(* A new section is necessary for previous definitions to work +Section Elt2. +(* A new section is necessary for previous definitions to work with different [elt], especially [MapsTo]... *) - + Variable elt elt' : Type. (** Specification of [map] *) -Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), +Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros m x e f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. constructor 1. unfold eqke in *; simpl in *; intuition congruence. @@ -556,15 +556,15 @@ Proof. unfold MapsTo in *; auto. Qed. -Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), +Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -578,9 +578,9 @@ Proof. Qed. Lemma map_lelistA : forall (m: t elt)(x:key)(e:elt)(e':elt')(f:elt->elt'), - lelistA (@ltk elt) (x,e) m -> + lelistA (@ltk elt) (x,e) m -> lelistA (@ltk elt') (x,e') (map f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x0,e0). @@ -589,30 +589,30 @@ Qed. Hint Resolve map_lelistA. -Lemma map_sorted : forall (m: t elt)(Hm : sort (@ltk elt) m)(f:elt -> elt'), +Lemma map_sorted : forall (m: t elt)(Hm : sort (@ltk elt) m)(f:elt -> elt'), sort (@ltk elt') (map f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x',e'). inversion_clear Hm. constructor; auto. exact (map_lelistA _ _ H0). -Qed. - +Qed. + (** Specification of [mapi] *) -Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), - MapsTo x e m -> +Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), + MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros m x e f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. exists x'. destruct H0; simpl in *. @@ -621,18 +621,18 @@ Proof. unfold eqke in *; simpl in *; intuition congruence. destruct IHm as (y, hyp); auto. exists y; intuition. -Qed. +Qed. -Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), +Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -646,9 +646,9 @@ Proof. Qed. Lemma mapi_lelistA : forall (m: t elt)(x:key)(e:elt)(f:key->elt->elt'), - lelistA (@ltk elt) (x,e) m -> + lelistA (@ltk elt) (x,e) m -> lelistA (@ltk elt') (x,f x e) (mapi f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x',e'). @@ -657,7 +657,7 @@ Qed. Hint Resolve mapi_lelistA. -Lemma mapi_sorted : forall m (Hm : sort (@ltk elt) m)(f: key ->elt -> elt'), +Lemma mapi_sorted : forall m (Hm : sort (@ltk elt) m)(f: key ->elt -> elt'), sort (@ltk elt') (mapi f m). Proof. induction m; simpl; auto. @@ -666,7 +666,7 @@ Proof. inversion_clear Hm; auto. Qed. -End Elt2. +End Elt2. Section Elt3. (** * [map2] *) @@ -674,27 +674,27 @@ Section Elt3. Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. -Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := - match o with +Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := + match o with | Some e => (k,e)::l | None => l end. -Fixpoint map2_l (m : t elt) : t elt'' := - match m with - | nil => nil +Fixpoint map2_l (m : t elt) : t elt'' := + match m with + | nil => nil | (k,e)::l => option_cons k (f (Some e) None) (map2_l l) - end. + end. -Fixpoint map2_r (m' : t elt') : t elt'' := - match m' with - | nil => nil +Fixpoint map2_r (m' : t elt') : t elt'' := + match m' with + | nil => nil | (k,e')::l' => option_cons k (f None (Some e')) (map2_r l') - end. + end. Fixpoint map2 (m : t elt) : t elt' -> t elt'' := match m with - | nil => map2_r + | nil => map2_r | (k,e) :: l => fix map2_aux (m' : t elt') : t elt'' := match m' with @@ -706,7 +706,7 @@ Fixpoint map2 (m : t elt) : t elt' -> t elt'' := | GT _ => option_cons k' (f None (Some e')) (map2_aux l') end end - end. + end. Notation oee' := (option elt * option elt')%type. @@ -724,14 +724,14 @@ Fixpoint combine (m : t elt) : t elt' -> t oee' := | GT _ => (k',(None,Some e'))::combine_aux l' end end - end. + end. -Definition fold_right_pair (A B C:Type)(f: A->B->C->C)(l:list (A*B))(i:C) := +Definition fold_right_pair (A B C:Type)(f: A->B->C->C)(l:list (A*B))(i:C) := List.fold_right (fun p => f (fst p) (snd p)) i l. -Definition map2_alt m m' := - let m0 : t oee' := combine m m' in - let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in +Definition map2_alt m m' := + let m0 : t oee' := combine m m' in + let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in fold_right_pair (option_cons (A:=elt'')) m1 nil. Lemma map2_alt_equiv : forall m m', map2_alt m m' = map2 m m'. @@ -758,20 +758,20 @@ Proof. apply IHm'. Qed. -Lemma combine_lelistA : - forall m m' (x:key)(e:elt)(e':elt')(e'':oee'), - lelistA (@ltk elt) (x,e) m -> - lelistA (@ltk elt') (x,e') m' -> +Lemma combine_lelistA : + forall m m' (x:key)(e:elt)(e':elt')(e'':oee'), + lelistA (@ltk elt) (x,e) m -> + lelistA (@ltk elt') (x,e') m' -> lelistA (@ltk oee') (x,e'') (combine m m'). Proof. - induction m. + induction m. intros. simpl. exact (map_lelistA _ _ H0). - induction m'. + induction m'. intros. destruct a. - replace (combine ((t0, e0) :: m) nil) with + replace (combine ((t0, e0) :: m) nil) with (map (fun e => (Some e,None (A:=elt'))) ((t0,e0)::m)); auto. exact (map_lelistA _ _ H). intros. @@ -784,18 +784,18 @@ Proof. Qed. Hint Resolve combine_lelistA. -Lemma combine_sorted : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), +Lemma combine_sorted : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), sort (@ltk oee') (combine m m'). Proof. - induction m. + induction m. intros; clear Hm. simpl. apply map_sorted; auto. - induction m'. + induction m'. intros; clear Hm'. destruct a. - replace (combine ((t0, e) :: m) nil) with + replace (combine ((t0, e) :: m) nil) with (map (fun e => (Some e,None (A:=elt'))) ((t0,e)::m)); auto. apply map_sorted; auto. intros. @@ -805,11 +805,11 @@ Proof. inversion_clear Hm. constructor; auto. assert (lelistA (ltk (elt:=elt')) (k, e') ((k',e')::m')) by auto. - exact (combine_lelistA _ H0 H1). + exact (combine_lelistA _ H0 H1). inversion_clear Hm; inversion_clear Hm'. constructor; auto. assert (lelistA (ltk (elt:=elt')) (k, e') m') by (apply Inf_eq with (k',e'); auto). - exact (combine_lelistA _ H0 H3). + exact (combine_lelistA _ H0 H3). inversion_clear Hm; inversion_clear Hm'. constructor; auto. change (lelistA (ltk (elt:=oee')) (k', (None, Some e')) @@ -818,8 +818,8 @@ Proof. exact (combine_lelistA _ H3 H2). Qed. -Lemma map2_sorted : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), +Lemma map2_sorted : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), sort (@ltk elt'') (map2 m m'). Proof. intros. @@ -829,7 +829,7 @@ Proof. set (l0:=combine m m') in *; clearbody l0. set (f':= fun p : oee' => f (fst p) (snd p)). assert (H1:=map_sorted (elt' := option elt'') H0 f'). - set (l1:=map f' l0) in *; clearbody l1. + set (l1:=map f' l0) in *; clearbody l1. clear f' f H0 l0 Hm Hm' m m'. induction l1. simpl; auto. @@ -848,16 +848,16 @@ Proof. apply IHl1; auto. apply Inf_lt with (t1, None (A:=elt'')); auto. Qed. - -Definition at_least_one (o:option elt)(o':option elt') := - match o, o' with - | None, None => None + +Definition at_least_one (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => Some (o,o') end. -Lemma combine_1 : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), - find x (combine m m') = at_least_one (find x m) (find x m'). +Lemma combine_1 : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), + find x (combine m m') = at_least_one (find x m) (find x m'). Proof. induction m. intros. @@ -881,32 +881,32 @@ Proof. destruct a as (k,e); destruct a0 as (k',e'); simpl. inversion Hm; inversion Hm'; subst. destruct (X.compare k k'); simpl; - destruct (X.compare x k); + destruct (X.compare x k); elim_comp || destruct (X.compare x k'); simpl; auto. rewrite IHm; auto; simpl; elim_comp; auto. rewrite IHm; auto; simpl; elim_comp; auto. rewrite IHm; auto; simpl; elim_comp; auto. change (find x (combine ((k, e) :: m) m') = at_least_one None (find x m')). - rewrite IHm'; auto. + rewrite IHm'; auto. simpl find; elim_comp; auto. change (find x (combine ((k, e) :: m) m') = Some (Some e, find x m')). - rewrite IHm'; auto. + rewrite IHm'; auto. simpl find; elim_comp; auto. - change (find x (combine ((k, e) :: m) m') = + change (find x (combine ((k, e) :: m) m') = at_least_one (find x m) (find x m')). - rewrite IHm'; auto. + rewrite IHm'; auto. simpl find; elim_comp; auto. Qed. -Definition at_least_one_then_f (o:option elt)(o':option elt') := - match o, o' with - | None, None => None +Definition at_least_one_then_f (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => f o o' end. -Lemma map2_0 : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), - find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). +Lemma map2_0 : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), + find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). Proof. intros. rewrite <- map2_alt_equiv. @@ -915,7 +915,7 @@ Proof. assert (H2:=combine_sorted Hm Hm'). set (f':= fun p : oee' => f (fst p) (snd p)). set (m0 := combine m m') in *; clearbody m0. - set (o:=find x m) in *; clearbody o. + set (o:=find x m) in *; clearbody o. set (o':=find x m') in *; clearbody o'. clear Hm Hm' m m'. generalize H; clear H. @@ -984,10 +984,10 @@ Qed. (** Specification of [map2] *) -Lemma map2_1 : +Lemma map2_1 : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), - In x m \/ In x m' -> - find x (map2 m m') = f (find x m) (find x m'). + In x m \/ In x m' -> + find x (map2 m m') = f (find x m) (find x m'). Proof. intros. rewrite map2_0; auto. @@ -997,10 +997,10 @@ Proof. rewrite (find_1 Hm' H). destruct (find x m); simpl; auto. Qed. - -Lemma map2_2 : - forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), - In x (map2 m m') -> In x m \/ In x m'. + +Lemma map2_2 : + forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), + In x (map2 m m') -> In x m \/ In x m'. Proof. intros. destruct H as (e,H). @@ -1008,9 +1008,9 @@ Proof. rewrite (find_1 (map2_sorted Hm Hm') H). generalize (@find_2 _ m x). generalize (@find_2 _ m' x). - destruct (find x m); + destruct (find x m); destruct (find x m'); simpl; intros. - left; exists e0; auto. + left; exists e0; auto. left; exists e0; auto. right; exists e0; auto. discriminate. @@ -1020,31 +1020,31 @@ End Elt3. End Raw. Module Make (X: OrderedType) <: S with Module E := X. -Module Raw := Raw X. +Module Raw := Raw X. Module E := X. Definition key := E.t. -Record slist (elt:Type) := +Record slist (elt:Type) := {this :> Raw.t elt; sorted : sort (@Raw.PX.ltk elt) this}. -Definition t (elt:Type) : Type := slist elt. +Definition t (elt:Type) : Type := slist elt. -Section Elt. - Variable elt elt' elt'':Type. +Section Elt. + Variable elt elt' elt'':Type. Implicit Types m : t elt. - Implicit Types x y : key. + Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Build_slist (Raw.empty_sorted elt). Definition is_empty m : bool := Raw.is_empty m.(this). Definition add x e m : t elt := Build_slist (Raw.add_sorted m.(sorted) x e). Definition find x m : option elt := Raw.find x m.(this). - Definition remove x m : t elt := Build_slist (Raw.remove_sorted m.(sorted) x). + Definition remove x m : t elt := Build_slist (Raw.remove_sorted m.(sorted) x). Definition mem x m : bool := Raw.mem x m.(this). Definition map f m : t elt' := Build_slist (Raw.map_sorted m.(sorted) f). Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_sorted m.(sorted) f). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Build_slist (Raw.map2_sorted f m.(sorted) m'.(sorted)). Definition elements m : list (key*elt) := @Raw.elements elt m.(this). Definition cardinal m := length m.(this). @@ -1056,9 +1056,9 @@ Section Elt. Definition Empty m : Prop := Raw.Empty m.(this). Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp m.(this) m'.(this). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. @@ -1095,7 +1095,7 @@ Section Elt. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m; exact (@Raw.remove_3 elt m.(this) m.(sorted)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m; exact (@Raw.find_1 elt m.(this) m.(sorted)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@Raw.find_2 elt m.(this)). Qed. @@ -1104,9 +1104,9 @@ Section Elt. Proof. intros m; exact (@Raw.elements_1 elt m.(this)). Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros m; exact (@Raw.elements_2 elt m.(this)). Qed. - Lemma elements_3 : forall m, sort lt_key (elements m). + Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@Raw.elements_3 elt m.(this) m.(sorted)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@Raw.elements_3w elt m.(this) m.(sorted)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). @@ -1116,22 +1116,22 @@ Section Elt. fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@Raw.fold_1 elt m.(this)). Qed. - Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. + Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. intros m m'; exact (@Raw.equal_1 elt m.(this) m.(sorted) m'.(this) m'.(sorted)). Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m m'; exact (@Raw.equal_2 elt m.(this) m.(sorted) m'.(this) m'.(sorted)). Qed. End Elt. - - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' m.(this)). Qed. - Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), - In x (map f m) -> In x m. + Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' m.(this)). Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' m.(this)). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -1139,58 +1139,58 @@ Section Elt. Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' m.(this)). Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. - intros elt elt' elt'' m m' x f; + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_1 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. - intros elt elt' elt'' m m' x f; + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_2 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x). Qed. End Make. -Module Make_ord (X: OrderedType)(D : OrderedType) <: -Sord with Module Data := D +Module Make_ord (X: OrderedType)(D : OrderedType) <: +Sord with Module Data := D with Module MapS.E := X. Module Data := D. -Module MapS := Make(X). +Module MapS := Make(X). Import MapS. Module MD := OrderedTypeFacts(D). Import MD. -Definition t := MapS.t D.t. +Definition t := MapS.t D.t. Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. -Fixpoint eq_list (m m' : list (X.t * D.t)) { struct m } : Prop := - match m, m' with +Fixpoint eq_list (m m' : list (X.t * D.t)) { struct m } : Prop := + match m, m' with | nil, nil => True - | (x,e)::l, (x',e')::l' => - match X.compare x x' with + | (x,e)::l, (x',e')::l' => + match X.compare x x' with | EQ _ => D.eq e e' /\ eq_list l l' | _ => False - end + end | _, _ => False end. Definition eq m m' := eq_list m.(this) m'.(this). -Fixpoint lt_list (m m' : list (X.t * D.t)) {struct m} : Prop := - match m, m' with +Fixpoint lt_list (m m' : list (X.t * D.t)) {struct m} : Prop := + match m, m' with | nil, nil => False | nil, _ => True | _, nil => False - | (x,e)::l, (x',e')::l' => - match X.compare x x' with + | (x,e)::l, (x',e')::l' => + match X.compare x x' with | LT _ => True | GT _ => False | EQ _ => D.lt e e' \/ (D.eq e e' /\ lt_list l l') @@ -1209,9 +1209,9 @@ Proof. destruct a; unfold equal; simpl; intuition. destruct a as (x,e). destruct p as (x',e'). - unfold equal; simpl. + unfold equal; simpl. destruct (X.compare x x'); simpl; intuition. - unfold cmp at 1. + unfold cmp at 1. MD.elim_comp; clear H; simpl. inversion_clear Hl. inversion_clear Hl'. @@ -1258,7 +1258,7 @@ Qed. Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Proof. - intros (m,Hm); induction m; + intros (m,Hm); induction m; intros (m', Hm'); destruct m'; unfold eq; simpl; try destruct a as (x,e); try destruct p as (x',e'); auto. destruct (X.compare x x'); MapS.Raw.MX.elim_comp; intuition. @@ -1267,15 +1267,15 @@ Proof. Qed. Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. -Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; - intros (m3, Hm3); destruct m3; unfold eq; simpl; - try destruct a as (x,e); - try destruct p as (x',e'); +Proof. + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; + intros (m3, Hm3); destruct m3; unfold eq; simpl; + try destruct a as (x,e); + try destruct p as (x',e'); try destruct p0 as (x'',e''); try contradiction; auto. - destruct (X.compare x x'); - destruct (X.compare x' x''); + destruct (X.compare x x'); + destruct (X.compare x' x''); MapS.Raw.MX.elim_comp. intuition. apply D.eq_trans with e'; auto. @@ -1285,14 +1285,14 @@ Qed. Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; - intros (m3, Hm3); destruct m3; unfold lt; simpl; - try destruct a as (x,e); - try destruct p as (x',e'); + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; + intros (m3, Hm3); destruct m3; unfold lt; simpl; + try destruct a as (x,e); + try destruct p as (x',e'); try destruct p0 as (x'',e''); try contradiction; auto. - destruct (X.compare x x'); - destruct (X.compare x' x''); + destruct (X.compare x x'); + destruct (X.compare x' x''); MapS.Raw.MX.elim_comp; auto. intuition. left; apply D.lt_trans with e'; auto. @@ -1307,9 +1307,9 @@ Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; unfold eq, lt; simpl; - try destruct a as (x,e); + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; unfold eq, lt; simpl; + try destruct a as (x,e); try destruct p as (x',e'); try contradiction; auto. destruct (X.compare x x'); auto. intuition. @@ -1322,20 +1322,20 @@ Ltac cmp_solve := unfold eq, lt; simpl; try Raw.MX.elim_comp; auto. Definition compare : forall m1 m2, Compare lt eq m1 m2. Proof. - intros (m1,Hm1); induction m1; - intros (m2, Hm2); destruct m2; + intros (m1,Hm1); induction m1; + intros (m2, Hm2); destruct m2; [ apply EQ | apply LT | apply GT | ]; cmp_solve. - destruct a as (x,e); destruct p as (x',e'). - destruct (X.compare x x'); + destruct a as (x,e); destruct p as (x',e'). + destruct (X.compare x x'); [ apply LT | | apply GT ]; cmp_solve. - destruct (D.compare e e'); + destruct (D.compare e e'); [ apply LT | | apply GT ]; cmp_solve. assert (Hm11 : sort (Raw.PX.ltk (elt:=D.t)) m1). inversion_clear Hm1; auto. assert (Hm22 : sort (Raw.PX.ltk (elt:=D.t)) m2). inversion_clear Hm2; auto. - destruct (IHm1 Hm11 (Build_slist Hm22)); + destruct (IHm1 Hm11 (Build_slist Hm22)); [ apply LT | apply EQ | apply GT ]; cmp_solve. Qed. -End Make_ord. +End Make_ord. diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v index 10c7ce4a8..112ccce30 100644 --- a/theories/FSets/FMapPositive.v +++ b/theories/FSets/FMapPositive.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -25,16 +25,16 @@ Open Local Scope positive_scope. (** * An implementation of [FMapInterface.S] for positive keys. *) -(** This file is an adaptation to the [FMap] framework of a work by +(** This file is an adaptation to the [FMap] framework of a work by Xavier Leroy and Sandrine Blazy (used for building certified compilers). - Keys are of type [positive], and maps are binary trees: the sequence + Keys are of type [positive], and maps are binary trees: the sequence of binary digits of a positive number corresponds to a path in such a tree. - This is quite similar to the [IntMap] library, except that no path compression - is implemented, and that the current file is simple enough to be + This is quite similar to the [IntMap] library, except that no path compression + is implemented, and that the current file is simple enough to be self-contained. *) -(** Even if [positive] can be seen as an ordered type with respect to the - usual order (see [OrderedTypeEx]), we use here a lexicographic order +(** Even if [positive] can be seen as an ordered type with respect to the + usual order (see [OrderedTypeEx]), we use here a lexicographic order over bits, which is more natural here (lower bits are considered first). *) Module PositiveOrderedTypeBits <: UsualOrderedType. @@ -44,8 +44,8 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. Definition eq_sym := @sym_eq t. Definition eq_trans := @trans_eq t. - Fixpoint bits_lt (p q:positive) { struct p } : Prop := - match p, q with + Fixpoint bits_lt (p q:positive) { struct p } : Prop := + match p, q with | xH, xI _ => True | xH, _ => False | xO p, xO q => bits_lt p q @@ -63,9 +63,9 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. induction y; destruct z; simpl; eauto; intuition. induction y; destruct z; simpl; eauto; intuition. Qed. - + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. - Proof. + Proof. exact bits_lt_trans. Qed. @@ -101,7 +101,7 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. apply LT; auto. apply EQ; rewrite e; red; auto. apply GT; auto. - (* O H *) + (* O H *) apply LT; simpl; auto. (* H I *) apply LT; simpl; auto. @@ -122,7 +122,7 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. End PositiveOrderedTypeBits. (** Other positive stuff *) - + Fixpoint append (i j : positive) {struct i} : positive := match i with | xH => j @@ -130,7 +130,7 @@ Fixpoint append (i j : positive) {struct i} : positive := | xO ii => xO (append ii j) end. -Lemma append_assoc_0 : +Lemma append_assoc_0 : forall (i j : positive), append i (xO j) = append (append i (xO xH)) j. Proof. induction i; intros; destruct j; simpl; @@ -140,7 +140,7 @@ Proof. auto. Qed. -Lemma append_assoc_1 : +Lemma append_assoc_1 : forall (i j : positive), append i (xI j) = append (append i (xI xH)) j. Proof. induction i; intros; destruct j; simpl; @@ -159,7 +159,7 @@ Lemma append_neutral_l : forall (i : positive), append xH i = i. Proof. simpl; auto. Qed. - + (** The module of maps over positive keys *) @@ -182,9 +182,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Implicit Arguments Leaf [A]. Definition empty : t A := Leaf. - - Fixpoint is_empty (m : t A) {struct m} : bool := - match m with + + Fixpoint is_empty (m : t A) {struct m} : bool := + match m with | Leaf => true | Node l None r => (is_empty l) && (is_empty r) | _ => false @@ -279,8 +279,8 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. (** [cardinal] *) Fixpoint cardinal (m : t A) : nat := - match m with - | Leaf => 0%nat + match m with + | Leaf => 0%nat | Node l None r => (cardinal l + cardinal r)%nat | Node l (Some _) r => S (cardinal l + cardinal r) end. @@ -565,7 +565,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. exact (xelements_complete i xH m v H). Qed. - Lemma cardinal_1 : + Lemma cardinal_1 : forall (m: t A), cardinal m = length (elements m). Proof. unfold elements. @@ -584,13 +584,13 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Definition Empty m := forall (a : positive)(e:A) , ~ MapsTo a e m. Definition eq_key (p p':positive*A) := E.eq (fst p) (fst p'). - - Definition eq_key_elt (p p':positive*A) := + + Definition eq_key_elt (p p':positive*A) := E.eq (fst p) (fst p') /\ (snd p) = (snd p'). Definition lt_key (p p':positive*A) := E.lt (fst p) (fst p'). - Lemma mem_find : + Lemma mem_find : forall m x, mem x m = match find x m with None => false | _ => true end. Proof. induction m; destruct x; simpl; auto. @@ -625,7 +625,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. simpl; generalize H0; rewrite Empty_alt; auto. Qed. - Section FMapSpec. + Section FMapSpec. Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. @@ -633,7 +633,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. destruct 1 as (e0,H0); rewrite H0; auto. Qed. - Lemma mem_2 : forall m x, mem x m = true -> In x m. + Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, MapsTo; intros m x; rewrite mem_find. destruct (find x m). @@ -659,7 +659,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. rewrite Empty_alt; apply gempty. Qed. - Lemma is_empty_1 : Empty m -> is_empty m = true. + Lemma is_empty_1 : Empty m -> is_empty m = true. Proof. induction m; simpl; auto. rewrite Empty_Node. @@ -699,7 +699,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x m). - Proof. + Proof. intros; intro. generalize (mem_1 H0). rewrite mem_find. @@ -716,15 +716,15 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Qed. Lemma remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. - Proof. + Proof. unfold MapsTo. destruct (E.eq_dec x y). subst. rewrite grs; intros; discriminate. rewrite gro; auto. Qed. - - Lemma elements_1 : + + Lemma elements_1 : MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. unfold MapsTo. @@ -736,7 +736,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. apply elements_correct; auto. Qed. - Lemma elements_2 : + Lemma elements_2 : InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. unfold MapsTo. @@ -746,7 +746,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. apply elements_complete; auto. Qed. - Lemma xelements_bits_lt_1 : forall p p0 q m v, + Lemma xelements_bits_lt_1 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xO q))) -> E.bits_lt p0 p. Proof. intros. @@ -755,7 +755,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. - Lemma xelements_bits_lt_2 : forall p p0 q m v, + Lemma xelements_bits_lt_2 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xI q))) -> E.bits_lt p p0. Proof. intros. @@ -803,7 +803,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. eapply xelements_bits_lt_2; eauto. Qed. - Lemma elements_3 : sort lt_key (elements m). + Lemma elements_3 : sort lt_key (elements m). Proof. unfold elements. apply xelements_sort; auto. @@ -818,7 +818,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. End FMapSpec. (** [map] and [mapi] *) - + Variable B : Type. Section Mapi. @@ -862,9 +862,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. rewrite append_neutral_l; auto. Qed. - Lemma mapi_1 : - forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:key->elt->elt'), - MapsTo x e m -> + Lemma mapi_1 : + forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:key->elt->elt'), + MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros. @@ -877,8 +877,8 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. simpl; auto. Qed. - Lemma mapi_2 : - forall (elt elt':Type)(m: t elt)(x:key)(f:key->elt->elt'), + Lemma mapi_2 : + forall (elt elt':Type)(m: t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros. @@ -891,14 +891,14 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. simpl in *; discriminate. Qed. - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros; unfold map. destruct (mapi_1 (fun _ => f) H); intuition. Qed. - - Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + + Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros; unfold map in *; eapply mapi_2; eauto. @@ -907,7 +907,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Section map2. Variable A B C : Type. Variable f : option A -> option B -> option C. - + Implicit Arguments Leaf [A]. Fixpoint xmap2_l (m : t A) {struct m} : t C := @@ -954,14 +954,14 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. End map2. - Definition map2 (elt elt' elt'':Type)(f:option elt->option elt'->option elt'') := + Definition map2 (elt elt' elt'':Type)(f:option elt->option elt'->option elt'') := _map2 (fun o1 o2 => match o1,o2 with None,None => None | _, _ => f o1 o2 end). Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. intros. unfold map2. rewrite gmap2; auto. @@ -974,7 +974,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Proof. intros. @@ -1032,12 +1032,12 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. rewrite xfoldi_1; reflexivity. Qed. - Fixpoint equal (A:Type)(cmp : A -> A -> bool)(m1 m2 : t A) {struct m1} : bool := - match m1, m2 with + Fixpoint equal (A:Type)(cmp : A -> A -> bool)(m1 m2 : t A) {struct m1} : bool := + match m1, m2 with | Leaf, _ => is_empty m2 | _, Leaf => is_empty m1 - | Node l1 o1 r1, Node l2 o2 r2 => - (match o1, o2 with + | Node l1 o1 r1, Node l2 o2 r2 => + (match o1, o2 with | None, None => true | Some v1, Some v2 => cmp v1 v2 | _, _ => false @@ -1045,19 +1045,19 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. && equal cmp l1 l2 && equal cmp r1 r2 end. - Definition Equal (A:Type)(m m':t A) := + Definition Equal (A:Type)(m m':t A) := forall y, find y m = find y m'. - Definition Equiv (A:Type)(eq_elt:A->A->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (A:Type)(eq_elt:A->A->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb (A:Type)(cmp: A->A->bool) := Equiv (Cmp cmp). - Lemma equal_1 : forall (A:Type)(m m':t A)(cmp:A->A->bool), - Equivb cmp m m' -> equal cmp m m' = true. - Proof. + Lemma equal_1 : forall (A:Type)(m m':t A)(cmp:A->A->bool), + Equivb cmp m m' -> equal cmp m m' = true. + Proof. induction m. (* m = Leaf *) - destruct 1. + destruct 1. simpl. apply is_empty_1. red; red; intros. @@ -1069,7 +1069,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. (* m = Node *) destruct m'. (* m' = Leaf *) - destruct 1. + destruct 1. simpl. destruct o. assert (In xH (Leaf A)). @@ -1106,9 +1106,9 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. apply andb_true_intro; split; auto. Qed. - Lemma equal_2 : forall (A:Type)(m m':t A)(cmp:A->A->bool), - equal cmp m m' = true -> Equivb cmp m m'. - Proof. + Lemma equal_2 : forall (A:Type)(m m':t A)(cmp:A->A->bool), + equal cmp m m' = true -> Equivb cmp m m'. + Proof. induction m. (* m = Leaf *) simpl. @@ -1182,7 +1182,7 @@ Module PositiveMapAdditionalFacts. rewrite (IHi m2 v H); congruence. rewrite (IHi m1 v H); congruence. Qed. - + Lemma xmap2_lr : forall (A B : Type)(f g: option A -> option A -> option B)(m : t A), (forall (i j : option A), f i j = g j i) -> @@ -1210,7 +1210,7 @@ Module PositiveMapAdditionalFacts. auto. rewrite IHm1_1. rewrite IHm1_2. - auto. + auto. Qed. End PositiveMapAdditionalFacts. diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v index 0c12516c4..e29bde236 100644 --- a/theories/FSets/FMapWeakList.v +++ b/theories/FSets/FMapWeakList.v @@ -8,7 +8,7 @@ (* $Id$ *) -(** * Finite map library *) +(** * Finite map library *) (** This file proposes an implementation of the non-dependant interface [FMapInterface.WS] using lists of pairs, unordered but without redundancy. *) @@ -29,7 +29,7 @@ Section Elt. Variable elt : Type. -Notation eqk := (eqk (elt:=elt)). +Notation eqk := (eqk (elt:=elt)). Notation eqke := (eqke (elt:=elt)). Notation MapsTo := (MapsTo (elt:=elt)). Notation In := (In (elt:=elt)). @@ -52,7 +52,7 @@ Qed. Hint Resolve empty_1. Lemma empty_NoDup : NoDupA empty. -Proof. +Proof. unfold empty; auto. Qed. @@ -60,7 +60,7 @@ Qed. Definition is_empty (l : t elt) : bool := if l then true else false. -Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. +Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. Proof. unfold Empty, PX.MapsTo. intros m. @@ -88,7 +88,7 @@ Function mem (k : key) (s : t elt) {struct s} : bool := Lemma mem_1 : forall m (Hm:NoDupA m) x, In x m -> mem x m = true. Proof. - intros m Hm x; generalize Hm; clear Hm. + intros m Hm x; generalize Hm; clear Hm. functional induction (mem x m);intros NoDup belong1;trivial. inversion belong1. inversion H. inversion_clear NoDup. @@ -98,13 +98,13 @@ Proof. contradiction. apply IHb; auto. exists x0; auto. -Qed. +Qed. -Lemma mem_2 : forall m (Hm:NoDupA m) x, mem x m = true -> In x m. +Lemma mem_2 : forall m (Hm:NoDupA m) x, mem x m = true -> In x m. Proof. intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo. functional induction (mem x m); intros NoDup hyp; try discriminate. - exists _x; auto. + exists _x; auto. inversion_clear NoDup. destruct IHb; auto. exists x0; auto. @@ -124,8 +124,8 @@ Proof. functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto. Qed. -Lemma find_1 : forall m (Hm:NoDupA m) x e, - MapsTo x e m -> find x m = Some e. +Lemma find_1 : forall m (Hm:NoDupA m) x e, + MapsTo x e m -> find x m = Some e. Proof. intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo. functional induction (find x m);simpl; subst; try clear H_eq_1. @@ -142,7 +142,7 @@ Qed. (* Not part of the exported specifications, used later for [combine]. *) -Lemma find_eq : forall m (Hm:NoDupA m) x x', +Lemma find_eq : forall m (Hm:NoDupA m) x x', X.eq x x' -> find x m = find x' m. Proof. induction m; simpl; auto; destruct a; intros. @@ -167,7 +167,7 @@ Proof. functional induction (add x e m);simpl;auto. Qed. -Lemma add_2 : forall m x y e e', +Lemma add_2 : forall m x y e e', ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; generalize y e; clear y e; unfold PX.MapsTo. @@ -178,7 +178,7 @@ Proof. auto. intros y' e'' eqky'; inversion_clear 1; intuition. Qed. - + Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. @@ -189,14 +189,14 @@ Proof. inversion_clear 2; auto. Qed. -Lemma add_3' : forall m x y e e', - ~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m. +Lemma add_3' : forall m x y e e', + ~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m. Proof. intros m x y e e'. generalize y e; clear y e. functional induction (add x e' m);simpl;auto. inversion_clear 2. compute in H1; elim H; auto. - inversion H1. + inversion H1. constructor 2; inversion_clear H0; auto. compute in H1; elim H; auto. inversion_clear 2; auto. @@ -218,7 +218,7 @@ Qed. (* Not part of the exported specifications, used later for [combine]. *) -Lemma add_eq : forall m (Hm:NoDupA m) x a e, +Lemma add_eq : forall m (Hm:NoDupA m) x a e, X.eq x a -> find x (add a e m) = Some e. Proof. intros. @@ -227,7 +227,7 @@ Proof. apply add_1; auto. Qed. -Lemma add_not_eq : forall m (Hm:NoDupA m) x a e, +Lemma add_not_eq : forall m (Hm:NoDupA m) x a e, ~X.eq x a -> find x (add a e m) = find x m. Proof. intros. @@ -250,7 +250,7 @@ Function remove (k : key) (s : t elt) {struct s} : t elt := match s with | nil => nil | (k',x) :: l => if X.eq_dec k k' then l else (k',x) :: remove k l - end. + end. Lemma remove_1 : forall m (Hm:NoDupA m) x y, X.eq x y -> ~ In y (remove x m). Proof. @@ -265,7 +265,7 @@ Proof. destruct H0 as (e,H2); unfold PX.MapsTo in H2. apply InA_eqk with (y,e); auto. compute; apply X.eq_trans with x; auto. - + intro H2. destruct H2 as (e,H2); inversion_clear H2. compute in H0; destruct H0. @@ -274,8 +274,8 @@ Proof. elim (IHt0 H2 H). exists e; auto. Qed. - -Lemma remove_2 : forall m (Hm:NoDupA m) x y e, + +Lemma remove_2 : forall m (Hm:NoDupA m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -283,11 +283,11 @@ Proof. inversion_clear 3; auto. compute in H1; destruct H1. elim H; apply X.eq_trans with k'; auto. - + inversion_clear 1; inversion_clear 2; auto. Qed. -Lemma remove_3 : forall m (Hm:NoDupA m) x y e, +Lemma remove_3 : forall m (Hm:NoDupA m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -295,7 +295,7 @@ Proof. do 2 inversion_clear 1; auto. Qed. -Lemma remove_3' : forall m (Hm:NoDupA m) x y e, +Lemma remove_3' : forall m (Hm:NoDupA m) x y e, InA eqk (y,e) (remove x m) -> InA eqk (y,e) m. Proof. intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo. @@ -313,7 +313,7 @@ Proof. simpl; case (X.eq_dec x x'); auto. constructor; auto. contradict H; apply remove_3' with x; auto. -Qed. +Qed. (** * [elements] *) @@ -325,12 +325,12 @@ Proof. Qed. Lemma elements_2 : forall m x e, InA eqke (x,e) (elements m) -> MapsTo x e m. -Proof. +Proof. auto. Qed. -Lemma elements_3w : forall m (Hm:NoDupA m), NoDupA (elements m). -Proof. +Lemma elements_3w : forall m (Hm:NoDupA m), NoDupA (elements m). +Proof. auto. Qed. @@ -344,34 +344,34 @@ Function fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc : A) {struct m} : A := Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. -Proof. +Proof. intros; functional induction (@fold A f m i); auto. Qed. (** * [equal] *) -Definition check (cmp : elt -> elt -> bool)(k:key)(e:elt)(m': t elt) := - match find k m' with +Definition check (cmp : elt -> elt -> bool)(k:key)(e:elt)(m': t elt) := + match find k m' with | None => false | Some e' => cmp e e' end. -Definition submap (cmp : elt -> elt -> bool)(m m' : t elt) : bool := - fold (fun k e b => andb (check cmp k e m') b) m true. - +Definition submap (cmp : elt -> elt -> bool)(m m' : t elt) : bool := + fold (fun k e b => andb (check cmp k e m') b) m true. + Definition equal (cmp : elt -> elt -> bool)(m m' : t elt) : bool := andb (submap cmp m m') (submap (fun e' e => cmp e e') m' m). -Definition Submap cmp m m' := - (forall k, In k m -> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). +Definition Submap cmp m m' := + (forall k, In k m -> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Definition Equivb cmp m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). +Definition Equivb cmp m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). -Lemma submap_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, - Submap cmp m m' -> submap cmp m m' = true. +Lemma submap_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, + Submap cmp m m' -> submap cmp m m' = true. Proof. unfold Submap, submap. induction m. @@ -390,9 +390,9 @@ Proof. destruct H5 as (e'',H5); exists e''; auto. apply H0 with k; auto. Qed. - -Lemma submap_2 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, - submap cmp m m' = true -> Submap cmp m m'. + +Lemma submap_2 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, + submap cmp m m' = true -> Submap cmp m m'. Proof. unfold Submap, submap. induction m. @@ -400,7 +400,7 @@ Proof. intuition. destruct H0; inversion H0. inversion H0. - + destruct a; simpl; intros. inversion_clear Hm. rewrite andb_b_true in H. @@ -414,7 +414,7 @@ Proof. rewrite H2 in H. destruct (IHm H1 m' Hm' cmp H); auto. unfold check in H2. - case_eq (find t0 m'); [intros e' H5 | intros H5]; + case_eq (find t0 m'); [intros e' H5 | intros H5]; rewrite H5 in H2; try discriminate. split; intros. destruct H6 as (e0,H6); inversion_clear H6. @@ -432,15 +432,15 @@ Qed. (** Specification of [equal] *) -Lemma equal_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, - Equivb cmp m m' -> equal cmp m m' = true. -Proof. +Lemma equal_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, + Equivb cmp m m' -> equal cmp m m' = true. +Proof. unfold Equivb, equal. intuition. apply andb_true_intro; split; apply submap_1; unfold Submap; firstorder. Qed. -Lemma equal_2 : forall m (Hm:NoDupA m) m' (Hm':NoDupA m') cmp, +Lemma equal_2 : forall m (Hm:NoDupA m) m' (Hm':NoDupA m') cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. unfold Equivb, equal. @@ -449,12 +449,12 @@ Proof. generalize (submap_2 Hm Hm' H0). generalize (submap_2 Hm' Hm H1). firstorder. -Qed. +Qed. Variable elt':Type. (** * [map] and [mapi] *) - + Fixpoint map (f:elt -> elt') (m:t elt) {struct m} : t elt' := match m with | nil => nil @@ -468,24 +468,24 @@ Fixpoint mapi (f: key -> elt -> elt') (m:t elt) {struct m} : t elt' := end. End Elt. -Section Elt2. -(* A new section is necessary for previous definitions to work +Section Elt2. +(* A new section is necessary for previous definitions to work with different [elt], especially [MapsTo]... *) - + Variable elt elt' : Type. (** Specification of [map] *) -Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), +Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros m x e f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. constructor 1. unfold eqke in *; simpl in *; intuition congruence. @@ -493,15 +493,15 @@ Proof. unfold MapsTo in *; auto. Qed. -Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), +Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -514,9 +514,9 @@ Proof. constructor 2; auto. Qed. -Lemma map_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f:elt->elt'), +Lemma map_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f:elt->elt'), NoDupA (@eqk elt') (map f m). -Proof. +Proof. induction m; simpl; auto. intros. destruct a as (x',e'). @@ -524,25 +524,25 @@ Proof. constructor; auto. contradict H. (* il faut un map_1 avec eqk au lieu de eqke *) - clear IHm H0. + clear IHm H0. induction m; simpl in *; auto. inversion H. destruct a; inversion H; auto. -Qed. - +Qed. + (** Specification of [mapi] *) -Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), - MapsTo x e m -> +Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), + MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros m x e f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m. inversion 1. - + destruct a as (x',e'). - simpl. + simpl. inversion_clear 1. exists x'. destruct H0; simpl in *. @@ -551,17 +551,17 @@ Proof. unfold eqke in *; simpl in *; intuition congruence. destruct IHm as (y, hyp); auto. exists y; intuition. -Qed. +Qed. -Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), +Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. - intros m x f. + intros m x f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. intros (e,abs). inversion abs. - + destruct a as (x',e). intros hyp. inversion hyp. clear hyp. @@ -574,7 +574,7 @@ Proof. constructor 2; auto. Qed. -Lemma mapi_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f: key->elt->elt'), +Lemma mapi_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f: key->elt->elt'), NoDupA (@eqk elt') (mapi f m). Proof. induction m; simpl; auto. @@ -589,30 +589,30 @@ Proof. destruct a; inversion_clear H; auto. Qed. -End Elt2. +End Elt2. Section Elt3. Variable elt elt' elt'' : Type. Notation oee' := (option elt * option elt')%type. - + Definition combine_l (m:t elt)(m':t elt') : t oee' := - mapi (fun k e => (Some e, find k m')) m. + mapi (fun k e => (Some e, find k m')) m. Definition combine_r (m:t elt)(m':t elt') : t oee' := - mapi (fun k e' => (find k m, Some e')) m'. + mapi (fun k e' => (find k m, Some e')) m'. -Definition fold_right_pair (A B C:Type)(f:A->B->C->C)(l:list (A*B))(i:C) := +Definition fold_right_pair (A B C:Type)(f:A->B->C->C)(l:list (A*B))(i:C) := List.fold_right (fun p => f (fst p) (snd p)) i l. -Definition combine (m:t elt)(m':t elt') : t oee' := - let l := combine_l m m' in - let r := combine_r m m' in +Definition combine (m:t elt)(m':t elt') : t oee' := + let l := combine_l m m' in + let r := combine_r m m' in fold_right_pair (add (elt:=oee')) l r. -Lemma fold_right_pair_NoDup : - forall l r (Hl: NoDupA (eqk (elt:=oee')) l) - (Hl: NoDupA (eqk (elt:=oee')) r), +Lemma fold_right_pair_NoDup : + forall l r (Hl: NoDupA (eqk (elt:=oee')) l) + (Hl: NoDupA (eqk (elt:=oee')) r), NoDupA (eqk (elt:=oee')) (fold_right_pair (add (elt:=oee')) l r). Proof. induction l; simpl; auto. @@ -622,8 +622,8 @@ Proof. Qed. Hint Resolve fold_right_pair_NoDup. -Lemma combine_NoDup : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), +Lemma combine_NoDup : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), NoDupA (@eqk oee') (combine m m'). Proof. unfold combine, combine_r, combine_l. @@ -637,21 +637,21 @@ Proof. auto. Qed. -Definition at_least_left (o:option elt)(o':option elt') := - match o with - | None => None +Definition at_least_left (o:option elt)(o':option elt') := + match o with + | None => None | _ => Some (o,o') end. -Definition at_least_right (o:option elt)(o':option elt') := - match o' with - | None => None +Definition at_least_right (o:option elt)(o':option elt') := + match o' with + | None => None | _ => Some (o,o') end. -Lemma combine_l_1 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (combine_l m m') = at_least_left (find x m) (find x m'). +Lemma combine_l_1 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (combine_l m m') = at_least_left (find x m) (find x m'). Proof. unfold combine_l. intros. @@ -668,9 +668,9 @@ Proof. rewrite (find_1 Hm H1) in H; discriminate. Qed. -Lemma combine_r_1 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (combine_r m m') = at_least_right (find x m) (find x m'). +Lemma combine_r_1 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (combine_r m m') = at_least_right (find x m) (find x m'). Proof. unfold combine_r. intros. @@ -687,15 +687,15 @@ Proof. rewrite (find_1 Hm' H1) in H; discriminate. Qed. -Definition at_least_one (o:option elt)(o':option elt') := - match o, o' with - | None, None => None +Definition at_least_one (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => Some (o,o') end. -Lemma combine_1 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (combine m m') = at_least_one (find x m) (find x m'). +Lemma combine_1 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (combine m m') = at_least_one (find x m) (find x m'). Proof. unfold combine. intros. @@ -726,19 +726,19 @@ Qed. Variable f : option elt -> option elt' -> option elt''. -Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := +Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := match o with | Some e => (k,e)::l | None => l end. -Definition map2 m m' := - let m0 : t oee' := combine m m' in - let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in +Definition map2 m m' := + let m0 : t oee' := combine m m' in + let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in fold_right_pair (option_cons (A:=elt'')) m1 nil. -Lemma map2_NoDup : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), +Lemma map2_NoDup : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), NoDupA (@eqk elt'') (map2 m m'). Proof. intros. @@ -747,7 +747,7 @@ Proof. set (l0:=combine m m') in *; clearbody l0. set (f':= fun p : oee' => f (fst p) (snd p)). assert (H1:=map_NoDup (elt' := option elt'') H0 f'). - set (l1:=map f' l0) in *; clearbody l1. + set (l1:=map f' l0) in *; clearbody l1. clear f' f H0 l0 Hm Hm' m m'. induction l1. simpl; auto. @@ -763,15 +763,15 @@ Proof. inversion_clear H; auto. Qed. -Definition at_least_one_then_f (o:option elt)(o':option elt') := - match o, o' with - | None, None => None +Definition at_least_one_then_f (o:option elt)(o':option elt') := + match o, o' with + | None, None => None | _, _ => f o o' end. -Lemma map2_0 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). +Lemma map2_0 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). Proof. intros. unfold map2. @@ -779,7 +779,7 @@ Proof. assert (H2:=combine_NoDup Hm Hm'). set (f':= fun p : oee' => f (fst p) (snd p)). set (m0 := combine m m') in *; clearbody m0. - set (o:=find x m) in *; clearbody o. + set (o:=find x m) in *; clearbody o. set (o':=find x m') in *; clearbody o'. clear Hm Hm' m m'. generalize H; clear H. @@ -795,14 +795,14 @@ Proof. destruct o; destruct o'; simpl in *; inversion_clear H; auto. rewrite H2. unfold f'; simpl. - destruct (f oo oo'); simpl. + destruct (f oo oo'); simpl. destruct (X.eq_dec x k); try contradict n; auto. destruct (IHm0 H1) as (_,H4); apply H4; auto. case_eq (find x m0); intros; auto. elim H0. apply InA_eqk with (x,p); auto. apply InA_eqke_eqk. - exact (find_2 H3). + exact (find_2 H3). (* k < x *) unfold f'; simpl. destruct (f oo oo'); simpl. @@ -826,10 +826,10 @@ Proof. Qed. (** Specification of [map2] *) -Lemma map2_1 : +Lemma map2_1 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - In x m \/ In x m' -> - find x (map2 m m') = f (find x m) (find x m'). + In x m \/ In x m' -> + find x (map2 m m') = f (find x m) (find x m'). Proof. intros. rewrite map2_0; auto. @@ -839,10 +839,10 @@ Proof. rewrite (find_1 Hm' H). destruct (find x m); simpl; auto. Qed. - -Lemma map2_2 : - forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), - In x (map2 m m') -> In x m \/ In x m'. + +Lemma map2_2 : + forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), + In x (map2 m m') -> In x m \/ In x m'. Proof. intros. destruct H as (e,H). @@ -850,9 +850,9 @@ Proof. rewrite (find_1 (map2_NoDup Hm Hm') H). generalize (@find_2 _ m x). generalize (@find_2 _ m' x). - destruct (find x m); + destruct (find x m); destruct (find x m'); simpl; intros. - left; exists e0; auto. + left; exists e0; auto. left; exists e0; auto. right; exists e0; auto. discriminate. @@ -863,31 +863,31 @@ End Raw. Module Make (X: DecidableType) <: WS with Module E:=X. - Module Raw := Raw X. + Module Raw := Raw X. Module E := X. - Definition key := E.t. + Definition key := E.t. - Record slist (elt:Type) := + Record slist (elt:Type) := {this :> Raw.t elt; NoDup : NoDupA (@Raw.PX.eqk elt) this}. - Definition t (elt:Type) := slist elt. + Definition t (elt:Type) := slist elt. -Section Elt. - Variable elt elt' elt'':Type. +Section Elt. + Variable elt elt' elt'':Type. Implicit Types m : t elt. - Implicit Types x y : key. + Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Build_slist (Raw.empty_NoDup elt). Definition is_empty m : bool := Raw.is_empty m.(this). Definition add x e m : t elt := Build_slist (Raw.add_NoDup m.(NoDup) x e). Definition find x m : option elt := Raw.find x m.(this). - Definition remove x m : t elt := Build_slist (Raw.remove_NoDup m.(NoDup) x). + Definition remove x m : t elt := Build_slist (Raw.remove_NoDup m.(NoDup) x). Definition mem x m : bool := Raw.mem x m.(this). Definition map f m : t elt' := Build_slist (Raw.map_NoDup m.(NoDup) f). Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_NoDup m.(NoDup) f). - Definition map2 f m (m':t elt') : t elt'' := + Definition map2 f m (m':t elt') : t elt'' := Build_slist (Raw.map2_NoDup f m.(NoDup) m'.(NoDup)). Definition elements m : list (key*elt) := @Raw.elements elt m.(this). Definition cardinal m := length m.(this). @@ -898,9 +898,9 @@ Section Elt. Definition Empty m : Prop := Raw.Empty m.(this). Definition Equal m m' := forall y, find y m = find y m'. - Definition Equiv (eq_elt:elt->elt->Prop) m m' := - (forall k, In k m <-> In k m') /\ - (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). + Definition Equiv (eq_elt:elt->elt->Prop) m m' := + (forall k, In k m <-> In k m') /\ + (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp m.(this) m'.(this). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. @@ -936,7 +936,7 @@ Section Elt. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m; exact (@Raw.remove_3 elt m.(this) m.(NoDup)). Qed. - Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. + Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m; exact (@Raw.find_1 elt m.(this) m.(NoDup)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@Raw.find_2 elt m.(this)). Qed. @@ -945,32 +945,32 @@ Section Elt. Proof. intros m; exact (@Raw.elements_1 elt m.(this)). Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros m; exact (@Raw.elements_2 elt m.(this)). Qed. - Lemma elements_3w : forall m, NoDupA eq_key (elements m). + Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@Raw.elements_3w elt m.(this) m.(NoDup)). Qed. - - Lemma cardinal_1 : forall m, cardinal m = length (elements m). + + Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intros; reflexivity. Qed. Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@Raw.fold_1 elt m.(this)). Qed. - Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. + Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. intros m m'; exact (@Raw.equal_1 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup)). Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m m'; exact (@Raw.equal_2 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup)). Qed. End Elt. - - Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), + + Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' m.(this)). Qed. - Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), - In x (map f m) -> In x m. + Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), + In x (map f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' m.(this)). Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) - (f:key->elt->elt'), MapsTo x e m -> + (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' m.(this)). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) @@ -978,18 +978,18 @@ Section Elt. Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' m.(this)). Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), - In x m \/ In x m' -> - find x (map2 f m m') = f (find x m) (find x m'). - Proof. - intros elt elt' elt'' m m' x f; + (x:key)(f:option elt->option elt'->option elt''), + In x m \/ In x m' -> + find x (map2 f m m') = f (find x m) (find x m'). + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_1 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') - (x:key)(f:option elt->option elt'->option elt''), + (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. - Proof. - intros elt elt' elt'' m m' x f; + Proof. + intros elt elt' elt'' m m' x f; exact (@Raw.map2_2 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x). Qed. diff --git a/theories/FSets/FSetAVL.v b/theories/FSets/FSetAVL.v index 10e06711f..0f0e675ee 100644 --- a/theories/FSets/FSetAVL.v +++ b/theories/FSets/FSetAVL.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -17,14 +17,14 @@ (** This module implements sets using AVL trees. It follows the implementation from Ocaml's standard library, - + All operations given here expect and produce well-balanced trees (in the ocaml sense: heigths of subtrees shouldn't differ by more than 2), and hence has low complexities (e.g. add is logarithmic in the size of the set). But proving these balancing preservations is in fact not necessary for ensuring correct operational behavior and hence fulfilling the FSet interface. As a consequence, - balancing results are not part of this file anymore, they can + balancing results are not part of this file anymore, they can now be found in [FSetFullAVL]. Four operations ([union], [subset], [compare] and [equal]) have @@ -47,9 +47,9 @@ Unset Strict Implicit. Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope. Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope. -(** * Raw - - Functor of pure functions + a posteriori proofs of invariant +(** * Raw + + Functor of pure functions + a posteriori proofs of invariant preservation *) Module Raw (Import I:Int)(X:OrderedType). @@ -89,19 +89,19 @@ Definition empty := Leaf. (** * Emptyness test *) -Definition is_empty s := +Definition is_empty s := match s with Leaf => true | _ => false end. (** * Appartness *) -(** The [mem] function is deciding appartness. It exploits the +(** The [mem] function is deciding appartness. It exploits the binary search tree invariant to achieve logarithmic complexity. *) -Fixpoint mem x s := - match s with - | Leaf => false - | Node l y r _ => match X.compare x y with - | LT _ => mem x l +Fixpoint mem x s := + match s with + | Leaf => false + | Node l y r _ => match X.compare x y with + | LT _ => mem x l | EQ _ => true | GT _ => mem x r end @@ -116,7 +116,7 @@ Definition singleton x := Node Leaf x Leaf 1. (** [create l x r] creates a node, assuming [l] and [r] to be balanced and [|height l - height r| <= 2]. *) -Definition create l x r := +Definition create l x r := Node l x r (max (height l) (height r) + 1). (** [bal l x r] acts as [create], but performs one step of @@ -124,44 +124,44 @@ Definition create l x r := Definition assert_false := create. -Definition bal l x r := - let hl := height l in +Definition bal l x r := + let hl := height l in let hr := height r in - if gt_le_dec hl (hr+2) then - match l with + if gt_le_dec hl (hr+2) then + match l with | Leaf => assert_false l x r - | Node ll lx lr _ => - if ge_lt_dec (height ll) (height lr) then + | Node ll lx lr _ => + if ge_lt_dec (height ll) (height lr) then create ll lx (create lr x r) - else - match lr with + else + match lr with | Leaf => assert_false l x r - | Node lrl lrx lrr _ => + | Node lrl lrx lrr _ => create (create ll lx lrl) lrx (create lrr x r) end end - else - if gt_le_dec hr (hl+2) then + else + if gt_le_dec hr (hl+2) then match r with | Leaf => assert_false l x r | Node rl rx rr _ => - if ge_lt_dec (height rr) (height rl) then + if ge_lt_dec (height rr) (height rl) then create (create l x rl) rx rr - else + else match rl with | Leaf => assert_false l x r - | Node rll rlx rlr _ => - create (create l x rll) rlx (create rlr rx rr) + | Node rll rlx rlr _ => + create (create l x rll) rlx (create rlr rx rr) end end - else + else create l x r. (** * Insertion *) -Fixpoint add x s := match s with +Fixpoint add x s := match s with | Leaf => Node Leaf x Leaf 1 - | Node l y r h => + | Node l y r h => match X.compare x y with | LT _ => bal (add x l) y r | EQ _ => Node l y r h @@ -171,19 +171,19 @@ Fixpoint add x s := match s with (** * Join - Same as [bal] but does not assume anything regarding heights - of [l] and [r]. + Same as [bal] but does not assume anything regarding heights + of [l] and [r]. *) Fixpoint join l : elt -> t -> t := match l with | Leaf => add - | Node ll lx lr lh => fun x => - fix join_aux (r:t) : t := match r with + | Node ll lx lr lh => fun x => + fix join_aux (r:t) : t := match r with | Leaf => add x l - | Node rl rx rr rh => + | Node rl rx rr rh => if gt_le_dec lh (rh+2) then bal ll lx (join lr x r) - else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rr + else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rr else create l x r end end. @@ -194,11 +194,11 @@ Fixpoint join l : elt -> t -> t := [t = Node l x r h]. Since we can't deal here with [assert false] for [t=Leaf], we pre-unpack [t] (and forget about [h]). *) - -Fixpoint remove_min l x r : t*elt := - match l with + +Fixpoint remove_min l x r : t*elt := + match l with | Leaf => (r,x) - | Node ll lx lr lh => + | Node ll lx lr lh => let (l',m) := remove_min ll lx lr in (bal l' x r, m) end. @@ -209,16 +209,16 @@ Fixpoint remove_min l x r : t*elt := [|height t1 - height t2| <= 2]. *) -Definition merge s1 s2 := match s1,s2 with - | Leaf, _ => s2 +Definition merge s1 s2 := match s1,s2 with + | Leaf, _ => s2 | _, Leaf => s1 - | _, Node l2 x2 r2 h2 => + | _, Node l2 x2 r2 h2 => let (s2',m) := remove_min l2 x2 r2 in bal s1 m s2' end. (** * Deletion *) -Fixpoint remove x s := match s with +Fixpoint remove x s := match s with | Leaf => Leaf | Node l y r h => match X.compare x y with @@ -230,7 +230,7 @@ Fixpoint remove x s := match s with (** * Minimum element *) -Fixpoint min_elt s := match s with +Fixpoint min_elt s := match s with | Leaf => None | Node Leaf y _ _ => Some y | Node l _ _ _ => min_elt l @@ -238,7 +238,7 @@ end. (** * Maximum element *) -Fixpoint max_elt s := match s with +Fixpoint max_elt s := match s with | Leaf => None | Node _ y Leaf _ => Some y | Node _ _ r _ => max_elt r @@ -253,16 +253,16 @@ Definition choose := min_elt. Same as [merge] but does not assume anything about heights. *) -Definition concat s1 s2 := - match s1, s2 with - | Leaf, _ => s2 +Definition concat s1 s2 := + match s1, s2 with + | Leaf, _ => s2 | _, Leaf => s1 - | _, Node l2 x2 r2 _ => - let (s2',m) := remove_min l2 x2 r2 in + | _, Node l2 x2 r2 _ => + let (s2',m) := remove_min l2 x2 r2 in join s1 m s2' end. -(** * Splitting +(** * Splitting [split x s] returns a triple [(l, present, r)] where - [l] is the set of elements of [s] that are [< x] @@ -278,8 +278,8 @@ Notation "t #r" := (t_right t) (at level 9, format "t '#r'"). Fixpoint split x s : triple := match s with | Leaf => << Leaf, false, Leaf >> - | Node l y r h => - match X.compare x y with + | Node l y r h => + match X.compare x y with | LT _ => let (ll,b,rl) := split x l in << ll, b, join rl y r >> | EQ _ => << l, true, r >> | GT _ => let (rl,b,rr) := split x r in << join l y rl, b, rr >> @@ -288,22 +288,22 @@ Fixpoint split x s : triple := match s with (** * Intersection *) -Fixpoint inter s1 s2 := match s1, s2 with +Fixpoint inter s1 s2 := match s1, s2 with | Leaf, _ => Leaf | _, Leaf => Leaf - | Node l1 x1 r1 h1, _ => - let (l2',pres,r2') := split x1 s2 in + | Node l1 x1 r1 h1, _ => + let (l2',pres,r2') := split x1 s2 in if pres then join (inter l1 l2') x1 (inter r1 r2') else concat (inter l1 l2') (inter r1 r2') end. (** * Difference *) -Fixpoint diff s1 s2 := match s1, s2 with +Fixpoint diff s1 s2 := match s1, s2 with | Leaf, _ => Leaf | _, Leaf => s1 - | Node l1 x1 r1 h1, _ => - let (l2',pres,r2') := split x1 s2 in + | Node l1 x1 r1 h1, _ => + let (l2',pres,r2') := split x1 s2 in if pres then concat (diff l1 l2') (diff r1 r2') else join (diff l1 l2') x1 (diff r1 r2') end. @@ -318,15 +318,15 @@ end. experimentally all the tests I've made in ocaml have shown this potential slowdown to be non-significant. Anyway, the exact code of ocaml has also been formalized thanks to Function+measure, see - [ocaml_union] in [FSetFullAVL]. + [ocaml_union] in [FSetFullAVL]. *) -Fixpoint union s1 s2 := - match s1, s2 with +Fixpoint union s1 s2 := + match s1, s2 with | Leaf, _ => s2 | _, Leaf => s1 - | Node l1 x1 r1 h1, _ => - let (l2',_,r2') := split x1 s2 in + | Node l1 x1 r1 h1, _ => + let (l2',_,r2') := split x1 s2 in join (union l1 l2') x1 (union r1 r2') end. @@ -347,10 +347,10 @@ Definition elements := elements_aux nil. (** * Filter *) -Fixpoint filter_acc (f:elt->bool) acc s := match s with +Fixpoint filter_acc (f:elt->bool) acc s := match s with | Leaf => acc - | Node l x r h => - filter_acc f (filter_acc f (if f x then add x acc else acc) l) r + | Node l x r h => + filter_acc f (filter_acc f (if f x then add x acc else acc) l) r end. Definition filter f := filter_acc f Leaf. @@ -358,11 +358,11 @@ Definition filter f := filter_acc f Leaf. (** * Partition *) -Fixpoint partition_acc (f:elt->bool)(acc : t*t)(s : t) : t*t := - match s with +Fixpoint partition_acc (f:elt->bool)(acc : t*t)(s : t) : t*t := + match s with | Leaf => acc - | Node l x r _ => - let (acct,accf) := acc in + | Node l x r _ => + let (acct,accf) := acc in partition_acc f (partition_acc f (if f x then (add x acct, accf) else (acct, add x accf)) l) r @@ -372,19 +372,19 @@ Definition partition f := partition_acc f (Leaf,Leaf). (** * [for_all] and [exists] *) -Fixpoint for_all (f:elt->bool) s := match s with +Fixpoint for_all (f:elt->bool) s := match s with | Leaf => true | Node l x r _ => f x &&& for_all f l &&& for_all f r end. -Fixpoint exists_ (f:elt->bool) s := match s with +Fixpoint exists_ (f:elt->bool) s := match s with | Leaf => false | Node l x r _ => f x ||| exists_ f l ||| exists_ f r end. (** * Fold *) -Fixpoint fold (A : Type) (f : elt -> A -> A)(s : tree) : A -> A := +Fixpoint fold (A : Type) (f : elt -> A -> A)(s : tree) : A -> A := fun a => match s with | Leaf => a | Node l x r _ => fold f r (f x (fold f l a)) @@ -394,43 +394,43 @@ Implicit Arguments fold [A]. (** * Subset *) -(** In ocaml, recursive calls are made on "half-trees" such as +(** In ocaml, recursive calls are made on "half-trees" such as (Node l1 x1 Leaf _) and (Node Leaf x1 r1 _). Instead of these non-structural calls, we propose here two specialized functions for - these situations. This version should be almost as efficient as - the one of ocaml (closures as arguments may slow things a bit), + these situations. This version should be almost as efficient as + the one of ocaml (closures as arguments may slow things a bit), it is simply less compact. The exact ocaml version has also been - formalized (thanks to Function+measure), see [ocaml_subset] in + formalized (thanks to Function+measure), see [ocaml_subset] in [FSetFullAVL]. *) -Fixpoint subsetl (subset_l1:t->bool) x1 s2 : bool := - match s2 with +Fixpoint subsetl (subset_l1:t->bool) x1 s2 : bool := + match s2 with | Leaf => false - | Node l2 x2 r2 h2 => - match X.compare x1 x2 with - | EQ _ => subset_l1 l2 + | Node l2 x2 r2 h2 => + match X.compare x1 x2 with + | EQ _ => subset_l1 l2 | LT _ => subsetl subset_l1 x1 l2 | GT _ => mem x1 r2 &&& subset_l1 s2 end end. -Fixpoint subsetr (subset_r1:t->bool) x1 s2 : bool := - match s2 with +Fixpoint subsetr (subset_r1:t->bool) x1 s2 : bool := + match s2 with | Leaf => false - | Node l2 x2 r2 h2 => - match X.compare x1 x2 with - | EQ _ => subset_r1 r2 + | Node l2 x2 r2 h2 => + match X.compare x1 x2 with + | EQ _ => subset_r1 r2 | LT _ => mem x1 l2 &&& subset_r1 s2 | GT _ => subsetr subset_r1 x1 r2 end end. -Fixpoint subset s1 s2 : bool := match s1, s2 with +Fixpoint subset s1 s2 : bool := match s1, s2 with | Leaf, _ => true | Node _ _ _ _, Leaf => false - | Node l1 x1 r1 h1, Node l2 x2 r2 h2 => - match X.compare x1 x2 with + | Node l1 x1 r1 h1, Node l2 x2 r2 h2 => + match X.compare x1 x2 with | EQ _ => subset l1 l2 &&& subset r1 r2 | LT _ => subsetl (subset l1) x1 l2 &&& subset r1 s2 | GT _ => subsetr (subset r1) x1 r2 &&& subset l1 s2 @@ -442,8 +442,8 @@ Fixpoint subset s1 s2 : bool := match s1, s2 with Transformation in C.P.S. suggested by Benjamin Grégoire. The original ocaml code (with non-structural recursive calls) has also been formalized (thanks to Function+measure), see - [ocaml_compare] in [FSetFullAVL]. The following code with - continuations computes dramatically faster in Coq, and + [ocaml_compare] in [FSetFullAVL]. The following code with + continuations computes dramatically faster in Coq, and should be almost as efficient after extraction. *) @@ -454,11 +454,11 @@ Inductive enumeration := | More : elt -> tree -> enumeration -> enumeration. -(** [cons t e] adds the elements of tree [t] on the head of +(** [cons t e] adds the elements of tree [t] on the head of enumeration [e]. *) -Fixpoint cons s e : enumeration := - match s with +Fixpoint cons s e : enumeration := + match s with | Leaf => e | Node l x r h => cons l (More x r e) end. @@ -478,7 +478,7 @@ Definition compare_more x1 (cont:enumeration->comparison) e2 := (** Comparison of left tree, middle element, then right tree *) -Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 := +Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 := match s1 with | Leaf => cont e2 | Node l1 x1 r1 _ => @@ -487,7 +487,7 @@ Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 := (** Initial continuation *) -Definition compare_end e2 := +Definition compare_end e2 := match e2 with End => Eq | _ => Lt end. (** The complete comparison *) @@ -496,10 +496,10 @@ Definition compare s1 s2 := compare_cont s1 compare_end (cons s2 End). (** * Equality test *) -Definition equal s1 s2 : bool := - match compare s1 s2 with +Definition equal s1 s2 : bool := + match compare s1 s2 with | Eq => true - | _ => false + | _ => false end. @@ -516,7 +516,7 @@ Inductive In (x : elt) : tree -> Prop := (** ** Binary search trees *) -(** [lt_tree x s]: all elements in [s] are smaller than [x] +(** [lt_tree x s]: all elements in [s] are smaller than [x] (resp. greater for [gt_tree]) *) Definition lt_tree x s := forall y, In y s -> X.lt y x. @@ -526,7 +526,7 @@ Definition gt_tree x s := forall y, In y s -> X.lt x y. Inductive bst : tree -> Prop := | BSLeaf : bst Leaf - | BSNode : forall x l r h, bst l -> bst r -> + | BSNode : forall x l r h, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node l x r h). @@ -553,15 +553,15 @@ Module Proofs. Hint Constructors In bst. Hint Unfold lt_tree gt_tree. -Tactic Notation "factornode" ident(l) ident(x) ident(r) ident(h) - "as" ident(s) := +Tactic Notation "factornode" ident(l) ident(x) ident(r) ident(h) + "as" ident(s) := set (s:=Node l x r h) in *; clearbody s; clear l x r h. -(** A tactic to repeat [inversion_clear] on all hyps of the +(** A tactic to repeat [inversion_clear] on all hyps of the form [(f (Node _ _ _ _))] *) Ltac inv f := - match goal with + match goal with | H:f Leaf |- _ => inversion_clear H; inv f | H:f _ Leaf |- _ => inversion_clear H; inv f | H:f (Node _ _ _ _) |- _ => inversion_clear H; inv f @@ -573,7 +573,7 @@ Ltac intuition_in := repeat progress (intuition; inv In). (** Helper tactic concerning order of elements. *) -Ltac order := match goal with +Ltac order := match goal with | U: lt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | U: gt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | _ => MX.order @@ -591,8 +591,8 @@ Proof. Qed. Hint Immediate In_1. -Lemma In_node_iff : - forall l x r h y, +Lemma In_node_iff : + forall l x r h y, In y (Node l x r h) <-> In y l \/ X.eq y x \/ In y r. Proof. intuition_in. @@ -655,10 +655,10 @@ Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans. (** * Inductions principles *) Functional Scheme mem_ind := Induction for mem Sort Prop. -Functional Scheme bal_ind := Induction for bal Sort Prop. +Functional Scheme bal_ind := Induction for bal Sort Prop. Functional Scheme add_ind := Induction for add Sort Prop. Functional Scheme remove_min_ind := Induction for remove_min Sort Prop. -Functional Scheme merge_ind := Induction for merge Sort Prop. +Functional Scheme merge_ind := Induction for merge Sort Prop. Functional Scheme remove_ind := Induction for remove Sort Prop. Functional Scheme min_elt_ind := Induction for min_elt Sort Prop. Functional Scheme max_elt_ind := Induction for max_elt Sort Prop. @@ -684,14 +684,14 @@ Qed. (** * Emptyness test *) -Lemma is_empty_1 : forall s, Empty s -> is_empty s = true. +Lemma is_empty_1 : forall s, Empty s -> is_empty s = true. Proof. destruct s as [|r x l h]; simpl; auto. intro H; elim (H x); auto. Qed. Lemma is_empty_2 : forall s, is_empty s = true -> Empty s. -Proof. +Proof. destruct s; simpl; intros; try discriminate; red; auto. Qed. @@ -701,12 +701,12 @@ Qed. Lemma mem_1 : forall s x, bst s -> In x s -> mem x s = true. Proof. - intros s x; functional induction mem x s; auto; intros; try clear e0; + intros s x; functional induction mem x s; auto; intros; try clear e0; inv bst; intuition_in; order. Qed. -Lemma mem_2 : forall s x, mem x s = true -> In x s. -Proof. +Lemma mem_2 : forall s x, mem x s = true -> In x s. +Proof. intros s x; functional induction mem x s; auto; intros; discriminate. Qed. @@ -714,13 +714,13 @@ Qed. (** * Singleton set *) -Lemma singleton_1 : forall x y, In y (singleton x) -> X.eq x y. -Proof. +Lemma singleton_1 : forall x y, In y (singleton x) -> X.eq x y. +Proof. unfold singleton; intros; inv In; order. Qed. -Lemma singleton_2 : forall x y, X.eq x y -> In y (singleton x). -Proof. +Lemma singleton_2 : forall x y, X.eq x y -> In y (singleton x). +Proof. unfold singleton; auto. Qed. @@ -733,33 +733,33 @@ Qed. (** * Helper functions *) -Lemma create_in : +Lemma create_in : forall l x r y, In y (create l x r) <-> X.eq y x \/ In y l \/ In y r. Proof. unfold create; split; [ inversion_clear 1 | ]; intuition. Qed. -Lemma create_bst : - forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> +Lemma create_bst : + forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (create l x r). Proof. unfold create; auto. Qed. Hint Resolve create_bst. -Lemma bal_in : forall l x r y, +Lemma bal_in : forall l x r y, In y (bal l x r) <-> X.eq y x \/ In y l \/ In y r. Proof. - intros l x r; functional induction bal l x r; intros; try clear e0; + intros l x r; functional induction bal l x r; intros; try clear e0; rewrite !create_in; intuition_in. Qed. -Lemma bal_bst : forall l x r, bst l -> bst r -> +Lemma bal_bst : forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (bal l x r). Proof. intros l x r; functional induction bal l x r; intros; inv bst; repeat apply create_bst; auto; unfold create; - (apply lt_tree_node || apply gt_tree_node); auto; + (apply lt_tree_node || apply gt_tree_node); auto; (eapply lt_tree_trans || eapply gt_tree_trans); eauto. Qed. Hint Resolve bal_bst. @@ -771,14 +771,14 @@ Hint Resolve bal_bst. Lemma add_in : forall s x y, In y (add x s) <-> X.eq y x \/ In y s. Proof. - intros s x; functional induction (add x s); auto; intros; + intros s x; functional induction (add x s); auto; intros; try rewrite bal_in, IHt; intuition_in. eapply In_1; eauto. Qed. Lemma add_bst : forall s x, bst s -> bst (add x s). -Proof. - intros s x; functional induction (add x s); auto; intros; +Proof. + intros s x; functional induction (add x s); auto; intros; inv bst; apply bal_bst; auto. (* lt_tree -> lt_tree (add ...) *) red; red in H3. @@ -800,25 +800,25 @@ Hint Resolve add_bst. (** * Join *) -(* Function/Functional Scheme can't deal with internal fix. +(* Function/Functional Scheme can't deal with internal fix. Let's do its job by hand: *) -Ltac join_tac := - intro l; induction l as [| ll _ lx lr Hlr lh]; +Ltac join_tac := + intro l; induction l as [| ll _ lx lr Hlr lh]; [ | intros x r; induction r as [| rl Hrl rx rr _ rh]; unfold join; - [ | destruct (gt_le_dec lh (rh+2)); - [ match goal with |- context b [ bal ?a ?b ?c] => - replace (bal a b c) - with (bal ll lx (join lr x (Node rl rx rr rh))); [ | auto] - end - | destruct (gt_le_dec rh (lh+2)); - [ match goal with |- context b [ bal ?a ?b ?c] => - replace (bal a b c) - with (bal (join (Node ll lx lr lh) x rl) rx rr); [ | auto] + [ | destruct (gt_le_dec lh (rh+2)); + [ match goal with |- context b [ bal ?a ?b ?c] => + replace (bal a b c) + with (bal ll lx (join lr x (Node rl rx rr rh))); [ | auto] + end + | destruct (gt_le_dec rh (lh+2)); + [ match goal with |- context b [ bal ?a ?b ?c] => + replace (bal a b c) + with (bal (join (Node ll lx lr lh) x rl) rx rr); [ | auto] end | ] ] ] ]; intros. -Lemma join_in : forall l x r y, +Lemma join_in : forall l x r y, In y (join l x r) <-> X.eq y x \/ In y l \/ In y r. Proof. join_tac. @@ -830,10 +830,10 @@ Proof. apply create_in. Qed. -Lemma join_bst : forall l x r, bst l -> bst r -> +Lemma join_bst : forall l x r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (join l x r). Proof. - join_tac; auto; inv bst; apply bal_bst; auto; + join_tac; auto; inv bst; apply bal_bst; auto; clear Hrl Hlr z; intro; intros; rewrite join_in in *. intuition; [ apply MX.lt_eq with x | ]; eauto. intuition; [ apply MX.eq_lt with x | ]; eauto. @@ -844,8 +844,8 @@ Hint Resolve join_bst. (** * Extraction of minimum element *) -Lemma remove_min_in : forall l x r h y, - In y (Node l x r h) <-> +Lemma remove_min_in : forall l x r h y, + In y (Node l x r h) <-> X.eq y (remove_min l x r)#2 \/ In y (remove_min l x r)#1. Proof. intros l x r; functional induction (remove_min l x r); simpl in *; intros. @@ -853,7 +853,7 @@ Proof. rewrite bal_in, In_node_iff, IHp, e0; simpl; intuition. Qed. -Lemma remove_min_bst : forall l x r h, +Lemma remove_min_bst : forall l x r h, bst (Node l x r h) -> bst (remove_min l x r)#1. Proof. intros l x r; functional induction (remove_min l x r); simpl; intros. @@ -865,7 +865,7 @@ Proof. rewrite remove_min_in, e0 in H2; simpl in H2; intuition. Qed. -Lemma remove_min_gt_tree : forall l x r h, +Lemma remove_min_gt_tree : forall l x r h, bst (Node l x r h) -> gt_tree (remove_min l x r)#2 (remove_min l x r)#1. Proof. @@ -873,8 +873,8 @@ Proof. inv bst; auto. inversion_clear H. specialize IHp with (1:=H0); rewrite e0 in IHp; simpl in IHp. - intro y; rewrite bal_in; intuition; - specialize (H2 m); rewrite remove_min_in, e0 in H2; simpl in H2; + intro y; rewrite bal_in; intuition; + specialize (H2 m); rewrite remove_min_in, e0 in H2; simpl in H2; [ apply MX.lt_eq with x | ]; eauto. Qed. Hint Resolve remove_min_bst remove_min_gt_tree. @@ -886,18 +886,18 @@ Hint Resolve remove_min_bst remove_min_gt_tree. Lemma merge_in : forall s1 s2 y, In y (merge s1 s2) <-> In y s1 \/ In y s2. Proof. - intros s1 s2; functional induction (merge s1 s2); intros; + intros s1 s2; functional induction (merge s1 s2); intros; try factornode _x _x0 _x1 _x2 as s1. intuition_in. intuition_in. rewrite bal_in, remove_min_in, e1; simpl; intuition. Qed. -Lemma merge_bst : forall s1 s2, bst s1 -> bst s2 -> - (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> +Lemma merge_bst : forall s1 s2, bst s1 -> bst s2 -> + (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> bst (merge s1 s2). Proof. - intros s1 s2; functional induction (merge s1 s2); intros; auto; + intros s1 s2; functional induction (merge s1 s2); intros; auto; try factornode _x _x0 _x1 _x2 as s1. apply bal_bst; auto. change s2' with ((s2',m)#1); rewrite <-e1; eauto. @@ -924,7 +924,7 @@ Proof. Qed. Lemma remove_bst : forall s x, bst s -> bst (remove x s). -Proof. +Proof. intros s x; functional induction (remove x s); intros; inv bst. auto. (* LT *) @@ -932,7 +932,7 @@ Proof. intro z; rewrite remove_in; auto; destruct 1; eauto. (* EQ *) eauto. - (* GT *) + (* GT *) apply bal_bst; auto. intro z; rewrite remove_in; auto; destruct 1; eauto. Qed. @@ -941,15 +941,15 @@ Hint Resolve remove_bst. (** * Minimum element *) -Lemma min_elt_1 : forall s x, min_elt s = Some x -> In x s. -Proof. +Lemma min_elt_1 : forall s x, min_elt s = Some x -> In x s. +Proof. intro s; functional induction (min_elt s); auto; inversion 1; auto. Qed. Lemma min_elt_2 : forall s x y, bst s -> - min_elt s = Some x -> In y s -> ~ X.lt y x. + min_elt s = Some x -> In y s -> ~ X.lt y x. Proof. - intro s; functional induction (min_elt s); + intro s; functional induction (min_elt s); try rename _x1 into l1, _x2 into x1, _x3 into r1, _x4 into h1. inversion_clear 2. inversion_clear 1. @@ -963,7 +963,7 @@ Proof. assert (X.lt x y) by (apply H2; auto). inversion_clear 1; auto; order. assert (X.lt x1 y) by auto. - inversion_clear 2; auto; + inversion_clear 2; auto; (assert (~ X.lt x1 x) by auto); order. Qed. @@ -980,13 +980,13 @@ Qed. (** * Maximum element *) -Lemma max_elt_1 : forall s x, max_elt s = Some x -> In x s. -Proof. +Lemma max_elt_1 : forall s x, max_elt s = Some x -> In x s. +Proof. intro s; functional induction (max_elt s); auto; inversion 1; auto. Qed. -Lemma max_elt_2 : forall s x y, bst s -> - max_elt s = Some x -> In y s -> ~ X.lt x y. +Lemma max_elt_2 : forall s x y, bst s -> + max_elt s = Some x -> In y s -> ~ X.lt x y. Proof. intro s; functional induction (max_elt s); try rename _x1 into l1, _x2 into x1, _x3 into r1, _x4 into h1. @@ -997,7 +997,7 @@ Proof. inversion_clear H5. inversion_clear 1. assert (X.lt y x1) by auto. - inversion_clear 2; auto; + inversion_clear 2; auto; (assert (~ X.lt x x1) by auto); order. Qed. @@ -1014,17 +1014,17 @@ Qed. (** * Any element *) Lemma choose_1 : forall s x, choose s = Some x -> In x s. -Proof. +Proof. exact min_elt_1. Qed. Lemma choose_2 : forall s, choose s = None -> Empty s. -Proof. +Proof. exact min_elt_3. Qed. -Lemma choose_3 : forall s s', bst s -> bst s' -> - forall x x', choose s = Some x -> choose s' = Some x' -> +Lemma choose_3 : forall s s', bst s -> bst s' -> + forall x x', choose s = Some x -> choose s' = Some x' -> Equal s s' -> X.eq x x'. Proof. unfold choose, Equal; intros s s' Hb Hb' x x' Hx Hx' H. @@ -1040,7 +1040,7 @@ Qed. (** * Concatenation *) -Lemma concat_in : forall s1 s2 y, +Lemma concat_in : forall s1 s2 y, In y (concat s1 s2) <-> In y s1 \/ In y s2. Proof. intros s1 s2; functional induction (concat s1 s2); intros; @@ -1049,12 +1049,12 @@ Proof. intuition_in. rewrite join_in, remove_min_in, e1; simpl; intuition. Qed. - -Lemma concat_bst : forall s1 s2, bst s1 -> bst s2 -> - (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> + +Lemma concat_bst : forall s1 s2, bst s1 -> bst s2 -> + (forall y1 y2 : elt, In y1 s1 -> In y2 s2 -> X.lt y1 y2) -> bst (concat s1 s2). -Proof. - intros s1 s2; functional induction (concat s1 s2); intros; auto; +Proof. + intros s1 s2; functional induction (concat s1 s2); intros; auto; try factornode _x _x0 _x1 _x2 as s1. apply join_bst; auto. change (bst (s2',m)#1); rewrite <-e1; eauto. @@ -1068,10 +1068,10 @@ Hint Resolve concat_bst. (** * Splitting *) -Lemma split_in_1 : forall s x y, bst s -> +Lemma split_in_1 : forall s x y, bst s -> (In y (split x s)#l <-> In y s /\ X.lt y x). Proof. - intros s x; functional induction (split x s); simpl; intros; + intros s x; functional induction (split x s); simpl; intros; inv bst; try clear e0. intuition_in. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. @@ -1080,10 +1080,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_2 : forall s x y, bst s -> +Lemma split_in_2 : forall s x y, bst s -> (In y (split x s)#r <-> In y s /\ X.lt x y). -Proof. - intros s x; functional induction (split x s); subst; simpl; intros; +Proof. + intros s x; functional induction (split x s); subst; simpl; intros; inv bst; try clear e0. intuition_in. rewrite join_in. @@ -1092,10 +1092,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_in_3 : forall s x, bst s -> +Lemma split_in_3 : forall s x, bst s -> ((split x s)#b = true <-> In x s). -Proof. - intros s x; functional induction (split x s); subst; simpl; intros; +Proof. + intros s x; functional induction (split x s); subst; simpl; intros; inv bst; try clear e0. intuition_in; try discriminate. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. @@ -1103,10 +1103,10 @@ Proof. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. -Lemma split_bst : forall s x, bst s -> +Lemma split_bst : forall s x, bst s -> bst (split x s)#l /\ bst (split x s)#r. -Proof. - intros s x; functional induction (split x s); subst; simpl; intros; +Proof. + intros s x; functional induction (split x s); subst; simpl; intros; inv bst; try clear e0; try rewrite e1 in *; simpl in *; intuition; apply join_bst; auto. intros y0. @@ -1119,15 +1119,15 @@ Qed. (** * Intersection *) -Lemma inter_bst_in : forall s1 s2, bst s1 -> bst s2 -> +Lemma inter_bst_in : forall s1 s2, bst s1 -> bst s2 -> bst (inter s1 s2) /\ (forall y, In y (inter s1 s2) <-> In y s1 /\ In y s2). Proof. - intros s1 s2; functional induction inter s1 s2; intros B1 B2; - [intuition_in|intuition_in | | ]; - factornode _x0 _x1 _x2 _x3 as s2; - generalize (split_bst x1 B2); + intros s1 s2; functional induction inter s1 s2; intros B1 B2; + [intuition_in|intuition_in | | ]; + factornode _x0 _x1 _x2 _x3 as s2; + generalize (split_bst x1 B2); rewrite e1; simpl; destruct 1; inv bst; - destruct IHt as (IHb1,IHi1); auto; + destruct IHt as (IHb1,IHi1); auto; destruct IHt0 as (IHb2,IHi2); auto; generalize (@split_in_1 s2 x1)(@split_in_2 s2 x1) (split_in_3 x1 B2)(split_bst x1 B2); @@ -1146,31 +1146,31 @@ Proof. apply In_1 with y; auto. Qed. -Lemma inter_in : forall s1 s2 y, bst s1 -> bst s2 -> +Lemma inter_in : forall s1 s2 y, bst s1 -> bst s2 -> (In y (inter s1 s2) <-> In y s1 /\ In y s2). -Proof. +Proof. intros s1 s2 y B1 B2; destruct (inter_bst_in B1 B2); auto. Qed. Lemma inter_bst : forall s1 s2, bst s1 -> bst s2 -> bst (inter s1 s2). -Proof. +Proof. intros s1 s2 B1 B2; destruct (inter_bst_in B1 B2); auto. Qed. (** * Difference *) -Lemma diff_bst_in : forall s1 s2, bst s1 -> bst s2 -> +Lemma diff_bst_in : forall s1 s2, bst s1 -> bst s2 -> bst (diff s1 s2) /\ (forall y, In y (diff s1 s2) <-> In y s1 /\ ~In y s2). Proof. - intros s1 s2; functional induction diff s1 s2; intros B1 B2; - [intuition_in|intuition_in | | ]; - factornode _x0 _x1 _x2 _x3 as s2; - generalize (split_bst x1 B2); - rewrite e1; simpl; destruct 1; - inv avl; inv bst; - destruct IHt as (IHb1,IHi1); auto; - destruct IHt0 as (IHb2,IHi2); auto; + intros s1 s2; functional induction diff s1 s2; intros B1 B2; + [intuition_in|intuition_in | | ]; + factornode _x0 _x1 _x2 _x3 as s2; + generalize (split_bst x1 B2); + rewrite e1; simpl; destruct 1; + inv avl; inv bst; + destruct IHt as (IHb1,IHi1); auto; + destruct IHt0 as (IHb2,IHi2); auto; generalize (@split_in_1 s2 x1)(@split_in_2 s2 x1) (split_in_3 x1 B2)(split_bst x1 B2); rewrite e1; simpl; split; intros. @@ -1189,21 +1189,21 @@ Proof. apply In_1 with y; auto. Qed. -Lemma diff_in : forall s1 s2 y, bst s1 -> bst s2 -> +Lemma diff_in : forall s1 s2 y, bst s1 -> bst s2 -> (In y (diff s1 s2) <-> In y s1 /\ ~In y s2). -Proof. +Proof. intros s1 s2 y B1 B2; destruct (diff_bst_in B1 B2); auto. Qed. -Lemma diff_bst : forall s1 s2, bst s1 -> bst s2 -> bst (diff s1 s2). -Proof. +Lemma diff_bst : forall s1 s2, bst s1 -> bst s2 -> bst (diff s1 s2). +Proof. intros s1 s2 B1 B2; destruct (diff_bst_in B1 B2); auto. Qed. (** * Union *) -Lemma union_in : forall s1 s2 y, bst s1 -> bst s2 -> +Lemma union_in : forall s1 s2 y, bst s1 -> bst s2 -> (In y (union s1 s2) <-> In y s1 \/ In y s2). Proof. intros s1 s2; functional induction union s1 s2; intros y B1 B2. @@ -1217,7 +1217,7 @@ Proof. case (X.compare y x1); intuition_in. Qed. -Lemma union_bst : forall s1 s2, bst s1 -> bst s2 -> +Lemma union_bst : forall s1 s2, bst s1 -> bst s2 -> bst (union s1 s2). Proof. intros s1 s2; functional induction union s1 s2; intros B1 B2; auto. @@ -1233,7 +1233,7 @@ Qed. (** * Elements *) -Lemma elements_aux_in : forall s acc x, +Lemma elements_aux_in : forall s acc x, InA X.eq x (elements_aux acc s) <-> In x s \/ InA X.eq x acc. Proof. induction s as [ | l Hl x r Hr h ]; simpl; auto. @@ -1245,8 +1245,8 @@ Proof. intuition; inversion_clear H3; intuition. Qed. -Lemma elements_in : forall s x, InA X.eq x (elements s) <-> In x s. -Proof. +Lemma elements_in : forall s x, InA X.eq x (elements s) <-> In x s. +Proof. intros; generalize (elements_aux_in s nil x); intuition. inversion_clear H0. Qed. @@ -1258,7 +1258,7 @@ Proof. induction s as [ | l Hl y r Hr h]; simpl; intuition. inv bst. apply Hl; auto. - constructor. + constructor. apply Hr; auto. apply MX.In_Inf; intros. destruct (elements_aux_in r acc y0); intuition. @@ -1318,10 +1318,10 @@ Qed. Section F. Variable f : elt -> bool. -Lemma filter_acc_in : forall s acc, - compat_bool X.eq f -> forall x : elt, +Lemma filter_acc_in : forall s acc, + compat_bool X.eq f -> forall x : elt, In x (filter_acc f acc s) <-> In x acc \/ In x s /\ f x = true. -Proof. +Proof. induction s; simpl; intros. intuition_in. rewrite IHs2, IHs1 by (destruct (f t); auto). @@ -1335,7 +1335,7 @@ Proof. rewrite H0 in H3; discriminate. Qed. -Lemma filter_acc_bst : forall s acc, bst s -> bst acc -> +Lemma filter_acc_bst : forall s acc, bst s -> bst acc -> bst (filter_acc f acc s). Proof. induction s; simpl; auto. @@ -1345,13 +1345,13 @@ Proof. Qed. Lemma filter_in : forall s, - compat_bool X.eq f -> forall x : elt, + compat_bool X.eq f -> forall x : elt, In x (filter f s) <-> In x s /\ f x = true. Proof. unfold filter; intros; rewrite filter_acc_in; intuition_in. Qed. -Lemma filter_bst : forall s, bst s -> bst (filter f s). +Lemma filter_bst : forall s, bst s -> bst (filter f s). Proof. unfold filter; intros; apply filter_acc_bst; auto. Qed. @@ -1360,15 +1360,15 @@ Qed. (** * Partition *) -Lemma partition_acc_in_1 : forall s acc, - compat_bool X.eq f -> forall x : elt, - In x (partition_acc f acc s)#1 <-> +Lemma partition_acc_in_1 : forall s acc, + compat_bool X.eq f -> forall x : elt, + In x (partition_acc f acc s)#1 <-> In x acc#1 \/ In x s /\ f x = true. -Proof. +Proof. induction s; simpl; intros. intuition_in. destruct acc as [acct accf]; simpl in *. - rewrite IHs2 by + rewrite IHs2 by (destruct (f t); auto; apply partition_acc_avl_1; simpl; auto). rewrite IHs1 by (destruct (f t); simpl; auto). case_eq (f t); simpl; intros. @@ -1381,15 +1381,15 @@ Proof. rewrite H0 in H3; discriminate. Qed. -Lemma partition_acc_in_2 : forall s acc, - compat_bool X.eq f -> forall x : elt, - In x (partition_acc f acc s)#2 <-> +Lemma partition_acc_in_2 : forall s acc, + compat_bool X.eq f -> forall x : elt, + In x (partition_acc f acc s)#2 <-> In x acc#2 \/ In x s /\ f x = false. -Proof. +Proof. induction s; simpl; intros. intuition_in. destruct acc as [acct accf]; simpl in *. - rewrite IHs2 by + rewrite IHs2 by (destruct (f t); auto; apply partition_acc_avl_2; simpl; auto). rewrite IHs1 by (destruct (f t); simpl; auto). case_eq (f t); simpl; intros. @@ -1403,23 +1403,23 @@ Proof. intuition. Qed. -Lemma partition_in_1 : forall s, - compat_bool X.eq f -> forall x : elt, +Lemma partition_in_1 : forall s, + compat_bool X.eq f -> forall x : elt, In x (partition f s)#1 <-> In x s /\ f x = true. Proof. - unfold partition; intros; rewrite partition_acc_in_1; + unfold partition; intros; rewrite partition_acc_in_1; simpl in *; intuition_in. -Qed. +Qed. Lemma partition_in_2 : forall s, - compat_bool X.eq f -> forall x : elt, + compat_bool X.eq f -> forall x : elt, In x (partition f s)#2 <-> In x s /\ f x = false. Proof. - unfold partition; intros; rewrite partition_acc_in_2; + unfold partition; intros; rewrite partition_acc_in_2; simpl in *; intuition_in. -Qed. +Qed. -Lemma partition_acc_bst_1 : forall s acc, bst s -> bst acc#1 -> +Lemma partition_acc_bst_1 : forall s acc, bst s -> bst acc#1 -> bst (partition_acc f acc s)#1. Proof. induction s; simpl; auto. @@ -1431,7 +1431,7 @@ Proof. apply IHs1; simpl; auto. Qed. -Lemma partition_acc_bst_2 : forall s acc, bst s -> bst acc#2 -> +Lemma partition_acc_bst_2 : forall s acc, bst s -> bst acc#2 -> bst (partition_acc f acc s)#2. Proof. induction s; simpl; auto. @@ -1443,12 +1443,12 @@ Proof. apply IHs1; simpl; auto. Qed. -Lemma partition_bst_1 : forall s, bst s -> bst (partition f s)#1. +Lemma partition_bst_1 : forall s, bst s -> bst (partition f s)#1. Proof. unfold partition; intros; apply partition_acc_bst_1; auto. Qed. -Lemma partition_bst_2 : forall s, bst s -> bst (partition f s)#2. +Lemma partition_bst_2 : forall s, bst s -> bst (partition f s)#2. Proof. unfold partition; intros; apply partition_acc_bst_2; auto. Qed. @@ -1493,10 +1493,10 @@ Qed. Lemma exists_2 : forall s, compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. -Proof. +Proof. induction s; simpl; intros; rewrite <- ?orb_lazy_alt in *. discriminate. - destruct (orb_true_elim _ _ H0) as [H1|H1]. + destruct (orb_true_elim _ _ H0) as [H1|H1]. destruct (orb_true_elim _ _ H1) as [H2|H2]. exists t; auto. destruct (IHs1 H H2); auto; exists x; intuition. @@ -1509,7 +1509,7 @@ End F. (** * Fold *) -Definition fold' (A : Type) (f : elt -> A -> A)(s : tree) := +Definition fold' (A : Type) (f : elt -> A -> A)(s : tree) := L.fold f (elements s). Implicit Arguments fold' [A]. @@ -1529,14 +1529,14 @@ Lemma fold_equiv : forall (A : Type) (s : tree) (f : elt -> A -> A) (a : A), fold f s a = fold' f s a. Proof. - unfold fold', elements in |- *. + unfold fold', elements in |- *. simple induction s; simpl in |- *; auto; intros. rewrite fold_equiv_aux. rewrite H0. simpl in |- *; auto. Qed. -Lemma fold_1 : +Lemma fold_1 : forall (s:t)(Hs:bst s)(A : Type)(f : elt -> A -> A)(i : A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. @@ -1552,7 +1552,7 @@ Qed. Lemma subsetl_12 : forall subset_l1 l1 x1 h1 s2, bst (Node l1 x1 Leaf h1) -> bst s2 -> - (forall s, bst s -> (subset_l1 s = true <-> Subset l1 s)) -> + (forall s, bst s -> (subset_l1 s = true <-> Subset l1 s)) -> (subsetl subset_l1 x1 s2 = true <-> Subset (Node l1 x1 Leaf h1) s2 ). Proof. induction s2 as [|l2 IHl2 x2 r2 IHr2 h2]; simpl; intros. @@ -1563,7 +1563,7 @@ Proof. specialize (IHr2 H H3 H1). inv bst. clear H8. destruct X.compare. - + rewrite IHl2; clear H1 IHl2 IHr2. unfold Subset. intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. @@ -1584,7 +1584,7 @@ Qed. Lemma subsetr_12 : forall subset_r1 r1 x1 h1 s2, bst (Node Leaf x1 r1 h1) -> bst s2 -> - (forall s, bst s -> (subset_r1 s = true <-> Subset r1 s)) -> + (forall s, bst s -> (subset_r1 s = true <-> Subset r1 s)) -> (subsetr subset_r1 x1 s2 = true <-> Subset (Node Leaf x1 r1 h1) s2). Proof. induction s2 as [|l2 IHl2 x2 r2 IHr2 h2]; simpl; intros. @@ -1606,7 +1606,7 @@ Proof. unfold Subset. intuition_in. assert (X.eq a x2) by order; intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. - + rewrite IHr2; clear H1 IHl2 IHr2. unfold Subset. intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. @@ -1614,7 +1614,7 @@ Proof. Qed. -Lemma subset_12 : forall s1 s2, bst s1 -> bst s2 -> +Lemma subset_12 : forall s1 s2, bst s1 -> bst s2 -> (subset s1 s2 = true <-> Subset s1 s2). Proof. induction s1 as [|l1 IHl1 x1 r1 IHr1 h1]; simpl; intros. @@ -1638,7 +1638,7 @@ Proof. assert (X.eq a x2) by order; intuition_in. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. - + rewrite <-andb_lazy_alt, andb_true_iff, IHl1 by auto. rewrite (@subsetr_12 (subset r1) r1 x1 h1) by auto. clear IHl1 IHr1. @@ -1656,7 +1656,7 @@ Qed. Definition eq := Equal. Definition lt (s1 s2 : t) : Prop := L.lt (elements s1) (elements s2). -Lemma eq_refl : forall s : t, Equal s s. +Lemma eq_refl : forall s : t, Equal s s. Proof. unfold Equal; intuition. Qed. @@ -1666,10 +1666,10 @@ Proof. unfold Equal; intros s s' H x; destruct (H x); split; auto. Qed. -Lemma eq_trans : forall s s' s'' : t, +Lemma eq_trans : forall s s' s'' : t, Equal s s' -> Equal s' s'' -> Equal s s''. Proof. - unfold Equal; intros s s' s'' H1 H2 x; + unfold Equal; intros s s' s'' H1 H2 x; destruct (H1 x); destruct (H2 x); split; auto. Qed. @@ -1686,10 +1686,10 @@ Proof. Qed. Hint Resolve eq_L_eq L_eq_eq. -Definition lt_trans (s s' s'' : t) (h : lt s s') +Definition lt_trans (s s' s'' : t) (h : lt s s') (h' : lt s' s'') : lt s s'' := L.lt_trans h h'. -Lemma lt_not_eq : forall s s' : t, +Lemma lt_not_eq : forall s s' : t, bst s -> bst s' -> lt s s' -> ~ Equal s s'. Proof. unfold lt in |- *; intros; intro. @@ -1713,7 +1713,7 @@ Hint Resolve L_eq_cons. (** [flatten_e e] returns the list of elements of [e] i.e. the list of elements actually compared *) - + Fixpoint flatten_e (e : enumeration) : list elt := match e with | End => nil | More x t r => x :: elements t ++ flatten_e r @@ -1726,7 +1726,7 @@ Proof. intros; simpl; apply elements_node. Qed. -Lemma cons_1 : forall s e, +Lemma cons_1 : forall s e, flatten_e (cons s e) = elements s ++ flatten_e e. Proof. induction s; simpl; auto; intros. @@ -1735,37 +1735,37 @@ Qed. (** Correctness of this comparison *) -Definition Cmp c := - match c with +Definition Cmp c := + match c with | Eq => L.eq | Lt => L.lt | Gt => (fun l1 l2 => L.lt l2 l1) end. Lemma cons_Cmp : forall c x1 x2 l1 l2, X.eq x1 x2 -> - Cmp c l1 l2 -> Cmp c (x1::l1) (x2::l2). + Cmp c l1 l2 -> Cmp c (x1::l1) (x2::l2). Proof. destruct c; simpl; auto. Qed. Hint Resolve cons_Cmp. -Lemma compare_end_Cmp : +Lemma compare_end_Cmp : forall e2, Cmp (compare_end e2) nil (flatten_e e2). Proof. destruct e2; simpl; auto. apply L.eq_refl. Qed. -Lemma compare_more_Cmp : forall x1 cont x2 r2 e2 l, - Cmp (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> - Cmp (compare_more x1 cont (More x2 r2 e2)) (x1::l) +Lemma compare_more_Cmp : forall x1 cont x2 r2 e2 l, + Cmp (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> + Cmp (compare_more x1 cont (More x2 r2 e2)) (x1::l) (flatten_e (More x2 r2 e2)). Proof. simpl; intros; destruct X.compare; simpl; auto. Qed. Lemma compare_cont_Cmp : forall s1 cont e2 l, - (forall e, Cmp (cont e) l (flatten_e e)) -> + (forall e, Cmp (cont e) l (flatten_e e)) -> Cmp (compare_cont s1 cont e2) (elements s1 ++ l) (flatten_e e2). Proof. induction s1 as [|l1 Hl1 x1 r1 Hr1 h1]; simpl; intros; auto. @@ -1781,7 +1781,7 @@ Lemma compare_Cmp : forall s1 s2, Proof. intros; unfold compare. rewrite (app_nil_end (elements s1)). - replace (elements s2) with (flatten_e (cons s2 End)) by + replace (elements s2) with (flatten_e (cons s2 End)) by (rewrite cons_1; simpl; rewrite <- app_nil_end; auto). apply compare_cont_Cmp; auto. intros. @@ -1790,21 +1790,21 @@ Qed. (** * Equality test *) -Lemma equal_1 : forall s1 s2, bst s1 -> bst s2 -> +Lemma equal_1 : forall s1 s2, bst s1 -> bst s2 -> Equal s1 s2 -> equal s1 s2 = true. Proof. unfold equal; intros s1 s2 B1 B2 E. -generalize (compare_Cmp s1 s2). +generalize (compare_Cmp s1 s2). destruct (compare s1 s2); simpl in *; auto; intros. elim (lt_not_eq B1 B2 H E); auto. elim (lt_not_eq B2 B1 H (eq_sym E)); auto. Qed. -Lemma equal_2 : forall s1 s2, +Lemma equal_2 : forall s1 s2, equal s1 s2 = true -> Equal s1 s2. Proof. unfold equal; intros s1 s2 E. -generalize (compare_Cmp s1 s2); +generalize (compare_Cmp s1 s2); destruct compare; auto; discriminate. Qed. @@ -1816,10 +1816,10 @@ End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we - need to encapsulate everything into a type of binary search trees. - They also happen to be well-balanced, but this has no influence - on the correctness of operations, so we won't state this here, + Now, in order to really provide a functor implementing [S], we + need to encapsulate everything into a type of binary search trees. + They also happen to be well-balanced, but this has no influence + on the correctness of operations, so we won't state this here, see [FSetFullAVL] if you need more than just the FSet interface. *) @@ -1832,7 +1832,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Record bst := Bst {this :> Raw.t; is_bst : Raw.bst this}. Definition t := bst. Definition elt := E.t. - + Definition In (x : elt) (s : t) := Raw.In x s. Definition Equal (s s':t) := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) := forall a : elt, In a s -> In a s'. @@ -1840,15 +1840,15 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Definition For_all (P : elt -> Prop) (s:t) := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) (s:t) := exists x, In x s /\ P x. - Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. + Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. Proof. intro s; exact (@In_1 s). Qed. - + Definition mem (x:elt)(s:t) : bool := Raw.mem x s. Definition empty : t := Bst empty_bst. Definition is_empty (s:t) : bool := Raw.is_empty s. Definition singleton (x:elt) : t := Bst (singleton_bst x). - Definition add (x:elt)(s:t) : t := Bst (add_bst x (is_bst s)). + Definition add (x:elt)(s:t) : t := Bst (add_bst x (is_bst s)). Definition remove (x:elt)(s:t) : t := Bst (remove_bst x (is_bst s)). Definition inter (s s':t) : t := Bst (inter_bst (is_bst s) (is_bst s')). Definition union (s s':t) : t := Bst (union_bst (is_bst s) (is_bst s')). @@ -1859,13 +1859,13 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Definition choose (s:t) : option elt := Raw.choose s. Definition fold (B : Type) (f : elt -> B -> B) (s:t) : B -> B := Raw.fold f s. Definition cardinal (s:t) : nat := Raw.cardinal s. - Definition filter (f : elt -> bool) (s:t) : t := + Definition filter (f : elt -> bool) (s:t) : t := Bst (filter_bst f (is_bst s)). Definition for_all (f : elt -> bool) (s:t) : bool := Raw.for_all f s. Definition exists_ (f : elt -> bool) (s:t) : bool := Raw.exists_ f s. Definition partition (f : elt -> bool) (s:t) : t * t := let p := Raw.partition f s in - (@Bst (fst p) (partition_bst_1 f (is_bst s)), + (@Bst (fst p) (partition_bst_1 f (is_bst s)), @Bst (snd p) (partition_bst_2 f (is_bst s))). Definition equal (s s':t) : bool := Raw.equal s s'. @@ -1890,13 +1890,13 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Defined. (* specs *) - Section Specs. - Variable s s' s'': t. + Section Specs. + Variable s s' s'': t. Variable x y : elt. Hint Resolve is_bst. - - Lemma mem_1 : In x s -> mem x s = true. + + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (mem_1 (is_bst s)). Qed. Lemma mem_2 : mem x s = true -> In x s. Proof. exact (@mem_2 s x). Qed. @@ -1918,14 +1918,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (@is_empty_1 s). Qed. - Lemma is_empty_2 : is_empty s = true -> Empty s. + Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (@is_empty_2 s). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. wrap add add_in. Qed. Lemma add_2 : In y s -> In y (add x s). Proof. wrap add add_in. Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. wrap add add_in. elim H; auto. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -1935,14 +1935,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. wrap remove remove_in. Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (@singleton_1 x y). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (@singleton_2 x y). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. wrap union union_in. Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. wrap union union_in. Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. wrap union union_in. Qed. @@ -1953,30 +1953,30 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. wrap inter inter_in. Qed. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. wrap inter inter_in. Qed. - - Lemma diff_1 : In x (diff s s') -> In x s. + + Lemma diff_1 : In x (diff s s') -> In x s. Proof. wrap diff diff_in. Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. wrap diff diff_in. Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. wrap diff diff_in. Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. unfold fold, elements; intros; apply fold_1; auto. Qed. Lemma cardinal_1 : cardinal s = length (elements s). - Proof. + Proof. unfold cardinal, elements; intros; apply elements_cardinal; auto. Qed. Section Filter. Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Proof. intro. wrap filter filter_in. Qed. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. intro. wrap filter filter_in. Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. - Proof. intro. wrap filter filter_in. Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. intro. wrap filter filter_in. Qed. @@ -1990,14 +1990,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma exists_2 : compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. exact (@exists_2 f s). Qed. - Lemma partition_1 : compat_bool E.eq f -> + Lemma partition_1 : compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. rewrite partition_in_1, filter_in; intuition. Qed. - Lemma partition_2 : compat_bool E.eq f -> + Lemma partition_2 : compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. @@ -2019,14 +2019,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma elements_3w : NoDupA E.eq (elements s). Proof. exact (elements_nodup (is_bst s)). Qed. - Lemma min_elt_1 : min_elt s = Some x -> In x s. + Lemma min_elt_1 : min_elt s = Some x -> In x s. Proof. exact (@min_elt_1 s x). Qed. Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. exact (@min_elt_2 s x y (is_bst s)). Qed. Lemma min_elt_3 : min_elt s = None -> Empty s. Proof. exact (@min_elt_3 s). Qed. - Lemma max_elt_1 : max_elt s = Some x -> In x s. + Lemma max_elt_1 : max_elt s = Some x -> In x s. Proof. exact (@max_elt_1 s x). Qed. Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. exact (@max_elt_2 s x y (is_bst s)). Qed. @@ -2037,17 +2037,17 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. exact (@choose_1 s x). Qed. Lemma choose_2 : choose s = None -> Empty s. Proof. exact (@choose_2 s). Qed. - Lemma choose_3 : choose s = Some x -> choose s' = Some y -> + Lemma choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. exact (@choose_3 _ _ (is_bst s) (is_bst s') x y). Qed. - Lemma eq_refl : eq s s. + Lemma eq_refl : eq s s. Proof. exact (eq_refl s). Qed. Lemma eq_sym : eq s s' -> eq s' s. Proof. exact (@eq_sym s s'). Qed. Lemma eq_trans : eq s s' -> eq s' s'' -> eq s s''. Proof. exact (@eq_trans s s' s''). Qed. - + Lemma lt_trans : lt s s' -> lt s' s'' -> lt s s''. Proof. exact (@lt_trans s s' s''). Qed. Lemma lt_not_eq : lt s s' -> ~eq s s'. diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v index e0e858211..796db9f8f 100644 --- a/theories/FSets/FSetBridge.v +++ b/theories/FSets/FSetBridge.v @@ -23,51 +23,51 @@ Set Firstorder Depth 2. Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition empty : {s : t | Empty s}. - Proof. + Proof. exists empty; auto with set. Qed. Definition is_empty : forall s : t, {Empty s} + {~ Empty s}. - Proof. + Proof. intros; generalize (is_empty_1 (s:=s)) (is_empty_2 (s:=s)). case (is_empty s); intuition. Qed. Definition mem : forall (x : elt) (s : t), {In x s} + {~ In x s}. - Proof. + Proof. intros; generalize (mem_1 (s:=s) (x:=x)) (mem_2 (s:=s) (x:=x)). case (mem x s); intuition. Qed. - + Definition Add (x : elt) (s s' : t) := forall y : elt, In y s' <-> E.eq x y \/ In y s. - + Definition add : forall (x : elt) (s : t), {s' : t | Add x s s'}. Proof. intros; exists (add x s); auto. unfold Add in |- *; intuition. elim (E.eq_dec x y); auto. - intros; right. + intros; right. eapply add_3; eauto. - Qed. - + Qed. + Definition singleton : forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}. - Proof. + Proof. intros; exists (singleton x); intuition. Qed. - + Definition remove : forall (x : elt) (s : t), {s' : t | forall y : elt, In y s' <-> ~ E.eq x y /\ In y s}. Proof. intros; exists (remove x s); intuition. absurd (In x (remove x s)); auto with set. - apply In_1 with y; auto. + apply In_1 with y; auto. elim (E.eq_dec x y); intros; auto. absurd (In x (remove x s)); auto with set. - apply In_1 with y; auto. + apply In_1 with y; auto. eauto with set. Qed. @@ -75,47 +75,47 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s \/ In x s'}. Proof. intros; exists (union s s'); intuition. - Qed. + Qed. Definition inter : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ In x s'}. - Proof. + Proof. intros; exists (inter s s'); intuition; eauto with set. Qed. Definition diff : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}. - Proof. - intros; exists (diff s s'); intuition; eauto with set. - absurd (In x s'); eauto with set. - Qed. - + Proof. + intros; exists (diff s s'); intuition; eauto with set. + absurd (In x s'); eauto with set. + Qed. + Definition equal : forall s s' : t, {Equal s s'} + {~ Equal s s'}. - Proof. - intros. + Proof. + intros. generalize (equal_1 (s:=s) (s':=s')) (equal_2 (s:=s) (s':=s')). case (equal s s'); intuition. Qed. Definition subset : forall s s' : t, {Subset s s'} + {~Subset s s'}. - Proof. - intros. + Proof. + intros. generalize (subset_1 (s:=s) (s':=s')) (subset_2 (s:=s) (s':=s')). case (subset s s'); intuition. - Qed. + Qed. Definition elements : forall s : t, {l : list elt | sort E.lt l /\ (forall x : elt, In x s <-> InA E.eq x l)}. Proof. - intros; exists (elements s); intuition. - Defined. + intros; exists (elements s); intuition. + Defined. Definition fold : forall (A : Type) (f : elt -> A -> A) (s : t) (i : A), - {r : A | let (l,_) := elements s in + {r : A | let (l,_) := elements s in r = fold_left (fun a e => f e a) l i}. - Proof. + Proof. intros; exists (fold (A:=A) f s i); exact (fold_1 s i f). Qed. @@ -124,10 +124,10 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. {r : nat | let (l,_) := elements s in r = length l }. Proof. intros; exists (cardinal s); exact (cardinal_1 s). - Qed. + Qed. Definition fdec (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) - (x : elt) := if Pdec x then true else false. + (x : elt) := if Pdec x then true else false. Lemma compat_P_aux : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}), @@ -143,7 +143,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {s' : t | compat_P E.eq P -> forall x : elt, In x s' <-> In x s /\ P x}. Proof. - intros. + intros. exists (filter (fdec Pdec) s). intro H; assert (compat_bool E.eq (fdec Pdec)); auto. intuition. @@ -160,29 +160,29 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition for_all : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}. - Proof. - intros. + Proof. + intros. generalize (for_all_1 (s:=s) (f:=fdec Pdec)) (for_all_2 (s:=s) (f:=fdec Pdec)). case (for_all (fdec Pdec) s); unfold For_all in |- *; [ left | right ]; intros. assert (compat_bool E.eq (fdec Pdec)); auto. generalize (H0 H3 (refl_equal _) _ H2). - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. inversion H4. - intuition. + intuition. absurd (false = true); [ auto with bool | apply H; auto ]. intro. - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. Qed. Definition exists_ : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> Exists P s} + {compat_P E.eq P -> ~ Exists P s}. - Proof. - intros. + Proof. + intros. generalize (exists_1 (s:=s) (f:=fdec Pdec)) (exists_2 (s:=s) (f:=fdec Pdec)). case (exists_ (fdec Pdec) s); unfold Exists in |- *; [ left | right ]; @@ -190,14 +190,14 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. elim H0; auto; intros. exists x; intuition. generalize H4. - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. inversion H2. - intuition. - elim H2; intros. + intuition. + elim H2; intros. absurd (false = true); [ auto with bool | apply H; auto ]. exists x; intuition. - unfold fdec in |- *. + unfold fdec in |- *. case (Pdec x); intuition. Qed. @@ -228,12 +228,12 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. inversion H9. generalize H; unfold For_all, Equal in |- *; intuition. elim (H0 x); intros. - cut ((fun x => negb (fdec Pdec x)) x = true). + cut ((fun x => negb (fdec Pdec x)) x = true). unfold fdec in |- *; case (Pdec x); intuition. change ((fun x => negb (fdec Pdec x)) x = true) in |- *. apply (filter_2 (s:=s) (x:=x)); auto. set (b := fdec Pdec x) in *; generalize (refl_equal b); - pattern b at -1 in |- *; case b; unfold b in |- *; + pattern b at -1 in |- *; case b; unfold b in |- *; [ left | right ]. elim (H4 x); intros _ B; apply B; auto with set. elim (H x); intros _ B; apply B; auto with set. @@ -242,16 +242,16 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. eapply (filter_1 (s:=s) (x:=x) H2); elim (H4 x); intros B _; apply B; auto. eapply (filter_1 (s:=s) (x:=x) H3); elim (H x); intros B _; apply B; auto. - Qed. + Qed. - Definition choose_aux: forall s : t, + Definition choose_aux: forall s : t, { x : elt | M.choose s = Some x } + { M.choose s = None }. Proof. intros. destruct (M.choose s); [left | right]; auto. exists e; auto. Qed. - + Definition choose : forall s : t, {x : elt | In x s} + {Empty s}. Proof. intros; destruct (choose_aux s) as [(x,Hx)|H]. @@ -259,12 +259,12 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. right; apply choose_2; auto. Defined. - Lemma choose_ok1 : - forall s x, M.choose s = Some x <-> exists H:In x s, + Lemma choose_ok1 : + forall s x, M.choose s = Some x <-> exists H:In x s, choose s = inleft _ (exist (fun x => In x s) x H). Proof. intros s x. - unfold choose; split; intros. + unfold choose; split; intros. destruct (choose_aux s) as [(y,Hy)|H']; try congruence. replace x with y in * by congruence. exists (choose_1 Hy); auto. @@ -272,10 +272,10 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. destruct (choose_aux s) as [(y,Hy)|H']; congruence. Qed. - Lemma choose_ok2 : - forall s, M.choose s = None <-> exists H:Empty s, + Lemma choose_ok2 : + forall s, M.choose s = None <-> exists H:Empty s, choose s = inright _ H. - Proof. + Proof. intros s. unfold choose; split; intros. destruct (choose_aux s) as [(y,Hy)|H']; try congruence. @@ -284,8 +284,8 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. destruct (choose_aux s) as [(y,Hy)|H']; congruence. Qed. - Lemma choose_equal : forall s s', Equal s s' -> - match choose s, choose s' with + Lemma choose_equal : forall s s', Equal s s' -> + match choose s, choose s' with | inleft (exist x _), inleft (exist x' _) => E.eq x x' | inright _, inright _ => True | _, _ => False @@ -306,29 +306,29 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition min_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt y x) s} + {Empty s}. - Proof. + Proof. intros; generalize (min_elt_1 (s:=s)) (min_elt_2 (s:=s)) (min_elt_3 (s:=s)). - case (min_elt s); [ left | right ]; auto. + case (min_elt s); [ left | right ]; auto. exists e; unfold For_all in |- *; eauto. - Qed. + Qed. Definition max_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt x y) s} + {Empty s}. - Proof. + Proof. intros; generalize (max_elt_1 (s:=s)) (max_elt_2 (s:=s)) (max_elt_3 (s:=s)). - case (max_elt s); [ left | right ]; auto. + case (max_elt s); [ left | right ]; auto. exists e; unfold For_all in |- *; eauto. - Qed. + Qed. - Module E := E. + Module E := E. Definition elt := elt. Definition t := t. - Definition In := In. + Definition In := In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. @@ -336,7 +336,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. forall x : elt, In x s -> P x. Definition Exists (P : elt -> Prop) (s : t) := exists x : elt, In x s /\ P x. - + Definition eq_In := In_1. Definition eq := Equal. @@ -344,7 +344,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition eq_refl := eq_refl. Definition eq_sym := eq_sym. Definition eq_trans := eq_trans. - Definition lt_trans := lt_trans. + Definition lt_trans := lt_trans. Definition lt_not_eq := lt_not_eq. Definition compare := compare. @@ -386,7 +386,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Proof. intros; unfold mem in |- *; case (M.mem x s); auto. Qed. - + Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s. Proof. intros s x; unfold mem in |- *; case (M.mem x s); auto. @@ -399,26 +399,26 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. if equal s s' then true else false. Lemma equal_1 : forall s s' : t, Equal s s' -> equal s s' = true. - Proof. + Proof. intros; unfold equal in |- *; case M.equal; intuition. - Qed. - + Qed. + Lemma equal_2 : forall s s' : t, equal s s' = true -> Equal s s'. - Proof. + Proof. intros s s'; unfold equal in |- *; case (M.equal s s'); intuition; inversion H. Qed. - + Definition subset (s s' : t) : bool := if subset s s' then true else false. Lemma subset_1 : forall s s' : t, Subset s s' -> subset s s' = true. - Proof. + Proof. intros; unfold subset in |- *; case M.subset; intuition. - Qed. - + Qed. + Lemma subset_2 : forall s s' : t, subset s s' = true -> Subset s s'. - Proof. + Proof. intros s s'; unfold subset in |- *; case (M.subset s s'); intuition; inversion H. Qed. @@ -441,34 +441,34 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. intro s; unfold choose in |- *; case (M.choose s); auto. simple destruct s0; intros; discriminate H. Qed. - - Lemma choose_3 : forall s s' x x', + + Lemma choose_3 : forall s s' x x', choose s = Some x -> choose s' = Some x' -> Equal s s' -> E.eq x x'. Proof. unfold choose; intros. generalize (M.choose_equal H1); clear H1. - destruct (M.choose s) as [(?,?)|?]; destruct (M.choose s') as [(?,?)|?]; + destruct (M.choose s) as [(?,?)|?]; destruct (M.choose s') as [(?,?)|?]; simpl; auto; congruence. Qed. - Definition elements (s : t) : list elt := let (l, _) := elements s in l. - + Definition elements (s : t) : list elt := let (l, _) := elements s in l. + Lemma elements_1 : forall (s : t) (x : elt), In x s -> InA E.eq x (elements s). - Proof. + Proof. intros; unfold elements in |- *; case (M.elements s); firstorder. Qed. Lemma elements_2 : forall (s : t) (x : elt), InA E.eq x (elements s) -> In x s. - Proof. + Proof. intros s x; unfold elements in |- *; case (M.elements s); firstorder. Qed. - Lemma elements_3 : forall s : t, sort E.lt (elements s). - Proof. + Lemma elements_3 : forall s : t, sort E.lt (elements s). + Proof. intros; unfold elements in |- *; case (M.elements s); firstorder. Qed. Hint Resolve elements_3. - + Lemma elements_3w : forall s : t, NoDupA E.eq (elements s). Proof. auto. Qed. @@ -478,27 +478,27 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. | inright _ => None end. - Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. + Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. Proof. intros s x; unfold min_elt in |- *; case (M.min_elt s). simple destruct s0; intros; injection H; intros; subst; intuition. intros; discriminate H. - Qed. + Qed. Lemma min_elt_2 : - forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x. + forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. intros s x y; unfold min_elt in |- *; case (M.min_elt s). unfold For_all in |- *; simple destruct s0; intros; injection H; intros; subst; firstorder. intros; discriminate H. - Qed. + Qed. Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s. Proof. intros s; unfold min_elt in |- *; case (M.min_elt s); auto. simple destruct s0; intros; discriminate H. - Qed. + Qed. Definition max_elt (s : t) : option elt := match max_elt s with @@ -506,27 +506,27 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. | inright _ => None end. - Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. + Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. Proof. intros s x; unfold max_elt in |- *; case (M.max_elt s). simple destruct s0; intros; injection H; intros; subst; intuition. intros; discriminate H. - Qed. + Qed. Lemma max_elt_2 : - forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y. + forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. intros s x y; unfold max_elt in |- *; case (M.max_elt s). unfold For_all in |- *; simple destruct s0; intros; injection H; intros; subst; firstorder. intros; discriminate H. - Qed. + Qed. Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s. Proof. intros s; unfold max_elt in |- *; case (M.max_elt s); auto. simple destruct s0; intros; discriminate H. - Qed. + Qed. Definition add (x : elt) (s : t) : t := let (s', _) := add x s in s'. @@ -566,70 +566,70 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Proof. intros s x y; unfold remove in |- *; case (M.remove x s); firstorder. Qed. - - Definition singleton (x : elt) : t := let (s, _) := singleton x in s. - - Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y. + + Definition singleton (x : elt) : t := let (s, _) := singleton x in s. + + Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y. Proof. intros x y; unfold singleton in |- *; case (M.singleton x); firstorder. Qed. - Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x). + Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x). Proof. intros x y; unfold singleton in |- *; case (M.singleton x); firstorder. Qed. - + Definition union (s s' : t) : t := let (s'', _) := union s s' in s''. - + Lemma union_1 : forall (s s' : t) (x : elt), In x (union s s') -> In x s \/ In x s'. - Proof. + Proof. intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. Qed. - Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s'). - Proof. + Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s'). + Proof. intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. Qed. Lemma union_3 : forall (s s' : t) (x : elt), In x s' -> In x (union s s'). - Proof. + Proof. intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. Qed. Definition inter (s s' : t) : t := let (s'', _) := inter s s' in s''. - + Lemma inter_1 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s. - Proof. + Proof. intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. Qed. Lemma inter_2 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s'. - Proof. + Proof. intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. Qed. Lemma inter_3 : forall (s s' : t) (x : elt), In x s -> In x s' -> In x (inter s s'). - Proof. + Proof. intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. Qed. Definition diff (s s' : t) : t := let (s'', _) := diff s s' in s''. - + Lemma diff_1 : forall (s s' : t) (x : elt), In x (diff s s') -> In x s. - Proof. + Proof. intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. Qed. Lemma diff_2 : forall (s s' : t) (x : elt), In x (diff s s') -> ~ In x s'. - Proof. + Proof. intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. Qed. Lemma diff_3 : forall (s s' : t) (x : elt), In x s -> ~ In x s' -> In x (diff s s'). - Proof. + Proof. intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. Qed. @@ -637,26 +637,26 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma cardinal_1 : forall s, cardinal s = length (elements s). Proof. - intros; unfold cardinal in |- *; case (M.cardinal s); unfold elements in *; + intros; unfold cardinal in |- *; case (M.cardinal s); unfold elements in *; destruct (M.elements s); auto. Qed. - Definition fold (B : Type) (f : elt -> B -> B) (i : t) + Definition fold (B : Type) (f : elt -> B -> B) (i : t) (s : B) : B := let (fold, _) := fold f i s in fold. Lemma fold_1 : forall (s : t) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. - intros; unfold fold in |- *; case (M.fold f s i); unfold elements in *; + intros; unfold fold in |- *; case (M.fold f s i); unfold elements in *; destruct (M.elements s); auto. - Qed. + Qed. Definition f_dec : forall (f : elt -> bool) (x : elt), {f x = true} + {f x <> true}. Proof. intros; case (f x); auto with bool. - Defined. + Defined. Lemma compat_P_aux : forall f : elt -> bool, @@ -666,7 +666,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Qed. Hint Resolve compat_P_aux. - + Definition filter (f : elt -> bool) (s : t) : t := let (s', _) := filter (P:=fun x => f x = true) (f_dec f) s in s'. @@ -680,7 +680,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma filter_2 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool E.eq f -> In x (filter f s) -> f x = true. + compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. intros s x f; unfold filter in |- *; case M.filter; intuition. generalize (i (compat_P_aux H)); firstorder. @@ -688,7 +688,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma filter_3 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). + compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. intros s x f; unfold filter in |- *; case M.filter; intuition. generalize (i (compat_P_aux H)); firstorder. @@ -697,98 +697,98 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Definition for_all (f : elt -> bool) (s : t) : bool := if for_all (P:=fun x => f x = true) (f_dec f) s then true - else false. + else false. Lemma for_all_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. - Proof. + Proof. intros s f; unfold for_all in |- *; case M.for_all; intuition; elim n; auto. Qed. - + Lemma for_all_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. - Proof. + Proof. intros s f; unfold for_all in |- *; case M.for_all; intuition; inversion H0. Qed. - + Definition exists_ (f : elt -> bool) (s : t) : bool := if exists_ (P:=fun x => f x = true) (f_dec f) s then true - else false. + else false. Lemma exists_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true. - Proof. + Proof. intros s f; unfold exists_ in |- *; case M.exists_; intuition; elim n; auto. Qed. - + Lemma exists_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. - Proof. + Proof. intros s f; unfold exists_ in |- *; case M.exists_; intuition; inversion H0. Qed. - - Definition partition (f : elt -> bool) (s : t) : + + Definition partition (f : elt -> bool) (s : t) : t * t := let (p, _) := partition (P:=fun x => f x = true) (f_dec f) s in p. - + Lemma partition_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. - intros s f; unfold partition in |- *; case M.partition. - intro p; case p; clear p; intros s1 s2 H C. + intros s f; unfold partition in |- *; case M.partition. + intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. simpl in |- *; unfold Equal in |- *; intuition. - apply filter_3; firstorder. - elim (H2 a); intros. - assert (In a s). + apply filter_3; firstorder. + elim (H2 a); intros. + assert (In a s). eapply filter_1; eauto. elim H3; intros; auto. absurd (f a = true). exact (H a H6). - eapply filter_2; eauto. - Qed. - + eapply filter_2; eauto. + Qed. + Lemma partition_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. - intros s f; unfold partition in |- *; case M.partition. - intro p; case p; clear p; intros s1 s2 H C. + intros s f; unfold partition in |- *; case M.partition. + intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. assert (D : compat_bool E.eq (fun x => negb (f x))). generalize C; unfold compat_bool in |- *; intros; apply (f_equal negb); auto. simpl in |- *; unfold Equal in |- *; intuition. apply filter_3; firstorder. - elim (H2 a); intros. - assert (In a s). + elim (H2 a); intros. + assert (In a s). eapply filter_1; eauto. elim H3; intros; auto. absurd (f a = true). intro. - generalize (filter_2 D H1). + generalize (filter_2 D H1). rewrite H7; intros H8; inversion H8. exact (H0 a H6). - Qed. + Qed. - Module E := E. + Module E := E. Definition elt := elt. Definition t := t. - Definition In := In. + Definition In := In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Add (x : elt) (s s' : t) := @@ -806,7 +806,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Definition eq_refl := eq_refl. Definition eq_sym := eq_sym. Definition eq_trans := eq_trans. - Definition lt_trans := lt_trans. + Definition lt_trans := lt_trans. Definition lt_not_eq := lt_not_eq. Definition compare := compare. diff --git a/theories/FSets/FSetDecide.v b/theories/FSets/FSetDecide.v index b7a1deb77..89cdc932f 100644 --- a/theories/FSets/FSetDecide.v +++ b/theories/FSets/FSetDecide.v @@ -148,35 +148,35 @@ the above form: XXX: This tactic and the similar subsequent ones should have been defined using [autorewrite]. However, dealing - with multiples rewrite sites and side-conditions is - done more cleverly with the following explicit + with multiples rewrite sites and side-conditions is + done more cleverly with the following explicit analysis of goals. *) - Ltac or_not_l_iff P Q tac := - (rewrite (or_not_l_iff_1 P Q) by tac) || + Ltac or_not_l_iff P Q tac := + (rewrite (or_not_l_iff_1 P Q) by tac) || (rewrite (or_not_l_iff_2 P Q) by tac). - Ltac or_not_r_iff P Q tac := - (rewrite (or_not_r_iff_1 P Q) by tac) || + Ltac or_not_r_iff P Q tac := + (rewrite (or_not_r_iff_1 P Q) by tac) || (rewrite (or_not_r_iff_2 P Q) by tac). - Ltac or_not_l_iff_in P Q H tac := - (rewrite (or_not_l_iff_1 P Q) in H by tac) || + Ltac or_not_l_iff_in P Q H tac := + (rewrite (or_not_l_iff_1 P Q) in H by tac) || (rewrite (or_not_l_iff_2 P Q) in H by tac). - Ltac or_not_r_iff_in P Q H tac := - (rewrite (or_not_r_iff_1 P Q) in H by tac) || + Ltac or_not_r_iff_in P Q H tac := + (rewrite (or_not_r_iff_1 P Q) in H by tac) || (rewrite (or_not_r_iff_2 P Q) in H by tac). Tactic Notation "push" "not" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with | |- context [True -> False] => rewrite not_true_iff | |- context [False -> False] => rewrite not_false_iff | |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec - | |- context [(?P -> False) -> (?Q -> False)] => + | |- context [(?P -> False) -> (?Q -> False)] => rewrite (contrapositive P Q) by dec | |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec | |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec @@ -192,23 +192,23 @@ the above form: Tactic Notation "push" "not" "in" "*" "|-" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with | H: context [True -> False] |- _ => rewrite not_true_iff in H | H: context [False -> False] |- _ => rewrite not_false_iff in H - | H: context [(?P -> False) -> False] |- _ => + | H: context [(?P -> False) -> False] |- _ => rewrite (not_not_iff P) in H by dec | H: context [(?P -> False) -> (?Q -> False)] |- _ => rewrite (contrapositive P Q) in H by dec | H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec | H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec - | H: context [(?P -> False) -> ?Q] |- _ => + | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [?P \/ ?Q -> False] |- _ => rewrite (not_or_iff P Q) in H | H: context [?P /\ ?Q -> False] |- _ => rewrite (not_and_iff P Q) in H - | H: context [(?P -> ?Q) -> False] |- _ => + | H: context [(?P -> ?Q) -> False] |- _ => rewrite (not_imp_iff P Q) in H by dec end); fold any not. @@ -253,7 +253,7 @@ the above form: the hypotheses and goal together. *) Tactic Notation "pull" "not" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with @@ -269,7 +269,7 @@ the above form: rewrite <- (not_or_iff P Q) | |- context [?P -> ?Q -> False] => rewrite <- (not_and_iff P Q) | |- context [?P /\ (?Q -> False)] => rewrite <- (not_imp_iff P Q) by dec - | |- context [(?Q -> False) /\ ?P] => + | |- context [(?Q -> False) /\ ?P] => rewrite <- (not_imp_rev_iff P Q) by dec end); fold any not. @@ -279,7 +279,7 @@ the above form: Tactic Notation "pull" "not" "in" "*" "|-" "using" ident(db) := - let dec := solve_decidable using db in + let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with @@ -294,8 +294,8 @@ the above form: | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [(?P -> False) /\ (?Q -> False)] |- _ => - rewrite <- (not_or_iff P Q) in H - | H: context [?P -> ?Q -> False] |- _ => + rewrite <- (not_or_iff P Q) in H + | H: context [?P -> ?Q -> False] |- _ => rewrite <- (not_and_iff P Q) in H | H: context [?P /\ (?Q -> False)] |- _ => rewrite <- (not_imp_iff P Q) in H by dec diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v index 7ec360a66..d843bbcd6 100644 --- a/theories/FSets/FSetEqProperties.v +++ b/theories/FSets/FSetEqProperties.v @@ -10,11 +10,11 @@ (** * Finite sets library *) -(** This module proves many properties of finite sets that - are consequences of the axiomatization in [FsetInterface] - Contrary to the functor in [FsetProperties] it uses +(** This module proves many properties of finite sets that + are consequences of the axiomatization in [FsetInterface] + Contrary to the functor in [FsetProperties] it uses sets operations instead of predicates over sets, i.e. - [mem x s=true] instead of [In x s], + [mem x s=true] instead of [In x s], [equal s s'=true] instead of [Equal s s'], etc. *) Require Import FSetProperties Zerob Sumbool Omega DecidableTypeEx. @@ -26,59 +26,59 @@ Import M. Definition Add := MP.Add. -Section BasicProperties. +Section BasicProperties. -(** Some old specifications written with boolean equalities. *) +(** Some old specifications written with boolean equalities. *) Variable s s' s'': t. Variable x y z : elt. -Lemma mem_eq: +Lemma mem_eq: E.eq x y -> mem x s=mem y s. -Proof. +Proof. intro H; rewrite H; auto. Qed. -Lemma equal_mem_1: +Lemma equal_mem_1: (forall a, mem a s=mem a s') -> equal s s'=true. -Proof. +Proof. intros; apply equal_1; unfold Equal; intros. do 2 rewrite mem_iff; rewrite H; tauto. Qed. -Lemma equal_mem_2: +Lemma equal_mem_2: equal s s'=true -> forall a, mem a s=mem a s'. -Proof. +Proof. intros; rewrite (equal_2 H); auto. Qed. -Lemma subset_mem_1: +Lemma subset_mem_1: (forall a, mem a s=true->mem a s'=true) -> subset s s'=true. -Proof. +Proof. intros; apply subset_1; unfold Subset; intros a. do 2 rewrite mem_iff; auto. Qed. -Lemma subset_mem_2: +Lemma subset_mem_2: subset s s'=true -> forall a, mem a s=true -> mem a s'=true. -Proof. +Proof. intros H a; do 2 rewrite <- mem_iff; apply subset_2; auto. Qed. - + Lemma empty_mem: mem x empty=false. -Proof. +Proof. rewrite <- not_mem_iff; auto with set. Qed. Lemma is_empty_equal_empty: is_empty s = equal s empty. -Proof. +Proof. apply bool_1; split; intros. auto with set. rewrite <- is_empty_iff; auto with set. Qed. - + Lemma choose_mem_1: choose s=Some x -> mem x s=true. -Proof. +Proof. auto with set. Qed. @@ -90,44 +90,44 @@ Qed. Lemma add_mem_1: mem x (add x s)=true. Proof. auto with set. -Qed. - +Qed. + Lemma add_mem_2: ~E.eq x y -> mem y (add x s)=mem y s. -Proof. +Proof. apply add_neq_b. Qed. Lemma remove_mem_1: mem x (remove x s)=false. -Proof. +Proof. rewrite <- not_mem_iff; auto with set. -Qed. - +Qed. + Lemma remove_mem_2: ~E.eq x y -> mem y (remove x s)=mem y s. -Proof. +Proof. apply remove_neq_b. Qed. -Lemma singleton_equal_add: +Lemma singleton_equal_add: equal (singleton x) (add x empty)=true. Proof. rewrite (singleton_equal_add x); auto with set. -Qed. +Qed. -Lemma union_mem: +Lemma union_mem: mem x (union s s')=mem x s || mem x s'. -Proof. +Proof. apply union_b. Qed. -Lemma inter_mem: +Lemma inter_mem: mem x (inter s s')=mem x s && mem x s'. -Proof. +Proof. apply inter_b. Qed. -Lemma diff_mem: +Lemma diff_mem: mem x (diff s s')=mem x s && negb (mem x s'). -Proof. +Proof. apply diff_b. Qed. @@ -143,7 +143,7 @@ Proof. intros; rewrite not_mem_iff; auto. Qed. -(** Properties of [equal] *) +(** Properties of [equal] *) Lemma equal_refl: equal s s=true. Proof. @@ -155,19 +155,19 @@ Proof. intros; apply bool_1; do 2 rewrite <- equal_iff; intuition. Qed. -Lemma equal_trans: +Lemma equal_trans: equal s s'=true -> equal s' s''=true -> equal s s''=true. Proof. intros; rewrite (equal_2 H); auto. Qed. -Lemma equal_equal: +Lemma equal_equal: equal s s'=true -> equal s s''=equal s' s''. Proof. intros; rewrite (equal_2 H); auto. Qed. -Lemma equal_cardinal: +Lemma equal_cardinal: equal s s'=true -> cardinal s=cardinal s'. Proof. auto with set. @@ -175,25 +175,25 @@ Qed. (* Properties of [subset] *) -Lemma subset_refl: subset s s=true. +Lemma subset_refl: subset s s=true. Proof. auto with set. Qed. -Lemma subset_antisym: +Lemma subset_antisym: subset s s'=true -> subset s' s=true -> equal s s'=true. Proof. auto with set. Qed. -Lemma subset_trans: +Lemma subset_trans: subset s s'=true -> subset s' s''=true -> subset s s''=true. Proof. do 3 rewrite <- subset_iff; intros. apply subset_trans with s'; auto. Qed. -Lemma subset_equal: +Lemma subset_equal: equal s s'=true -> subset s s'=true. Proof. auto with set. @@ -201,7 +201,7 @@ Qed. (** Properties of [choose] *) -Lemma choose_mem_3: +Lemma choose_mem_3: is_empty s=false -> {x:elt|choose s=Some x /\ mem x s=true}. Proof. intros. @@ -221,13 +221,13 @@ Qed. (** Properties of [add] *) -Lemma add_mem_3: +Lemma add_mem_3: mem y s=true -> mem y (add x s)=true. Proof. auto with set. Qed. -Lemma add_equal: +Lemma add_equal: mem x s=true -> equal (add x s) s=true. Proof. auto with set. @@ -235,26 +235,26 @@ Qed. (** Properties of [remove] *) -Lemma remove_mem_3: +Lemma remove_mem_3: mem y (remove x s)=true -> mem y s=true. Proof. rewrite remove_b; intros H;destruct (andb_prop _ _ H); auto. Qed. -Lemma remove_equal: +Lemma remove_equal: mem x s=false -> equal (remove x s) s=true. Proof. intros; apply equal_1; apply remove_equal. rewrite not_mem_iff; auto. Qed. -Lemma add_remove: +Lemma add_remove: mem x s=true -> equal (add x (remove x s)) s=true. Proof. intros; apply equal_1; apply add_remove; auto with set. Qed. -Lemma remove_add: +Lemma remove_add: mem x s=false -> equal (remove x (add x s)) s=true. Proof. intros; apply equal_1; apply remove_add; auto. @@ -297,37 +297,37 @@ Proof. auto with set. Qed. -Lemma union_subset_equal: +Lemma union_subset_equal: subset s s'=true -> equal (union s s') s'=true. Proof. auto with set. Qed. -Lemma union_equal_1: +Lemma union_equal_1: equal s s'=true-> equal (union s s'') (union s' s'')=true. Proof. auto with set. Qed. -Lemma union_equal_2: +Lemma union_equal_2: equal s' s''=true-> equal (union s s') (union s s'')=true. Proof. auto with set. Qed. -Lemma union_assoc: +Lemma union_assoc: equal (union (union s s') s'') (union s (union s' s''))=true. Proof. auto with set. Qed. -Lemma add_union_singleton: +Lemma add_union_singleton: equal (add x s) (union (singleton x) s)=true. Proof. auto with set. Qed. -Lemma union_add: +Lemma union_add: equal (union (add x s) s') (add x (union s s'))=true. Proof. auto with set. @@ -346,62 +346,62 @@ auto with set. Qed. Lemma union_subset_3: - subset s s''=true -> subset s' s''=true -> + subset s s''=true -> subset s' s''=true -> subset (union s s') s''=true. Proof. intros; apply subset_1; apply union_subset_3; auto with set. Qed. -(** Properties of [inter] *) +(** Properties of [inter] *) Lemma inter_sym: equal (inter s s') (inter s' s)=true. Proof. auto with set. Qed. -Lemma inter_subset_equal: +Lemma inter_subset_equal: subset s s'=true -> equal (inter s s') s=true. Proof. auto with set. Qed. -Lemma inter_equal_1: +Lemma inter_equal_1: equal s s'=true -> equal (inter s s'') (inter s' s'')=true. Proof. auto with set. Qed. -Lemma inter_equal_2: +Lemma inter_equal_2: equal s' s''=true -> equal (inter s s') (inter s s'')=true. Proof. auto with set. Qed. -Lemma inter_assoc: +Lemma inter_assoc: equal (inter (inter s s') s'') (inter s (inter s' s''))=true. Proof. auto with set. Qed. -Lemma union_inter_1: +Lemma union_inter_1: equal (inter (union s s') s'') (union (inter s s'') (inter s' s''))=true. Proof. auto with set. Qed. -Lemma union_inter_2: +Lemma union_inter_2: equal (union (inter s s') s'') (inter (union s s'') (union s' s''))=true. Proof. auto with set. Qed. -Lemma inter_add_1: mem x s'=true -> +Lemma inter_add_1: mem x s'=true -> equal (inter (add x s) s') (add x (inter s s'))=true. Proof. auto with set. Qed. -Lemma inter_add_2: mem x s'=false -> +Lemma inter_add_2: mem x s'=false -> equal (inter (add x s) s') (inter s s')=true. Proof. intros; apply equal_1; apply inter_add_2. @@ -421,7 +421,7 @@ auto with set. Qed. Lemma inter_subset_3: - subset s'' s=true -> subset s'' s'=true -> + subset s'' s=true -> subset s'' s'=true -> subset s'' (inter s s')=true. Proof. intros; apply subset_1; apply inter_subset_3; auto with set. @@ -440,19 +440,19 @@ Proof. auto with set. Qed. -Lemma remove_inter_singleton: +Lemma remove_inter_singleton: equal (remove x s) (diff s (singleton x))=true. Proof. auto with set. Qed. Lemma diff_inter_empty: - equal (inter (diff s s') (inter s s')) empty=true. + equal (inter (diff s s') (inter s s')) empty=true. Proof. auto with set. Qed. -Lemma diff_inter_all: +Lemma diff_inter_all: equal (union (diff s s') (inter s s')) s=true. Proof. auto with set. @@ -462,7 +462,7 @@ End BasicProperties. Hint Immediate empty_mem is_empty_equal_empty add_mem_1 remove_mem_1 singleton_equal_add union_mem inter_mem - diff_mem equal_sym add_remove remove_add : set. + diff_mem equal_sym add_remove remove_add : set. Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1 choose_mem_2 add_mem_2 remove_mem_2 equal_refl equal_equal subset_refl subset_equal subset_antisym @@ -472,8 +472,8 @@ Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1 (** General recursion principle *) Lemma set_rec: forall (P:t->Type), - (forall s s', equal s s'=true -> P s -> P s') -> - (forall s x, mem x s=false -> P s -> P (add x s)) -> + (forall s s', equal s s'=true -> P s -> P s') -> + (forall s x, mem x s=false -> P s -> P (add x s)) -> P empty -> forall s, P s. Proof. intros. @@ -493,51 +493,51 @@ intros; do 2 rewrite mem_iff. destruct (mem x s); destruct (mem x s'); intuition. Qed. -Section Fold. +Section Fold. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). Variables (i:A). Variables (s s':t)(x:elt). - + Lemma fold_empty: (fold f empty i) = i. -Proof. +Proof. apply fold_empty; auto. Qed. -Lemma fold_equal: +Lemma fold_equal: equal s s'=true -> eqA (fold f s i) (fold f s' i). -Proof. +Proof. intros; apply fold_equal with (eqA:=eqA); auto with set. Qed. - -Lemma fold_add: + +Lemma fold_add: mem x s=false -> eqA (fold f (add x s) i) (f x (fold f s i)). -Proof. +Proof. intros; apply fold_add with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. -Lemma add_fold: +Lemma add_fold: mem x s=true -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply add_fold with (eqA:=eqA); auto with set. Qed. -Lemma remove_fold_1: +Lemma remove_fold_1: mem x s=true -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros; apply remove_fold_1 with (eqA:=eqA); auto with set. Qed. -Lemma remove_fold_2: +Lemma remove_fold_2: mem x s=false -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros; apply remove_fold_2 with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. -Lemma fold_union: - (forall x, mem x s && mem x s'=false) -> +Lemma fold_union: + (forall x, mem x s && mem x s'=false) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. intros; apply fold_union with (eqA:=eqA); auto. @@ -548,40 +548,40 @@ End Fold. (** Properties of [cardinal] *) -Lemma add_cardinal_1: +Lemma add_cardinal_1: forall s x, mem x s=true -> cardinal (add x s)=cardinal s. Proof. auto with set. Qed. -Lemma add_cardinal_2: +Lemma add_cardinal_2: forall s x, mem x s=false -> cardinal (add x s)=S (cardinal s). Proof. intros; apply add_cardinal_2; auto. rewrite not_mem_iff; auto. Qed. -Lemma remove_cardinal_1: +Lemma remove_cardinal_1: forall s x, mem x s=true -> S (cardinal (remove x s))=cardinal s. Proof. intros; apply remove_cardinal_1; auto with set. Qed. -Lemma remove_cardinal_2: +Lemma remove_cardinal_2: forall s x, mem x s=false -> cardinal (remove x s)=cardinal s. Proof. intros; apply Equal_cardinal; apply equal_2; auto with set. Qed. -Lemma union_cardinal: - forall s s', (forall x, mem x s && mem x s'=false) -> +Lemma union_cardinal: + forall s s', (forall x, mem x s && mem x s'=false) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; apply union_cardinal; auto; intros. rewrite exclusive_set; auto. Qed. -Lemma subset_cardinal: +Lemma subset_cardinal: forall s s', subset s s'=true -> cardinal s<=cardinal s'. Proof. intros; apply subset_cardinal; auto with set. @@ -600,16 +600,16 @@ unfold compat_bool in *; intros; f_equal; auto. Qed. Lemma filter_mem: forall s x, mem x (filter f s)=mem x s && f x. -Proof. +Proof. intros; apply filter_b; auto. Qed. -Lemma for_all_filter: +Lemma for_all_filter: forall s, for_all f s=is_empty (filter (fun x => negb (f x)) s). -Proof. +Proof. intros; apply bool_1; split; intros. apply is_empty_1. -unfold Empty; intros. +unfold Empty; intros. rewrite filter_iff; auto. red; destruct 1. rewrite <- (@for_all_iff s f) in H; auto. @@ -621,10 +621,10 @@ rewrite filter_iff; auto. destruct (f x); auto. Qed. -Lemma exists_filter : +Lemma exists_filter : forall s, exists_ f s=negb (is_empty (filter f s)). -Proof. -intros; apply bool_1; split; intros. +Proof. +intros; apply bool_1; split; intros. destruct (exists_2 Comp H) as (a,(Ha1,Ha2)). apply bool_6. red; intros; apply (@is_empty_2 _ H0 a); auto with set. @@ -636,28 +636,28 @@ intros _ H0. rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate. Qed. -Lemma partition_filter_1: +Lemma partition_filter_1: forall s, equal (fst (partition f s)) (filter f s)=true. -Proof. +Proof. auto with set. Qed. -Lemma partition_filter_2: +Lemma partition_filter_2: forall s, equal (snd (partition f s)) (filter (fun x => negb (f x)) s)=true. -Proof. +Proof. auto with set. Qed. -Lemma filter_add_1 : forall s x, f x = true -> - filter f (add x s) [=] add x (filter f s). +Lemma filter_add_1 : forall s x, f x = true -> + filter f (add x s) [=] add x (filter f s). Proof. red; intros; set_iff; do 2 (rewrite filter_iff; auto); set_iff. intuition. rewrite <- H; apply Comp; auto. Qed. -Lemma filter_add_2 : forall s x, f x = false -> - filter f (add x s) [=] filter f s. +Lemma filter_add_2 : forall s x, f x = false -> + filter f (add x s) [=] filter f s. Proof. red; intros; do 2 (rewrite filter_iff; auto); set_iff. intuition. @@ -665,18 +665,18 @@ assert (f x = f a) by (apply Comp; auto). rewrite H in H1; rewrite H2 in H1; discriminate. Qed. -Lemma add_filter_1 : forall s s' x, +Lemma add_filter_1 : forall s s' x, f x=true -> (Add x s s') -> (Add x (filter f s) (filter f s')). Proof. unfold Add, MP.Add; intros. repeat rewrite filter_iff; auto. rewrite H0; clear H0. -assert (E.eq x y -> f y = true) by +assert (E.eq x y -> f y = true) by (intro H0; rewrite <- (Comp _ _ H0); auto). tauto. Qed. -Lemma add_filter_2 : forall s s' x, +Lemma add_filter_2 : forall s s' x, f x=false -> (Add x s s') -> filter f s [=] filter f s'. Proof. unfold Add, MP.Add, Equal; intros. @@ -686,7 +686,7 @@ assert (f a = true -> ~E.eq x a). intros H0 H1. rewrite (Comp _ _ H1) in H. rewrite H in H0; discriminate. -tauto. +tauto. Qed. Lemma union_filter: forall f g, (compat_bool E.eq f) -> (compat_bool E.eq g) -> @@ -711,7 +711,7 @@ Qed. (** Properties of [for_all] *) -Lemma for_all_mem_1: forall s, +Lemma for_all_mem_1: forall s, (forall x, (mem x s)=true->(f x)=true) -> (for_all f s)=true. Proof. intros. @@ -724,8 +724,8 @@ generalize (H a); case (mem a s);intros;auto. rewrite H0;auto. Qed. -Lemma for_all_mem_2: forall s, - (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. +Lemma for_all_mem_2: forall s, + (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. Proof. intros. rewrite for_all_filter in H; auto. @@ -737,7 +737,7 @@ rewrite H0; simpl;intros. rewrite <- negb_false_iff; auto. Qed. -Lemma for_all_mem_3: +Lemma for_all_mem_3: forall s x,(mem x s)=true -> (f x)=false -> (for_all f s)=false. Proof. intros. @@ -752,7 +752,7 @@ rewrite H0. simpl;auto. Qed. -Lemma for_all_mem_4: +Lemma for_all_mem_4: forall s, for_all f s=false -> {x:elt | mem x s=true /\ f x=false}. Proof. intros. @@ -767,7 +767,7 @@ Qed. (** Properties of [exists] *) -Lemma for_all_exists: +Lemma for_all_exists: forall s, exists_ f s = negb (for_all (fun x =>negb (f x)) s). Proof. intros. @@ -788,7 +788,7 @@ Proof. unfold compat_bool in *; intros; f_equal; auto. Qed. -Lemma exists_mem_1: +Lemma exists_mem_1: forall s, (forall x, mem x s=true->f x=false) -> exists_ f s=false. Proof. intros. @@ -798,8 +798,8 @@ intros;generalize (H x H0);intros. rewrite negb_true_iff; auto. Qed. -Lemma exists_mem_2: - forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. +Lemma exists_mem_2: + forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. Proof. intros. rewrite for_all_exists in H; auto. @@ -808,7 +808,7 @@ rewrite <- negb_true_iff. apply for_all_mem_2 with (2:=H); auto. Qed. -Lemma exists_mem_3: +Lemma exists_mem_3: forall s x, mem x s=true -> f x=true -> exists_ f s=true. Proof. intros. @@ -818,7 +818,7 @@ apply for_all_mem_3 with x;auto. rewrite negb_false_iff; auto. Qed. -Lemma exists_mem_4: +Lemma exists_mem_4: forall s, exists_ f s=true -> {x:elt | (mem x s)=true /\ (f x)=true}. Proof. intros. @@ -836,12 +836,12 @@ Section Sum. (** Adding a valuation function on all elements of a set. *) -Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. +Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. Notation compat_opL := (compat_op E.eq (@Logic.eq _)). Notation transposeL := (transpose (@Logic.eq _)). -Lemma sum_plus : - forall f g, compat_nat E.eq f -> compat_nat E.eq g -> +Lemma sum_plus : + forall f g, compat_nat E.eq f -> compat_nat E.eq g -> forall s, sum (fun x =>f x+g x) s = sum f s + sum g s. Proof. unfold sum. @@ -863,12 +863,12 @@ rewrite H0;simpl;omega. do 3 rewrite fold_empty;auto. Qed. -Lemma sum_filter : forall f, (compat_bool E.eq f) -> +Lemma sum_filter : forall f, (compat_bool E.eq f) -> forall s, (sum (fun x => if f x then 1 else 0) s) = (cardinal (filter f s)). Proof. unfold sum; intros f Hf. assert (st : Equivalence (@Logic.eq nat)) by (split; congruence). -assert (cc : compat_opL (fun x => plus (if f x then 1 else 0))). +assert (cc : compat_opL (fun x => plus (if f x then 1 else 0))). red; intros. rewrite (Hf x x' H); auto. assert (ct : transposeL (fun x => plus (if f x then 1 else 0))). @@ -891,12 +891,12 @@ unfold Empty; intros. rewrite filter_iff; auto; set_iff; tauto. Qed. -Lemma fold_compat : +Lemma fold_compat : forall (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA) (f g:elt->A->A), - (compat_op E.eq eqA f) -> (transpose eqA f) -> - (compat_op E.eq eqA g) -> (transpose eqA g) -> - forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> + (compat_op E.eq eqA f) -> (transpose eqA f) -> + (compat_op E.eq eqA g) -> (transpose eqA g) -> + forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> (eqA (fold f s i) (fold g s i)). Proof. intros A eqA st f g fc ft gc gt i. @@ -916,8 +916,8 @@ symmetry; apply fold_add with (eqA:=eqA); auto. do 2 rewrite fold_empty; reflexivity. Qed. -Lemma sum_compat : - forall f g, compat_nat E.eq f -> compat_nat E.eq g -> +Lemma sum_compat : + forall f g, compat_nat E.eq f -> compat_nat E.eq g -> forall s, (forall x, In x s -> f x=g x) -> sum f s=sum g s. intros. unfold sum; apply (fold_compat _ (@Logic.eq nat)); auto. diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v index a96def34a..412b6f5c5 100644 --- a/theories/FSets/FSetFacts.v +++ b/theories/FSets/FSetFacts.v @@ -11,8 +11,8 @@ (** * Finite sets library *) (** This functor derives additional facts from [FSetInterface.S]. These - facts are mainly the specifications of [FSetInterface.S] written using - different styles: equivalence and boolean equalities. + facts are mainly the specifications of [FSetInterface.S] written using + different styles: equivalence and boolean equalities. Moreover, we prove that [E.Eq] and [Equal] are setoid equalities. *) @@ -30,7 +30,7 @@ Definition eqb x y := if eq_dec x y then true else false. (** * Specifications written using equivalences *) -Section IffSpec. +Section IffSpec. Variable s s' s'' : t. Variable x y z : elt. @@ -50,12 +50,12 @@ rewrite mem_iff; destruct (mem x s); intuition. Qed. Lemma equal_iff : s[=]s' <-> equal s s' = true. -Proof. +Proof. split; [apply equal_1|apply equal_2]. Qed. Lemma subset_iff : s[<=]s' <-> subset s s' = true. -Proof. +Proof. split; [apply subset_1|apply subset_2]. Qed. @@ -64,8 +64,8 @@ Proof. intuition; apply (empty_1 H). Qed. -Lemma is_empty_iff : Empty s <-> is_empty s = true. -Proof. +Lemma is_empty_iff : Empty s <-> is_empty s = true. +Proof. split; [apply is_empty_1|apply is_empty_2]. Qed. @@ -75,7 +75,7 @@ split; [apply singleton_1|apply singleton_2]. Qed. Lemma add_iff : In y (add x s) <-> E.eq x y \/ In y s. -Proof. +Proof. split; [ | destruct 1; [apply add_1|apply add_2]]; auto. destruct (eq_dec x y) as [E|E]; auto. intro H; right; exact (add_3 E H). @@ -116,8 +116,8 @@ Qed. Variable f : elt->bool. Lemma filter_iff : compat_bool E.eq f -> (In x (filter f s) <-> In x s /\ f x = true). -Proof. -split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto. +Proof. +split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto. Qed. Lemma for_all_iff : compat_bool E.eq f -> @@ -125,7 +125,7 @@ Lemma for_all_iff : compat_bool E.eq f -> Proof. split; [apply for_all_1 | apply for_all_2]; auto. Qed. - + Lemma exists_iff : compat_bool E.eq f -> (Exists (fun x => f x = true) s <-> exists_ f s = true). Proof. @@ -133,17 +133,17 @@ split; [apply exists_1 | apply exists_2]; auto. Qed. Lemma elements_iff : In x s <-> InA E.eq x (elements s). -Proof. +Proof. split; [apply elements_1 | apply elements_2]. Qed. End IffSpec. (** Useful tactic for simplifying expressions like [In y (add x (union s s'))] *) - -Ltac set_iff := + +Ltac set_iff := repeat (progress ( - rewrite add_iff || rewrite remove_iff || rewrite singleton_iff + rewrite add_iff || rewrite remove_iff || rewrite singleton_iff || rewrite union_iff || rewrite inter_iff || rewrite diff_iff || rewrite empty_iff)). @@ -154,7 +154,7 @@ Variable s s' s'' : t. Variable x y z : elt. Lemma mem_b : E.eq x y -> mem x s = mem y s. -Proof. +Proof. intros. generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H). destruct (mem x s); destruct (mem y s); intuition. @@ -191,7 +191,7 @@ destruct (mem y s); destruct (mem y (remove x s)); intuition. Qed. Lemma singleton_b : mem y (singleton x) = eqb x y. -Proof. +Proof. generalize (mem_iff (singleton x) y)(singleton_iff x y); unfold eqb. destruct (eq_dec x y); destruct (mem y (singleton x)); intuition. Qed. @@ -236,7 +236,7 @@ Qed. Variable f : elt->bool. Lemma filter_b : compat_bool E.eq f -> mem x (filter f s) = mem x s && f x. -Proof. +Proof. intros. generalize (mem_iff (filter f s) x)(mem_iff s x)(filter_iff s x H). destruct (mem x s); destruct (mem x (filter f s)); destruct (f x); simpl; intuition. @@ -264,7 +264,7 @@ rewrite H2. rewrite InA_alt; eauto. Qed. -Lemma exists_b : compat_bool E.eq f -> +Lemma exists_b : compat_bool E.eq f -> exists_ f s = existsb f (elements s). Proof. intros. @@ -297,20 +297,20 @@ constructor ; red; [apply E.eq_refl|apply E.eq_sym|apply E.eq_trans]. Qed. Definition Equal_ST : Equivalence Equal. -Proof. +Proof. constructor ; red; [apply eq_refl | apply eq_sym | apply eq_trans]. Qed. -Add Relation elt E.eq - reflexivity proved by E.eq_refl +Add Relation elt E.eq + reflexivity proved by E.eq_refl symmetry proved by E.eq_sym - transitivity proved by E.eq_trans + transitivity proved by E.eq_trans as EltSetoid. -Add Relation t Equal - reflexivity proved by eq_refl +Add Relation t Equal + reflexivity proved by eq_refl symmetry proved by eq_sym - transitivity proved by eq_trans + transitivity proved by eq_trans as EqualSetoid. Add Morphism In with signature E.eq ==> Equal ==> iff as In_m. @@ -323,7 +323,7 @@ Add Morphism is_empty : is_empty_m. Proof. unfold Equal; intros s s' H. generalize (is_empty_iff s)(is_empty_iff s'). -destruct (is_empty s); destruct (is_empty s'); +destruct (is_empty s); destruct (is_empty s'); unfold Empty; auto; intros. symmetry. rewrite <- H1; intros a Ha. @@ -388,14 +388,14 @@ do 2 rewrite diff_iff; rewrite H; rewrite H0; intuition. Qed. Add Morphism Subset with signature Equal ==> Equal ==> iff as Subset_m. -Proof. +Proof. unfold Equal, Subset; firstorder. Qed. Add Morphism subset : subset_m. Proof. intros s s' H s'' s''' H0. -generalize (subset_iff s s'') (subset_iff s' s'''). +generalize (subset_iff s s'') (subset_iff s' s'''). destruct (subset s s''); destruct (subset s' s'''); auto; intros. rewrite H in H1; rewrite H0 in H1; intuition. rewrite H in H1; rewrite H0 in H1; intuition. @@ -467,7 +467,7 @@ Qed. (* [fold], [filter], [for_all], [exists_] and [partition] cannot be proved morphism without additional hypothesis on [f]. For instance: *) -Lemma filter_equal : forall f, compat_bool E.eq f -> +Lemma filter_equal : forall f, compat_bool E.eq f -> forall s s', s[=]s' -> filter f s [=] filter f s'. Proof. unfold Equal; intros; repeat rewrite filter_iff; auto; rewrite H0; tauto. @@ -481,7 +481,7 @@ rewrite Hff', Hss'; intuition. red; intros; rewrite <- 2 Hff'; auto. Qed. -Lemma filter_subset : forall f, compat_bool E.eq f -> +Lemma filter_subset : forall f, compat_bool E.eq f -> forall s s', s[<=]s' -> filter f s [<=] filter f s'. Proof. unfold Subset; intros; rewrite filter_iff in *; intuition. diff --git a/theories/FSets/FSetFullAVL.v b/theories/FSets/FSetFullAVL.v index 81ed9a572..bc0d758bd 100644 --- a/theories/FSets/FSetFullAVL.v +++ b/theories/FSets/FSetFullAVL.v @@ -6,27 +6,27 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) (* $Id$ *) (** * FSetFullAVL - + This file contains some complements to [FSetAVL]. - - Functor [AvlProofs] proves that trees of [FSetAVL] are not only + - Functor [AvlProofs] proves that trees of [FSetAVL] are not only binary search trees, but moreover well-balanced ones. This is done by proving that all operations preserve the balancing. - - Functor [OcamlOps] contains variants of [union], [subset], + - Functor [OcamlOps] contains variants of [union], [subset], [compare] and [equal] that are faithful to the original ocaml codes, while the versions in FSetAVL have been adapted to perform only - structural recursive code. - - - Finally, we pack the previous elements in a [Make] functor + structural recursive code. + + - Finally, we pack the previous elements in a [Make] functor similar to the one of [FSetAVL], but richer. *) @@ -54,7 +54,7 @@ Inductive avl : tree -> Prop := | RBLeaf : avl Leaf | RBNode : forall x l r h, avl l -> avl r -> -(2) <= height l - height r <= 2 -> - h = max (height l) (height r) + 1 -> + h = max (height l) (height r) + 1 -> avl (Node l x r h). (** * Automation and dedicated tactics *) @@ -64,7 +64,7 @@ Hint Constructors avl. (** A tactic for cleaning hypothesis after use of functional induction. *) Ltac clearf := - match goal with + match goal with | H : (@Logic.eq (Compare _ _ _ _) _ _) |- _ => clear H; clearf | H : (@Logic.eq (sumbool _ _) _ _) |- _ => clear H; clearf | _ => idtac @@ -77,25 +77,25 @@ Proof. induction s; simpl; intros; auto with zarith. inv avl; intuition; omega_max. Qed. -Implicit Arguments height_non_negative. +Implicit Arguments height_non_negative. (** When [H:avl r], typing [avl_nn H] or [avl_nn r] adds [height r>=0] *) -Ltac avl_nn_hyp H := +Ltac avl_nn_hyp H := let nz := fresh "nz" in assert (nz := height_non_negative H). -Ltac avl_nn h := - let t := type of h in - match type of t with +Ltac avl_nn h := + let t := type of h in + match type of t with | Prop => avl_nn_hyp h | _ => match goal with H : avl h |- _ => avl_nn_hyp H end end. -(* Repeat the previous tactic. +(* Repeat the previous tactic. Drawback: need to clear the [avl _] hyps ... Thank you Ltac *) Ltac avl_nns := - match goal with + match goal with | H:avl _ |- _ => avl_nn_hyp H; clear H; avl_nns | _ => idtac end. @@ -110,7 +110,7 @@ Qed. (** * Results about [avl] *) -Lemma avl_node : +Lemma avl_node : forall x l r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (Node l x r (max (height l) (height r) + 1)). @@ -123,7 +123,7 @@ Hint Resolve avl_node. (** empty *) Lemma empty_avl : avl empty. -Proof. +Proof. auto. Qed. @@ -137,15 +137,15 @@ Qed. (** create *) -Lemma create_avl : - forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_avl : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (create l x r). Proof. unfold create; auto. Qed. -Lemma create_height : - forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma create_height : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (create l x r) = max (height l) (height r) + 1. Proof. unfold create; auto. @@ -153,17 +153,17 @@ Qed. (** bal *) -Lemma bal_avl : forall l x r, avl l -> avl r -> +Lemma bal_avl : forall l x r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> avl (bal l x r). Proof. intros l x r; functional induction bal l x r; intros; clearf; - inv avl; simpl in *; + inv avl; simpl in *; match goal with |- avl (assert_false _ _ _) => avl_nns | _ => repeat apply create_avl; simpl in *; auto end; omega_max. Qed. -Lemma bal_height_1 : forall l x r, avl l -> avl r -> +Lemma bal_height_1 : forall l x r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> 0 <= height (bal l x r) - max (height l) (height r) <= 1. Proof. @@ -171,25 +171,25 @@ Proof. inv avl; avl_nns; simpl in *; omega_max. Qed. -Lemma bal_height_2 : - forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> +Lemma bal_height_2 : + forall l x r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (bal l x r) == max (height l) (height r) +1. Proof. intros l x r; functional induction bal l x r; intros; clearf; inv avl; simpl in *; omega_max. Qed. -Ltac omega_bal := match goal with - | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?r ] => - generalize (bal_height_1 x H H') (bal_height_2 x H H'); +Ltac omega_bal := match goal with + | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?r ] => + generalize (bal_height_1 x H H') (bal_height_2 x H H'); omega_max end. (** add *) -Lemma add_avl_1 : forall s x, avl s -> +Lemma add_avl_1 : forall s x, avl s -> avl (add x s) /\ 0 <= height (add x s) - height s <= 1. -Proof. +Proof. intros s x; functional induction (add x s); subst;intros; inv avl; simpl in *. intuition; try constructor; simpl; auto; try omega_max. (* LT *) @@ -216,10 +216,10 @@ Hint Resolve add_avl. Lemma join_avl_1 : forall l x r, avl l -> avl r -> avl (join l x r) /\ 0<= height (join l x r) - max (height l) (height r) <= 1. -Proof. +Proof. join_tac. - split; simpl; auto. + split; simpl; auto. destruct (add_avl_1 x H0). avl_nns; omega_max. set (l:=Node ll lx lr lh) in *. @@ -269,8 +269,8 @@ Hint Resolve join_avl. (** remove_min *) -Lemma remove_min_avl_1 : forall l x r h, avl (Node l x r h) -> - avl (remove_min l x r)#1 /\ +Lemma remove_min_avl_1 : forall l x r h, avl (Node l x r h) -> + avl (remove_min l x r)#1 /\ 0 <= height (Node l x r h) - height (remove_min l x r)#1 <= 1. Proof. intros l x r; functional induction (remove_min l x r); subst;simpl in *; intros. @@ -278,25 +278,25 @@ Proof. avl_nns; omega_max. inversion_clear H. rewrite e0 in IHp;simpl in IHp;destruct (IHp _x); auto. - split; simpl in *. + split; simpl in *. apply bal_avl; auto; omega_max. omega_bal. Qed. -Lemma remove_min_avl : forall l x r h, avl (Node l x r h) -> - avl (remove_min l x r)#1. +Lemma remove_min_avl : forall l x r h, avl (Node l x r h) -> + avl (remove_min l x r)#1. Proof. intros; destruct (remove_min_avl_1 H); auto. Qed. (** merge *) -Lemma merge_avl_1 : forall s1 s2, avl s1 -> avl s2 -> - -(2) <= height s1 - height s2 <= 2 -> - avl (merge s1 s2) /\ +Lemma merge_avl_1 : forall s1 s2, avl s1 -> avl s2 -> + -(2) <= height s1 - height s2 <= 2 -> + avl (merge s1 s2) /\ 0<= height (merge s1 s2) - max (height s1) (height s2) <=1. Proof. - intros s1 s2; functional induction (merge s1 s2); intros; + intros s1 s2; functional induction (merge s1 s2); intros; try factornode _x _x0 _x1 _x2 as s1. simpl; split; auto; avl_nns; omega_max. simpl; split; auto; avl_nns; simpl in *; omega_max. @@ -308,16 +308,16 @@ Proof. simpl in *; omega_bal. Qed. -Lemma merge_avl : forall s1 s2, avl s1 -> avl s2 -> +Lemma merge_avl : forall s1 s2, avl s1 -> avl s2 -> -(2) <= height s1 - height s2 <= 2 -> avl (merge s1 s2). -Proof. +Proof. intros; destruct (merge_avl_1 H H0 H1); auto. Qed. (** remove *) -Lemma remove_avl_1 : forall s x, avl s -> +Lemma remove_avl_1 : forall s x, avl s -> avl (remove x s) /\ 0 <= height s - height (remove x s) <= 1. Proof. intros s x; functional induction (remove x s); intros. @@ -325,25 +325,25 @@ Proof. (* LT *) inv avl. destruct (IHt H0). - split. + split. apply bal_avl; auto. omega_max. omega_bal. (* EQ *) - inv avl. + inv avl. generalize (merge_avl_1 H0 H1 H2). intuition omega_max. (* GT *) inv avl. destruct (IHt H1). - split. + split. apply bal_avl; auto. omega_max. omega_bal. Qed. Lemma remove_avl : forall s x, avl s -> avl (remove x s). -Proof. +Proof. intros; destruct (remove_avl_1 x H); auto. Qed. Hint Resolve remove_avl. @@ -360,9 +360,9 @@ Hint Resolve concat_avl. (** split *) -Lemma split_avl : forall s x, avl s -> +Lemma split_avl : forall s x, avl s -> avl (split x s)#l /\ avl (split x s)#r. -Proof. +Proof. intros s x; functional induction (split x s); simpl; auto. rewrite e1 in IHt;simpl in IHt;inversion_clear 1; intuition. simpl; inversion_clear 1; auto. @@ -371,19 +371,19 @@ Qed. (** inter *) -Lemma inter_avl : forall s1 s2, avl s1 -> avl s2 -> avl (inter s1 s2). +Lemma inter_avl : forall s1 s2, avl s1 -> avl s2 -> avl (inter s1 s2). Proof. intros s1 s2; functional induction inter s1 s2; auto; intros A1 A2; - generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; + generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; inv avl; auto. Qed. (** diff *) -Lemma diff_avl : forall s1 s2, avl s1 -> avl s2 -> avl (diff s1 s2). -Proof. +Lemma diff_avl : forall s1 s2, avl s1 -> avl s2 -> avl (diff s1 s2). +Proof. intros s1 s2; functional induction diff s1 s2; auto; intros A1 A2; - generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; + generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; inv avl; auto. Qed. @@ -392,30 +392,30 @@ Qed. Lemma union_avl : forall s1 s2, avl s1 -> avl s2 -> avl (union s1 s2). Proof. intros s1 s2; functional induction union s1 s2; auto; intros A1 A2; - generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; + generalize (split_avl x1 A2); rewrite e1; simpl; destruct 1; inv avl; auto. Qed. (** filter *) -Lemma filter_acc_avl : forall f s acc, avl s -> avl acc -> +Lemma filter_acc_avl : forall f s acc, avl s -> avl acc -> avl (filter_acc f acc s). Proof. induction s; simpl; auto. intros. inv avl. destruct (f t); auto. -Qed. +Qed. Hint Resolve filter_acc_avl. -Lemma filter_avl : forall f s, avl s -> avl (filter f s). +Lemma filter_avl : forall f s, avl s -> avl (filter f s). Proof. unfold filter; intros; apply filter_acc_avl; auto. Qed. (** partition *) -Lemma partition_acc_avl_1 : forall f s acc, avl s -> +Lemma partition_acc_avl_1 : forall f s acc, avl s -> avl acc#1 -> avl (partition_acc f acc s)#1. Proof. induction s; simpl; auto. @@ -427,7 +427,7 @@ Proof. destruct (f t); simpl; auto. Qed. -Lemma partition_acc_avl_2 : forall f s acc, avl s -> +Lemma partition_acc_avl_2 : forall f s acc, avl s -> avl acc#2 -> avl (partition_acc f acc s)#2. Proof. induction s; simpl; auto. @@ -437,14 +437,14 @@ Proof. apply IHs2; auto. apply IHs1; auto. destruct (f t); simpl; auto. -Qed. +Qed. -Lemma partition_avl_1 : forall f s, avl s -> avl (partition f s)#1. +Lemma partition_avl_1 : forall f s, avl s -> avl (partition f s)#1. Proof. unfold partition; intros; apply partition_acc_avl_1; auto. Qed. -Lemma partition_avl_2 : forall f s, avl s -> avl (partition f s)#2. +Lemma partition_avl_2 : forall f s, avl s -> avl (partition f s)#2. Proof. unfold partition; intros; apply partition_acc_avl_2; auto. Qed. @@ -462,29 +462,29 @@ Open Local Scope nat_scope. (** Properties of cardinal *) -Lemma bal_cardinal : forall l x r, +Lemma bal_cardinal : forall l x r, cardinal (bal l x r) = S (cardinal l + cardinal r). Proof. intros l x r; functional induction bal l x r; intros; clearf; simpl; auto with arith; romega with *. Qed. -Lemma add_cardinal : forall x s, +Lemma add_cardinal : forall x s, cardinal (add x s) <= S (cardinal s). Proof. - intros; functional induction add x s; simpl; auto with arith; + intros; functional induction add x s; simpl; auto with arith; rewrite bal_cardinal; romega with *. Qed. -Lemma join_cardinal : forall l x r, +Lemma join_cardinal : forall l x r, cardinal (join l x r) <= S (cardinal l + cardinal r). Proof. join_tac; auto with arith. simpl; apply add_cardinal. simpl; destruct X.compare; simpl; auto with arith. - generalize (bal_cardinal (add x ll) lx lr) (add_cardinal x ll); + generalize (bal_cardinal (add x ll) lx lr) (add_cardinal x ll); romega with *. - generalize (bal_cardinal ll lx (add x lr)) (add_cardinal x lr); + generalize (bal_cardinal ll lx (add x lr)) (add_cardinal x lr); romega with *. generalize (bal_cardinal ll lx (join lr x (Node rl rx rr rh))) (Hlr x (Node rl rx rr rh)); simpl; romega with *. @@ -492,7 +492,7 @@ Proof. romega with *. Qed. -Lemma split_cardinal_1 : forall x s, +Lemma split_cardinal_1 : forall x s, (cardinal (split x s)#l <= cardinal s)%nat. Proof. intros x s; functional induction split x s; simpl; auto. @@ -503,7 +503,7 @@ Proof. generalize (@join_cardinal l y rl); romega with *. Qed. -Lemma split_cardinal_2 : forall x s, +Lemma split_cardinal_2 : forall x s, (cardinal (split x s)#r <= cardinal s)%nat. Proof. intros x s; functional induction split x s; simpl; auto. @@ -517,26 +517,26 @@ Qed. Definition cardinal2 (s:t*t) := (cardinal s#1 + cardinal s#2)%nat. -Ltac ocaml_union_tac := +Ltac ocaml_union_tac := intros; unfold cardinal2; simpl fst in *; simpl snd in *; - match goal with H: split ?x ?s = _ |- _ => - generalize (split_cardinal_1 x s) (split_cardinal_2 x s); + match goal with H: split ?x ?s = _ |- _ => + generalize (split_cardinal_1 x s) (split_cardinal_2 x s); rewrite H; simpl; romega with * end. Function ocaml_union (s : t * t) { measure cardinal2 s } : t := - match s with + match s with | (Leaf, Leaf) => s#2 | (Leaf, Node _ _ _ _) => s#2 | (Node _ _ _ _, Leaf) => s#1 - | (Node l1 x1 r1 h1, Node l2 x2 r2 h2) => + | (Node l1 x1 r1 h1, Node l2 x2 r2 h2) => if ge_lt_dec h1 h2 then if eq_dec h2 1%I then add x2 s#1 else - let (l2',_,r2') := split x1 s#2 in + let (l2',_,r2') := split x1 s#2 in join (ocaml_union (l1,l2')) x1 (ocaml_union (r1,r2')) else if eq_dec h1 1%I then add x1 s#2 else - let (l1',_,r1') := split x2 s#1 in + let (l1',_,r1') := split x2 s#1 in join (ocaml_union (l1',l2)) x2 (ocaml_union (r1',r2)) end. Proof. @@ -546,11 +546,11 @@ abstract ocaml_union_tac. abstract ocaml_union_tac. Defined. -Lemma ocaml_union_in : forall s y, +Lemma ocaml_union_in : forall s y, bst s#1 -> avl s#1 -> bst s#2 -> avl s#2 -> (In y (ocaml_union s) <-> In y s#1 \/ In y s#2). Proof. - intros s; functional induction ocaml_union s; intros y B1 A1 B2 A2; + intros s; functional induction ocaml_union s; intros y B1 A1 B2 A2; simpl fst in *; simpl snd in *; try clear e0 e1. intuition_in. intuition_in. @@ -575,7 +575,7 @@ Proof. rewrite (height_0 H4); [ | avl_nn r1; omega_max]. rewrite add_in; auto; intuition_in. (* join (union (l1',l2)) x1 (union (r1',r2)) *) - generalize + generalize (split_avl x2 A1) (split_bst x2 B1) (split_in_1 x2 y B1) (split_in_2 x2 y B1). rewrite e2; simpl. @@ -589,7 +589,7 @@ Lemma ocaml_union_bst : forall s, bst s#1 -> avl s#1 -> bst s#2 -> avl s#2 -> bst (ocaml_union s). Proof. intros s; functional induction ocaml_union s; intros B1 A1 B2 A2; - simpl fst in *; simpl snd in *; try clear e0 e1; + simpl fst in *; simpl snd in *; try clear e0 e1; try apply add_bst; auto. (* join (union (l1,l2')) x1 (union (r1,r2')) *) clear _x _x0; factornode l2 x2 r2 h2 as s2. @@ -613,10 +613,10 @@ Proof. intro y; rewrite ocaml_union_in, H4; intuition_in. Qed. -Lemma ocaml_union_avl : forall s, +Lemma ocaml_union_avl : forall s, avl s#1 -> avl s#2 -> avl (ocaml_union s). Proof. - intros s; functional induction ocaml_union s; + intros s; functional induction ocaml_union s; simpl fst in *; simpl snd in *; auto. intros A1 A2; generalize (split_avl x1 A2); rewrite e2; simpl. inv avl; destruct 1; auto. @@ -654,7 +654,7 @@ Proof. intros; unfold cardinal2; simpl; abstract romega with *. Defined. -Lemma ocaml_subset_12 : forall s, +Lemma ocaml_subset_12 : forall s, bst s#1 -> bst s#2 -> (ocaml_subset s = true <-> Subset s#1 s#2). Proof. @@ -685,7 +685,7 @@ Proof. assert (In a (Node l2 x2 r2 h2)) by auto; intuition_in; order. Qed. -Lemma ocaml_subset_alt : forall s, bst s#1 -> bst s#2 -> +Lemma ocaml_subset_alt : forall s, bst s#1 -> bst s#2 -> ocaml_subset s = subset s#1 s#2. Proof. intros. @@ -704,7 +704,7 @@ Fixpoint cardinal_e e := match e with | More _ s r => S (cardinal s + cardinal_e r) end. -Lemma cons_cardinal_e : forall s e, +Lemma cons_cardinal_e : forall s e, cardinal_e (cons s e) = cardinal s + cardinal_e e. Proof. induction s; simpl; intros; auto. @@ -713,32 +713,32 @@ Qed. Definition cardinal_e_2 e := cardinal_e e#1 + cardinal_e e#2. -Function ocaml_compare_aux - (e:enumeration*enumeration) { measure cardinal_e_2 e } : comparison := - match e with +Function ocaml_compare_aux + (e:enumeration*enumeration) { measure cardinal_e_2 e } : comparison := + match e with | (End,End) => Eq - | (End,More _ _ _) => Lt - | (More _ _ _, End) => Gt - | (More x1 r1 e1, More x2 r2 e2) => - match X.compare x1 x2 with + | (End,More _ _ _) => Lt + | (More _ _ _, End) => Gt + | (More x1 r1 e1, More x2 r2 e2) => + match X.compare x1 x2 with | EQ _ => ocaml_compare_aux (cons r1 e1, cons r2 e2) - | LT _ => Lt - | GT _ => Gt + | LT _ => Lt + | GT _ => Gt end end. Proof. -intros; unfold cardinal_e_2; simpl; +intros; unfold cardinal_e_2; simpl; abstract (do 2 rewrite cons_cardinal_e; romega with *). Defined. -Definition ocaml_compare s1 s2 := +Definition ocaml_compare s1 s2 := ocaml_compare_aux (cons s1 End, cons s2 End). -Lemma ocaml_compare_aux_Cmp : forall e, +Lemma ocaml_compare_aux_Cmp : forall e, Cmp (ocaml_compare_aux e) (flatten_e e#1) (flatten_e e#2). Proof. - intros e; functional induction ocaml_compare_aux e; simpl; intros; + intros e; functional induction ocaml_compare_aux e; simpl; intros; auto; try discriminate. apply L.eq_refl. simpl in *. @@ -756,11 +756,11 @@ Proof. apply (@ocaml_compare_aux_Cmp (cons s1 End, cons s2 End)). Qed. -Lemma ocaml_compare_alt : forall s1 s2, bst s1 -> bst s2 -> +Lemma ocaml_compare_alt : forall s1 s2, bst s1 -> bst s2 -> ocaml_compare s1 s2 = compare s1 s2. Proof. intros s1 s2 B1 B2. - generalize (ocaml_compare_Cmp s1 s2)(compare_Cmp s1 s2). + generalize (ocaml_compare_Cmp s1 s2)(compare_Cmp s1 s2). unfold Cmp. destruct ocaml_compare; destruct compare; auto; intros; elimtype False. elim (lt_not_eq B1 B2 H0); auto. @@ -781,13 +781,13 @@ Qed. (** * Equality test *) -Definition ocaml_equal s1 s2 : bool := - match ocaml_compare s1 s2 with +Definition ocaml_equal s1 s2 : bool := + match ocaml_compare s1 s2 with | Eq => true - | _ => false + | _ => false end. -Lemma ocaml_equal_1 : forall s1 s2, bst s1 -> bst s2 -> +Lemma ocaml_equal_1 : forall s1 s2, bst s1 -> bst s2 -> Equal s1 s2 -> ocaml_equal s1 s2 = true. Proof. unfold ocaml_equal; intros s1 s2 B1 B2 E. @@ -801,11 +801,11 @@ Lemma ocaml_equal_2 : forall s1 s2, ocaml_equal s1 s2 = true -> Equal s1 s2. Proof. unfold ocaml_equal; intros s1 s2 E. -generalize (ocaml_compare_Cmp s1 s2); +generalize (ocaml_compare_Cmp s1 s2); destruct ocaml_compare; auto; discriminate. Qed. -Lemma ocaml_equal_alt : forall s1 s2, bst s1 -> bst s2 -> +Lemma ocaml_equal_alt : forall s1 s2, bst s1 -> bst s2 -> ocaml_equal s1 s2 = equal s1 s2. Proof. intros; unfold ocaml_equal, equal; rewrite ocaml_compare_alt; auto. @@ -817,14 +817,14 @@ End OcamlOps. (** * Encapsulation - We can implement [S] with balanced binary search trees. + We can implement [S] with balanced binary search trees. When compared to [FSetAVL], we maintain here two invariants (bst and avl) instead of only bst, which is enough for fulfilling the FSet interface. - This encapsulation propose the non-structural variants + This encapsulation propose the non-structural variants [ocaml_union], [ocaml_subset], [ocaml_compare], [ocaml_equal]. -*) +*) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. @@ -837,61 +837,61 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Record bbst := Bbst {this :> Raw.t; is_bst : bst this; is_avl : avl this}. Definition t := bbst. Definition elt := E.t. - + Definition In (x : elt) (s : t) : Prop := In x s. Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. Definition Empty (s:t) : Prop := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) (s:t) : Prop := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) (s:t) : Prop := exists x, In x s /\ P x. - - Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. + + Lemma In_1 : forall (s:t)(x y:elt), E.eq x y -> In x s -> In y s. Proof. intro s; exact (@In_1 s). Qed. - + Definition mem (x:elt)(s:t) : bool := mem x s. Definition empty : t := Bbst empty_bst empty_avl. Definition is_empty (s:t) : bool := is_empty s. - Definition singleton (x:elt) : t := + Definition singleton (x:elt) : t := Bbst (singleton_bst x) (singleton_avl x). - Definition add (x:elt)(s:t) : t := - Bbst (add_bst x (is_bst s)) (add_avl x (is_avl s)). - Definition remove (x:elt)(s:t) : t := + Definition add (x:elt)(s:t) : t := + Bbst (add_bst x (is_bst s)) (add_avl x (is_avl s)). + Definition remove (x:elt)(s:t) : t := Bbst (remove_bst x (is_bst s)) (remove_avl x (is_avl s)). - Definition inter (s s':t) : t := + Definition inter (s s':t) : t := Bbst (inter_bst (is_bst s) (is_bst s')) (inter_avl (is_avl s) (is_avl s')). Definition union (s s':t) : t := Bbst (union_bst (is_bst s) (is_bst s')) (union_avl (is_avl s) (is_avl s')). Definition ocaml_union (s s':t) : t := - Bbst (@ocaml_union_bst (s.(this),s'.(this)) + Bbst (@ocaml_union_bst (s.(this),s'.(this)) (is_bst s) (is_avl s) (is_bst s') (is_avl s')) (@ocaml_union_avl (s.(this),s'.(this)) (is_avl s) (is_avl s')). - Definition diff (s s':t) : t := + Definition diff (s s':t) : t := Bbst (diff_bst (is_bst s) (is_bst s')) (diff_avl (is_avl s) (is_avl s')). Definition elements (s:t) : list elt := elements s. Definition min_elt (s:t) : option elt := min_elt s. Definition max_elt (s:t) : option elt := max_elt s. Definition choose (s:t) : option elt := choose s. - Definition fold (B : Type) (f : elt -> B -> B) (s:t) : B -> B := fold f s. + Definition fold (B : Type) (f : elt -> B -> B) (s:t) : B -> B := fold f s. Definition cardinal (s:t) : nat := cardinal s. - Definition filter (f : elt -> bool) (s:t) : t := + Definition filter (f : elt -> bool) (s:t) : t := Bbst (filter_bst f (is_bst s)) (filter_avl f (is_avl s)). Definition for_all (f : elt -> bool) (s:t) : bool := for_all f s. Definition exists_ (f : elt -> bool) (s:t) : bool := exists_ f s. Definition partition (f : elt -> bool) (s:t) : t * t := let p := partition f s in - (@Bbst (fst p) (partition_bst_1 f (is_bst s)) - (partition_avl_1 f (is_avl s)), + (@Bbst (fst p) (partition_bst_1 f (is_bst s)) + (partition_avl_1 f (is_avl s)), @Bbst (snd p) (partition_bst_2 f (is_bst s)) (partition_avl_2 f (is_avl s))). Definition equal (s s':t) : bool := equal s s'. Definition ocaml_equal (s s':t) : bool := ocaml_equal s s'. Definition subset (s s':t) : bool := subset s s'. - Definition ocaml_subset (s s':t) : bool := + Definition ocaml_subset (s s':t) : bool := ocaml_subset (s.(this),s'.(this)). Definition eq (s s':t) : Prop := Equal s s'. @@ -922,13 +922,13 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Defined. (* specs *) - Section Specs. - Variable s s' s'': t. + Section Specs. + Variable s s' s'': t. Variable x y : elt. Hint Resolve is_bst is_avl. - - Lemma mem_1 : In x s -> mem x s = true. + + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (mem_1 (is_bst s)). Qed. Lemma mem_2 : mem x s = true -> In x s. Proof. exact (@mem_2 s x). Qed. @@ -939,15 +939,15 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. exact (@equal_2 s s'). Qed. Lemma ocaml_equal_alt : ocaml_equal s s' = equal s s'. - Proof. + Proof. destruct s; destruct s'; unfold ocaml_equal, equal; simpl. apply ocaml_equal_alt; auto. Qed. - + Lemma ocaml_equal_1 : Equal s s' -> ocaml_equal s s' = true. Proof. exact (ocaml_equal_1 (is_bst s) (is_bst s')). Qed. Lemma ocaml_equal_2 : ocaml_equal s s' = true -> Equal s s'. - Proof. exact (@ocaml_equal_2 s s'). Qed. + Proof. exact (@ocaml_equal_2 s s'). Qed. Ltac wrap t H := unfold t, In; simpl; rewrite H; auto; intuition. @@ -957,7 +957,7 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. wrap subset subset_12. Qed. Lemma ocaml_subset_alt : ocaml_subset s s' = subset s s'. - Proof. + Proof. destruct s; destruct s'; unfold ocaml_subset, subset; simpl. rewrite ocaml_subset_alt; auto. Qed. @@ -972,14 +972,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (@is_empty_1 s). Qed. - Lemma is_empty_2 : is_empty s = true -> Empty s. + Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (@is_empty_2 s). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. wrap add add_in. Qed. Lemma add_2 : In y s -> In y (add x s). Proof. wrap add add_in. Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. wrap add add_in. elim H; auto. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -989,20 +989,20 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. wrap remove remove_in. Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (@singleton_1 x y). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (@singleton_2 x y). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. wrap union union_in. Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. wrap union union_in. Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. wrap union union_in. Qed. Lemma ocaml_union_alt : Equal (ocaml_union s s') (union s s'). - Proof. + Proof. unfold ocaml_union, union, Equal, In. destruct s as (s0,b,a); destruct s' as (s0',b',a'); simpl. exact (@ocaml_union_alt (s0,s0') b a b' a'). @@ -1021,32 +1021,32 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. wrap inter inter_in. Qed. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. wrap inter inter_in. Qed. - - Lemma diff_1 : In x (diff s s') -> In x s. + + Lemma diff_1 : In x (diff s s') -> In x s. Proof. wrap diff diff_in. Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. wrap diff diff_in. Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. wrap diff diff_in. Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. - Proof. + Proof. unfold fold, elements; intros; apply fold_1; auto. Qed. Lemma cardinal_1 : cardinal s = length (elements s). - Proof. + Proof. unfold cardinal, elements; intros; apply elements_cardinal; auto. Qed. Section Filter. Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Proof. intro. wrap filter filter_in. Qed. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. intro. wrap filter filter_in. Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. - Proof. intro. wrap filter filter_in. Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. intro. wrap filter filter_in. Qed. @@ -1060,14 +1060,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma exists_2 : compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. exact (@exists_2 f s). Qed. - Lemma partition_1 : compat_bool E.eq f -> + Lemma partition_1 : compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. rewrite partition_in_1, filter_in; intuition. Qed. - Lemma partition_2 : compat_bool E.eq f -> + Lemma partition_2 : compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. unfold partition, filter, Equal, In; simpl ;intros H a. @@ -1089,14 +1089,14 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Lemma elements_3w : NoDupA E.eq (elements s). Proof. exact (elements_nodup (is_bst s)). Qed. - Lemma min_elt_1 : min_elt s = Some x -> In x s. + Lemma min_elt_1 : min_elt s = Some x -> In x s. Proof. exact (@min_elt_1 s x). Qed. Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. exact (@min_elt_2 s x y (is_bst s)). Qed. Lemma min_elt_3 : min_elt s = None -> Empty s. Proof. exact (@min_elt_3 s). Qed. - Lemma max_elt_1 : max_elt s = Some x -> In x s. + Lemma max_elt_1 : max_elt s = Some x -> In x s. Proof. exact (@max_elt_1 s x). Qed. Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. exact (@max_elt_2 s x y (is_bst s)). Qed. @@ -1107,17 +1107,17 @@ Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Proof. exact (@choose_1 s x). Qed. Lemma choose_2 : choose s = None -> Empty s. Proof. exact (@choose_2 s). Qed. - Lemma choose_3 : choose s = Some x -> choose s' = Some y -> + Lemma choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. exact (@choose_3 _ _ (is_bst s) (is_bst s') x y). Qed. - Lemma eq_refl : eq s s. + Lemma eq_refl : eq s s. Proof. exact (eq_refl s). Qed. Lemma eq_sym : eq s s' -> eq s' s. Proof. exact (@eq_sym s s'). Qed. Lemma eq_trans : eq s s' -> eq s' s'' -> eq s s''. Proof. exact (@eq_trans s s' s''). Qed. - + Lemma lt_trans : lt s s' -> lt s' s'' -> lt s s''. Proof. exact (@lt_trans s s' s''). Qed. Lemma lt_not_eq : lt s s' -> ~eq s s'. diff --git a/theories/FSets/FSetInterface.v b/theories/FSets/FSetInterface.v index 1f21a2262..d94ff7c95 100644 --- a/theories/FSets/FSetInterface.v +++ b/theories/FSets/FSetInterface.v @@ -10,13 +10,13 @@ (** * Finite set library *) -(** Set interfaces, inspired by the one of Ocaml. When compared with - Ocaml, the main differences are: +(** Set interfaces, inspired by the one of Ocaml. When compared with + Ocaml, the main differences are: - the lack of [iter] function, useless since Coq is purely functional - the use of [option] types instead of [Not_found] exceptions - - the use of [nat] instead of [int] for the [cardinal] function + - the use of [nat] instead of [int] for the [cardinal] function - Several variants of the set interfaces are available: + Several variants of the set interfaces are available: - [WSfun] : functorial signature for weak sets, non-dependent style - [WS] : self-contained version of [WSfun] - [Sfun] : functorial signature for ordered sets, non-dependent style @@ -24,7 +24,7 @@ - [Sdep] : analog of [S] written using dependent style If unsure, [S] is probably what you're looking for: other signatures - are subsets of it, apart from [Sdep] which is isomorphic to [S] (see + are subsets of it, apart from [Sdep] which is isomorphic to [S] (see [FSetBridge]). *) @@ -34,14 +34,14 @@ Unset Strict Implicit. (** * Non-dependent signatures - The following signatures presents sets as purely informative + The following signatures presents sets as purely informative programs together with axioms *) (** ** Functorial signature for weak sets - Weak sets are sets without ordering on base elements, only + Weak sets are sets without ordering on base elements, only a decidable equality. *) Module Type WSfun (E : DecidableType). @@ -57,7 +57,7 @@ Module Type WSfun (E : DecidableType). Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. - + Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). @@ -137,7 +137,7 @@ Module Type WSfun (E : DecidableType). the set is empty. Which element is chosen is unspecified. Equal sets could return different elements. *) - Section Spec. + Section Spec. Variable s s' s'': t. Variable x y : elt. @@ -146,15 +146,15 @@ Module Type WSfun (E : DecidableType). Parameter In_1 : E.eq x y -> In x s -> In y s. (** Specification of [eq] *) - Parameter eq_refl : eq s s. + Parameter eq_refl : eq s s. Parameter eq_sym : eq s s' -> eq s' s. Parameter eq_trans : eq s s' -> eq s' s'' -> eq s s''. (** Specification of [mem] *) Parameter mem_1 : In x s -> mem x s = true. - Parameter mem_2 : mem x s = true -> In x s. - - (** Specification of [equal] *) + Parameter mem_2 : mem x s = true -> In x s. + + (** Specification of [equal] *) Parameter equal_1 : Equal s s' -> equal s s' = true. Parameter equal_2 : equal s s' = true -> Equal s s'. @@ -166,13 +166,13 @@ Module Type WSfun (E : DecidableType). Parameter empty_1 : Empty empty. (** Specification of [is_empty] *) - Parameter is_empty_1 : Empty s -> is_empty s = true. + Parameter is_empty_1 : Empty s -> is_empty s = true. Parameter is_empty_2 : is_empty s = true -> Empty s. - + (** Specification of [add] *) Parameter add_1 : E.eq x y -> In y (add x s). Parameter add_2 : In y s -> In y (add x s). - Parameter add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Parameter add_3 : ~ E.eq x y -> In y (add x s) -> In y s. (** Specification of [remove] *) Parameter remove_1 : E.eq x y -> ~ In y (remove x s). @@ -180,12 +180,12 @@ Module Type WSfun (E : DecidableType). Parameter remove_3 : In y (remove x s) -> In y s. (** Specification of [singleton] *) - Parameter singleton_1 : In y (singleton x) -> E.eq x y. - Parameter singleton_2 : E.eq x y -> In y (singleton x). + Parameter singleton_1 : In y (singleton x) -> E.eq x y. + Parameter singleton_2 : E.eq x y -> In y (singleton x). (** Specification of [union] *) Parameter union_1 : In x (union s s') -> In x s \/ In x s'. - Parameter union_2 : In x s -> In x (union s s'). + Parameter union_2 : In x s -> In x (union s s'). Parameter union_3 : In x s' -> In x (union s s'). (** Specification of [inter] *) @@ -194,24 +194,24 @@ Module Type WSfun (E : DecidableType). Parameter inter_3 : In x s -> In x s' -> In x (inter s s'). (** Specification of [diff] *) - Parameter diff_1 : In x (diff s s') -> In x s. + Parameter diff_1 : In x (diff s s') -> In x s. Parameter diff_2 : In x (diff s s') -> ~ In x s'. Parameter diff_3 : In x s -> ~ In x s' -> In x (diff s s'). - - (** Specification of [fold] *) + + (** Specification of [fold] *) Parameter fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. - (** Specification of [cardinal] *) + (** Specification of [cardinal] *) Parameter cardinal_1 : cardinal s = length (elements s). Section Filter. - + Variable f : elt -> bool. (** Specification of [filter] *) - Parameter filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. - Parameter filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Parameter filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Parameter filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Parameter filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). @@ -243,7 +243,7 @@ Module Type WSfun (E : DecidableType). (** Specification of [elements] *) Parameter elements_1 : In x s -> InA E.eq x (elements s). Parameter elements_2 : InA E.eq x (elements s) -> In x s. - (** When compared with ordered sets, here comes the only + (** When compared with ordered sets, here comes the only property that is really weaker: *) Parameter elements_3w : NoDupA E.eq (elements s). @@ -257,11 +257,11 @@ Module Type WSfun (E : DecidableType). is_empty_1 choose_1 choose_2 add_1 add_2 remove_1 remove_2 singleton_2 union_1 union_2 union_3 inter_3 diff_3 fold_1 filter_3 for_all_1 exists_1 - partition_1 partition_2 elements_1 elements_3w + partition_1 partition_2 elements_1 elements_3w : set. Hint Immediate In_1 mem_2 equal_2 subset_2 is_empty_2 add_3 remove_3 singleton_1 inter_1 inter_2 diff_1 diff_2 - filter_1 filter_2 for_all_2 exists_2 elements_2 + filter_1 filter_2 for_all_2 exists_2 elements_2 : set. End WSfun. @@ -270,7 +270,7 @@ End WSfun. (** ** Static signature for weak sets - Similar to the functorial signature [SW], except that the + Similar to the functorial signature [SW], except that the module [E] of base elements is incorporated in the signature. *) Module Type WS. @@ -295,48 +295,48 @@ Module Type Sfun (E : OrderedType). Parameter min_elt : t -> option elt. (** Return the smallest element of the given set - (with respect to the [E.compare] ordering), + (with respect to the [E.compare] ordering), or [None] if the set is empty. *) Parameter max_elt : t -> option elt. (** Same as [min_elt], but returns the largest element of the given set. *) - Section Spec. + Section Spec. Variable s s' s'' : t. Variable x y : elt. - + (** Specification of [lt] *) Parameter lt_trans : lt s s' -> lt s' s'' -> lt s s''. Parameter lt_not_eq : lt s s' -> ~ eq s s'. (** Additional specification of [elements] *) - Parameter elements_3 : sort E.lt (elements s). + Parameter elements_3 : sort E.lt (elements s). (** Remark: since [fold] is specified via [elements], this stronger - specification of [elements] has an indirect impact on [fold], + specification of [elements] has an indirect impact on [fold], which can now be proved to receive elements in increasing order. *) (** Specification of [min_elt] *) - Parameter min_elt_1 : min_elt s = Some x -> In x s. - Parameter min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. + Parameter min_elt_1 : min_elt s = Some x -> In x s. + Parameter min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Parameter min_elt_3 : min_elt s = None -> Empty s. - (** Specification of [max_elt] *) - Parameter max_elt_1 : max_elt s = Some x -> In x s. - Parameter max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. + (** Specification of [max_elt] *) + Parameter max_elt_1 : max_elt s = Some x -> In x s. + Parameter max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Parameter max_elt_3 : max_elt s = None -> Empty s. (** Additional specification of [choose] *) - Parameter choose_3 : choose s = Some x -> choose s' = Some y -> + Parameter choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. End Spec. Hint Resolve elements_3 : set. - Hint Immediate + Hint Immediate min_elt_1 min_elt_2 min_elt_3 max_elt_1 max_elt_2 max_elt_3 : set. End Sfun. @@ -344,7 +344,7 @@ End Sfun. (** ** Static signature for sets on ordered elements - Similar to the functorial signature [Sfun], except that the + Similar to the functorial signature [Sfun], except that the module [E] of base elements is incorporated in the signature. *) Module Type S. @@ -411,7 +411,7 @@ Module Type Sdep. Parameter singleton : forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}. - + Parameter remove : forall (x : elt) (s : t), @@ -433,7 +433,7 @@ Module Type Sdep. {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}. Parameter equal : forall s s' : t, {s[=]s'} + {~ s[=]s'}. - + Parameter subset : forall s s' : t, {Subset s s'} + {~ Subset s s'}. Parameter @@ -447,7 +447,7 @@ Module Type Sdep. forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}. - + Parameter exists_ : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) @@ -474,7 +474,7 @@ Module Type Sdep. Parameter fold : forall (A : Type) (f : elt -> A -> A) (s : t) (i : A), - {r : A | let (l,_) := elements s in + {r : A | let (l,_) := elements s in r = fold_left (fun a e => f e a) l i}. Parameter @@ -494,10 +494,10 @@ Module Type Sdep. Parameter choose : forall s : t, {x : elt | In x s} + {Empty s}. - (** The [choose_3] specification of [S] cannot be packed + (** The [choose_3] specification of [S] cannot be packed in the dependent version of [choose], so we leave it separate. *) - Parameter choose_equal : forall s s', Equal s s' -> - match choose s, choose s' with + Parameter choose_equal : forall s s', Equal s s' -> + match choose s, choose s' with | inleft (exist x _), inleft (exist x' _) => E.eq x x' | inright _, inright _ => True | _, _ => False diff --git a/theories/FSets/FSetList.v b/theories/FSets/FSetList.v index 4e46610bc..eb6f7b222 100644 --- a/theories/FSets/FSetList.v +++ b/theories/FSets/FSetList.v @@ -10,7 +10,7 @@ (** * Finite sets library *) -(** This file proposes an implementation of the non-dependant +(** This file proposes an implementation of the non-dependant interface [FSetInterface.S] using strictly ordered list. *) Require Export FSetInterface. @@ -20,11 +20,11 @@ Unset Strict Implicit. (** * Functions over lists First, we provide sets as lists which are not necessarily sorted. - The specs are proved under the additional condition of being sorted. + The specs are proved under the additional condition of being sorted. And the functions returning sets are proved to preserve this invariant. *) Module Raw (X: OrderedType). - + Module MX := OrderedTypeFacts X. Import MX. @@ -59,7 +59,7 @@ Module Raw (X: OrderedType). end end. - Definition singleton (x : elt) : t := x :: nil. + Definition singleton (x : elt) : t := x :: nil. Fixpoint remove (x : elt) (s : t) {struct s} : t := match s with @@ -70,8 +70,8 @@ Module Raw (X: OrderedType). | EQ _ => l | GT _ => y :: remove x l end - end. - + end. + Fixpoint union (s : t) : t -> t := match s with | nil => fun s' => s' @@ -86,7 +86,7 @@ Module Raw (X: OrderedType). | GT _ => x' :: union_aux l' end end) - end. + end. Fixpoint inter (s : t) : t -> t := match s with @@ -102,8 +102,8 @@ Module Raw (X: OrderedType). | GT _ => inter_aux l' end end) - end. - + end. + Fixpoint diff (s : t) : t -> t := match s with | nil => fun _ => nil @@ -118,8 +118,8 @@ Module Raw (X: OrderedType). | GT _ => diff_aux l' end end) - end. - + end. + Fixpoint equal (s : t) : t -> bool := fun s' : t => match s, s' with @@ -144,31 +144,31 @@ Module Raw (X: OrderedType). | _, _ => false end. - Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : + Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : B -> B := fun i => match s with | nil => i | x :: l => fold f l (f x i) - end. + end. Fixpoint filter (f : elt -> bool) (s : t) {struct s} : t := match s with | nil => nil | x :: l => if f x then x :: filter f l else filter f l - end. + end. Fixpoint for_all (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => true | x :: l => if f x then for_all f l else false - end. - + end. + Fixpoint exists_ (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => false | x :: l => if f x then true else exists_ f l end. - Fixpoint partition (f : elt -> bool) (s : t) {struct s} : + Fixpoint partition (f : elt -> bool) (s : t) {struct s} : t * t := match s with | nil => (nil, nil) @@ -211,7 +211,7 @@ Module Raw (X: OrderedType). Definition Exists (P : elt -> Prop) (s : t) := exists x, In x s /\ P x. Lemma mem_1 : - forall (s : t) (Hs : Sort s) (x : elt), In x s -> mem x s = true. + forall (s : t) (Hs : Sort s) (x : elt), In x s -> mem x s = true. Proof. simple induction s; intros. inversion H. @@ -234,25 +234,25 @@ Module Raw (X: OrderedType). Lemma add_Inf : forall (s : t) (x a : elt), Inf a s -> X.lt a x -> Inf a (add x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion H0; intuition. Qed. Hint Resolve add_Inf. - + Lemma add_sort : forall (s : t) (Hs : Sort s) (x : elt), Sort (add x s). Proof. simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear Hs; auto. - Qed. + Qed. Lemma add_1 : forall (s : t) (Hs : Sort s) (x y : elt), X.eq x y -> In y (add x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); inversion_clear Hs; auto. constructor; apply X.eq_trans with x; auto. @@ -261,7 +261,7 @@ Module Raw (X: OrderedType). Lemma add_2 : forall (s : t) (Hs : Sort s) (x y : elt), In y s -> In y (add x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition. inversion_clear Hs; inversion_clear H0; auto. @@ -271,7 +271,7 @@ Module Raw (X: OrderedType). forall (s : t) (Hs : Sort s) (x y : elt), ~ X.eq x y -> In y (add x s) -> In y s. Proof. - simple induction s. + simple induction s. simpl; inversion_clear 3; auto; order. simpl; intros a l Hrec Hs x y; case (X.compare x a); intros; inversion_clear H0; inversion_clear Hs; auto. @@ -282,7 +282,7 @@ Module Raw (X: OrderedType). Lemma remove_Inf : forall (s : t) (Hs : Sort s) (x a : elt), Inf a s -> Inf a (remove x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear H0; auto. inversion_clear Hs; apply Inf_lt with a; auto. @@ -295,14 +295,14 @@ Module Raw (X: OrderedType). simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear Hs; auto. - Qed. + Qed. Lemma remove_1 : forall (s : t) (Hs : Sort s) (x y : elt), X.eq x y -> ~ In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; red; intros; inversion H0. - simpl; intros; case (X.compare x a); intuition; inversion_clear Hs. + simpl; intros; case (X.compare x a); intuition; inversion_clear Hs. inversion_clear H1. order. generalize (Sort_Inf_In H2 H3 H4); order. @@ -316,23 +316,23 @@ Module Raw (X: OrderedType). forall (s : t) (Hs : Sort s) (x y : elt), ~ X.eq x y -> In y s -> In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.compare x a); intuition; inversion_clear Hs; - inversion_clear H1; auto. + inversion_clear H1; auto. destruct H0; apply X.eq_trans with a; auto. Qed. Lemma remove_3 : forall (s : t) (Hs : Sort s) (x y : elt), In y (remove x s) -> In y s. Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros a l Hrec Hs x y; case (X.compare x a); intuition. inversion_clear Hs; inversion_clear H; auto. constructor 2; apply Hrec with x; auto. Qed. - + Lemma singleton_sort : forall x : elt, Sort (singleton x). Proof. unfold singleton; simpl; auto. @@ -342,12 +342,12 @@ Module Raw (X: OrderedType). Proof. unfold singleton; simpl; intuition. inversion_clear H; auto; inversion H0. - Qed. + Qed. Lemma singleton_2 : forall x y : elt, X.eq x y -> In y (singleton x). Proof. unfold singleton; simpl; auto. - Qed. + Qed. Ltac DoubleInd := simple induction s; @@ -366,15 +366,15 @@ Module Raw (X: OrderedType). case (X.compare x x'); auto. Qed. Hint Resolve union_Inf. - + Lemma union_sort : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (union s s'). Proof. DoubleInd; case (X.compare x x'); intuition; constructor; auto. apply Inf_eq with x'; trivial; apply union_Inf; trivial; apply Inf_eq with x; auto. change (Inf x' (union (x :: l) l')); auto. - Qed. - + Qed. + Lemma union_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x (union s s') -> In x s \/ In x s'. @@ -389,7 +389,7 @@ Module Raw (X: OrderedType). forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x s -> In x (union s s'). Proof. - DoubleInd. + DoubleInd. intros i Hi; case (X.compare x x'); intuition; inversion_clear Hi; auto. Qed. @@ -397,23 +397,23 @@ Module Raw (X: OrderedType). forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x s' -> In x (union s s'). Proof. - DoubleInd. + DoubleInd. intros i Hi; case (X.compare x x'); inversion_clear Hi; intuition. - constructor; apply X.eq_trans with x'; auto. + constructor; apply X.eq_trans with x'; auto. Qed. - + Lemma inter_Inf : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (a : elt), Inf a s -> Inf a s' -> Inf a (inter s s'). Proof. DoubleInd. intros i His His'; inversion His; inversion His'; subst. - case (X.compare x x'); intuition. + case (X.compare x x'); intuition. apply Inf_lt with x; auto. apply H3; auto. apply Inf_lt with x'; auto. Qed. - Hint Resolve inter_Inf. + Hint Resolve inter_Inf. Lemma inter_sort : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (inter s s'). @@ -421,8 +421,8 @@ Module Raw (X: OrderedType). DoubleInd; case (X.compare x x'); auto. constructor; auto. apply Inf_eq with x'; trivial; apply inter_Inf; trivial; apply Inf_eq with x; auto. - Qed. - + Qed. + Lemma inter_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x (inter s s') -> In x s. @@ -455,7 +455,7 @@ Module Raw (X: OrderedType). inversion_clear His; auto; inversion_clear His'; auto. constructor; apply X.eq_trans with x'; auto. - change (In i (inter (x :: l) l')). + change (In i (inter (x :: l) l')). inversion_clear His'; auto. generalize (Sort_Inf_In Hs (cons_leA _ _ _ _ l0) His); order. Qed. @@ -473,14 +473,14 @@ Module Raw (X: OrderedType). apply H10; trivial. apply Inf_lt with x'; auto. Qed. - Hint Resolve diff_Inf. + Hint Resolve diff_Inf. Lemma diff_sort : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (diff s s'). Proof. DoubleInd; case (X.compare x x'); auto. - Qed. - + Qed. + Lemma diff_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt), In x (diff s s') -> In x s. @@ -496,18 +496,18 @@ Module Raw (X: OrderedType). In x (diff s s') -> ~ In x s'. Proof. DoubleInd. - intros; intro Abs; inversion Abs. + intros; intro Abs; inversion Abs. case (X.compare x x'); intuition. inversion_clear H. generalize (Sort_Inf_In Hs' (cons_leA _ _ _ _ l0) H3); order. apply Hrec with (x'::l') x0; auto. - + inversion_clear H3. generalize (Sort_Inf_In H1 H2 (diff_1 H1 H5 H)); order. apply Hrec with l' x0; auto. - - inversion_clear H3. + + inversion_clear H3. generalize (Sort_Inf_In Hs (cons_leA _ _ _ _ l0) (diff_1 Hs H5 H)); order. apply H0 with x0; auto. Qed. @@ -519,7 +519,7 @@ Module Raw (X: OrderedType). DoubleInd. intros i His His'; elim (X.compare x x'); intuition; inversion_clear His; auto. elim His'; constructor; apply X.eq_trans with x; auto. - Qed. + Qed. Lemma equal_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), @@ -539,7 +539,7 @@ Module Raw (X: OrderedType). assert (A : In x (x' :: l')); auto; inversion_clear A. order. generalize (Sort_Inf_In H5 H6 H4); order. - + apply Hrec; intuition; elim (H a); intros. assert (A : In a (x' :: l')); auto; inversion_clear A; auto. generalize (Sort_Inf_In H1 H2 H0); order. @@ -565,8 +565,8 @@ Module Raw (X: OrderedType). elim (Hrec l' H a); intuition; inversion_clear H2; auto. constructor; apply X.eq_trans with x; auto. constructor; apply X.eq_trans with x'; auto. - Qed. - + Qed. + Lemma subset_1 : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Subset s s' -> subset s s' = true. @@ -574,7 +574,7 @@ Module Raw (X: OrderedType). intros s s'; generalize s' s; clear s s'. simple induction s'; unfold Subset. intro s; case s; auto. - intros; elim (H e); intros; assert (A : In e nil); auto; inversion A. + intros; elim (H e); intros; assert (A : In e nil); auto; inversion A. intros x' l' Hrec s; case s. simpl; auto. intros x l Hs Hs'; inversion Hs; inversion Hs'; subst. @@ -583,14 +583,14 @@ Module Raw (X: OrderedType). assert (A : In x (x' :: l')); auto; inversion_clear A. order. generalize (Sort_Inf_In H5 H6 H0); order. - + apply Hrec; intuition. assert (A : In a (x' :: l')); auto; inversion_clear A; auto. generalize (Sort_Inf_In H1 H2 H0); order. apply Hrec; intuition. assert (A : In a (x' :: l')); auto; inversion_clear A; auto. - inversion_clear H0. + inversion_clear H0. order. generalize (Sort_Inf_In H1 H2 H4); order. Qed. @@ -604,13 +604,13 @@ Module Raw (X: OrderedType). intros x' l' Hrec s; case s. intros; inversion H0. intros x l; simpl; case (X.compare x); intros; auto. - discriminate H. + discriminate H. inversion_clear H0. constructor; apply X.eq_trans with x; auto. constructor 2; apply Hrec with l; auto. constructor 2; apply Hrec with (x::l); auto. - Qed. - + Qed. + Lemma empty_sort : Sort empty. Proof. unfold empty; constructor. @@ -619,15 +619,15 @@ Module Raw (X: OrderedType). Lemma empty_1 : Empty empty. Proof. unfold Empty, empty; intuition; inversion H. - Qed. + Qed. Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true. Proof. unfold Empty; intro s; case s; simpl; intuition. elim (H e); auto. Qed. - - Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. + + Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. Proof. unfold Empty; intro s; case s; simpl; intuition; inversion H0. @@ -639,39 +639,39 @@ Module Raw (X: OrderedType). Qed. Lemma elements_2 : forall (s : t) (x : elt), In x (elements s) -> In x s. - Proof. + Proof. unfold elements; auto. Qed. - - Lemma elements_3 : forall (s : t) (Hs : Sort s), Sort (elements s). - Proof. + + Lemma elements_3 : forall (s : t) (Hs : Sort s), Sort (elements s). + Proof. unfold elements; auto. Qed. - Lemma elements_3w : forall (s : t) (Hs : Sort s), NoDupA X.eq (elements s). - Proof. + Lemma elements_3w : forall (s : t) (Hs : Sort s), NoDupA X.eq (elements s). + Proof. unfold elements; auto. Qed. - Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. + Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. Proof. intro s; case s; simpl; intros; inversion H; auto. - Qed. + Qed. Lemma min_elt_2 : forall (s : t) (Hs : Sort s) (x y : elt), - min_elt s = Some x -> In y s -> ~ X.lt y x. + min_elt s = Some x -> In y s -> ~ X.lt y x. Proof. simple induction s; simpl. intros; inversion H. - intros a l; case l; intros; inversion H0; inversion_clear H1; subst. + intros a l; case l; intros; inversion H0; inversion_clear H1; subst. order. inversion H2. order. inversion_clear Hs. inversion_clear H3. generalize (H H1 e y (refl_equal (Some e)) H2); order. - Qed. + Qed. Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s. Proof. @@ -679,8 +679,8 @@ Module Raw (X: OrderedType). inversion H; inversion H0. Qed. - Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. - Proof. + Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. + Proof. simple induction s; simpl. intros; inversion H. intros x l; case l; simpl. @@ -689,10 +689,10 @@ Module Raw (X: OrderedType). intros. constructor 2; apply (H _ H0). Qed. - + Lemma max_elt_2 : forall (s : t) (Hs : Sort s) (x y : elt), - max_elt s = Some x -> In y s -> ~ X.lt x y. + max_elt s = Some x -> In y s -> ~ X.lt x y. Proof. simple induction s; simpl. intros; inversion H. @@ -706,7 +706,7 @@ Module Raw (X: OrderedType). assert (In e (e::l0)) by auto. generalize (H H2 x0 e H0 H1); order. generalize (H H2 x0 y H0 H3); order. - Qed. + Qed. Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s. Proof. @@ -734,7 +734,7 @@ Module Raw (X: OrderedType). rewrite H; auto using min_elt_1. destruct (X.compare x x'); intuition. Qed. - + Lemma fold_1 : forall (s : t) (Hs : Sort s) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. @@ -758,9 +758,9 @@ Module Raw (X: OrderedType). Inf x s -> Inf x (filter f s). Proof. simple induction s; simpl. - intuition. + intuition. intros x l Hrec Hs a f Ha; inversion_clear Hs; inversion_clear Ha. - case (f x). + case (f x). constructor; auto. apply Hrec; auto. apply Inf_lt with x; auto. @@ -774,7 +774,7 @@ Module Raw (X: OrderedType). intros x l Hrec Hs f; inversion_clear Hs. case (f x); auto. constructor; auto. - apply filter_Inf; auto. + apply filter_Inf; auto. Qed. Lemma filter_1 : @@ -793,7 +793,7 @@ Module Raw (X: OrderedType). Lemma filter_2 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x (filter f s) -> f x = true. + compat_bool X.eq f -> In x (filter f s) -> f x = true. Proof. simple induction s; simpl. intros; inversion H0. @@ -802,10 +802,10 @@ Module Raw (X: OrderedType). inversion_clear 2; auto. symmetry; auto. Qed. - + Lemma filter_3 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). + compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). Proof. simple induction s; simpl. intros; inversion H0. @@ -820,9 +820,9 @@ Module Raw (X: OrderedType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. intros; rewrite (H x); auto. @@ -832,11 +832,11 @@ Module Raw (X: OrderedType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. intros; inversion H1. - intros x l Hrec f Hf. - intros A a; intros. + intros x l Hrec f Hf. + intros A a; intros. assert (f x = true). generalize A; case (f x); auto. rewrite H0 in A; simpl in A. @@ -850,9 +850,9 @@ Module Raw (X: OrderedType). Proof. simple induction s; simpl; auto; unfold Exists. intros. - elim H0; intuition. + elim H0; intuition. inversion H2. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. destruct 2 as [a (A1,A2)]. @@ -865,7 +865,7 @@ Module Raw (X: OrderedType). Lemma exists_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold Exists. intros; discriminate. intros x l Hrec f Hf. @@ -880,7 +880,7 @@ Module Raw (X: OrderedType). Inf x s -> Inf x (fst (partition f s)). Proof. simple induction s; simpl. - intuition. + intuition. intros x l Hrec Hs f a Ha; inversion_clear Hs; inversion_clear Ha. generalize (Hrec H f a). case (f x); case (partition f l); simpl. @@ -893,7 +893,7 @@ Module Raw (X: OrderedType). Inf x s -> Inf x (snd (partition f s)). Proof. simple induction s; simpl. - intuition. + intuition. intros x l Hrec Hs f a Ha; inversion_clear Hs; inversion_clear Ha. generalize (Hrec H f a). case (f x); case (partition f l); simpl. @@ -910,7 +910,7 @@ Module Raw (X: OrderedType). generalize (Hrec H f); generalize (partition_Inf_1 H f). case (f x); case (partition f l); simpl; auto. Qed. - + Lemma partition_sort_2 : forall (s : t) (Hs : Sort s) (f : elt -> bool), Sort (snd (partition f s)). Proof. @@ -935,7 +935,7 @@ Module Raw (X: OrderedType). constructor 2; rewrite <- H; auto. constructor 2; rewrite H; auto. Qed. - + Lemma partition_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> @@ -943,7 +943,7 @@ Module Raw (X: OrderedType). Proof. simple induction s; simpl; auto; unfold Equal. split; auto. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. destruct (partition f l) as [s1 s2]; simpl; intros. case (f x); simpl; auto. @@ -951,21 +951,21 @@ Module Raw (X: OrderedType). constructor 2; rewrite <- H; auto. constructor 2; rewrite H; auto. Qed. - + Definition eq : t -> t -> Prop := Equal. - Lemma eq_refl : forall s : t, eq s s. - Proof. + Lemma eq_refl : forall s : t, eq s s. + Proof. unfold eq, Equal; intuition. Qed. Lemma eq_sym : forall s s' : t, eq s s' -> eq s' s. - Proof. + Proof. unfold eq, Equal; intros; destruct (H a); intuition. Qed. Lemma eq_trans : forall s s' s'' : t, eq s s' -> eq s' s'' -> eq s s''. - Proof. + Proof. unfold eq, Equal; intros; destruct (H a); destruct (H0 a); intuition. Qed. @@ -977,29 +977,29 @@ Module Raw (X: OrderedType). forall (x y : elt) (s s' : t), X.eq x y -> lt s s' -> lt (x :: s) (y :: s'). Hint Constructors lt. - + Lemma lt_trans : forall s s' s'' : t, lt s s' -> lt s' s'' -> lt s s''. - Proof. + Proof. intros s s' s'' H; generalize s''; clear s''; elim H. intros x l s'' H'; inversion_clear H'; auto. - intros x x' l l' E s'' H'; inversion_clear H'; auto. + intros x x' l l' E s'' H'; inversion_clear H'; auto. constructor; apply X.lt_trans with x'; auto. constructor; apply lt_eq with x'; auto. intros. inversion_clear H3. constructor; apply eq_lt with y; auto. - constructor 3; auto; apply X.eq_trans with y; auto. - Qed. + constructor 3; auto; apply X.eq_trans with y; auto. + Qed. Lemma lt_not_eq : forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), lt s s' -> ~ eq s s'. - Proof. - unfold eq, Equal. + Proof. + unfold eq, Equal. intros s s' Hs Hs' H; generalize Hs Hs'; clear Hs Hs'; elim H; intros; intro. elim (H0 x); intros. assert (X : In x nil); auto; inversion X. inversion_clear Hs; inversion_clear Hs'. - elim (H1 x); intros. + elim (H1 x); intros. assert (X : In x (y :: s'0)); auto; inversion_clear X. order. generalize (Sort_Inf_In H4 H5 H8); order. @@ -1019,8 +1019,8 @@ Module Raw (X: OrderedType). forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Compare lt eq s s'. Proof. simple induction s. - intros; case s'. - constructor 2; apply eq_refl. + intros; case s'. + constructor 2; apply eq_refl. constructor 1; auto. intros a l Hrec s'; case s'. constructor 3; auto. @@ -1039,25 +1039,25 @@ Module Raw (X: OrderedType). destruct (e1 a0); auto. Defined. - End ForNotations. + End ForNotations. Hint Constructors lt. End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we + Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of strictly ordered lists. *) Module Make (X: OrderedType) <: S with Module E := X. - Module Raw := Raw X. + Module Raw := Raw X. Module E := X. Record slist := {this :> Raw.t; sorted : sort E.lt this}. - Definition t := slist. + Definition t := slist. Definition elt := E.t. - + Definition In (x : elt) (s : t) : Prop := InA E.eq x s.(this). Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. @@ -1070,12 +1070,12 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition remove (x : elt)(s : t) : t := Build_slist (Raw.remove_sort (sorted s) x). Definition singleton (x : elt) : t := Build_slist (Raw.singleton_sort x). Definition union (s s' : t) : t := - Build_slist (Raw.union_sort (sorted s) (sorted s')). + Build_slist (Raw.union_sort (sorted s) (sorted s')). Definition inter (s s' : t) : t := - Build_slist (Raw.inter_sort (sorted s) (sorted s')). + Build_slist (Raw.inter_sort (sorted s) (sorted s')). Definition diff (s s' : t) : t := - Build_slist (Raw.diff_sort (sorted s) (sorted s')). - Definition equal (s s' : t) : bool := Raw.equal s s'. + Build_slist (Raw.diff_sort (sorted s) (sorted s')). + Definition equal (s s' : t) : bool := Raw.equal s s'. Definition subset (s s' : t) : bool := Raw.subset s s'. Definition empty : t := Build_slist Raw.empty_sort. Definition is_empty (s : t) : bool := Raw.is_empty s. @@ -1083,7 +1083,7 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition min_elt (s : t) : option elt := Raw.min_elt s. Definition max_elt (s : t) : option elt := Raw.max_elt s. Definition choose (s : t) : option elt := Raw.choose s. - Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. + Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. Definition cardinal (s : t) : nat := Raw.cardinal s. Definition filter (f : elt -> bool) (s : t) : t := Build_slist (Raw.filter_sort (sorted s) f). @@ -1096,18 +1096,18 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition eq (s s' : t) : Prop := Raw.eq s s'. Definition lt (s s' : t) : Prop := Raw.lt s s'. - Section Spec. + Section Spec. Variable s s' s'': t. Variable x y : elt. - Lemma In_1 : E.eq x y -> In x s -> In y s. + Lemma In_1 : E.eq x y -> In x s -> In y s. Proof. exact (fun H H' => Raw.MX.In_eq H H'). Qed. - + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (fun H => Raw.mem_1 s.(sorted) H). Qed. - Lemma mem_2 : mem x s = true -> In x s. + Lemma mem_2 : mem x s = true -> In x s. Proof. exact (fun H => Raw.mem_2 H). Qed. - + Lemma equal_1 : Equal s s' -> equal s s' = true. Proof. exact (Raw.equal_1 s.(sorted) s'.(sorted)). Qed. Lemma equal_2 : equal s s' = true -> Equal s s'. @@ -1121,16 +1121,16 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma empty_1 : Empty empty. Proof. exact Raw.empty_1. Qed. - Lemma is_empty_1 : Empty s -> is_empty s = true. + Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (fun H => Raw.is_empty_1 H). Qed. Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (fun H => Raw.is_empty_2 H). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. exact (fun H => Raw.add_1 s.(sorted) H). Qed. Lemma add_2 : In y s -> In y (add x s). Proof. exact (fun H => Raw.add_2 s.(sorted) x H). Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. exact (fun H => Raw.add_3 s.(sorted) H). Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -1140,14 +1140,14 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. exact (fun H => Raw.remove_3 s.(sorted) H). Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (fun H => Raw.singleton_1 H). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (fun H => Raw.singleton_2 H). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. exact (fun H => Raw.union_1 s.(sorted) s'.(sorted) H). Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. exact (fun H => Raw.union_2 s.(sorted) s'.(sorted) H). Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. exact (fun H => Raw.union_3 s.(sorted) s'.(sorted) H). Qed. @@ -1159,13 +1159,13 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. exact (fun H => Raw.inter_3 s.(sorted) s'.(sorted) H). Qed. - Lemma diff_1 : In x (diff s s') -> In x s. + Lemma diff_1 : In x (diff s s') -> In x s. Proof. exact (fun H => Raw.diff_1 s.(sorted) s'.(sorted) H). Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. exact (fun H => Raw.diff_2 s.(sorted) s'.(sorted) H). Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. exact (fun H => Raw.diff_3 s.(sorted) s'.(sorted) H). Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. exact (Raw.fold_1 s.(sorted)). Qed. @@ -1174,12 +1174,12 @@ Module Make (X: OrderedType) <: S with Module E := X. Proof. exact (Raw.cardinal_1 s.(sorted)). Qed. Section Filter. - + Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. Proof. exact (@Raw.filter_1 s x f). Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. exact (@Raw.filter_2 s x f). Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). @@ -1222,16 +1222,16 @@ Module Make (X: OrderedType) <: S with Module E := X. Lemma elements_3w : NoDupA E.eq (elements s). Proof. exact (Raw.elements_3w s.(sorted)). Qed. - Lemma min_elt_1 : min_elt s = Some x -> In x s. + Lemma min_elt_1 : min_elt s = Some x -> In x s. Proof. exact (fun H => Raw.min_elt_1 H). Qed. - Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. + Lemma min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. exact (fun H => Raw.min_elt_2 s.(sorted) H). Qed. Lemma min_elt_3 : min_elt s = None -> Empty s. Proof. exact (fun H => Raw.min_elt_3 H). Qed. - Lemma max_elt_1 : max_elt s = Some x -> In x s. + Lemma max_elt_1 : max_elt s = Some x -> In x s. Proof. exact (fun H => Raw.max_elt_1 H). Qed. - Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. + Lemma max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. exact (fun H => Raw.max_elt_2 s.(sorted) H). Qed. Lemma max_elt_3 : max_elt s = None -> Empty s. Proof. exact (fun H => Raw.max_elt_3 H). Qed. @@ -1240,7 +1240,7 @@ Module Make (X: OrderedType) <: S with Module E := X. Proof. exact (fun H => Raw.choose_1 H). Qed. Lemma choose_2 : choose s = None -> Empty s. Proof. exact (fun H => Raw.choose_2 H). Qed. - Lemma choose_3 : choose s = Some x -> choose s' = Some y -> + Lemma choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. exact (@Raw.choose_3 _ _ s.(sorted) s'.(sorted) x y). Qed. @@ -1259,8 +1259,8 @@ Module Make (X: OrderedType) <: S with Module E := X. Definition compare : Compare lt eq s s'. Proof. elim (Raw.compare s.(sorted) s'.(sorted)); - [ constructor 1 | constructor 2 | constructor 3 ]; - auto. + [ constructor 1 | constructor 2 | constructor 3 ]; + auto. Defined. Definition eq_dec : { eq s s' } + { ~ eq s s' }. diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v index 6a062ea14..032f0c1b3 100644 --- a/theories/FSets/FSetProperties.v +++ b/theories/FSets/FSetProperties.v @@ -11,9 +11,9 @@ (** * Finite sets library *) (** This functor derives additional properties from [FSetInterface.S]. - Contrary to the functor in [FSetEqProperties] it uses + Contrary to the functor in [FSetEqProperties] it uses predicates over sets instead of sets operations, i.e. - [In x s] instead of [mem x s=true], + [In x s] instead of [mem x s=true], [Equal s s'] instead of [equal s s'=true], etc. *) Require Export FSetInterface. @@ -47,7 +47,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). fsetdec. fsetdec. Qed. - + Ltac expAdd := repeat rewrite Add_Equal. Section BasicProperties. @@ -64,7 +64,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma equal_trans : s1[=]s2 -> s2[=]s3 -> s1[=]s3. Proof. fsetdec. Qed. - Lemma subset_refl : s[<=]s. + Lemma subset_refl : s[<=]s. Proof. fsetdec. Qed. Lemma subset_trans : s1[<=]s2 -> s2[<=]s3 -> s1[<=]s3. @@ -84,7 +84,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma subset_diff : s1[<=]s3 -> diff s1 s2 [<=] s3. Proof. fsetdec. Qed. - + Lemma subset_add_3 : In x s2 -> s1[<=]s2 -> add x s1 [<=] s2. Proof. fsetdec. Qed. @@ -93,7 +93,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma in_subset : In x s1 -> s1[<=]s2 -> In x s2. Proof. fsetdec. Qed. - + Lemma double_inclusion : s1[=]s2 <-> s1[<=]s2 /\ s2[<=]s1. Proof. intuition fsetdec. Qed. @@ -105,7 +105,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma add_equal : In x s -> add x s [=] s. Proof. fsetdec. Qed. - + Lemma add_add : add x (add x' s) [=] add x' (add x s). Proof. fsetdec. Qed. @@ -149,11 +149,11 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma union_add : union (add x s) s' [=] add x (union s s'). Proof. fsetdec. Qed. - Lemma union_remove_add_1 : + Lemma union_remove_add_1 : union (remove x s) (add x s') [=] union (add x s) (remove x s'). Proof. fsetdec. Qed. - Lemma union_remove_add_2 : In x s -> + Lemma union_remove_add_2 : In x s -> union (remove x s) (add x s') [=] union s s'. Proof. fsetdec. Qed. @@ -167,10 +167,10 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Proof. fsetdec. Qed. Lemma union_subset_4 : s[<=]s' -> union s s'' [<=] union s' s''. - Proof. fsetdec. Qed. + Proof. fsetdec. Qed. Lemma union_subset_5 : s[<=]s' -> union s'' s [<=] union s'' s'. - Proof. fsetdec. Qed. + Proof. fsetdec. Qed. Lemma empty_union_1 : Empty s -> union s s' [=] s'. Proof. fsetdec. Qed. @@ -178,7 +178,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma empty_union_2 : Empty s -> union s' s [=] s'. Proof. fsetdec. Qed. - Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). + Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). Proof. fsetdec. Qed. Lemma inter_sym : inter s s' [=] inter s' s. @@ -224,7 +224,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). s''[<=]s -> s''[<=]s' -> s''[<=] inter s s'. Proof. fsetdec. Qed. - Lemma empty_diff_1 : Empty s -> Empty (diff s s'). + Lemma empty_diff_1 : Empty s -> Empty (diff s s'). Proof. fsetdec. Qed. Lemma empty_diff_2 : Empty s -> diff s' s [=] s'. @@ -240,7 +240,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). remove x s [=] diff s (singleton x). Proof. fsetdec. Qed. - Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. + Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. Proof. fsetdec. Qed. Lemma diff_inter_all : union (diff s s') (inter s s') [=] s. @@ -249,19 +249,19 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma Add_add : Add x s (add x s). Proof. expAdd; fsetdec. Qed. - Lemma Add_remove : In x s -> Add x (remove x s) s. + Lemma Add_remove : In x s -> Add x (remove x s) s. Proof. expAdd; fsetdec. Qed. Lemma union_Add : Add x s s' -> Add x (union s s'') (union s' s''). - Proof. expAdd; fsetdec. Qed. + Proof. expAdd; fsetdec. Qed. Lemma inter_Add : In x s'' -> Add x s s' -> Add x (inter s s'') (inter s' s''). - Proof. expAdd; fsetdec. Qed. + Proof. expAdd; fsetdec. Qed. Lemma union_Equal : In x s'' -> Add x s s' -> union s s'' [=] union s' s''. - Proof. expAdd; fsetdec. Qed. + Proof. expAdd; fsetdec. Qed. Lemma inter_Add_2 : ~In x s'' -> Add x s s' -> inter s s'' [=] inter s' s''. @@ -270,16 +270,16 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). End BasicProperties. Hint Immediate equal_sym add_remove remove_add union_sym inter_sym: set. - Hint Resolve equal_refl equal_trans subset_refl subset_equal subset_antisym - subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 + Hint Resolve equal_refl equal_trans subset_refl subset_equal subset_antisym + subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 subset_add_2 in_subset empty_is_empty_1 empty_is_empty_2 add_equal - remove_equal singleton_equal_add union_subset_equal union_equal_1 - union_equal_2 union_assoc add_union_singleton union_add union_subset_1 + remove_equal singleton_equal_add union_subset_equal union_equal_1 + union_equal_2 union_assoc add_union_singleton union_add union_subset_1 union_subset_2 union_subset_3 inter_subset_equal inter_equal_1 inter_equal_2 inter_assoc union_inter_1 union_inter_2 inter_add_1 inter_add_2 - empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 - empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union - inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal + empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 + empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union + inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal remove_diff_singleton diff_inter_empty diff_inter_all Add_add Add_remove Equal_remove add_add : set. @@ -504,7 +504,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). generalize H H2; clear H H2; case l; simpl; intros. reflexivity. elim (H e). - elim (H2 e); intuition. + elim (H2 e); intuition. Qed. Lemma fold_2 : @@ -514,17 +514,17 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). transpose eqA f -> ~ In x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)). Proof. - intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); + intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); destruct (fold_0 s' i f) as (l',(Hl', (Hl'1, Hl'2))). rewrite Hl2; rewrite Hl'2; clear Hl2 Hl'2. apply fold_right_add with (eqA:=E.eq)(eqB:=eqA); auto. eauto. rewrite <- Hl1; auto. - intros a; rewrite InA_cons; rewrite <- Hl1; rewrite <- Hl'1; + intros a; rewrite InA_cons; rewrite <- Hl1; rewrite <- Hl'1; rewrite (H2 a); intuition. Qed. - (** In fact, [fold] on empty sets is more than equivalent to + (** In fact, [fold] on empty sets is more than equivalent to the initial element, it is Leibniz-equal to it. *) Lemma fold_1b : @@ -541,7 +541,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). - Lemma fold_commutes : forall i s x, + Lemma fold_commutes : forall i s x, eqA (fold f s (f x i)) (f x (fold f s i)). Proof. intros. @@ -552,15 +552,15 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). (** ** Fold is a morphism *) - Lemma fold_init : forall i i' s, eqA i i' -> + Lemma fold_init : forall i i' s, eqA i i' -> eqA (fold f s i) (fold f s i'). Proof. intros. apply fold_rel with (R:=eqA); auto. Qed. - Lemma fold_equal : + Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). - Proof. + Proof. intros i s; pattern s; apply set_induction; clear s; intros. transitivity i. apply fold_1; auto. @@ -576,23 +576,23 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). (** ** Fold and other set operators *) Lemma fold_empty : forall i, fold f empty i = i. - Proof. + Proof. intros i; apply fold_1b; auto with set. Qed. - Lemma fold_add : forall i s x, ~In x s -> + Lemma fold_add : forall i s x, ~In x s -> eqA (fold f (add x s) i) (f x (fold f s i)). - Proof. + Proof. intros; apply fold_2 with (eqA := eqA); auto with set. Qed. - Lemma add_fold : forall i s x, In x s -> + Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. - Lemma remove_fold_1: forall i s x, In x s -> + Lemma remove_fold_1: forall i s x, In x s -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros. @@ -600,7 +600,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_2 with (eqA:=eqA); auto with set. Qed. - Lemma remove_fold_2: forall i s x, ~In x s -> + Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. @@ -620,7 +620,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). symmetry; apply fold_1; auto. rename s'0 into s''. destruct (In_dec x s'). - (* In x s' *) + (* In x s' *) transitivity (fold f (union s'' s') (f x (fold f (inter s s') i))); auto with set. apply fold_init; auto. apply fold_2 with (eqA:=eqA); auto with set. @@ -646,7 +646,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). symmetry; apply fold_2 with (eqA:=eqA); auto. Qed. - Lemma fold_diff_inter : forall i s s', + Lemma fold_diff_inter : forall i s s', eqA (fold f (diff s s') (fold f (inter s s') i)) (fold f s i). Proof. intros. @@ -659,7 +659,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_1; auto with set. Qed. - Lemma fold_union: forall i s s', + Lemma fold_union: forall i s s', (forall x, ~(In x s/\In x s')) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. @@ -696,9 +696,9 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Lemma cardinal_0 : forall s, exists l : list elt, NoDupA E.eq l /\ - (forall x : elt, In x s <-> InA E.eq x l) /\ + (forall x : elt, In x s <-> InA E.eq x l) /\ cardinal s = length l. - Proof. + Proof. intros; exists (elements s); intuition; apply cardinal_1. Qed. @@ -724,32 +724,32 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). destruct (elements s); intuition; discriminate. Qed. - Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. + Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. Proof. - intros; rewrite cardinal_Empty; auto. + intros; rewrite cardinal_Empty; auto. Qed. Hint Resolve cardinal_inv_1. - + Lemma cardinal_inv_2 : forall s n, cardinal s = S n -> { x : elt | In x s }. - Proof. + Proof. intros; rewrite M.cardinal_1 in H. generalize (elements_2 (s:=s)). - destruct (elements s); try discriminate. + destruct (elements s); try discriminate. exists e; auto. Qed. Lemma cardinal_inv_2b : forall s, cardinal s <> 0 -> { x : elt | In x s }. Proof. - intro; generalize (@cardinal_inv_2 s); destruct cardinal; + intro; generalize (@cardinal_inv_2 s); destruct cardinal; [intuition|eauto]. Qed. (** ** Cardinal is a morphism *) Lemma Equal_cardinal : forall s s', s[=]s' -> cardinal s = cardinal s'. - Proof. + Proof. symmetry. remember (cardinal s) as n; symmetry in Heqn; revert s s' Heqn H. induction n; intros. @@ -794,8 +794,8 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_diff_inter with (eqA:=@Logic.eq nat); auto. Qed. - Lemma union_cardinal: - forall s s', (forall x, ~(In x s/\In x s')) -> + Lemma union_cardinal: + forall s s', (forall x, ~(In x s/\In x s')) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; do 3 rewrite cardinal_fold. @@ -803,7 +803,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_union; auto. Qed. - Lemma subset_cardinal : + Lemma subset_cardinal : forall s s', s[<=]s' -> cardinal s <= cardinal s' . Proof. intros. @@ -812,9 +812,9 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). rewrite (inter_subset_equal H); auto with arith. Qed. - Lemma subset_cardinal_lt : + Lemma subset_cardinal_lt : forall s s' x, s[<=]s' -> In x s' -> ~In x s -> cardinal s < cardinal s'. - Proof. + Proof. intros. rewrite <- (diff_inter_cardinal s' s). rewrite (inter_sym s' s). @@ -826,7 +826,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). intros _. change (0 + cardinal s < S n + cardinal s). apply Plus.plus_lt_le_compat; auto with arith. - Qed. + Qed. Theorem union_inter_cardinal : forall s s', cardinal (union s s') + cardinal (inter s s') = cardinal s + cardinal s' . @@ -837,7 +837,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply fold_union_inter with (eqA:=@Logic.eq nat); auto. Qed. - Lemma union_cardinal_inter : + Lemma union_cardinal_inter : forall s s', cardinal (union s s') = cardinal s + cardinal s' - cardinal (inter s s'). Proof. intros. @@ -846,17 +846,17 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). auto with arith. Qed. - Lemma union_cardinal_le : + Lemma union_cardinal_le : forall s s', cardinal (union s s') <= cardinal s + cardinal s'. Proof. intros; generalize (union_inter_cardinal s s'). intros; rewrite <- H; auto with arith. Qed. - Lemma add_cardinal_1 : + Lemma add_cardinal_1 : forall s x, In x s -> cardinal (add x s) = cardinal s. Proof. - auto with set. + auto with set. Qed. Lemma add_cardinal_2 : @@ -877,9 +877,9 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). apply remove_fold_1 with (eqA:=@Logic.eq nat); auto. Qed. - Lemma remove_cardinal_2 : + Lemma remove_cardinal_2 : forall s x, ~In x s -> cardinal (remove x s) = cardinal s. - Proof. + Proof. auto with set. Qed. @@ -950,7 +950,7 @@ Module OrdProperties (M:S). Qed. Hint Resolve gtb_compat leb_compat. - Lemma elements_split : forall x s, + Lemma elements_split : forall x s, elements s = elements_lt x s ++ elements_ge x s. Proof. unfold elements_lt, elements_ge, leb; intros. @@ -964,8 +964,8 @@ Module OrdProperties (M:S). ME.order. Qed. - Lemma elements_Add : forall s s' x, ~In x s -> Add x s s' -> - eqlistA E.eq (elements s') (elements_lt x s ++ x :: elements_ge x s). + Lemma elements_Add : forall s s' x, ~In x s -> Add x s s' -> + eqlistA E.eq (elements s') (elements_lt x s ++ x :: elements_ge x s). Proof. intros; unfold elements_ge, elements_lt. apply sort_equivlistA_eqlistA; auto with set. @@ -1003,8 +1003,8 @@ Module OrdProperties (M:S). Definition Above x s := forall y, In y s -> E.lt y x. Definition Below x s := forall y, In y s -> E.lt x y. - Lemma elements_Add_Above : forall s s' x, - Above x s -> Add x s s' -> + Lemma elements_Add_Above : forall s s' x, + Above x s -> Add x s s' -> eqlistA E.eq (elements s') (elements s ++ x::nil). Proof. intros. @@ -1020,8 +1020,8 @@ Module OrdProperties (M:S). do 2 rewrite <- elements_iff; rewrite (H0 a); intuition. Qed. - Lemma elements_Add_Below : forall s s' x, - Below x s -> Add x s s' -> + Lemma elements_Add_Below : forall s s' x, + Below x s -> Add x s s' -> eqlistA E.eq (elements s') (x::elements s). Proof. intros. @@ -1038,7 +1038,7 @@ Module OrdProperties (M:S). do 2 rewrite <- elements_iff; rewrite (H0 a); intuition. Qed. - (** Two other induction principles on sets: we can be more restrictive + (** Two other induction principles on sets: we can be more restrictive on the element we add at each step. *) Lemma set_induction_max : @@ -1119,15 +1119,15 @@ Module OrdProperties (M:S). apply elements_Add_Below; auto. Qed. - (** The following results have already been proved earlier, + (** The following results have already been proved earlier, but we can now prove them with one hypothesis less: no need for [(transpose eqA f)]. *) - Section FoldOpt. + Section FoldOpt. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f). - Lemma fold_equal : + Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). Proof. intros; do 2 rewrite M.fold_1. @@ -1138,13 +1138,13 @@ Module OrdProperties (M:S). red; intro a; do 2 rewrite <- elements_iff; auto. Qed. - Lemma add_fold : forall i s x, In x s -> + Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. - Lemma remove_fold_2: forall i s x, ~In x s -> + Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. @@ -1155,16 +1155,16 @@ Module OrdProperties (M:S). (** An alternative version of [choose_3] *) - Lemma choose_equal : forall s s', Equal s s' -> - match choose s, choose s' with + Lemma choose_equal : forall s s', Equal s s' -> + match choose s, choose s' with | Some x, Some x' => E.eq x x' | None, None => True | _, _ => False end. Proof. - intros s s' H; + intros s s' H; generalize (@choose_1 s)(@choose_2 s) - (@choose_1 s')(@choose_2 s')(@choose_3 s s'); + (@choose_1 s')(@choose_2 s')(@choose_3 s s'); destruct (choose s); destruct (choose s'); simpl; intuition. apply H5 with e; rewrite <-H; auto. apply H5 with e; rewrite H; auto. diff --git a/theories/FSets/FSetToFiniteSet.v b/theories/FSets/FSetToFiniteSet.v index 7938beda7..23420109c 100644 --- a/theories/FSets/FSetToFiniteSet.v +++ b/theories/FSets/FSetToFiniteSet.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -16,14 +16,14 @@ Require Import Ensembles Finite_sets. Require Import FSetInterface FSetProperties OrderedTypeEx DecidableTypeEx. -(** * Going from [FSets] with usual Leibniz equality +(** * Going from [FSets] with usual Leibniz equality to the good old [Ensembles] and [Finite_sets] theory. *) Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). Module MP:= WProperties_fun U M. Import M MP FM Ensembles Finite_sets. - Definition mkEns : M.t -> Ensemble M.elt := + Definition mkEns : M.t -> Ensemble M.elt := fun s x => M.In x s. Notation " !! " := mkEns. @@ -115,11 +115,11 @@ Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). Proof. intro s; pattern s; apply set_induction; clear s; intros. intros; replace (!!s) with (Empty_set elt); auto with sets. - symmetry; apply Extensionality_Ensembles. + symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. replace (!!s') with (Add _ (!!s) x). constructor 2; auto. - symmetry; apply Extensionality_Ensembles. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. @@ -128,18 +128,18 @@ Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). intro s; pattern s; apply set_induction; clear s; intros. intros; replace (!!s) with (Empty_set elt); auto with sets. rewrite cardinal_1; auto with sets. - symmetry; apply Extensionality_Ensembles. + symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. replace (!!s') with (Add _ (!!s) x). - rewrite (cardinal_2 H0 H1); auto with sets. - symmetry; apply Extensionality_Ensembles. + rewrite (cardinal_2 H0 H1); auto with sets. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. - (** we can even build a function from Finite Ensemble to FSet + (** we can even build a function from Finite Ensemble to FSet ... at least in Prop. *) - Lemma Ens_to_FSet : forall e : Ensemble M.elt, Finite _ e -> + Lemma Ens_to_FSet : forall e : Ensemble M.elt, Finite _ e -> exists s:M.t, !!s === e. Proof. induction 1. @@ -147,7 +147,7 @@ Module WS_to_Finite_set (U:UsualDecidableType)(M: WSfun U). apply empty_Empty_Set. destruct IHFinite as (s,Hs). exists (M.add x s). - apply Extensionality_Ensembles in Hs. + apply Extensionality_Ensembles in Hs. rewrite <- Hs. apply add_Add. Qed. diff --git a/theories/FSets/FSetWeakList.v b/theories/FSets/FSetWeakList.v index d03e3bdc8..7a3e60d38 100644 --- a/theories/FSets/FSetWeakList.v +++ b/theories/FSets/FSetWeakList.v @@ -10,7 +10,7 @@ (** * Finite sets library *) -(** This file proposes an implementation of the non-dependant +(** This file proposes an implementation of the non-dependant interface [FSetWeakInterface.S] using lists without redundancy. *) Require Import FSetInterface. @@ -20,7 +20,7 @@ Unset Strict Implicit. (** * Functions over lists First, we provide sets as lists which are (morally) without redundancy. - The specs are proved under the additional condition of no redundancy. + The specs are proved under the additional condition of no redundancy. And the functions returning sets are proved to preserve this invariant. *) Module Raw (X: DecidableType). @@ -48,7 +48,7 @@ Module Raw (X: DecidableType). if X.eq_dec x y then s else y :: add x l end. - Definition singleton (x : elt) : t := x :: nil. + Definition singleton (x : elt) : t := x :: nil. Fixpoint remove (x : elt) (s : t) {struct s} : t := match s with @@ -57,42 +57,42 @@ Module Raw (X: DecidableType). if X.eq_dec x y then l else y :: remove x l end. - Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : + Fixpoint fold (B : Type) (f : elt -> B -> B) (s : t) {struct s} : B -> B := fun i => match s with | nil => i | x :: l => fold f l (f x i) - end. + end. Definition union (s : t) : t -> t := fold add s. - + Definition diff (s s' : t) : t := fold remove s' s. - Definition inter (s s': t) : t := + Definition inter (s s': t) : t := fold (fun x s => if mem x s' then add x s else s) s nil. Definition subset (s s' : t) : bool := is_empty (diff s s'). - Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s). + Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s). Fixpoint filter (f : elt -> bool) (s : t) {struct s} : t := match s with | nil => nil | x :: l => if f x then x :: filter f l else filter f l - end. + end. Fixpoint for_all (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => true | x :: l => if f x then for_all f l else false - end. - + end. + Fixpoint exists_ (f : elt -> bool) (s : t) {struct s} : bool := match s with | nil => false | x :: l => if f x then true else exists_ f l end. - Fixpoint partition (f : elt -> bool) (s : t) {struct s} : + Fixpoint partition (f : elt -> bool) (s : t) {struct s} : t * t := match s with | nil => (nil, nil) @@ -105,14 +105,14 @@ Module Raw (X: DecidableType). Definition elements (s : t) : list elt := s. - Definition choose (s : t) : option elt := - match s with + Definition choose (s : t) : option elt := + match s with | nil => None | x::_ => Some x end. (** ** Proofs of set operation specifications. *) - Section ForNotations. + Section ForNotations. Notation NoDup := (NoDupA X.eq). Notation In := (InA X.eq). @@ -130,7 +130,7 @@ Module Raw (X: DecidableType). Hint Immediate In_eq. Lemma mem_1 : - forall (s : t)(x : elt), In x s -> mem x s = true. + forall (s : t)(x : elt), In x s -> mem x s = true. Proof. induction s; intros. inversion H. @@ -140,7 +140,7 @@ Module Raw (X: DecidableType). Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s. Proof. - induction s. + induction s. intros; inversion H. intros x; simpl. destruct (X.eq_dec x a); firstorder; discriminate. @@ -149,7 +149,7 @@ Module Raw (X: DecidableType). Lemma add_1 : forall (s : t) (Hs : NoDup s) (x y : elt), X.eq x y -> In y (add x s). Proof. - induction s. + induction s. simpl; intuition. simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs; firstorder. @@ -159,7 +159,7 @@ Module Raw (X: DecidableType). Lemma add_2 : forall (s : t) (Hs : NoDup s) (x y : elt), In y s -> In y (add x s). Proof. - induction s. + induction s. simpl; intuition. simpl; intros; case (X.eq_dec x a); intuition. inversion_clear Hs; eauto; inversion_clear H; intuition. @@ -169,18 +169,18 @@ Module Raw (X: DecidableType). forall (s : t) (Hs : NoDup s) (x y : elt), ~ X.eq x y -> In y (add x s) -> In y s. Proof. - induction s. + induction s. simpl; intuition. inversion_clear H0; firstorder; absurd (X.eq x y); auto. simpl; intros Hs x y; case (X.eq_dec x a); intros; - inversion_clear H0; inversion_clear Hs; firstorder; + inversion_clear H0; inversion_clear Hs; firstorder; absurd (X.eq x y); auto. Qed. Lemma add_unique : forall (s : t) (Hs : NoDup s)(x:elt), NoDup (add x s). Proof. - induction s. + induction s. simpl; intuition. constructor; auto. intro H0; inversion H0. @@ -197,9 +197,9 @@ Module Raw (X: DecidableType). Lemma remove_1 : forall (s : t) (Hs : NoDup s) (x y : elt), X.eq x y -> ~ In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; red; intros; inversion H0. - simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs. + simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs. elim H2. apply In_eq with y; eauto. inversion_clear H1; eauto. @@ -209,17 +209,17 @@ Module Raw (X: DecidableType). forall (s : t) (Hs : NoDup s) (x y : elt), ~ X.eq x y -> In y s -> In y (remove x s). Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs; - inversion_clear H1; auto. - absurd (X.eq x y); eauto. + inversion_clear H1; auto. + absurd (X.eq x y); eauto. Qed. Lemma remove_3 : forall (s : t) (Hs : NoDup s) (x y : elt), In y (remove x s) -> In y s. Proof. - simple induction s. + simple induction s. simpl; intuition. simpl; intros a l Hrec Hs x y; case (X.eq_dec x a); intuition. inversion_clear Hs; inversion_clear H; firstorder. @@ -235,7 +235,7 @@ Module Raw (X: DecidableType). constructor; auto. intro H2; elim H0. eapply remove_3; eauto. - Qed. + Qed. Lemma singleton_unique : forall x : elt, NoDup (singleton x). Proof. @@ -246,13 +246,13 @@ Module Raw (X: DecidableType). Proof. unfold singleton; simpl; intuition. inversion_clear H; auto; inversion H0. - Qed. + Qed. Lemma singleton_2 : forall x y : elt, X.eq x y -> In y (singleton x). Proof. unfold singleton; simpl; intuition. - Qed. - + Qed. + Lemma empty_unique : NoDup empty. Proof. unfold empty; constructor. @@ -261,15 +261,15 @@ Module Raw (X: DecidableType). Lemma empty_1 : Empty empty. Proof. unfold Empty, empty; intuition; inversion H. - Qed. + Qed. Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true. Proof. unfold Empty; intro s; case s; simpl; intuition. elim (H e); auto. Qed. - - Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. + + Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. Proof. unfold Empty; intro s; case s; simpl; intuition; inversion H0. @@ -281,12 +281,12 @@ Module Raw (X: DecidableType). Qed. Lemma elements_2 : forall (s : t) (x : elt), In x (elements s) -> In x s. - Proof. + Proof. unfold elements; auto. Qed. - - Lemma elements_3w : forall (s : t) (Hs : NoDup s), NoDup (elements s). - Proof. + + Lemma elements_3w : forall (s : t) (Hs : NoDup s), NoDup (elements s). + Proof. unfold elements; auto. Qed. @@ -306,7 +306,7 @@ Module Raw (X: DecidableType). apply IHs; auto. apply add_unique; auto. Qed. - + Lemma union_1 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (union s s') -> In x s \/ In x s'. @@ -319,7 +319,7 @@ Module Raw (X: DecidableType). right; eapply add_3; eauto. Qed. - Lemma union_0 : + Lemma union_0 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x s \/ In x s' -> In x (union s s'). Proof. @@ -355,14 +355,14 @@ Module Raw (X: DecidableType). unfold inter; intros s. set (acc := nil (A:=elt)). assert (NoDup acc) by (unfold acc; auto). - clearbody acc; generalize H; clear H; generalize acc; clear acc. + clearbody acc; generalize H; clear H; generalize acc; clear acc. induction s; simpl; auto; intros. inversion_clear Hs. apply IHs; auto. destruct (mem a s'); intros; auto. apply add_unique; auto. - Qed. - + Qed. + Lemma inter_0 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (inter s s') -> In x s /\ In x s'. @@ -373,7 +373,7 @@ Module Raw (X: DecidableType). cut ((In x s /\ In x s') \/ In x acc). destruct 1; auto. inversion H1. - clearbody acc. + clearbody acc. generalize H0 H Hs' Hs; clear H0 H Hs Hs'. generalize acc x s'; clear acc x s'. induction s; simpl; auto; intros. @@ -414,7 +414,7 @@ Module Raw (X: DecidableType). unfold inter. set (acc := nil (A:=elt)) in *. assert (NoDup acc) by (unfold acc; auto). - clearbody acc. + clearbody acc. generalize H Hs' Hs; clear H Hs Hs'. generalize acc x s'; clear acc x s'. induction s; simpl; auto; intros. @@ -446,8 +446,8 @@ Module Raw (X: DecidableType). inversion_clear Hs'. apply IHs'; auto. apply remove_unique; auto. - Qed. - + Qed. + Lemma diff_0 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (diff s s') -> In x s /\ ~ In x s'. @@ -458,7 +458,7 @@ Module Raw (X: DecidableType). split; auto; intro H1; inversion H1. inversion_clear Hs'. destruct (IHs' (remove a s) (remove_unique Hs a) H1 x H). - split. + split. eapply remove_3; eauto. red; intros. inversion_clear H4; auto. @@ -469,14 +469,14 @@ Module Raw (X: DecidableType). forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (diff s s') -> In x s. Proof. - intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. + intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. Qed. Lemma diff_2 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt), In x (diff s s') -> ~ In x s'. Proof. - intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. + intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. Qed. Lemma diff_3 : @@ -489,8 +489,8 @@ Module Raw (X: DecidableType). apply IHs'; auto. apply remove_unique; auto. apply remove_2; auto. - Qed. - + Qed. + Lemma subset_1 : forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s'), Subset s s' -> subset s s' = true. @@ -504,7 +504,7 @@ Module Raw (X: DecidableType). eapply diff_1; eauto. Qed. - Lemma subset_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), + Lemma subset_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), subset s s' = true -> Subset s s'. Proof. unfold subset, Subset; intros. @@ -524,26 +524,26 @@ Module Raw (X: DecidableType). apply andb_true_intro; split; apply subset_1; firstorder. Qed. - Lemma equal_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), + Lemma equal_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), equal s s' = true -> Equal s s'. Proof. unfold Equal, equal; intros. destruct (andb_prop _ _ H); clear H. split; apply subset_2; auto. - Qed. + Qed. Definition choose_1 : forall (s : t) (x : elt), choose s = Some x -> In x s. Proof. destruct s; simpl; intros; inversion H; auto. - Qed. + Qed. Definition choose_2 : forall s : t, choose s = None -> Empty s. Proof. destruct s; simpl; intros. intros x H0; inversion H0. inversion H. - Qed. + Qed. Lemma cardinal_1 : forall (s : t) (Hs : NoDup s), cardinal s = length (elements s). @@ -567,7 +567,7 @@ Module Raw (X: DecidableType). Lemma filter_2 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x (filter f s) -> f x = true. + compat_bool X.eq f -> In x (filter f s) -> f x = true. Proof. simple induction s; simpl. intros; inversion H0. @@ -576,10 +576,10 @@ Module Raw (X: DecidableType). inversion_clear 2; auto. symmetry; auto. Qed. - + Lemma filter_3 : forall (s : t) (x : elt) (f : elt -> bool), - compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). + compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s). Proof. simple induction s; simpl. intros; inversion H0. @@ -607,9 +607,9 @@ Module Raw (X: DecidableType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. intros; rewrite (H x); auto. @@ -619,11 +619,11 @@ Module Raw (X: DecidableType). forall (s : t) (f : elt -> bool), compat_bool X.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold For_all. intros; inversion H1. - intros x l Hrec f Hf. - intros A a; intros. + intros x l Hrec f Hf. + intros A a; intros. assert (f x = true). generalize A; case (f x); auto. rewrite H0 in A; simpl in A. @@ -637,9 +637,9 @@ Module Raw (X: DecidableType). Proof. simple induction s; simpl; auto; unfold Exists. intros. - elim H0; intuition. + elim H0; intuition. inversion H2. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hf x); case (f x); simpl. auto. destruct 2 as [a (A1,A2)]. @@ -652,7 +652,7 @@ Module Raw (X: DecidableType). Lemma exists_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. - Proof. + Proof. simple induction s; simpl; auto; unfold Exists. intros; discriminate. intros x l Hrec f Hf. @@ -671,9 +671,9 @@ Module Raw (X: DecidableType). intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. case (partition f l); intros s1 s2; simpl; intros. - case (f x); simpl; firstorder; inversion H0; intros; firstorder. + case (f x); simpl; firstorder; inversion H0; intros; firstorder. Qed. - + Lemma partition_2 : forall (s : t) (f : elt -> bool), compat_bool X.eq f -> @@ -681,14 +681,14 @@ Module Raw (X: DecidableType). Proof. simple induction s; simpl; auto; unfold Equal. firstorder. - intros x l Hrec f Hf. + intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. case (partition f l); intros s1 s2; simpl; intros. - case (f x); simpl; firstorder; inversion H0; intros; firstorder. + case (f x); simpl; firstorder; inversion H0; intros; firstorder. Qed. - Lemma partition_aux_1 : - forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), + Lemma partition_aux_1 : + forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), In x (fst (partition f s)) -> In x s. Proof. induction s; simpl; auto; intros. @@ -696,10 +696,10 @@ Module Raw (X: DecidableType). generalize (IHs H1 f x). destruct (f a); destruct (partition f s); simpl in *; auto. inversion_clear H; auto. - Qed. - - Lemma partition_aux_2 : - forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), + Qed. + + Lemma partition_aux_2 : + forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), In x (snd (partition f s)) -> In x s. Proof. induction s; simpl; auto; intros. @@ -707,8 +707,8 @@ Module Raw (X: DecidableType). generalize (IHs H1 f x). destruct (f a); destruct (partition f s); simpl in *; auto. inversion_clear H; auto. - Qed. - + Qed. + Lemma partition_unique_1 : forall (s : t) (Hs : NoDup s) (f : elt -> bool), NoDup (fst (partition f s)). Proof. @@ -719,7 +719,7 @@ Module Raw (X: DecidableType). generalize (Hrec H0 f). case (f x); case (partition f l); simpl; auto. Qed. - + Lemma partition_unique_2 : forall (s : t) (Hs : NoDup s) (f : elt -> bool), NoDup (snd (partition f s)). Proof. @@ -733,17 +733,17 @@ Module Raw (X: DecidableType). Definition eq : t -> t -> Prop := Equal. - Lemma eq_refl : forall s, eq s s. + Lemma eq_refl : forall s, eq s s. Proof. firstorder. Qed. Lemma eq_sym : forall s s', eq s s' -> eq s' s. Proof. firstorder. Qed. - Lemma eq_trans : + Lemma eq_trans : forall s s' s'', eq s s' -> eq s' s'' -> eq s s''. Proof. firstorder. Qed. - Definition eq_dec : forall (s s':t)(Hs:NoDup s)(Hs':NoDup s'), + Definition eq_dec : forall (s s':t)(Hs:NoDup s)(Hs':NoDup s'), { eq s s' }+{ ~eq s s' }. Proof. intros. @@ -758,18 +758,18 @@ End Raw. (** * Encapsulation - Now, in order to really provide a functor implementing [S], we + Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of lists without redundancy. *) Module Make (X: DecidableType) <: WS with Module E := X. - Module Raw := Raw X. + Module Raw := Raw X. Module E := X. Record slist := {this :> Raw.t; unique : NoDupA E.eq this}. - Definition t := slist. + Definition t := slist. Definition elt := E.t. - + Definition In (x : elt) (s : t) : Prop := InA E.eq x s.(this). Definition Equal (s s':t) : Prop := forall a : elt, In a s <-> In a s'. Definition Subset (s s':t) : Prop := forall a : elt, In a s -> In a s'. @@ -783,18 +783,18 @@ Module Make (X: DecidableType) <: WS with Module E := X. Definition remove (x : elt)(s : t) : t := Build_slist (Raw.remove_unique (unique s) x). Definition singleton (x : elt) : t := Build_slist (Raw.singleton_unique x). Definition union (s s' : t) : t := - Build_slist (Raw.union_unique (unique s) (unique s')). + Build_slist (Raw.union_unique (unique s) (unique s')). Definition inter (s s' : t) : t := - Build_slist (Raw.inter_unique (unique s) (unique s')). + Build_slist (Raw.inter_unique (unique s) (unique s')). Definition diff (s s' : t) : t := - Build_slist (Raw.diff_unique (unique s) (unique s')). - Definition equal (s s' : t) : bool := Raw.equal s s'. + Build_slist (Raw.diff_unique (unique s) (unique s')). + Definition equal (s s' : t) : bool := Raw.equal s s'. Definition subset (s s' : t) : bool := Raw.subset s s'. Definition empty : t := Build_slist Raw.empty_unique. Definition is_empty (s : t) : bool := Raw.is_empty s. Definition elements (s : t) : list elt := Raw.elements s. Definition choose (s:t) : option elt := Raw.choose s. - Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. + Definition fold (B : Type) (f : elt -> B -> B) (s : t) : B -> B := Raw.fold (B:=B) f s. Definition cardinal (s : t) : nat := Raw.cardinal s. Definition filter (f : elt -> bool) (s : t) : t := Build_slist (Raw.filter_unique (unique s) f). @@ -805,18 +805,18 @@ Module Make (X: DecidableType) <: WS with Module E := X. (Build_slist (this:=fst p) (Raw.partition_unique_1 (unique s) f), Build_slist (this:=snd p) (Raw.partition_unique_2 (unique s) f)). - Section Spec. + Section Spec. Variable s s' : t. Variable x y : elt. - Lemma In_1 : E.eq x y -> In x s -> In y s. + Lemma In_1 : E.eq x y -> In x s -> In y s. Proof. exact (fun H H' => Raw.In_eq H H'). Qed. - + Lemma mem_1 : In x s -> mem x s = true. Proof. exact (fun H => Raw.mem_1 H). Qed. - Lemma mem_2 : mem x s = true -> In x s. + Lemma mem_2 : mem x s = true -> In x s. Proof. exact (fun H => Raw.mem_2 H). Qed. - + Lemma equal_1 : Equal s s' -> equal s s' = true. Proof. exact (Raw.equal_1 s.(unique) s'.(unique)). Qed. Lemma equal_2 : equal s s' = true -> Equal s s'. @@ -830,16 +830,16 @@ Module Make (X: DecidableType) <: WS with Module E := X. Lemma empty_1 : Empty empty. Proof. exact Raw.empty_1. Qed. - Lemma is_empty_1 : Empty s -> is_empty s = true. + Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. exact (fun H => Raw.is_empty_1 H). Qed. Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. exact (fun H => Raw.is_empty_2 H). Qed. - + Lemma add_1 : E.eq x y -> In y (add x s). Proof. exact (fun H => Raw.add_1 s.(unique) H). Qed. Lemma add_2 : In y s -> In y (add x s). Proof. exact (fun H => Raw.add_2 s.(unique) x H). Qed. - Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. + Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. exact (fun H => Raw.add_3 s.(unique) H). Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). @@ -849,14 +849,14 @@ Module Make (X: DecidableType) <: WS with Module E := X. Lemma remove_3 : In y (remove x s) -> In y s. Proof. exact (fun H => Raw.remove_3 s.(unique) H). Qed. - Lemma singleton_1 : In y (singleton x) -> E.eq x y. + Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. exact (fun H => Raw.singleton_1 H). Qed. - Lemma singleton_2 : E.eq x y -> In y (singleton x). + Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. exact (fun H => Raw.singleton_2 H). Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. exact (fun H => Raw.union_1 s.(unique) s'.(unique) H). Qed. - Lemma union_2 : In x s -> In x (union s s'). + Lemma union_2 : In x s -> In x (union s s'). Proof. exact (fun H => Raw.union_2 s.(unique) s'.(unique) H). Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. exact (fun H => Raw.union_3 s.(unique) s'.(unique) H). Qed. @@ -868,13 +868,13 @@ Module Make (X: DecidableType) <: WS with Module E := X. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. exact (fun H => Raw.inter_3 s.(unique) s'.(unique) H). Qed. - Lemma diff_1 : In x (diff s s') -> In x s. + Lemma diff_1 : In x (diff s s') -> In x s. Proof. exact (fun H => Raw.diff_1 s.(unique) s'.(unique) H). Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. exact (fun H => Raw.diff_2 s.(unique) s'.(unique) H). Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. exact (fun H => Raw.diff_3 s.(unique) s'.(unique) H). Qed. - + Lemma fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. exact (Raw.fold_1 s.(unique)). Qed. @@ -883,12 +883,12 @@ Module Make (X: DecidableType) <: WS with Module E := X. Proof. exact (Raw.cardinal_1 s.(unique)). Qed. Section Filter. - + Variable f : elt -> bool. - Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. + Lemma filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. Proof. exact (fun H => @Raw.filter_1 s x f). Qed. - Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. + Lemma filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. exact (@Raw.filter_2 s x f). Qed. Lemma filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). @@ -938,20 +938,20 @@ Module Make (X: DecidableType) <: WS with Module E := X. Definition eq : t -> t -> Prop := Equal. - Lemma eq_refl : forall s, eq s s. + Lemma eq_refl : forall s, eq s s. Proof. firstorder. Qed. Lemma eq_sym : forall s s', eq s s' -> eq s' s. Proof. firstorder. Qed. - Lemma eq_trans : + Lemma eq_trans : forall s s' s'', eq s s' -> eq s' s'' -> eq s s''. Proof. firstorder. Qed. - Definition eq_dec : forall (s s':t), + Definition eq_dec : forall (s s':t), { eq s s' }+{ ~eq s s' }. - Proof. - intros s s'; exact (Raw.eq_dec s.(unique) s'.(unique)). + Proof. + intros s s'; exact (Raw.eq_dec s.(unique) s'.(unique)). Defined. End Make. diff --git a/theories/FSets/OrderedType.v b/theories/FSets/OrderedType.v index 8c4c6818a..4e5d39faf 100644 --- a/theories/FSets/OrderedType.v +++ b/theories/FSets/OrderedType.v @@ -69,22 +69,22 @@ Module OrderedTypeFacts (Import O: OrderedType). Lemma lt_antirefl : forall x, ~ lt x x. Proof. - intros; intro; absurd (eq x x); auto. + intros; intro; absurd (eq x x); auto. Qed. Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z. - Proof. + Proof. intros; destruct (compare x z); auto. elim (lt_not_eq H); apply eq_trans with z; auto. elim (lt_not_eq (lt_trans l H)); auto. - Qed. + Qed. - Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z. + Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z. Proof. intros; destruct (compare x z); auto. elim (lt_not_eq H0); apply eq_trans with x; auto. elim (lt_not_eq (lt_trans H0 l)); auto. - Qed. + Qed. Lemma le_eq : forall x y z, ~lt x y -> eq y z -> ~lt x z. Proof. @@ -125,23 +125,23 @@ Module OrderedTypeFacts (Import O: OrderedType). Qed. Lemma le_neq : forall x y, ~lt x y -> ~eq x y -> lt y x. - Proof. + Proof. intros; destruct (compare x y); intuition. Qed. Lemma neq_sym : forall x y, ~eq x y -> ~eq y x. - Proof. + Proof. intuition. Qed. -(* TODO concernant la tactique order: +(* TODO concernant la tactique order: * propagate_lt n'est sans doute pas complet * un propagate_le * exploiter les hypotheses negatives restant a la fin * faire que ca marche meme quand une hypothese depend d'un eq ou lt. -*) +*) -Ltac abstraction := match goal with +Ltac abstraction := match goal with (* First, some obvious simplifications *) | H : False |- _ => elim H | H : lt ?x ?x |- _ => elim (lt_antirefl H) @@ -151,43 +151,43 @@ Ltac abstraction := match goal with | |- eq ?x ?x => exact (eq_refl x) | |- lt ?x ?x => elimtype False; abstraction | |- ~ _ => intro; abstraction - | H1: ~lt ?x ?y, H2: ~eq ?x ?y |- _ => + | H1: ~lt ?x ?y, H2: ~eq ?x ?y |- _ => generalize (le_neq H1 H2); clear H1 H2; intro; abstraction - | H1: ~lt ?x ?y, H2: ~eq ?y ?x |- _ => + | H1: ~lt ?x ?y, H2: ~eq ?y ?x |- _ => generalize (le_neq H1 (neq_sym H2)); clear H1 H2; intro; abstraction (* Then, we generalize all interesting facts *) | H : ~eq ?x ?y |- _ => revert H; abstraction - | H : ~lt ?x ?y |- _ => revert H; abstraction + | H : ~lt ?x ?y |- _ => revert H; abstraction | H : lt ?x ?y |- _ => revert H; abstraction | H : eq ?x ?y |- _ => revert H; abstraction | _ => idtac end. -Ltac do_eq a b EQ := match goal with - | |- lt ?x ?y -> _ => let H := fresh "H" in - (intro H; +Ltac do_eq a b EQ := match goal with + | |- lt ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_lt (eq_sym EQ) H); clear H; intro H) || - (generalize (lt_eq H EQ); clear H; intro H) || - idtac); + (generalize (lt_eq H EQ); clear H; intro H) || + idtac); do_eq a b EQ - | |- ~lt ?x ?y -> _ => let H := fresh "H" in - (intro H; + | |- ~lt ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_le (eq_sym EQ) H); clear H; intro H) || - (generalize (le_eq H EQ); clear H; intro H) || - idtac); - do_eq a b EQ - | |- eq ?x ?y -> _ => let H := fresh "H" in - (intro H; + (generalize (le_eq H EQ); clear H; intro H) || + idtac); + do_eq a b EQ + | |- eq ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_trans (eq_sym EQ) H); clear H; intro H) || - (generalize (eq_trans H EQ); clear H; intro H) || - idtac); - do_eq a b EQ - | |- ~eq ?x ?y -> _ => let H := fresh "H" in - (intro H; + (generalize (eq_trans H EQ); clear H; intro H) || + idtac); + do_eq a b EQ + | |- ~eq ?x ?y -> _ => let H := fresh "H" in + (intro H; (generalize (eq_neq (eq_sym EQ) H); clear H; intro H) || - (generalize (neq_eq H EQ); clear H; intro H) || - idtac); - do_eq a b EQ + (generalize (neq_eq H EQ); clear H; intro H) || + idtac); + do_eq a b EQ | |- lt a ?y => apply eq_lt with b; [exact EQ|] | |- lt ?y a => apply lt_eq with b; [|exact (eq_sym EQ)] | |- eq a ?y => apply eq_trans with b; [exact EQ|] @@ -195,27 +195,27 @@ Ltac do_eq a b EQ := match goal with | _ => idtac end. -Ltac propagate_eq := abstraction; clear; match goal with +Ltac propagate_eq := abstraction; clear; match goal with (* the abstraction tactic leaves equality facts in head position...*) - | |- eq ?a ?b -> _ => - let EQ := fresh "EQ" in (intro EQ; do_eq a b EQ; clear EQ); - propagate_eq + | |- eq ?a ?b -> _ => + let EQ := fresh "EQ" in (intro EQ; do_eq a b EQ; clear EQ); + propagate_eq | _ => idtac end. -Ltac do_lt x y LT := match goal with +Ltac do_lt x y LT := match goal with (* LT *) | |- lt x y -> _ => intros _; do_lt x y LT - | |- lt y ?z -> _ => let H := fresh "H" in + | |- lt y ?z -> _ => let H := fresh "H" in (intro H; generalize (lt_trans LT H); intro); do_lt x y LT - | |- lt ?z x -> _ => let H := fresh "H" in + | |- lt ?z x -> _ => let H := fresh "H" in (intro H; generalize (lt_trans H LT); intro); do_lt x y LT | |- lt _ _ -> _ => intro; do_lt x y LT (* GE *) | |- ~lt y x -> _ => intros _; do_lt x y LT - | |- ~lt x ?z -> _ => let H := fresh "H" in + | |- ~lt x ?z -> _ => let H := fresh "H" in (intro H; generalize (le_lt_trans H LT); intro); do_lt x y LT - | |- ~lt ?z y -> _ => let H := fresh "H" in + | |- ~lt ?z y -> _ => let H := fresh "H" in (intro H; generalize (lt_le_trans LT H); intro); do_lt x y LT | |- ~lt _ _ -> _ => intro; do_lt x y LT | _ => idtac @@ -223,21 +223,21 @@ Ltac do_lt x y LT := match goal with Definition hide_lt := lt. -Ltac propagate_lt := abstraction; match goal with +Ltac propagate_lt := abstraction; match goal with (* when no [=] remains, the abstraction tactic leaves [<] facts first. *) - | |- lt ?x ?y -> _ => - let LT := fresh "LT" in (intro LT; do_lt x y LT; - change (hide_lt x y) in LT); - propagate_lt + | |- lt ?x ?y -> _ => + let LT := fresh "LT" in (intro LT; do_lt x y LT; + change (hide_lt x y) in LT); + propagate_lt | _ => unfold hide_lt in * end. -Ltac order := - intros; - propagate_eq; - propagate_lt; - auto; - propagate_lt; +Ltac order := + intros; + propagate_eq; + propagate_lt; + auto; + propagate_lt; eauto. Ltac false_order := elimtype False; order. @@ -245,22 +245,22 @@ Ltac false_order := elimtype False; order. Lemma gt_not_eq : forall x y, lt y x -> ~ eq x y. Proof. order. - Qed. - + Qed. + Lemma eq_not_lt : forall x y : t, eq x y -> ~ lt x y. - Proof. + Proof. order. Qed. Hint Resolve gt_not_eq eq_not_lt. Lemma eq_not_gt : forall x y : t, eq x y -> ~ lt y x. - Proof. + Proof. order. Qed. Lemma lt_not_gt : forall x y : t, lt x y -> ~ lt y x. - Proof. + Proof. order. Qed. @@ -269,44 +269,44 @@ Ltac false_order := elimtype False; order. Lemma elim_compare_eq : forall x y : t, eq x y -> exists H : eq x y, compare x y = EQ _ H. - Proof. + Proof. intros; case (compare x y); intros H'; try solve [false_order]. - exists H'; auto. + exists H'; auto. Qed. Lemma elim_compare_lt : forall x y : t, lt x y -> exists H : lt x y, compare x y = LT _ H. - Proof. + Proof. intros; case (compare x y); intros H'; try solve [false_order]. - exists H'; auto. + exists H'; auto. Qed. Lemma elim_compare_gt : forall x y : t, lt y x -> exists H : lt y x, compare x y = GT _ H. - Proof. + Proof. intros; case (compare x y); intros H'; try solve [false_order]. - exists H'; auto. + exists H'; auto. Qed. - Ltac elim_comp := - match goal with - | |- ?e => match e with + Ltac elim_comp := + match goal with + | |- ?e => match e with | context ctx [ compare ?a ?b ] => - let H := fresh in - (destruct (compare a b) as [H|H|H]; + let H := fresh in + (destruct (compare a b) as [H|H|H]; try solve [ intros; false_order]) end end. Ltac elim_comp_eq x y := elim (elim_compare_eq (x:=x) (y:=y)); - [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. + [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. Ltac elim_comp_lt x y := elim (elim_compare_lt (x:=x) (y:=y)); - [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. + [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. Ltac elim_comp_gt x y := elim (elim_compare_gt (x:=x) (y:=y)); @@ -314,7 +314,7 @@ Ltac false_order := elimtype False; order. (** For compatibility reasons *) Definition eq_dec := eq_dec. - + Lemma lt_dec : forall x y : t, {lt x y} + {~ lt x y}. Proof. intros; elim (compare x y); [ left | right | right ]; auto. @@ -322,8 +322,8 @@ Ltac false_order := elimtype False; order. Definition eqb x y : bool := if eq_dec x y then true else false. - Lemma eqb_alt : - forall x y, eqb x y = match compare x y with EQ _ => true | _ => false end. + Lemma eqb_alt : + forall x y, eqb x y = match compare x y with EQ _ => true | _ => false end. Proof. unfold eqb; intros; destruct (eq_dec x y); elim_comp; auto. Qed. @@ -345,20 +345,20 @@ Proof. exact (In_InA eq_refl). Qed. Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l. Proof. exact (InfA_ltA lt_trans). Qed. - + Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l. Proof. exact (InfA_eqA eq_lt). Qed. Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x. Proof. exact (SortA_InfA_InA eq_refl eq_sym lt_trans lt_eq eq_lt). Qed. - + Lemma ListIn_Inf : forall l x, (forall y, List.In y l -> lt x y) -> Inf x l. Proof. exact (@In_InfA t lt). Qed. Lemma In_Inf : forall l x, (forall y, In y l -> lt x y) -> Inf x l. Proof. exact (InA_InfA eq_refl (ltA:=lt)). Qed. -Lemma Inf_alt : +Lemma Inf_alt : forall l x, Sort l -> (Inf x l <-> (forall y, In y l -> lt x y)). Proof. exact (InfA_alt eq_refl eq_sym lt_trans lt_eq eq_lt). Qed. @@ -367,8 +367,8 @@ Proof. exact (SortA_NoDupA eq_refl eq_sym lt_trans lt_not_eq lt_eq eq_lt) . Qed. End ForNotations. -Hint Resolve ListIn_In Sort_NoDup Inf_lt. -Hint Immediate In_eq Inf_lt. +Hint Resolve ListIn_In Sort_NoDup Inf_lt. +Hint Immediate In_eq Inf_lt. End OrderedTypeFacts. @@ -382,7 +382,7 @@ Module KeyOrderedType(O:OrderedType). Notation key:=t. Definition eqk (p p':key*elt) := eq (fst p) (fst p'). - Definition eqke (p p':key*elt) := + Definition eqke (p p':key*elt) := eq (fst p) (fst p') /\ (snd p) = (snd p'). Definition ltk (p p':key*elt) := lt (fst p) (fst p'). @@ -390,7 +390,7 @@ Module KeyOrderedType(O:OrderedType). Hint Extern 2 (eqke ?a ?b) => split. (* eqke is stricter than eqk *) - + Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'. Proof. unfold eqk, eqke; intuition. @@ -406,7 +406,7 @@ Module KeyOrderedType(O:OrderedType). Hint Immediate ltk_right_r ltk_right_l. (* eqk, eqke are equalities, ltk is a strict order *) - + Lemma eqk_refl : forall e, eqk e e. Proof. auto. Qed. @@ -431,7 +431,7 @@ Module KeyOrderedType(O:OrderedType). Proof. eauto. Qed. Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'. - Proof. unfold eqk, ltk; auto. Qed. + Proof. unfold eqk, ltk; auto. Qed. Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'. Proof. @@ -458,10 +458,10 @@ Module KeyOrderedType(O:OrderedType). intros (k,e) (k',e') (k'',e''). unfold ltk, eqk; simpl; eauto. Qed. - Hint Resolve eqk_not_ltk. + Hint Resolve eqk_not_ltk. Hint Immediate ltk_eqk eqk_ltk. - Lemma InA_eqke_eqk : + Lemma InA_eqke_eqk : forall x m, InA eqke x m -> InA eqk x m. Proof. unfold eqke; induction 1; intuition. @@ -496,7 +496,7 @@ Module KeyOrderedType(O:OrderedType). Lemma In_eq : forall l x y, eq x y -> In x l -> In y l. Proof. destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto. - Qed. + Qed. Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l. Proof. exact (InfA_eqA eqk_ltk). Qed. @@ -507,13 +507,13 @@ Module KeyOrderedType(O:OrderedType). Hint Immediate Inf_eq. Hint Resolve Inf_lt. - Lemma Sort_Inf_In : + Lemma Sort_Inf_In : forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p. - Proof. + Proof. exact (SortA_InfA_InA eqk_refl eqk_sym ltk_trans ltk_eqk eqk_ltk). Qed. - Lemma Sort_Inf_NotIn : + Lemma Sort_Inf_NotIn : forall l k e, Sort l -> Inf (k,e) l -> ~In k l. Proof. intros; red; intros. @@ -524,7 +524,7 @@ Module KeyOrderedType(O:OrderedType). Qed. Lemma Sort_NoDupA: forall l, Sort l -> NoDupA eqk l. - Proof. + Proof. exact (SortA_NoDupA eqk_refl eqk_sym ltk_trans ltk_not_eqk ltk_eqk eqk_ltk). Qed. @@ -540,7 +540,7 @@ Module KeyOrderedType(O:OrderedType). left; apply Sort_In_cons_1 with l; auto. Qed. - Lemma Sort_In_cons_3 : + Lemma Sort_In_cons_3 : forall x l k e, Sort ((k,e)::l) -> In x l -> ~eq x k. Proof. inversion_clear 1; red; intros. @@ -552,15 +552,15 @@ Module KeyOrderedType(O:OrderedType). inversion 1. inversion_clear H0; eauto. destruct H1; simpl in *; intuition. - Qed. + Qed. - Lemma In_inv_2 : forall k k' e e' l, + Lemma In_inv_2 : forall k k' e e' l, InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l. - Proof. + Proof. inversion_clear 1; compute in H0; intuition. Qed. - Lemma In_inv_3 : forall x x' l, + Lemma In_inv_3 : forall x x' l, InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l. Proof. inversion_clear 1; compute in H0; intuition. @@ -573,7 +573,7 @@ Module KeyOrderedType(O:OrderedType). Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl. Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke. Hint Immediate eqk_sym eqke_sym. - Hint Resolve eqk_not_ltk. + Hint Resolve eqk_not_ltk. Hint Immediate ltk_eqk eqk_ltk. Hint Resolve InA_eqke_eqk. Hint Unfold MapsTo In. diff --git a/theories/FSets/OrderedTypeAlt.v b/theories/FSets/OrderedTypeAlt.v index 95c9c31a9..3a9fa1a73 100644 --- a/theories/FSets/OrderedTypeAlt.v +++ b/theories/FSets/OrderedTypeAlt.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -19,23 +19,23 @@ Require Import OrderedType. inferface. *) (** NB: [comparison], defined in [Datatypes.v] is [Eq|Lt|Gt] -whereas [compare], defined in [OrderedType.v] is [EQ _ | LT _ | GT _ ] +whereas [compare], defined in [OrderedType.v] is [EQ _ | LT _ | GT _ ] *) Module Type OrderedTypeAlt. Parameter t : Type. - + Parameter compare : t -> t -> comparison. Infix "?=" := compare (at level 70, no associativity). - Parameter compare_sym : + Parameter compare_sym : forall x y, (y?=x) = CompOpp (x?=y). - Parameter compare_trans : + Parameter compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. -End OrderedTypeAlt. +End OrderedTypeAlt. (** From this new presentation to the original one. *) @@ -56,7 +56,7 @@ Module OrderedType_from_Alt (O:OrderedTypeAlt) <: OrderedType. Qed. Lemma eq_sym : forall x y, eq x y -> eq y x. - Proof. + Proof. unfold eq; intros. rewrite compare_sym. rewrite H; simpl; auto. @@ -88,7 +88,7 @@ Module OrderedType_from_Alt (O:OrderedTypeAlt) <: OrderedType. case (x ?= y); [ left | right | right ]; auto; discriminate. Defined. -End OrderedType_from_Alt. +End OrderedType_from_Alt. (** From the original presentation to this alternative one. *) @@ -99,30 +99,30 @@ Module OrderedType_to_Alt (O:OrderedType) <: OrderedTypeAlt. Definition t := t. - Definition compare x y := match compare x y with + Definition compare x y := match compare x y with | LT _ => Lt | EQ _ => Eq | GT _ => Gt - end. + end. Infix "?=" := compare (at level 70, no associativity). - Lemma compare_sym : + Lemma compare_sym : forall x y, (y?=x) = CompOpp (x?=y). Proof. intros x y; unfold compare. destruct O.compare; elim_comp; simpl; auto. Qed. - - Lemma compare_trans : + + Lemma compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. Proof. intros c x y z. - destruct c; unfold compare; - do 2 (destruct O.compare; intros; try discriminate); + destruct c; unfold compare; + do 2 (destruct O.compare; intros; try discriminate); elim_comp; auto. Qed. End OrderedType_to_Alt. - + diff --git a/theories/FSets/OrderedTypeEx.v b/theories/FSets/OrderedTypeEx.v index e6312a147..e76cead2d 100644 --- a/theories/FSets/OrderedTypeEx.v +++ b/theories/FSets/OrderedTypeEx.v @@ -6,8 +6,8 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) @@ -21,7 +21,7 @@ Require Import Compare_dec. (** * Examples of Ordered Type structures. *) -(** First, a particular case of [OrderedType] where +(** First, a particular case of [OrderedType] where the equality is the usual one of Coq. *) Module Type UsualOrderedType. @@ -80,7 +80,7 @@ Open Local Scope Z_scope. Module Z_as_OT <: UsualOrderedType. Definition t := Z. - Definition eq := @eq Z. + Definition eq := @eq Z. Definition eq_refl := @refl_equal t. Definition eq_sym := @sym_eq t. Definition eq_trans := @trans_eq t. @@ -105,7 +105,7 @@ Module Z_as_OT <: UsualOrderedType. End Z_as_OT. -(** [positive] is an ordered type with respect to the usual order on natural numbers. *) +(** [positive] is an ordered type with respect to the usual order on natural numbers. *) Open Local Scope positive_scope. @@ -117,9 +117,9 @@ Module Positive_as_OT <: UsualOrderedType. Definition eq_trans := @trans_eq t. Definition lt p q:= (p ?= q) Eq = Lt. - + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. - Proof. + Proof. unfold lt; intros x y z. change ((Zpos x < Zpos y)%Z -> (Zpos y < Zpos z)%Z -> (Zpos x < Zpos z)%Z). omega. @@ -149,7 +149,7 @@ Module Positive_as_OT <: UsualOrderedType. End Positive_as_OT. -(** [N] is an ordered type with respect to the usual order on natural numbers. *) +(** [N] is an ordered type with respect to the usual order on natural numbers. *) Open Local Scope positive_scope. @@ -180,7 +180,7 @@ Module N_as_OT <: UsualOrderedType. End N_as_OT. -(** From two ordered types, we can build a new OrderedType +(** From two ordered types, we can build a new OrderedType over their cartesian product, using the lexicographic order. *) Module PairOrderedType(O1 O2:OrderedType) <: OrderedType. @@ -188,29 +188,29 @@ Module PairOrderedType(O1 O2:OrderedType) <: OrderedType. Module MO2:=OrderedTypeFacts(O2). Definition t := prod O1.t O2.t. - + Definition eq x y := O1.eq (fst x) (fst y) /\ O2.eq (snd x) (snd y). - Definition lt x y := - O1.lt (fst x) (fst y) \/ + Definition lt x y := + O1.lt (fst x) (fst y) \/ (O1.eq (fst x) (fst y) /\ O2.lt (snd x) (snd y)). Lemma eq_refl : forall x : t, eq x x. - Proof. + Proof. intros (x1,x2); red; simpl; auto. Qed. Lemma eq_sym : forall x y : t, eq x y -> eq y x. - Proof. + Proof. intros (x1,x2) (y1,y2); unfold eq; simpl; intuition. Qed. Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. - Proof. + Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq; simpl; intuition eauto. Qed. - - Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. + + Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq, lt; simpl; intuition. left; eauto. diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index 147d1e8d3..8d790d1fd 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -98,7 +98,7 @@ Defined. (** [nat] is the datatype of natural numbers built from [O] and successor [S]; note that the constructor name is the letter O. - Numbers in [nat] can be denoted using a decimal notation; + Numbers in [nat] can be denoted using a decimal notation; e.g. [3%nat] abbreviates [S (S (S O))] *) Inductive nat : Set := @@ -166,7 +166,7 @@ Section projections. Definition snd (p:A * B) := match p with | (x, y) => y end. -End projections. +End projections. Hint Resolve pair inl inr: core. @@ -181,13 +181,13 @@ Lemma injective_projections : fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2. Proof. destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd. - rewrite Hfst; rewrite Hsnd; reflexivity. + rewrite Hfst; rewrite Hsnd; reflexivity. Qed. -Definition prod_uncurry (A B C:Type) (f:prod A B -> C) +Definition prod_uncurry (A B C:Type) (f:prod A B -> C) (x:A) (y:B) : C := f (pair x y). -Definition prod_curry (A B C:Type) (f:A -> B -> C) +Definition prod_curry (A B C:Type) (f:A -> B -> C) (p:prod A B) : C := match p with | pair x y => f x y end. diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index bdec651da..1333f3545 100644 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -28,7 +28,7 @@ Section identity_is_a_congruence. Variable f : A -> B. Variables x y z : A. - + Lemma identity_sym : identity x y -> identity y x. Proof. destruct 1; trivial. diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index 2244e1b9a..748229b17 100644 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -18,9 +18,9 @@ Require Import Logic. (** Subsets and Sigma-types *) -(** [(sig A P)], or more suggestively [{x:A | P x}], denotes the subset +(** [(sig A P)], or more suggestively [{x:A | P x}], denotes the subset of elements of the type [A] which satisfy the predicate [P]. - Similarly [(sig2 A P Q)], or [{x:A | P x & Q x}], denotes the subset + Similarly [(sig2 A P Q)], or [{x:A | P x & Q x}], denotes the subset of elements of the type [A] which satisfy both [P] and [Q]. *) Inductive sig (A:Type) (P:A -> Prop) : Type := @@ -29,7 +29,7 @@ Inductive sig (A:Type) (P:A -> Prop) : Type := Inductive sig2 (A:Type) (P Q:A -> Prop) : Type := exist2 : forall x:A, P x -> Q x -> sig2 P Q. -(** [(sigT A P)], or more suggestively [{x:A & (P x)}] is a Sigma-type. +(** [(sigT A P)], or more suggestively [{x:A & (P x)}] is a Sigma-type. Similarly for [(sigT2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *) Inductive sigT (A:Type) (P:A -> Type) : Type := @@ -123,7 +123,7 @@ Coercion sig_of_sigT : sigT >-> sig. Inductive sumbool (A B:Prop) : Set := | left : A -> {A} + {B} - | right : B -> {A} + {B} + | right : B -> {A} + {B} where "{ A } + { B }" := (sumbool A B) : type_scope. Add Printing If sumbool. @@ -133,7 +133,7 @@ Add Printing If sumbool. Inductive sumor (A:Type) (B:Prop) : Type := | inleft : A -> A + {B} - | inright : B -> A + {B} + | inright : B -> A + {B} where "A + { B }" := (sumor A B) : type_scope. Add Printing If sumor. @@ -186,12 +186,12 @@ Section Choice_lemmas. End Choice_lemmas. - (** A result of type [(Exc A)] is either a normal value of type [A] or + (** A result of type [(Exc A)] is either a normal value of type [A] or an [error] : [Inductive Exc [A:Type] : Type := value : A->(Exc A) | error : (Exc A)]. - It is implemented using the option type. *) + It is implemented using the option type. *) Definition Exc := option. Definition value := Some. diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v index 39cd268d9..0d36d40e3 100644 --- a/theories/Init/Tactics.v +++ b/theories/Init/Tactics.v @@ -14,38 +14,38 @@ Require Import Specif. (** * Useful tactics *) -(** A tactic for proof by contradiction. With contradict H, +(** A tactic for proof by contradiction. With contradict H, - H:~A |- B gives |- A - H:~A |- ~B gives H: B |- A - H: A |- B gives |- ~A - H: A |- ~B gives H: B |- ~A - H:False leads to a resolved subgoal. - Moreover, negations may be in unfolded forms, + Moreover, negations may be in unfolded forms, and A or B may live in Type *) Ltac contradict H := let save tac H := let x:=fresh in intro x; tac H; rename x into H - in - let negpos H := case H; clear H - in + in + let negpos H := case H; clear H + in let negneg H := save negpos H in - let pospos H := + let pospos H := let A := type of H in (elimtype False; revert H; try fold (~A)) in let posneg H := save pospos H - in - let neg H := match goal with + in + let neg H := match goal with | |- (~_) => negneg H | |- (_->False) => negneg H | |- _ => negpos H - end in - let pos H := match goal with + end in + let pos H := match goal with | |- (~_) => posneg H | |- (_->False) => posneg H | |- _ => pospos H end in - match type of H with + match type of H with | (~_) => neg H | (_->False) => neg H | _ => (elim H;fail) || pos H @@ -53,20 +53,20 @@ Ltac contradict H := (* Transforming a negative goal [ H:~A |- ~B ] into a positive one [ B |- A ]*) -Ltac swap H := +Ltac swap H := idtac "swap is OBSOLETE: use contradict instead."; intro; apply H; clear H. (* To contradict an hypothesis without copying its type. *) -Ltac absurd_hyp H := +Ltac absurd_hyp H := idtac "absurd_hyp is OBSOLETE: use contradict instead."; - let T := type of H in + let T := type of H in absurd T. (* A useful complement to contradict. Here H:A while G allows to conclude ~A *) -Ltac false_hyp H G := +Ltac false_hyp H G := let T := type of H in absurd T; [ apply G | assumption ]. (* A case with no loss of information. *) @@ -77,11 +77,11 @@ Ltac case_eq x := generalize (refl_equal x); pattern x at -1; case x. Tactic Notation "destruct_with_eqn" constr(x) := destruct x as []_eqn. -Tactic Notation "destruct_with_eqn" ident(n) := +Tactic Notation "destruct_with_eqn" ident(n) := try intros until n; destruct n as []_eqn. Tactic Notation "destruct_with_eqn" ":" ident(H) constr(x) := destruct x as []_eqn:H. -Tactic Notation "destruct_with_eqn" ":" ident(H) ident(n) := +Tactic Notation "destruct_with_eqn" ":" ident(H) ident(n) := try intros until n; destruct n as []_eqn:H. (* Rewriting in all hypothesis several times everywhere *) @@ -181,7 +181,7 @@ Ltac now_show c := change c. Set Implicit Arguments. -Lemma decide_left : forall (C:Prop) (decide:{C}+{~C}), +Lemma decide_left : forall (C:Prop) (decide:{C}+{~C}), C -> forall P:{C}+{~C}->Prop, (forall H:C, P (left _ H)) -> P decide. Proof. intros; destruct decide. apply H0. contradiction. @@ -194,8 +194,8 @@ intros; destruct decide. contradiction. apply H0. Qed. Tactic Notation "decide" constr(lemma) "with" constr(H) := - let try_to_merge_hyps H := - try (clear H; intro H) || + let try_to_merge_hyps H := + try (clear H; intro H) || (let H' := fresh H "bis" in intro H'; try clear H') || (let H' := fresh in intro H'; try clear H') in match type of H with diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v index 2d35a4b23..f1baf71a7 100644 --- a/theories/Init/Wf.v +++ b/theories/Init/Wf.v @@ -65,7 +65,7 @@ Section Well_founded. exact (fun P:A -> Prop => well_founded_induction_type P). Defined. -(** Well-founded fixpoints *) +(** Well-founded fixpoints *) Section FixPoint. @@ -80,13 +80,13 @@ Section Well_founded. Lemma Fix_F_eq : forall (x:A) (r:Acc x), F (fun (y:A) (p:R y x) => Fix_F (x:=y) (Acc_inv r p)) = Fix_F (x:=x) r. - Proof. + Proof. destruct r using Acc_inv_dep; auto. Qed. Definition Fix (x:A) := Fix_F (Rwf x). - (** Proof that [well_founded_induction] satisfies the fixpoint equation. + (** Proof that [well_founded_induction] satisfies the fixpoint equation. It requires an extra property of the functional *) Hypothesis @@ -111,7 +111,7 @@ Section Well_founded. End FixPoint. -End Well_founded. +End Well_founded. (** Well-founded fixpoints over pairs *) @@ -120,7 +120,7 @@ Section Well_founded_2. Variables A B : Type. Variable R : A * B -> A * B -> Prop. - Variable P : A -> B -> Type. + Variable P : A -> B -> Type. Section FixPoint_2. @@ -129,7 +129,7 @@ Section Well_founded_2. forall (x:A) (x':B), (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x'. - Fixpoint Fix_F_2 (x:A) (x':B) (a:Acc R (x, x')) {struct a} : + Fixpoint Fix_F_2 (x:A) (x':B) (a:Acc R (x, x')) {struct a} : P x x' := F (fun (y:A) (y':B) (h:R (y, y') (x, x')) => diff --git a/theories/Lists/List.v b/theories/Lists/List.v index 9add5f48d..f2961635e 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -42,7 +42,7 @@ Section Lists. match l with | nil => default | x :: _ => x - end. + end. Definition tail (l:list) : list := match l with @@ -71,9 +71,9 @@ Section Lists. | nil => m | a :: l1 => a :: app l1 m end. - + Infix "++" := app (right associativity, at level 60) : list_scope. - + End Lists. (** Exporting list notations and tactics *) @@ -101,7 +101,7 @@ Section Facts. (** Discrimination *) Theorem nil_cons : forall (x:A) (l:list A), nil <> x :: l. - Proof. + Proof. intros; discriminate. Qed. @@ -114,9 +114,9 @@ Section Facts. right; reflexivity. left; exists a; exists tl; reflexivity. Qed. - + (** *** Head and tail *) - + Theorem head_nil : head (@nil A) = None. Proof. simpl; reflexivity. @@ -129,19 +129,19 @@ Section Facts. (************************) - (** *** Facts about [In] *) + (** *** Facts about [In] *) (************************) (** Characterization of [In] *) - + Theorem in_eq : forall (a:A) (l:list A), In a (a :: l). - Proof. + Proof. simpl in |- *; auto. Qed. - + Theorem in_cons : forall (a b:A) (l:list A), In b l -> In b (a :: l). - Proof. + Proof. simpl in |- *; auto. Qed. @@ -173,7 +173,7 @@ Section Facts. intro H; induction l as [| a0 l IHl]. right; apply in_nil. destruct (H a0 a); simpl in |- *; auto. - destruct IHl; simpl in |- *; auto. + destruct IHl; simpl in |- *; auto. right; unfold not in |- *; intros [Hc1| Hc2]; auto. Defined. @@ -199,7 +199,7 @@ Section Facts. Qed. Theorem app_nil_r : forall l:list A, l ++ nil = l. - Proof. + Proof. induction l; simpl; f_equal; auto. Qed. @@ -211,23 +211,23 @@ Section Facts. (** [app] is associative *) Theorem app_assoc : forall l m n:list A, l ++ m ++ n = (l ++ m) ++ n. - Proof. + Proof. intros l m n; induction l; simpl; f_equal; auto. Qed. Theorem app_assoc_reverse : forall l m n:list A, (l ++ m) ++ n = l ++ m ++ n. - Proof. + Proof. auto using app_assoc. Qed. Hint Resolve app_assoc_reverse. - (** [app] commutes with [cons] *) + (** [app] commutes with [cons] *) Theorem app_comm_cons : forall (x y:list A) (a:A), a :: (x ++ y) = (a :: x) ++ y. Proof. auto. Qed. - (** Facts deduced from the result of a concatenation *) + (** Facts deduced from the result of a concatenation *) Theorem app_eq_nil : forall l l':list A, l ++ l' = nil -> l = nil /\ l' = nil. Proof. @@ -261,7 +261,7 @@ Section Facts. forall (x y:list A) (a b:A), x ++ a :: nil = y ++ b :: nil -> x = y /\ a = b. Proof. induction x as [| x l IHl]; - [ destruct y as [| a l] | destruct y as [| a l0] ]; + [ destruct y as [| a l] | destruct y as [| a l0] ]; simpl in |- *; auto. intros a b H. injection H. @@ -276,7 +276,7 @@ Section Facts. generalize (app_cons_not_nil _ _ _ H2); destruct 1. intros a0 b H. injection H; intros. - destruct (IHl l0 a0 b H0). + destruct (IHl l0 a0 b H0). split; auto. rewrite <- H1; rewrite <- H2; reflexivity. Qed. @@ -290,7 +290,7 @@ Section Facts. Qed. Lemma in_app_or : forall (l m:list A) (a:A), In a (l ++ m) -> In a l \/ In a m. - Proof. + Proof. intros l m a. elim l; simpl in |- *; auto. intros a0 y H H0. @@ -302,7 +302,7 @@ Section Facts. Qed. Lemma in_or_app : forall (l m:list A) (a:A), In a l \/ In a m -> In a (l ++ m). - Proof. + Proof. intros l m a. elim l; simpl in |- *; intro H. now_show (In a m). @@ -327,12 +327,12 @@ Section Facts. Proof. induction l; simpl; auto; injection 1; auto. Qed. - + Lemma app_inv_tail: forall l l1 l2 : list A, l1 ++ l = l2 ++ l -> l1 = l2. Proof. intros l l1 l2; revert l1 l2 l. - induction l1 as [ | x1 l1]; destruct l2 as [ | x2 l2]; + induction l1 as [ | x1 l1]; destruct l2 as [ | x2 l2]; simpl; auto; intros l H. absurd (length (x2 :: l2 ++ l) <= length l). simpl; rewrite app_length; auto with arith. @@ -348,7 +348,7 @@ End Facts. Hint Resolve app_assoc app_assoc_reverse: datatypes v62. Hint Resolve app_comm_cons app_cons_not_nil: datatypes v62. Hint Immediate app_eq_nil: datatypes v62. -Hint Resolve app_eq_unit app_inj_tail: datatypes v62. +Hint Resolve app_eq_unit app_inj_tail: datatypes v62. Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes v62. @@ -384,18 +384,18 @@ Section Elts. Lemma nth_in_or_default : forall (n:nat) (l:list A) (d:A), {In (nth n l d) l} + {nth n l d = d}. (* Realizer nth_ok. Program_all. *) - Proof. + Proof. intros n l d; generalize n; induction l; intro n0. right; case n0; trivial. case n0; simpl in |- *. auto. - intro n1; elim (IHl n1); auto. + intro n1; elim (IHl n1); auto. Qed. Lemma nth_S_cons : forall (n:nat) (l:list A) (d a:A), In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l). - Proof. + Proof. simpl in |- *; auto. Qed. @@ -436,7 +436,7 @@ Section Elts. apply IHl; auto with arith. Qed. - Lemma nth_indep : + Lemma nth_indep : forall l n d d', n < length l -> nth n l d = nth n l d'. Proof. induction l; simpl; intros; auto. @@ -444,7 +444,7 @@ Section Elts. destruct n; simpl; auto with arith. Qed. - Lemma app_nth1 : + Lemma app_nth1 : forall l l' d n, n < length l -> nth n (l++l') d = nth n l d. Proof. induction l. @@ -455,7 +455,7 @@ Section Elts. intros; rewrite IHl; auto with arith. Qed. - Lemma app_nth2 : + Lemma app_nth2 : forall l l' d n, n >= length l -> nth n (l++l') d = nth (n-length l) l' d. Proof. induction l. @@ -480,22 +480,22 @@ Section Elts. Section Remove. Hypothesis eq_dec : forall x y : A, {x = y}+{x <> y}. - + Fixpoint remove (x : A) (l : list A){struct l} : list A := match l with | nil => nil | y::tl => if (eq_dec x y) then remove x tl else y::(remove x tl) end. - + Theorem remove_In : forall (l : list A) (x : A), ~ In x (remove x l). Proof. induction l as [|x l]; auto. - intro y; simpl; destruct (eq_dec y x) as [yeqx | yneqx]. + intro y; simpl; destruct (eq_dec y x) as [yeqx | yneqx]. apply IHl. unfold not; intro HF; simpl in HF; destruct HF; auto. - apply (IHl y); assumption. + apply (IHl y); assumption. Qed. - + End Remove. @@ -503,26 +503,26 @@ Section Elts. (** ** Last element of a list *) (******************************) - (** [last l d] returns the last element of the list [l], + (** [last l d] returns the last element of the list [l], or the default value [d] if [l] is empty. *) - Fixpoint last (l:list A) (d:A) {struct l} : A := - match l with - | nil => d - | a :: nil => a + Fixpoint last (l:list A) (d:A) {struct l} : A := + match l with + | nil => d + | a :: nil => a | a :: l => last l d end. (** [removelast l] remove the last element of [l] *) - Fixpoint removelast (l:list A) {struct l} : list A := - match l with - | nil => nil - | a :: nil => nil + Fixpoint removelast (l:list A) {struct l} : list A := + match l with + | nil => nil + | a :: nil => nil | a :: l => a :: removelast l end. - - Lemma app_removelast_last : + + Lemma app_removelast_last : forall l d, l<>nil -> l = removelast l ++ (last l d :: nil). Proof. induction l. @@ -531,10 +531,10 @@ Section Elts. destruct l; auto. pattern (a0::l) at 1; rewrite IHl with d; auto; discriminate. Qed. - - Lemma exists_last : - forall l, l<>nil -> { l' : (list A) & { a : A | l = l'++a::nil}}. - Proof. + + Lemma exists_last : + forall l, l<>nil -> { l' : (list A) & { a : A | l = l'++a::nil}}. + Proof. induction l. destruct 1; auto. intros _. @@ -545,7 +545,7 @@ Section Elts. exists (a::l'); exists a'; auto. Qed. - Lemma removelast_app : + Lemma removelast_app : forall l l', l' <> nil -> removelast (l++l') = l ++ removelast l'. Proof. induction l. @@ -559,31 +559,31 @@ Section Elts. destruct (l++l'); [elim H0; auto|f_equal; auto]. Qed. - + (****************************************) (** ** Counting occurences of a element *) (****************************************) Hypotheses eqA_dec : forall x y : A, {x = y}+{x <> y}. - + Fixpoint count_occ (l : list A) (x : A){struct l} : nat := - match l with + match l with | nil => 0 - | y :: tl => - let n := count_occ tl x in + | y :: tl => + let n := count_occ tl x in if eqA_dec y x then S n else n end. - + (** Compatibility of count_occ with operations on list *) Theorem count_occ_In : forall (l : list A) (x : A), In x l <-> count_occ l x > 0. Proof. induction l as [|y l]. simpl; intros; split; [destruct 1 | apply gt_irrefl]. simpl. intro x; destruct (eqA_dec y x) as [Heq|Hneq]. - rewrite Heq; intuition. + rewrite Heq; intuition. pose (IHl x). intuition. Qed. - + Theorem count_occ_inv_nil : forall (l : list A), (forall x:A, count_occ l x = 0) <-> l = nil. Proof. split. @@ -600,7 +600,7 @@ Section Elts. (* Case <- *) intro H; rewrite H; simpl; reflexivity. Qed. - + Lemma count_occ_nil : forall (x : A), count_occ nil x = 0. Proof. intro x; simpl; reflexivity. @@ -611,11 +611,11 @@ Section Elts. intros l x y H; simpl. destruct (eqA_dec x y); [reflexivity | contradiction]. Qed. - + Lemma count_occ_cons_neq : forall (l : list A) (x y : A), x <> y -> count_occ (x::l) y = count_occ l y. Proof. intros l x y H; simpl. - destruct (eqA_dec x y); [contradiction | reflexivity]. + destruct (eqA_dec x y); [contradiction | reflexivity]. Qed. End Elts. @@ -697,7 +697,7 @@ Section ListOps. elim (length l); simpl; auto. Qed. - Lemma rev_nth : forall l d n, n < length l -> + Lemma rev_nth : forall l d n, n < length l -> nth n (rev l) d = nth (length l - S n) l d. Proof. induction l. @@ -720,11 +720,11 @@ Section ListOps. Qed. - (** An alternative tail-recursive definition for reverse *) + (** An alternative tail-recursive definition for reverse *) - Fixpoint rev_append (l l': list A) {struct l} : list A := - match l with - | nil => l' + Fixpoint rev_append (l l': list A) {struct l} : list A := + match l with + | nil => l' | a::l => rev_append l (a::l') end. @@ -750,11 +750,11 @@ Section ListOps. (*********************************************) (** Reverse Induction Principle on Lists *) (*********************************************) - + Section Reverse_Induction. - + Unset Implicit Arguments. - + Lemma rev_list_ind : forall P:list A-> Prop, P nil -> @@ -764,7 +764,7 @@ Section ListOps. induction l; auto. Qed. Set Implicit Arguments. - + Theorem rev_ind : forall P:list A -> Prop, P nil -> @@ -775,13 +775,13 @@ Section ListOps. intros E; rewrite <- E. apply (rev_list_ind P). auto. - + simpl in |- *. intros. apply (H0 a (rev l0)). auto. Qed. - + End Reverse_Induction. @@ -818,7 +818,7 @@ Section ListOps. Theorem Permutation_refl : forall l : list A, Permutation l l. Proof. - induction l; constructor. exact IHl. + induction l; constructor. exact IHl. Qed. Theorem Permutation_sym : forall l l' : list A, Permutation l l' -> Permutation l' l. @@ -838,7 +838,7 @@ Section ListOps. Theorem Permutation_in : forall (l l' : list A) (x : A), Permutation l l' -> In x l -> In x l'. Proof. - intros l l' x Hperm; induction Hperm; simpl; tauto. + intros l l' x Hperm; induction Hperm; simpl; tauto. Qed. Lemma Permutation_app_tail : forall (l l' tl : list A), Permutation l l' -> Permutation (l++tl) (l'++tl). @@ -863,7 +863,7 @@ Section ListOps. Theorem Permutation_app_swap : forall (l l' : list A), Permutation (l++l') (l'++l). Proof. - induction l as [|x l]. + induction l as [|x l]. simpl; intro l'; rewrite app_nil_r; trivial. induction l' as [|y l']. simpl; rewrite app_nil_r; trivial. @@ -872,7 +872,7 @@ Section ListOps. apply Permutation_trans with (l' := y :: x :: l' ++ l); constructor. apply Permutation_trans with (l' := x :: l ++ l'); auto. Qed. - + Theorem Permutation_cons_app : forall (l l1 l2:list A) a, Permutation l (l1 ++ l2) -> Permutation (a :: l) (l1 ++ a :: l2). Proof. @@ -895,7 +895,7 @@ Section ListOps. apply trans_eq with (y:= (length l')); trivial. Qed. - Theorem Permutation_rev : forall (l : list A), Permutation l (rev l). + Theorem Permutation_rev : forall (l : list A), Permutation l (rev l). Proof. induction l as [| x l]; simpl; trivial. apply Permutation_trans with (l' := (x::nil)++rev l). @@ -903,7 +903,7 @@ Section ListOps. apply Permutation_app_swap. Qed. - Theorem Permutation_ind_bis : + Theorem Permutation_ind_bis : forall P : list A -> list A -> Prop, P (@nil A) (@nil A) -> (forall x l l', Permutation l l' -> P l l' -> P (x :: l) (x :: l')) -> @@ -922,14 +922,14 @@ Section ListOps. eauto. Qed. - Ltac break_list l x l' H := - destruct l as [|x l']; simpl in *; + Ltac break_list l x l' H := + destruct l as [|x l']; simpl in *; injection H; intros; subst; clear H. Theorem Permutation_app_inv : forall (l1 l2 l3 l4:list A) a, Permutation (l1++a::l2) (l3++a::l4) -> Permutation (l1++l2) (l3 ++ l4). Proof. - set (P:=fun l l' => + set (P:=fun l l' => forall a l1 l2 l3 l4, l=l1++a::l2 -> l'=l3++a::l4 -> Permutation (l1++l2) (l3++l4)). cut (forall l l', Permutation l l' -> P l l'). intros; apply (H _ _ H0 a); auto. @@ -951,10 +951,10 @@ Section ListOps. break_list l3' b l3'' H. auto. apply perm_trans with (c::l3''++b::l4); auto. - break_list l1' c l1'' H1. + break_list l1' c l1'' H1. auto. apply perm_trans with (b::l1''++c::l2); auto. - break_list l3' d l3'' H; break_list l1' e l1'' H1. + break_list l3' d l3'' H; break_list l1' e l1'' H1. auto. apply perm_trans with (e::a::l1''++l2); auto. apply perm_trans with (e::l1''++a::l2); auto. @@ -974,28 +974,28 @@ Section ListOps. apply (H2 _ _ _ _ _ H6 H4). Qed. - Theorem Permutation_cons_inv : + Theorem Permutation_cons_inv : forall l l' a, Permutation (a::l) (a::l') -> Permutation l l'. Proof. - intros; exact (Permutation_app_inv (@nil _) l (@nil _) l' a H). + intros; exact (Permutation_app_inv (@nil _) l (@nil _) l' a H). Qed. Theorem Permutation_cons_app_inv : forall l l1 l2 a, Permutation (a :: l) (l1 ++ a :: l2) -> Permutation l (l1 ++ l2). Proof. - intros; exact (Permutation_app_inv (@nil _) l l1 l2 a H). + intros; exact (Permutation_app_inv (@nil _) l l1 l2 a H). Qed. - - Theorem Permutation_app_inv_l : + + Theorem Permutation_app_inv_l : forall l l1 l2, Permutation (l ++ l1) (l ++ l2) -> Permutation l1 l2. - Proof. + Proof. induction l; simpl; auto. intros. apply IHl. apply Permutation_cons_inv with a; auto. Qed. - Theorem Permutation_app_inv_r : + Theorem Permutation_app_inv_r : forall l l1 l2, Permutation (l1 ++ l) (l2 ++ l) -> Permutation l1 l2. Proof. induction l. @@ -1019,9 +1019,9 @@ Section ListOps. Proof. induction l as [| x l IHl]; destruct l' as [| y l']. left; trivial. - right; apply nil_cons. + right; apply nil_cons. right; unfold not; intro HF; apply (nil_cons (sym_eq HF)). - destruct (eqA_dec x y) as [xeqy|xneqy]; destruct (IHl l') as [leql'|lneql']; + destruct (eqA_dec x y) as [xeqy|xneqy]; destruct (IHl l') as [leql'|lneql']; try (right; unfold not; intro HF; injection HF; intros; contradiction). rewrite xeqy; rewrite leql'; left; trivial. Qed. @@ -1041,21 +1041,21 @@ End ListOps. Section Map. Variables A B : Type. Variable f : A -> B. - + Fixpoint map (l:list A) : list B := match l with | nil => nil | cons a t => cons (f a) (map t) end. - + Lemma in_map : forall (l:list A) (x:A), In x l -> In (f x) (map l). - Proof. + Proof. induction l as [| a l IHl]; simpl in |- *; [ auto | destruct 1; [ left; apply f_equal with (f := f); assumption | auto ] ]. Qed. - + Lemma in_map_iff : forall l y, In y (map l) <-> exists x, f x = y /\ In x l. Proof. induction l; firstorder (subst; auto). @@ -1066,7 +1066,7 @@ Section Map. induction l; simpl; auto. Qed. - Lemma map_nth : forall l d n, + Lemma map_nth : forall l d n, nth n (map l) (f d) = f (nth n l d). Proof. induction l; simpl map; destruct n; firstorder. @@ -1078,15 +1078,15 @@ Section Map. induction n; intros [ | ] ? Heq; simpl in *; inversion Heq; auto. Qed. - Lemma map_app : forall l l', + Lemma map_app : forall l l', map (l++l') = (map l)++(map l'). - Proof. + Proof. induction l; simpl; auto. intros; rewrite IHl; auto. Qed. - + Lemma map_rev : forall l, map (rev l) = rev (map l). - Proof. + Proof. induction l; simpl; auto. rewrite map_app. rewrite IHl; auto. @@ -1094,23 +1094,23 @@ Section Map. Hint Constructors Permutation. - Lemma Permutation_map : + Lemma Permutation_map : forall l l', Permutation l l' -> Permutation (map l) (map l'). - Proof. + Proof. induction 1; simpl; auto; eauto. Qed. (** [flat_map] *) - Fixpoint flat_map (f:A -> list B) (l:list A) {struct l} : + Fixpoint flat_map (f:A -> list B) (l:list A) {struct l} : list B := match l with | nil => nil | cons x t => (f x)++(flat_map f t) end. - + Lemma in_flat_map : forall (f:A->list B)(l:list A)(y:B), - In y (flat_map f l) <-> exists x, In x l /\ In y (f x). + In y (flat_map f l) <-> exists x, In x l /\ In y (f x). Proof. induction l; simpl; split; intros. contradiction. @@ -1126,7 +1126,7 @@ Section Map. exists x; auto. Qed. -End Map. +End Map. Lemma map_id : forall (A :Type) (l : list A), map (fun x => x) l = l. @@ -1134,14 +1134,14 @@ Proof. induction l; simpl; auto; rewrite IHl; auto. Qed. -Lemma map_map : forall (A B C:Type)(f:A->B)(g:B->C) l, +Lemma map_map : forall (A B C:Type)(f:A->B)(g:B->C) l, map g (map f l) = map (fun x => g (f x)) l. Proof. induction l; simpl; auto. rewrite IHl; auto. Qed. -Lemma map_ext : +Lemma map_ext : forall (A B : Type)(f g:A->B), (forall a, f a = g a) -> forall l, map f l = map g l. Proof. induction l; simpl; auto. @@ -1156,17 +1156,17 @@ Qed. Section Fold_Left_Recursor. Variables A B : Type. Variable f : A -> B -> A. - + Fixpoint fold_left (l:list B) (a0:A) {struct l} : A := match l with | nil => a0 | cons b t => fold_left t (f a0 b) end. - - Lemma fold_left_app : forall (l l':list B)(i:A), + + Lemma fold_left_app : forall (l l':list B)(i:A), fold_left (l++l') i = fold_left l' (fold_left l i). Proof. - induction l. + induction l. simpl; auto. intros. simpl. @@ -1175,7 +1175,7 @@ Section Fold_Left_Recursor. End Fold_Left_Recursor. -Lemma fold_left_length : +Lemma fold_left_length : forall (A:Type)(l:list A), fold_left (fun x _ => S x) l 0 = length l. Proof. intro A. @@ -1195,7 +1195,7 @@ Section Fold_Right_Recursor. Variables A B : Type. Variable f : B -> A -> A. Variable a0 : A. - + Fixpoint fold_right (l:list B) : A := match l with | nil => a0 @@ -1204,7 +1204,7 @@ Section Fold_Right_Recursor. End Fold_Right_Recursor. - Lemma fold_right_app : forall (A B:Type)(f:A->B->B) l l' i, + Lemma fold_right_app : forall (A B:Type)(f:A->B->B) l l' i, fold_right f i (l++l') = fold_right f (fold_right f i l') l. Proof. induction l. @@ -1213,7 +1213,7 @@ End Fold_Right_Recursor. f_equal; auto. Qed. - Lemma fold_left_rev_right : forall (A B:Type)(f:A->B->B) l i, + Lemma fold_left_rev_right : forall (A B:Type)(f:A->B->B) l i, fold_right f i (rev l) = fold_left (fun x y => f y x) l i. Proof. induction l. @@ -1264,20 +1264,20 @@ End Fold_Right_Recursor. (** ** Boolean operations over lists *) (*************************************) - Section Bool. + Section Bool. Variable A : Type. Variable f : A -> bool. - (** find whether a boolean function can be satisfied by an + (** find whether a boolean function can be satisfied by an elements of the list. *) - Fixpoint existsb (l:list A) {struct l}: bool := - match l with + Fixpoint existsb (l:list A) {struct l}: bool := + match l with | nil => false | a::l => f a || existsb l end. - Lemma existsb_exists : + Lemma existsb_exists : forall l, existsb l = true <-> exists x, In x l /\ f x = true. Proof. induction l; simpl; intuition. @@ -1296,11 +1296,11 @@ End Fold_Right_Recursor. inversion 1. simpl; intros. destruct (orb_false_elim _ _ H0); clear H0; auto. - destruct n ; auto. + destruct n ; auto. rewrite IHl; auto with arith. Qed. - Lemma existsb_app : forall l1 l2, + Lemma existsb_app : forall l1 l2, existsb (l1++l2) = existsb l1 || existsb l2. Proof. induction l1; intros l2; simpl. @@ -1308,16 +1308,16 @@ End Fold_Right_Recursor. case (f a); simpl; solve[auto]. Qed. - (** find whether a boolean function is satisfied by + (** find whether a boolean function is satisfied by all the elements of a list. *) - Fixpoint forallb (l:list A) {struct l} : bool := - match l with + Fixpoint forallb (l:list A) {struct l} : bool := + match l with | nil => true | a::l => f a && forallb l end. - Lemma forallb_forall : + Lemma forallb_forall : forall l, forallb l = true <-> (forall x, In x l -> f x = true). Proof. induction l; simpl; intuition. @@ -1326,7 +1326,7 @@ End Fold_Right_Recursor. destruct (andb_prop _ _ H1); auto. assert (forallb l = true). apply H0; intuition. - rewrite H1; auto. + rewrite H1; auto. Qed. Lemma forallb_app : @@ -1338,8 +1338,8 @@ End Fold_Right_Recursor. Qed. (** [filter] *) - Fixpoint filter (l:list A) : list A := - match l with + Fixpoint filter (l:list A) : list A := + match l with | nil => nil | x :: l => if f x then x::(filter l) else filter l end. @@ -1362,10 +1362,10 @@ End Fold_Right_Recursor. (** [partition] *) - Fixpoint partition (l:list A) {struct l} : list A * list A := + Fixpoint partition (l:list A) {struct l} : list A * list A := match l with | nil => (nil, nil) - | x :: tl => let (g,d) := partition tl in + | x :: tl => let (g,d) := partition tl in if f x then (x::g,d) else (g,x::d) end. @@ -1380,7 +1380,7 @@ End Fold_Right_Recursor. Section ListPairs. Variables A B : Type. - + (** [split] derives two lists from a list of pairs *) Fixpoint split (l:list (A*B)) { struct l }: list A * list B := @@ -1389,8 +1389,8 @@ End Fold_Right_Recursor. | (x,y) :: tl => let (g,d) := split tl in (x::g, y::d) end. - Lemma in_split_l : forall (l:list (A*B))(p:A*B), - In p l -> In (fst p) (fst (split l)). + Lemma in_split_l : forall (l:list (A*B))(p:A*B), + In p l -> In (fst p) (fst (split l)). Proof. induction l; simpl; intros; auto. destruct p; destruct a; destruct (split l); simpl in *. @@ -1399,8 +1399,8 @@ End Fold_Right_Recursor. right; apply (IHl (a0,b) H). Qed. - Lemma in_split_r : forall (l:list (A*B))(p:A*B), - In p l -> In (snd p) (snd (split l)). + Lemma in_split_r : forall (l:list (A*B))(p:A*B), + In p l -> In (snd p) (snd (split l)). Proof. induction l; simpl; intros; auto. destruct p; destruct a; destruct (split l); simpl in *. @@ -1409,7 +1409,7 @@ End Fold_Right_Recursor. right; apply (IHl (a0,b) H). Qed. - Lemma split_nth : forall (l:list (A*B))(n:nat)(d:A*B), + Lemma split_nth : forall (l:list (A*B))(n:nat)(d:A*B), nth n l d = (nth n (fst (split l)) (fst d), nth n (snd (split l)) (snd d)). Proof. induction l. @@ -1421,21 +1421,21 @@ End Fold_Right_Recursor. Qed. Lemma split_length_l : forall (l:list (A*B)), - length (fst (split l)) = length l. + length (fst (split l)) = length l. Proof. induction l; simpl; auto. destruct a; destruct (split l); simpl; auto. Qed. Lemma split_length_r : forall (l:list (A*B)), - length (snd (split l)) = length l. + length (snd (split l)) = length l. Proof. induction l; simpl; auto. destruct a; destruct (split l); simpl; auto. Qed. - (** [combine] is the opposite of [split]. - Lists given to [combine] are meant to be of same length. + (** [combine] is the opposite of [split]. + Lists given to [combine] are meant to be of same length. If not, [combine] stops on the shorter list *) Fixpoint combine (l : list A) (l' : list B){struct l} : list (A*B) := @@ -1444,17 +1444,17 @@ End Fold_Right_Recursor. | _, _ => nil end. - Lemma split_combine : forall (l: list (A*B)), + Lemma split_combine : forall (l: list (A*B)), let (l1,l2) := split l in combine l1 l2 = l. Proof. induction l. simpl; auto. - destruct a; simpl. + destruct a; simpl. destruct (split l); simpl in *. f_equal; auto. Qed. - Lemma combine_split : forall (l:list A)(l':list B), length l = length l' -> + Lemma combine_split : forall (l:list A)(l':list B), length l = length l' -> split (combine l l') = (l,l'). Proof. induction l; destruct l'; simpl; intros; auto; try discriminate. @@ -1462,19 +1462,19 @@ End Fold_Right_Recursor. rewrite IHl; auto. Qed. - Lemma in_combine_l : forall (l:list A)(l':list B)(x:A)(y:B), + Lemma in_combine_l : forall (l:list A)(l':list B)(x:A)(y:B), In (x,y) (combine l l') -> In x l. Proof. induction l. simpl; auto. destruct l'; simpl; auto; intros. - contradiction. + contradiction. destruct H. injection H; auto. right; apply IHl with l' y; auto. Qed. - Lemma in_combine_r : forall (l:list A)(l':list B)(x:A)(y:B), + Lemma in_combine_r : forall (l:list A)(l':list B)(x:A)(y:B), In (x,y) (combine l l') -> In y l'. Proof. induction l. @@ -1485,7 +1485,7 @@ End Fold_Right_Recursor. right; apply IHl with x; auto. Qed. - Lemma combine_length : forall (l:list A)(l':list B), + Lemma combine_length : forall (l:list A)(l':list B), length (combine l l') = min (length l) (length l'). Proof. induction l. @@ -1493,8 +1493,8 @@ End Fold_Right_Recursor. destruct l'; simpl; auto. Qed. - Lemma combine_nth : forall (l:list A)(l':list B)(n:nat)(x:A)(y:B), - length l = length l' -> + Lemma combine_nth : forall (l:list A)(l':list B)(n:nat)(x:A)(y:B), + length l = length l' -> nth n (combine l l') (x,y) = (nth n l x, nth n l' y). Proof. induction l; destruct l'; intros; try discriminate. @@ -1503,7 +1503,7 @@ End Fold_Right_Recursor. Qed. (** [list_prod] has the same signature as [combine], but unlike - [combine], it adds every possible pairs, not only those at the + [combine], it adds every possible pairs, not only those at the same position. *) Fixpoint list_prod (l:list A) (l':list B) {struct l} : @@ -1516,7 +1516,7 @@ End Fold_Right_Recursor. Lemma in_prod_aux : forall (x:A) (y:B) (l:list B), In y l -> In (x, y) (map (fun y0:B => (x, y0)) l). - Proof. + Proof. induction l; [ simpl in |- *; auto | simpl in |- *; destruct 1 as [H1| ]; @@ -1526,15 +1526,15 @@ End Fold_Right_Recursor. Lemma in_prod : forall (l:list A) (l':list B) (x:A) (y:B), In x l -> In y l' -> In (x, y) (list_prod l l'). - Proof. + Proof. induction l; [ simpl in |- *; tauto | simpl in |- *; intros; apply in_or_app; destruct H; [ left; rewrite H; apply in_prod_aux; assumption | right; auto ] ]. Qed. - Lemma in_prod_iff : - forall (l:list A)(l':list B)(x:A)(y:B), + Lemma in_prod_iff : + forall (l:list A)(l':list B)(x:A)(y:B), In (x,y) (list_prod l l') <-> In x l /\ In y l'. Proof. split; [ | intros; apply in_prod; intuition ]. @@ -1545,9 +1545,9 @@ End Fold_Right_Recursor. destruct (H1 H0) as (z,(H2,H3)); clear H0 H1. injection H2; clear H2; intros; subst; intuition. intuition. - Qed. + Qed. - Lemma prod_length : forall (l:list A)(l':list B), + Lemma prod_length : forall (l:list A)(l':list B), length (list_prod l l') = (length l) * (length l'). Proof. induction l; simpl; auto. @@ -1581,34 +1581,34 @@ Section length_order. Variables l m n : list A. Lemma lel_refl : lel l l. - Proof. + Proof. unfold lel in |- *; auto with arith. Qed. Lemma lel_trans : lel l m -> lel m n -> lel l n. - Proof. + Proof. unfold lel in |- *; intros. now_show (length l <= length n). apply le_trans with (length m); auto with arith. Qed. Lemma lel_cons_cons : lel l m -> lel (a :: l) (b :: m). - Proof. + Proof. unfold lel in |- *; simpl in |- *; auto with arith. Qed. Lemma lel_cons : lel l m -> lel l (b :: m). - Proof. + Proof. unfold lel in |- *; simpl in |- *; auto with arith. Qed. Lemma lel_tail : lel (a :: l) (b :: m) -> lel l m. - Proof. + Proof. unfold lel in |- *; simpl in |- *; auto with arith. Qed. Lemma lel_nil : forall l':list A, lel l' nil -> nil = l'. - Proof. + Proof. intro l'; elim l'; auto with arith. intros a' y H H0. now_show (nil = a' :: y). @@ -1630,39 +1630,39 @@ Section SetIncl. Definition incl (l m:list A) := forall a:A, In a l -> In a m. Hint Unfold incl. - + Lemma incl_refl : forall l:list A, incl l l. - Proof. + Proof. auto. Qed. Hint Resolve incl_refl. - + Lemma incl_tl : forall (a:A) (l m:list A), incl l m -> incl l (a :: m). - Proof. + Proof. auto with datatypes. Qed. Hint Immediate incl_tl. Lemma incl_tran : forall l m n:list A, incl l m -> incl m n -> incl l n. - Proof. + Proof. auto. Qed. - + Lemma incl_appl : forall l m n:list A, incl l n -> incl l (n ++ m). - Proof. + Proof. auto with datatypes. Qed. Hint Immediate incl_appl. - + Lemma incl_appr : forall l m n:list A, incl l n -> incl l (m ++ n). - Proof. + Proof. auto with datatypes. Qed. Hint Immediate incl_appr. - + Lemma incl_cons : forall (a:A) (l m:list A), In a m -> incl l m -> incl (a :: l) m. - Proof. + Proof. unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1. now_show (In a0 m). elim H1. @@ -1674,15 +1674,15 @@ Section SetIncl. auto. Qed. Hint Resolve incl_cons. - + Lemma incl_app : forall l m n:list A, incl l n -> incl m n -> incl (l ++ m) n. - Proof. + Proof. unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1. now_show (In a n). elim (in_app_or _ _ _ H1); auto. Qed. Hint Resolve incl_app. - + End SetIncl. Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons @@ -1697,24 +1697,24 @@ Section Cutting. Variable A : Type. - Fixpoint firstn (n:nat)(l:list A) {struct n} : list A := - match n with - | 0 => nil - | S n => match l with - | nil => nil + Fixpoint firstn (n:nat)(l:list A) {struct n} : list A := + match n with + | 0 => nil + | S n => match l with + | nil => nil | a::l => a::(firstn n l) end end. - - Fixpoint skipn (n:nat)(l:list A) { struct n } : list A := - match n with - | 0 => l - | S n => match l with - | nil => nil + + Fixpoint skipn (n:nat)(l:list A) { struct n } : list A := + match n with + | 0 => l + | S n => match l with + | nil => nil | a::l => skipn n l end end. - + Lemma firstn_skipn : forall n l, firstn n l ++ skipn n l = l. Proof. induction n. @@ -1728,7 +1728,7 @@ Section Cutting. induction n; destruct l; simpl; auto. Qed. - Lemma removelast_firstn : forall n l, n < length l -> + Lemma removelast_firstn : forall n l, n < length l -> removelast (firstn (S n) l) = firstn n l. Proof. induction n; destruct l. @@ -1741,13 +1741,13 @@ Section Cutting. change (firstn (S n) (a::l)) with (a::firstn n l). rewrite removelast_app. rewrite IHn; auto with arith. - + clear IHn; destruct l; simpl in *; try discriminate. inversion_clear H. inversion_clear H0. Qed. - Lemma firstn_removelast : forall n l, n < length l -> + Lemma firstn_removelast : forall n l, n < length l -> firstn n (removelast l) = firstn n l. Proof. induction n; destruct l. @@ -1772,10 +1772,10 @@ End Cutting. Section ReDun. Variable A : Type. - - Inductive NoDup : list A -> Prop := - | NoDup_nil : NoDup nil - | NoDup_cons : forall x l, ~ In x l -> NoDup l -> NoDup (x::l). + + Inductive NoDup : list A -> Prop := + | NoDup_nil : NoDup nil + | NoDup_cons : forall x l, ~ In x l -> NoDup l -> NoDup (x::l). Lemma NoDup_remove_1 : forall l l' a, NoDup (l++a::l') -> NoDup (l++l'). Proof. @@ -1800,10 +1800,10 @@ Section ReDun. destruct (IHl _ _ H1); auto. Qed. - Lemma NoDup_Permutation : forall l l', + Lemma NoDup_Permutation : forall l l', NoDup l -> NoDup l' -> (forall x, In x l <-> In x l') -> Permutation l l'. Proof. - induction l. + induction l. destruct l'; simpl; intros. apply perm_nil. destruct (H1 a) as (_,H2); destruct H2; auto. @@ -1823,7 +1823,7 @@ Section ReDun. subst x; destruct H2; auto. assert (In x (l'1++a::l'2)). apply in_or_app; destruct (in_app_or _ _ _ H); simpl; auto. - destruct (H1 x) as (_,H5); destruct H5; auto. + destruct (H1 x) as (_,H5); destruct H5; auto. subst x. destruct (NoDup_remove_2 _ _ _ H0 H). Qed. @@ -1837,21 +1837,21 @@ End ReDun. Section NatSeq. - (** [seq] computes the sequence of [len] contiguous integers + (** [seq] computes the sequence of [len] contiguous integers that starts at [start]. For instance, [seq 2 3] is [2::3::4::nil]. *) - - Fixpoint seq (start len:nat) {struct len} : list nat := - match len with + + Fixpoint seq (start len:nat) {struct len} : list nat := + match len with | 0 => nil | S len => start :: seq (S start) len - end. - + end. + Lemma seq_length : forall len start, length (seq start len) = len. Proof. induction len; simpl; auto. Qed. - - Lemma seq_nth : forall len start n d, + + Lemma seq_nth : forall len start n d, n < len -> nth n (seq start len) d = start+n. Proof. induction len; intros. @@ -1864,7 +1864,7 @@ Section NatSeq. Lemma seq_shift : forall len start, map S (seq start len) = seq (S start) len. - Proof. + Proof. induction len; simpl; auto. intros. rewrite IHlen. diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v index 77caa9c22..d8a8183f3 100644 --- a/theories/Lists/ListSet.v +++ b/theories/Lists/ListSet.v @@ -47,7 +47,7 @@ Section first_definitions. | right _ => set_mem a x1 end end. - + (** If [a] belongs to [x], removes [a] from [x]. If not, does nothing *) Fixpoint set_remove (a:A) (x:set) {struct x} : set := match x with @@ -72,7 +72,7 @@ Section first_definitions. | nil => x | a1 :: y1 => set_add a1 (set_union x y1) end. - + (** returns the set of all els of [x] that does not belong to [y] *) Fixpoint set_diff (x y:set) {struct x} : set := match x with @@ -80,7 +80,7 @@ Section first_definitions. | a1 :: x1 => if set_mem a1 y then set_diff x1 y else set_add a1 (set_diff x1 y) end. - + Definition set_In : A -> set -> Prop := In (A:=A). @@ -123,7 +123,7 @@ Section first_definitions. case H3; auto. Qed. - + Lemma set_mem_correct1 : forall (a:A) (x:set), set_mem a x = true -> set_In a x. Proof. @@ -191,11 +191,11 @@ Section first_definitions. Lemma set_add_intro : forall (a b:A) (x:set), a = b \/ set_In a x -> set_In a (set_add b x). - + Proof. intros a b x [H1| H2]; auto with datatypes. Qed. - + Lemma set_add_elim : forall (a b:A) (x:set), set_In a (set_add b x) -> a = b \/ set_In a x. @@ -225,7 +225,7 @@ Section first_definitions. simple induction x; simpl in |- *. discriminate. intros; elim (Aeq_dec a a0); intros; discriminate. - Qed. + Qed. Lemma set_union_intro1 : @@ -289,7 +289,7 @@ Section first_definitions. elim (set_mem a y); simpl in |- *; intros. auto with datatypes. absurd (set_In a y); auto with datatypes. - elim (set_mem a0 y); [ right; auto with datatypes | auto with datatypes ]. + elim (set_mem a0 y); [ right; auto with datatypes | auto with datatypes ]. Qed. Lemma set_inter_elim1 : @@ -324,7 +324,7 @@ Section first_definitions. set_In a (set_inter x y) -> set_In a x /\ set_In a y. Proof. eauto with datatypes. - Qed. + Qed. Lemma set_diff_intro : forall (a:A) (x y:set), @@ -354,7 +354,7 @@ Section first_definitions. forall (a:A) (x y:set), set_In a (set_diff x y) -> ~ set_In a y. intros a x y; elim x; simpl in |- *. intros; contradiction. - intros a0 l Hrec. + intros a0 l Hrec. apply set_mem_ind2; auto. intros H1 H2; case (set_add_elim _ _ _ H2); intros; auto. rewrite H; trivial. @@ -387,10 +387,10 @@ Section other_definitions. Definition set_fold_left : (B -> A -> B) -> set A -> B -> B := fold_left (A:=B) (B:=A). - Definition set_fold_right (f:A -> B -> B) (x:set A) + Definition set_fold_right (f:A -> B -> B) (x:set A) (b:B) : B := fold_right f b x. - + End other_definitions. Unset Implicit Arguments. diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v index 2da70c467..0a21a9e27 100644 --- a/theories/Lists/ListTactics.v +++ b/theories/Lists/ListTactics.v @@ -22,10 +22,10 @@ Ltac list_fold_right fcons fnil l := Ltac lazy_list_fold_right fcons fnil l := let f := match l with - | ?x :: ?tl => + | ?x :: ?tl => fun _ => fcons x ltac:(fun _ => lazy_list_fold_right fcons fnil tl) - | nil => fun _ => fnil() + | nil => fun _ => fnil() end in f(). @@ -75,7 +75,7 @@ Ltac check_is_list t := Ltac check_fv l := check_is_list l; - match type of l with + match type of l with | list _ => idtac | _ => fail 100 "anomaly: built an ill-typed list" end. diff --git a/theories/Lists/SetoidList.v b/theories/Lists/SetoidList.v index f55043d37..20af2878b 100644 --- a/theories/Lists/SetoidList.v +++ b/theories/Lists/SetoidList.v @@ -14,15 +14,15 @@ Require Export Setoid. Set Implicit Arguments. Unset Strict Implicit. -(** * Logical relations over lists with respect to a setoid equality - or ordering. *) +(** * Logical relations over lists with respect to a setoid equality + or ordering. *) -(** This can be seen as a complement of predicate [lelistA] and [sort] +(** This can be seen as a complement of predicate [lelistA] and [sort] found in [Sorting]. *) Section Type_with_equality. Variable A : Type. -Variable eqA : A -> A -> Prop. +Variable eqA : A -> A -> Prop. (** Being in a list modulo an equality relation over type [A]. *) @@ -47,7 +47,7 @@ Qed. (** An alternative definition of [InA]. *) Lemma InA_alt : forall x l, InA x l <-> exists y, eqA x y /\ In y l. -Proof. +Proof. induction l; intuition. inversion H. firstorder. @@ -98,10 +98,10 @@ Hint Resolve eqA_refl eqA_trans. Hint Immediate eqA_sym. Lemma InA_eqA : forall l x y, eqA x y -> InA x l -> InA y l. -Proof. +Proof. intros s x y. do 2 rewrite InA_alt. - intros H (z,(U,V)). + intros H (z,(U,V)). exists z; split; eauto. Qed. Hint Immediate InA_eqA. @@ -109,12 +109,12 @@ Hint Immediate InA_eqA. Lemma In_InA : forall l x, In x l -> InA x l. Proof. simple induction l; simpl in |- *; intuition. - subst; auto. + subst; auto. Qed. Hint Resolve In_InA. -Lemma InA_split : forall l x, InA x l -> - exists l1, exists y, exists l2, +Lemma InA_split : forall l x, InA x l -> + exists l1, exists y, exists l2, eqA x y /\ l = l1++y::l2. Proof. induction l; inversion_clear 1. @@ -144,7 +144,7 @@ Proof. apply in_or_app; auto. Qed. -Lemma InA_rev : forall p m, +Lemma InA_rev : forall p m, InA p (rev m) <-> InA p m. Proof. intros; do 2 rewrite InA_alt. @@ -173,20 +173,20 @@ Hint Constructors lelistA sort. Lemma InfA_ltA : forall l x y, ltA x y -> InfA y l -> InfA x l. Proof. - destruct l; constructor; inversion_clear H0; + destruct l; constructor; inversion_clear H0; eapply ltA_trans; eauto. Qed. - + Lemma InfA_eqA : forall l x y, eqA x y -> InfA y l -> InfA x l. Proof. intro s; case s; constructor; inversion_clear H0; eauto. Qed. -Hint Immediate InfA_ltA InfA_eqA. +Hint Immediate InfA_ltA InfA_eqA. Lemma SortA_InfA_InA : forall l x a, SortA l -> InfA a l -> InA x l -> ltA a x. -Proof. +Proof. simple induction l. intros; inversion H1. intros. @@ -194,13 +194,13 @@ Proof. eapply ltA_eqA; eauto. eauto. Qed. - + Lemma In_InfA : forall l x, (forall y, In y l -> ltA x y) -> InfA x l. Proof. simple induction l; simpl in |- *; intros; constructor; auto. Qed. - + Lemma InA_InfA : forall l x, (forall y, InA y l -> ltA x y) -> InfA x l. Proof. @@ -209,9 +209,9 @@ Qed. (* In fact, this may be used as an alternative definition for InfA: *) -Lemma InfA_alt : +Lemma InfA_alt : forall l x, SortA l -> (InfA x l <-> (forall y, InA y l -> ltA x y)). -Proof. +Proof. split. intros; eapply SortA_InfA_InA; eauto. apply InA_InfA. @@ -242,14 +242,14 @@ Proof. simple induction l; auto. intros x l' H H0. inversion_clear H0. - constructor; auto. + constructor; auto. intro. assert (ltA x x) by (eapply SortA_InfA_InA; eauto). elim (ltA_not_eqA H3); auto. Qed. -Lemma NoDupA_app : forall l l', NoDupA l -> NoDupA l' -> - (forall x, InA x l -> InA x l' -> False) -> +Lemma NoDupA_app : forall l l', NoDupA l -> NoDupA l' -> + (forall x, InA x l -> InA x l' -> False) -> NoDupA (l++l'). Proof. induction l; simpl; auto; intros. @@ -325,14 +325,14 @@ Proof. induction 1; auto; simpl; congruence. Qed. -Lemma eqlistA_app : forall l1 l1' l2 l2', +Lemma eqlistA_app : forall l1 l1' l2 l2', eqlistA l1 l1' -> eqlistA l2 l2' -> eqlistA (l1++l2) (l1'++l2'). Proof. intros l1 l1' l2 l2' H; revert l2 l2'; induction H; simpl; auto. Qed. -Lemma eqlistA_rev_app : forall l1 l1', - eqlistA l1 l1' -> forall l2 l2', eqlistA l2 l2' -> +Lemma eqlistA_rev_app : forall l1 l1', + eqlistA l1 l1' -> forall l2 l2', eqlistA l2 l2' -> eqlistA ((rev l1)++l2) ((rev l1')++l2'). Proof. induction 1; auto. @@ -340,7 +340,7 @@ simpl; intros. do 2 rewrite app_ass; simpl; auto. Qed. -Lemma eqlistA_rev : forall l1 l1', +Lemma eqlistA_rev : forall l1 l1', eqlistA l1 l1' -> eqlistA (rev l1) (rev l1'). Proof. intros. @@ -349,12 +349,12 @@ rewrite (app_nil_end (rev l1')). apply eqlistA_rev_app; auto. Qed. -Lemma SortA_equivlistA_eqlistA : forall l l', +Lemma SortA_equivlistA_eqlistA : forall l l', SortA l -> SortA l' -> equivlistA l l' -> eqlistA l l'. Proof. induction l; destruct l'; simpl; intros; auto. -destruct (H1 a); assert (H4 : InA a nil) by auto; inversion H4. -destruct (H1 a); assert (H4 : InA a nil) by auto; inversion H4. +destruct (H1 a); assert (H4 : InA a nil) by auto; inversion H4. +destruct (H1 a); assert (H4 : InA a nil) by auto; inversion H4. inversion_clear H; inversion_clear H0. assert (forall y, InA y l -> ltA a y). intros; eapply SortA_InfA_InA with (l:=l); eauto. @@ -374,10 +374,10 @@ constructor; auto. apply IHl; auto. split; intros. destruct (H1 x). -assert (H8 : InA x (a0::l')) by auto; inversion_clear H8; auto. +assert (H8 : InA x (a0::l')) by auto; inversion_clear H8; auto. elim (@ltA_not_eqA a x); eauto. destruct (H1 x). -assert (H8 : InA x (a::l)) by auto; inversion_clear H8; auto. +assert (H8 : InA x (a::l)) by auto; inversion_clear H8; auto. elim (@ltA_not_eqA a0 x); eauto. Qed. @@ -399,7 +399,7 @@ rewrite filter_In in H; destruct H. eapply SortA_InfA_InA; eauto. Qed. -Lemma filter_InA : forall f, (compat_bool f) -> +Lemma filter_InA : forall f, (compat_bool f) -> forall l x, InA x (List.filter f l) <-> InA x l /\ f x = true. Proof. intros; do 2 rewrite InA_alt; intuition. @@ -410,8 +410,8 @@ destruct H1 as (y,(H0,H1)); exists y; rewrite filter_In; intuition. rewrite <- (H _ _ H0); auto. Qed. -Lemma filter_split : - forall f, (forall x y, f x = true -> f y = false -> ltA x y) -> +Lemma filter_split : + forall f, (forall x y, f x = true -> f y = false -> ltA x y) -> forall l, SortA l -> l = filter f l ++ filter (fun x=>negb (f x)) l. Proof. induction l; simpl; intros; auto. @@ -443,7 +443,7 @@ Definition compat_op (f : A -> B -> B) := (** Two-argument functions that allow to reorder their arguments. *) Definition transpose (f : A -> B -> B) := - forall (x y : A) (z : B), eqB (f x (f y z)) (f y (f x z)). + forall (x y : A) (z : B), eqB (f x (f y z)) (f y (f x z)). (** A version of transpose with restriction on where it should hold *) Definition transpose_restr (R : A -> A -> Prop)(f : A -> B -> B) := @@ -454,16 +454,16 @@ Variable f:A->B->B. Variable i:B. Variable Comp:compat_op f. -Lemma fold_right_eqlistA : - forall s s', eqlistA s s' -> +Lemma fold_right_eqlistA : + forall s s', eqlistA s s' -> eqB (fold_right f i s) (fold_right f i s'). Proof. induction 1; simpl; auto. reflexivity. Qed. -Lemma equivlistA_NoDupA_split : forall l l1 l2 x y, eqA x y -> - NoDupA (x::l) -> NoDupA (l1++y::l2) -> +Lemma equivlistA_NoDupA_split : forall l l1 l2 x y, eqA x y -> + NoDupA (x::l) -> NoDupA (l1++y::l2) -> equivlistA (x::l) (l1++y::l2) -> equivlistA l (l1++l2). Proof. intros; intro a. @@ -687,7 +687,7 @@ destruct (eqA_dec x a). left; auto. destruct IHl. left; auto. -right; red; inversion_clear 1; contradiction. +right; red; inversion_clear 1; contradiction. Qed. Fixpoint removeA (x : A) (l : list A){struct l} : list A := @@ -731,16 +731,16 @@ Proof. simple induction s; simpl; intros. auto. inversion_clear H0. -destruct (eqA_dec x a); simpl; auto. +destruct (eqA_dec x a); simpl; auto. constructor; auto. rewrite removeA_InA. intuition. -Qed. +Qed. -Lemma removeA_equivlistA : forall l l' x, +Lemma removeA_equivlistA : forall l l' x, ~InA x l -> equivlistA (x :: l) l' -> equivlistA l (removeA x l'). -Proof. -unfold equivlistA; intros. +Proof. +unfold equivlistA; intros. rewrite removeA_InA. split; intros. rewrite <- H0; split; auto. @@ -761,22 +761,22 @@ End Type_with_equality. Hint Unfold compat_bool compat_nat compat_P. Hint Constructors InA NoDupA sort lelistA eqlistA. -Section Find. -Variable A B : Type. -Variable eqA : A -> A -> Prop. +Section Find. +Variable A B : Type. +Variable eqA : A -> A -> Prop. Hypothesis eqA_sym : forall x y, eqA x y -> eqA y x. Hypothesis eqA_trans : forall x y z, eqA x y -> eqA y z -> eqA x z. Hypothesis eqA_dec : forall x y : A, {eqA x y}+{~(eqA x y)}. -Fixpoint findA (f : A -> bool) (l:list (A*B)) : option B := - match l with - | nil => None +Fixpoint findA (f : A -> bool) (l:list (A*B)) : option B := + match l with + | nil => None | (a,b)::l => if f a then Some b else findA f l end. -Lemma findA_NoDupA : - forall l a b, - NoDupA (fun p p' => eqA (fst p) (fst p')) l -> +Lemma findA_NoDupA : + forall l a b, + NoDupA (fun p p' => eqA (fst p) (fst p')) l -> (InA (fun p p' => eqA (fst p) (fst p') /\ snd p = snd p') (a,b) l <-> findA (fun a' => if eqA_dec a a' then true else false) l = Some b). Proof. @@ -808,4 +808,4 @@ constructor 2. rewrite IHl; auto. Qed. -End Find. +End Find. diff --git a/theories/Lists/StreamMemo.v b/theories/Lists/StreamMemo.v index bdbe0eccc..e8b935841 100644 --- a/theories/Lists/StreamMemo.v +++ b/theories/Lists/StreamMemo.v @@ -11,8 +11,8 @@ Require Import Streams. (** * Memoization *) -(** Successive outputs of a given function [f] are stored in - a stream in order to avoid duplicated computations. *) +(** Successive outputs of a given function [f] are stored in + a stream in order to avoid duplicated computations. *) Section MemoFunction. @@ -24,8 +24,8 @@ CoFixpoint memo_make (n:nat) : Stream A := Cons (f n) (memo_make (S n)). Definition memo_list := memo_make 0. Fixpoint memo_get (n:nat) (l:Stream A) : A := - match n with - | O => hd l + match n with + | O => hd l | S n1 => memo_get n1 (tl l) end. @@ -49,7 +49,7 @@ Variable g: A -> A. Hypothesis Hg_correct: forall n, f (S n) = g (f n). CoFixpoint imemo_make (fn:A) : Stream A := - let fn1 := g fn in + let fn1 := g fn in Cons fn1 (imemo_make fn1). Definition imemo_list := let f0 := f 0 in @@ -68,7 +68,7 @@ Qed. End MemoFunction. -(** For a dependent function, the previous solution is +(** For a dependent function, the previous solution is reused thanks to a temporarly hiding of the dependency in a "container" [memo_val]. *) @@ -88,7 +88,7 @@ Fixpoint is_eq (n m : nat) {struct n}: {n = m} + {True} := | S n1, S m1 => match is_eq n1 m1 with | left H => left True (f_equal S H) - | right _ => right (S n1 = S m1) I + | right _ => right (S n1 = S m1) I end end. @@ -134,7 +134,7 @@ Variable g: forall n, A n -> A (S n). Hypothesis Hg_correct: forall n, f (S n) = g n (f n). -Let mg v := match v with +Let mg v := match v with memo_mval n1 v1 => memo_mval (S n1) (g n1 v1) end. Definition dimemo_list := imemo_list _ mf mg. @@ -166,13 +166,13 @@ End DependentMemoFunction. Require Import ZArith. Open Scope Z_scope. -Fixpoint tfact (n: nat) := - match n with - | O => 1 - | S n1 => Z_of_nat n * tfact n1 +Fixpoint tfact (n: nat) := + match n with + | O => 1 + | S n1 => Z_of_nat n * tfact n1 end. -Definition lfact_list := +Definition lfact_list := dimemo_list _ tfact (fun n z => (Z_of_nat (S n) * z)). Definition lfact n := dmemo_get _ tfact n lfact_list. @@ -183,18 +183,18 @@ intros n; unfold lfact, lfact_list. rewrite dimemo_get_correct; auto. Qed. -Fixpoint nop p := +Fixpoint nop p := match p with - | xH => 0 - | xI p1 => nop p1 - | xO p1 => nop p1 + | xH => 0 + | xI p1 => nop p1 + | xO p1 => nop p1 end. -Fixpoint test z := +Fixpoint test z := match z with - | Z0 => 0 - | Zpos p1 => nop p1 - | Zneg p1 => nop p1 + | Z0 => 0 + | Zpos p1 => nop p1 + | Zneg p1 => nop p1 end. Time Eval vm_compute in test (lfact 2000). @@ -202,4 +202,4 @@ Time Eval vm_compute in test (lfact 2000). Time Eval vm_compute in test (lfact 1500). Time Eval vm_compute in (lfact 1500). *) - + diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v index 472265f3e..ace157749 100644 --- a/theories/Lists/Streams.v +++ b/theories/Lists/Streams.v @@ -41,7 +41,7 @@ Definition Str_nth (n:nat) (s:Stream) : A := hd (Str_nth_tl n s). Lemma unfold_Stream : forall x:Stream, x = match x with | Cons a s => Cons a s - end. + end. Proof. intro x. case x. @@ -223,7 +223,7 @@ Variable f: A -> B -> C. CoFixpoint zipWith (a:Stream A) (b:Stream B) : Stream C := Cons (f (hd a) (hd b)) (zipWith (tl a) (tl b)). -Lemma Str_nth_tl_zipWith : forall n (a:Stream A) (b:Stream B), +Lemma Str_nth_tl_zipWith : forall n (a:Stream A) (b:Stream B), Str_nth_tl n (zipWith a b)= zipWith (Str_nth_tl n a) (Str_nth_tl n b). Proof. induction n. diff --git a/theories/Lists/TheoryList.v b/theories/Lists/TheoryList.v index 226d07149..5185f2c53 100644 --- a/theories/Lists/TheoryList.v +++ b/theories/Lists/TheoryList.v @@ -349,7 +349,7 @@ destruct (TS_dec a) as [[c H1]| ]. left; exists c. exists a; auto. auto. -(* +(* Realizer try_find. *) Qed. @@ -359,7 +359,7 @@ End Find_sec. Section Assoc_sec. Variable B : Type. -Fixpoint assoc (a:A) (l:list (A * B)) {struct l} : +Fixpoint assoc (a:A) (l:list (A * B)) {struct l} : Exc B := match l with | nil => error diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v index 27e375f62..5b2f5063b 100644 --- a/theories/Logic/Berardi.v +++ b/theories/Logic/Berardi.v @@ -67,10 +67,10 @@ Section Retracts. Variables A B : Prop. -Record retract : Prop := +Record retract : Prop := {i : A -> B; j : B -> A; inv : forall a:A, j (i a) = a}. -Record retract_cond : Prop := +Record retract_cond : Prop := {i2 : A -> B; j2 : B -> A; inv2 : retract -> forall a:A, j2 (i2 a) = a}. @@ -94,7 +94,7 @@ Proof. intros A B. destruct (EM (retract (pow A) (pow B))) as [(f0,g0,e) | hf]. exists f0 g0; trivial. - exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F); intros; + exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F); intros; destruct hf; auto. Qed. diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v index 3f4c4354b..32880b2f7 100644 --- a/theories/Logic/ChoiceFacts.v +++ b/theories/Logic/ChoiceFacts.v @@ -20,7 +20,7 @@ description principles (a "type-theoretic" axiom of choice) - AC! = functional relation reification (known as axiom of unique choice in topos theory, - sometimes called principle of definite description in + sometimes called principle of definite description in the context of constructive type theory) - GAC_rel = guarded relational form of the (non extensional) axiom of choice @@ -146,16 +146,16 @@ Definition ConstructiveDefiniteDescription_on := (** GAC_rel *) -Definition GuardedRelationalChoice_on := +Definition GuardedRelationalChoice_on := forall P : A->Prop, forall R : A->B->Prop, (forall x : A, P x -> exists y : B, R x y) -> - (exists R' : A->B->Prop, + (exists R' : A->B->Prop, subrelation R' R /\ forall x, P x -> exists! y, R' x y). (** GAC_fun *) -Definition GuardedFunctionalChoice_on := - forall P : A->Prop, forall R : A->B->Prop, +Definition GuardedFunctionalChoice_on := + forall P : A->Prop, forall R : A->B->Prop, inhabited B -> (forall x : A, P x -> exists y : B, R x y) -> (exists f : A->B, forall x, P x -> R x (f x)). @@ -163,34 +163,34 @@ Definition GuardedFunctionalChoice_on := (** GFR_fun *) Definition GuardedFunctionalRelReification_on := - forall P : A->Prop, forall R : A->B->Prop, + forall P : A->Prop, forall R : A->B->Prop, inhabited B -> (forall x : A, P x -> exists! y : B, R x y) -> (exists f : A->B, forall x : A, P x -> R x (f x)). (** OAC_rel *) -Definition OmniscientRelationalChoice_on := +Definition OmniscientRelationalChoice_on := forall R : A->B->Prop, - exists R' : A->B->Prop, + exists R' : A->B->Prop, subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y. (** OAC_fun *) -Definition OmniscientFunctionalChoice_on := - forall R : A->B->Prop, +Definition OmniscientFunctionalChoice_on := + forall R : A->B->Prop, inhabited B -> exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x). (** D_epsilon *) -Definition EpsilonStatement_on := +Definition EpsilonStatement_on := forall P:A->Prop, inhabited A -> { x:A | (exists x, P x) -> P x }. (** D_iota *) -Definition IotaStatement_on := +Definition IotaStatement_on := forall P:A->Prop, inhabited A -> { x:A | (exists! x, P x) -> P x }. @@ -207,7 +207,7 @@ Notation FunctionalChoiceOnInhabitedSet := Notation FunctionalRelReification := (forall A B, FunctionalRelReification_on A B). -Notation GuardedRelationalChoice := +Notation GuardedRelationalChoice := (forall A B, GuardedRelationalChoice_on A B). Notation GuardedFunctionalChoice := (forall A B, GuardedFunctionalChoice_on A B). @@ -219,14 +219,14 @@ Notation OmniscientRelationalChoice := Notation OmniscientFunctionalChoice := (forall A B, OmniscientFunctionalChoice_on A B). -Notation ConstructiveDefiniteDescription := +Notation ConstructiveDefiniteDescription := (forall A, ConstructiveDefiniteDescription_on A). -Notation ConstructiveIndefiniteDescription := +Notation ConstructiveIndefiniteDescription := (forall A, ConstructiveIndefiniteDescription_on A). -Notation IotaStatement := +Notation IotaStatement := (forall A, IotaStatement_on A). -Notation EpsilonStatement := +Notation EpsilonStatement := (forall A, EpsilonStatement_on A). (** Subclassical schemes *) @@ -235,7 +235,7 @@ Definition ProofIrrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. Definition IndependenceOfGeneralPremises := - forall (A:Type) (P:A -> Prop) (Q:Prop), + forall (A:Type) (P:A -> Prop) (Q:Prop), inhabited A -> (Q -> exists x, P x) -> exists x, Q -> P x. @@ -270,7 +270,7 @@ Proof. apply HR'R; assumption. Qed. -Lemma funct_choice_imp_rel_choice : +Lemma funct_choice_imp_rel_choice : forall A B, FunctionalChoice_on A B -> RelationalChoice_on A B. Proof. intros A B FunCh R H. @@ -283,7 +283,7 @@ Proof. trivial. Qed. -Lemma funct_choice_imp_description : +Lemma funct_choice_imp_description : forall A B, FunctionalChoice_on A B -> FunctionalRelReification_on A B. Proof. intros A B FunCh R H. @@ -297,7 +297,7 @@ Proof. Qed. Corollary FunChoice_Equiv_RelChoice_and_ParamDefinDescr : - forall A B, FunctionalChoice_on A B <-> + forall A B, FunctionalChoice_on A B <-> RelationalChoice_on A B /\ FunctionalRelReification_on A B. Proof. intros A B; split. @@ -312,7 +312,7 @@ Qed. (** We show that the guarded formulations of the axiom of choice are equivalent to their "omniscient" variant and comes from the non guarded - formulation in presence either of the independance of general premises + formulation in presence either of the independance of general premises or subset types (themselves derivable from subtypes thanks to proof- irrelevance) *) @@ -341,12 +341,12 @@ Proof. Qed. Lemma rel_choice_indep_of_general_premises_imp_guarded_rel_choice : - forall A B, inhabited B -> RelationalChoice_on A B -> + forall A B, inhabited B -> RelationalChoice_on A B -> IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B. Proof. intros A B Inh AC_rel IndPrem P R H. destruct (AC_rel (fun x y => P x -> R x y)) as (R',(HR'R,H0)). - intro x. apply IndPrem. exact Inh. intro Hx. + intro x. apply IndPrem. exact Inh. intro Hx. apply H; assumption. exists (fun x y => P x /\ R' x y). firstorder. @@ -385,7 +385,7 @@ Qed. (** ** AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker *) (** AC_fun + IGP = GAC_fun *) - + Lemma guarded_fun_choice_imp_indep_of_general_premises : GuardedFunctionalChoice -> IndependenceOfGeneralPremises. Proof. @@ -446,7 +446,7 @@ Proof. Qed. Lemma fun_choice_and_small_drinker_imp_omniscient_fun_choice : - FunctionalChoiceOnInhabitedSet -> SmallDrinker'sParadox + FunctionalChoiceOnInhabitedSet -> SmallDrinker'sParadox -> OmniscientFunctionalChoice. Proof. intros AC_fun Drinker A B R Inh. @@ -456,10 +456,10 @@ Proof. Qed. Corollary fun_choice_and_small_drinker_iff_omniscient_fun_choice : - FunctionalChoiceOnInhabitedSet /\ SmallDrinker'sParadox + FunctionalChoiceOnInhabitedSet /\ SmallDrinker'sParadox <-> OmniscientFunctionalChoice. Proof. - auto decomp using + auto decomp using omniscient_fun_choice_imp_small_drinker, omniscient_fun_choice_imp_fun_choice, fun_choice_and_small_drinker_imp_omniscient_fun_choice. @@ -510,7 +510,7 @@ Lemma constructive_indefinite_description_and_small_drinker_imp_epsilon : SmallDrinker'sParadox -> ConstructiveIndefiniteDescription -> EpsilonStatement. Proof. - intros Drinkers D_epsilon A P Inh; + intros Drinkers D_epsilon A P Inh; apply D_epsilon; apply Drinkers; assumption. Qed. @@ -542,7 +542,7 @@ Qed. We show instead that functional relation reification and the functional form of the axiom of choice are equivalent on decidable - relation with [nat] as codomain + relation with [nat] as codomain *) Require Import Wf_nat. @@ -552,10 +552,10 @@ Definition FunctionalChoice_on_rel (A B:Type) (R:A->B->Prop) := (forall x:A, exists y : B, R x y) -> exists f : A -> B, (forall x:A, R x (f x)). -Lemma classical_denumerable_description_imp_fun_choice : - forall A:Type, - FunctionalRelReification_on A nat -> - forall R:A->nat->Prop, +Lemma classical_denumerable_description_imp_fun_choice : + forall A:Type, + FunctionalRelReification_on A nat -> + forall R:A->nat->Prop, (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R. Proof. intros A Descr. @@ -563,7 +563,7 @@ Proof. set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y'). destruct (Descr R') as (f,Hf). intro x. - apply (dec_inh_nat_subset_has_unique_least_element (R x)). + apply (dec_inh_nat_subset_has_unique_least_element (R x)). apply Rdec. apply (H x). exists f. @@ -582,12 +582,12 @@ Definition DependentFunctionalChoice_on (A:Type) (B:A -> Type) := (forall x:A, exists y : B x, R x y) -> (exists f : (forall x:A, B x), forall x:A, R x (f x)). -Notation DependentFunctionalChoice := +Notation DependentFunctionalChoice := (forall A (B:A->Type), DependentFunctionalChoice_on B). (** The easy part *) -Theorem dep_non_dep_functional_choice : +Theorem dep_non_dep_functional_choice : DependentFunctionalChoice -> FunctionalChoice. Proof. intros AC_depfun A B R H. @@ -606,12 +606,12 @@ Scheme eq_indd := Induction for eq Sort Prop. Definition proj1_inf (A B:Prop) (p : A/\B) := let (a,b) := p in a. -Theorem non_dep_dep_functional_choice : +Theorem non_dep_dep_functional_choice : FunctionalChoice -> DependentFunctionalChoice. Proof. intros AC_fun A B R H. - pose (B' := { x:A & B x }). - pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). + pose (B' := { x:A & B x }). + pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). destruct (AC_fun A B' R') as (f,Hf). intros x. destruct (H x) as (y,Hy). exists (existT (fun x => B x) x y). split; trivial. @@ -633,7 +633,7 @@ Notation DependentFunctionalRelReification := (** The easy part *) -Theorem dep_non_dep_functional_rel_reification : +Theorem dep_non_dep_functional_rel_reification : DependentFunctionalRelReification -> FunctionalRelReification. Proof. intros DepFunReify A B R H. @@ -646,12 +646,12 @@ Qed. conjunction projections and dependent elimination of conjunction and equality *) -Theorem non_dep_dep_functional_rel_reification : +Theorem non_dep_dep_functional_rel_reification : FunctionalRelReification -> DependentFunctionalRelReification. Proof. intros AC_fun A B R H. - pose (B' := { x:A & B x }). - pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). + pose (B' := { x:A & B x }). + pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). destruct (AC_fun A B' R') as (f,Hf). intros x. destruct (H x) as (y,(Hy,Huni)). exists (existT (fun x => B x) x y). repeat split; trivial. @@ -665,7 +665,7 @@ Proof. destruct Heq using eq_indd; trivial. Qed. -Corollary dep_iff_non_dep_functional_rel_reification : +Corollary dep_iff_non_dep_functional_rel_reification : FunctionalRelReification <-> DependentFunctionalRelReification. Proof. auto decomp using @@ -786,11 +786,11 @@ Proof. intros [|] [|] H1 H2; simpl in *; reflexivity || contradiction. left; trivial. right; trivial. -Qed. +Qed. Corollary fun_reification_descr_computational_excluded_middle_in_prop_context : FunctionalRelReification -> - (forall P:Prop, P \/ ~ P) -> + (forall P:Prop, P \/ ~ P) -> forall C:Prop, ((forall P:Prop, {P} + {~ P}) -> C) -> C. Proof. intros FunReify EM C; auto decomp using diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v index dad60fb77..2b9df6d97 100644 --- a/theories/Logic/ClassicalDescription.v +++ b/theories/Logic/ClassicalDescription.v @@ -30,12 +30,12 @@ Axiom constructive_definite_description : Theorem excluded_middle_informative : forall P:Prop, {P} + {~ P}. Proof. -apply - (constructive_definite_descr_excluded_middle +apply + (constructive_definite_descr_excluded_middle constructive_definite_description classic). Qed. -Theorem classical_definite_description : +Theorem classical_definite_description : forall (A : Type) (P : A->Prop), inhabited A -> { x : A | (exists! x : A, P x) -> P x }. Proof. @@ -54,7 +54,7 @@ Qed. Definition iota (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (classical_definite_description P i). -Definition iota_spec (A : Type) (i:inhabited A) (P : A->Prop) : +Definition iota_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists! x:A, P x) -> P (iota i P) := proj2_sig (classical_definite_description P i). diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v index c45aeb6f9..0d65a89ba 100644 --- a/theories/Logic/ClassicalEpsilon.v +++ b/theories/Logic/ClassicalEpsilon.v @@ -22,11 +22,11 @@ Require Import ChoiceFacts. Set Implicit Arguments. Axiom constructive_indefinite_description : - forall (A : Type) (P : A->Prop), + forall (A : Type) (P : A->Prop), (exists x, P x) -> { x : A | P x }. Lemma constructive_definite_description : - forall (A : Type) (P : A->Prop), + forall (A : Type) (P : A->Prop), (exists! x, P x) -> { x : A | P x }. Proof. intros; apply constructive_indefinite_description; firstorder. @@ -34,18 +34,18 @@ Qed. Theorem excluded_middle_informative : forall P:Prop, {P} + {~ P}. Proof. - apply - (constructive_definite_descr_excluded_middle + apply + (constructive_definite_descr_excluded_middle constructive_definite_description classic). Qed. -Theorem classical_indefinite_description : +Theorem classical_indefinite_description : forall (A : Type) (P : A->Prop), inhabited A -> { x : A | (exists x, P x) -> P x }. Proof. intros A P i. destruct (excluded_middle_informative (exists x, P x)) as [Hex|HnonP]. - apply constructive_indefinite_description + apply constructive_indefinite_description with (P:= fun x => (exists x, P x) -> P x). destruct Hex as (x,Hx). exists x; intros _; exact Hx. @@ -60,7 +60,7 @@ Defined. Definition epsilon (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (classical_indefinite_description P i). -Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : +Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists x, P x) -> P (epsilon i P) := proj2_sig (classical_indefinite_description P i). @@ -76,7 +76,7 @@ Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : the actual proof that the domain of [P] is inhabited (proof idea kindly provided by Pierre Castéran) *) -Lemma epsilon_inh_irrelevance : +Lemma epsilon_inh_irrelevance : forall (A:Type) (i j : inhabited A) (P:A->Prop), (exists x, P x) -> epsilon i P = epsilon j P. Proof. diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v index d4ba4a3a7..9ec916a7d 100644 --- a/theories/Logic/ClassicalFacts.v +++ b/theories/Logic/ClassicalFacts.v @@ -111,7 +111,7 @@ Qed. (** We successively show that: [prop_extensionality] - implies equality of [A] and [A->A] for inhabited [A], which + implies equality of [A] and [A->A] for inhabited [A], which implies the existence of a (trivial) retract from [A->A] to [A] (just take the identity), which implies the existence of a fixpoint operator in [A] @@ -128,7 +128,7 @@ Proof. apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ]. Qed. -Record retract (A B:Prop) : Prop := +Record retract (A B:Prop) : Prop := {f1 : A -> B; f2 : B -> A; f1_o_f2 : forall x:B, f1 (f2 x) = x}. Lemma prop_ext_retract_A_A_imp_A : @@ -140,7 +140,7 @@ Proof. reflexivity. Qed. -Record has_fixpoint (A:Prop) : Prop := +Record has_fixpoint (A:Prop) : Prop := {F : (A -> A) -> A; Fix : forall f:A -> A, F f = f (F f)}. Lemma ext_prop_fixpoint : @@ -224,7 +224,7 @@ End Proof_irrelevance_gen. *) Section Proof_irrelevance_Prop_Ext_CC. - + Definition BoolP := forall C:Prop, C -> C -> C. Definition TrueP : BoolP := fun C c1 c2 => c1. Definition FalseP : BoolP := fun C c1 c2 => c2. @@ -233,10 +233,10 @@ Section Proof_irrelevance_Prop_Ext_CC. c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1. Definition BoolP_elim_redr (C:Prop) (c1 c2:C) : c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2. - + Definition BoolP_dep_induction := forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b. - + Lemma ext_prop_dep_proof_irrel_cc : prop_extensionality -> BoolP_dep_induction -> proof_irrelevance. Proof. @@ -248,7 +248,7 @@ End Proof_irrelevance_Prop_Ext_CC. (** Remark: [prop_extensionality] can be replaced in lemma [ext_prop_dep_proof_irrel_gen] by the weakest property - [provable_prop_extensionality]. + [provable_prop_extensionality]. *) (************************************************************************) @@ -260,7 +260,7 @@ End Proof_irrelevance_Prop_Ext_CC. *) Section Proof_irrelevance_CIC. - + Inductive boolP : Prop := | trueP : boolP | falseP : boolP. @@ -269,7 +269,7 @@ Section Proof_irrelevance_CIC. Definition boolP_elim_redr (C:Prop) (c1 c2:C) : c2 = boolP_ind C c1 c2 falseP := refl_equal c2. Scheme boolP_indd := Induction for boolP Sort Prop. - + Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance. Proof. exact (fun pe => @@ -316,7 +316,7 @@ End Proof_irrelevance_CIC. Require Import Hurkens. Section Proof_irrelevance_EM_CC. - + Variable or : Prop -> Prop -> Prop. Variable or_introl : forall A B:Prop, A -> or A B. Variable or_intror : forall A B:Prop, B -> or A B. @@ -334,11 +334,11 @@ Section Proof_irrelevance_EM_CC. forall (A B:Prop) (P:or A B -> Prop), (forall a:A, P (or_introl A B a)) -> (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b. - + Hypothesis em : forall A:Prop, or A (~ A). Variable B : Prop. Variables b1 b2 : B. - + (** [p2b] and [b2p] form a retract if [~b1=b2] *) Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A). @@ -392,13 +392,13 @@ End Proof_irrelevance_EM_CC. Section Proof_irrelevance_CCI. Hypothesis em : forall A:Prop, A \/ ~ A. - - Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) + + Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a). - Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) + Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b). Scheme or_indd := Induction for or Sort Prop. - + Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2. Proof. exact (proof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl @@ -438,7 +438,7 @@ Definition weak_excluded_middle := [weak_generalized_excluded_middle] is that it holds even in logic without a primitive [False] connective (like Gödel-Dummett axiom) *) -Definition weak_generalized_excluded_middle := +Definition weak_generalized_excluded_middle := forall A B:Prop, ((A -> B) -> B) \/ (A -> B). (** ** Gödel-Dummett axiom *) @@ -473,7 +473,7 @@ Lemma Godel_Dummett_iff_right_distr_implication_over_disjunction : Proof. split. intros GD A B C HCAB. - destruct (GD B A) as [HBA|HAB]; [left|right]; intro HC; + destruct (GD B A) as [HBA|HAB]; [left|right]; intro HC; destruct (HCAB HC) as [HA|HB]; [ | apply HBA | apply HAB | ]; assumption. intros Distr A B. destruct (Distr A B (A\/B)) as [HABA|HABB]. @@ -484,7 +484,7 @@ Qed. (** [(A->B) \/ (B->A)] is stronger than the weak excluded middle *) -Lemma Godel_Dummett_weak_excluded_middle : +Lemma Godel_Dummett_weak_excluded_middle : GodelDummett -> weak_excluded_middle. Proof. intros GD A. destruct (GD (~A) A) as [HnotAA|HAnotA]. @@ -539,10 +539,10 @@ Qed. (** Independence of general premises is equivalent to the drinker's paradox *) Definition DrinkerParadox := - forall (A:Type) (P:A -> Prop), + forall (A:Type) (P:A -> Prop), inhabited A -> exists x, (exists x, P x) -> P x. -Lemma independence_general_premises_drinker : +Lemma independence_general_premises_drinker : IndependenceOfGeneralPremises <-> DrinkerParadox. Proof. split. @@ -551,14 +551,14 @@ Proof. exists x; intro HQ; apply (Hx (H HQ)). Qed. -(** Independence of general premises is weaker than (generalized) +(** Independence of general premises is weaker than (generalized) excluded middle Remark: generalized excluded middle is preferred here to avoid relying on the "ex falso quodlibet" property (i.e. [False -> forall A, A]) *) -Definition generalized_excluded_middle := +Definition generalized_excluded_middle := forall A B:Prop, A \/ (A -> B). Lemma excluded_middle_independence_general_premises : @@ -569,4 +569,4 @@ Proof. exists x; intro; exact Hx. exists x0; exact Hnot. Qed. - + diff --git a/theories/Logic/ClassicalUniqueChoice.v b/theories/Logic/ClassicalUniqueChoice.v index 2e739dd51..c1f9881fa 100644 --- a/theories/Logic/ClassicalUniqueChoice.v +++ b/theories/Logic/ClassicalUniqueChoice.v @@ -80,4 +80,4 @@ destruct (f P). discriminate. assumption. Qed. - + diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v index ce94bec14..b30308af5 100644 --- a/theories/Logic/Classical_Pred_Type.v +++ b/theories/Logic/Classical_Pred_Type.v @@ -44,7 +44,7 @@ Proof. (* Intuitionistic *) unfold not in |- *; intros P notex n abs. apply notex. exists n; trivial. -Qed. +Qed. Lemma not_ex_not_all : forall P:U -> Prop, ~ (exists n : U, ~ P n) -> forall n:U, P n. diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v index 8d2e946de..df732959f 100644 --- a/theories/Logic/Classical_Prop.v +++ b/theories/Logic/Classical_Prop.v @@ -22,7 +22,7 @@ unfold not in |- *; intros; elim (classic p); auto. intro NP; elim (H NP). Qed. -(** Peirce's law states [forall P Q:Prop, ((P -> Q) -> P) -> P]. +(** Peirce's law states [forall P Q:Prop, ((P -> Q) -> P) -> P]. Thanks to [forall P, False -> P], it is equivalent to the following form *) @@ -95,11 +95,11 @@ Proof proof_irrelevance_cci classic. (* classical_left transforms |- A \/ B into ~B |- A *) (* classical_right transforms |- A \/ B into ~A |- B *) -Ltac classical_right := match goal with +Ltac classical_right := match goal with | _:_ |-?X1 \/ _ => (elim (classic X1);intro;[left;trivial|right]) end. -Ltac classical_left := match goal with +Ltac classical_left := match goal with | _:_ |- _ \/?X1 => (elim (classic X1);intro;[right;trivial|left]) end. @@ -107,7 +107,7 @@ Require Export EqdepFacts. Module Eq_rect_eq. -Lemma eq_rect_eq : +Lemma eq_rect_eq : forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof. intros; rewrite proof_irrelevance with (p1:=h) (p2:=refl_equal p); reflexivity. diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v index 6129128de..c6d32d9be 100644 --- a/theories/Logic/Decidable.v +++ b/theories/Logic/Decidable.v @@ -13,7 +13,7 @@ Definition decidable (P:Prop) := P \/ ~ P. Theorem dec_not_not : forall P:Prop, decidable P -> (~ P -> False) -> P. Proof. -unfold decidable; tauto. +unfold decidable; tauto. Qed. Theorem dec_True : decidable True. @@ -29,27 +29,27 @@ Qed. Theorem dec_or : forall A B:Prop, decidable A -> decidable B -> decidable (A \/ B). Proof. -unfold decidable; tauto. +unfold decidable; tauto. Qed. Theorem dec_and : forall A B:Prop, decidable A -> decidable B -> decidable (A /\ B). Proof. -unfold decidable; tauto. +unfold decidable; tauto. Qed. Theorem dec_not : forall A:Prop, decidable A -> decidable (~ A). Proof. -unfold decidable; tauto. +unfold decidable; tauto. Qed. Theorem dec_imp : forall A B:Prop, decidable A -> decidable B -> decidable (A -> B). Proof. -unfold decidable; tauto. +unfold decidable; tauto. Qed. -Theorem dec_iff : +Theorem dec_iff : forall A B:Prop, decidable A -> decidable B -> decidable (A<->B). Proof. unfold decidable; tauto. @@ -67,7 +67,7 @@ Qed. Theorem not_and : forall A B:Prop, decidable A -> ~ (A /\ B) -> ~ A \/ ~ B. Proof. -unfold decidable; tauto. +unfold decidable; tauto. Qed. Theorem not_imp : forall A B:Prop, decidable A -> ~ (A -> B) -> A /\ ~ B. @@ -80,16 +80,16 @@ Proof. unfold decidable; tauto. Qed. -Theorem not_iff : - forall A B:Prop, decidable A -> decidable B -> +Theorem not_iff : + forall A B:Prop, decidable A -> decidable B -> ~ (A <-> B) -> (A /\ ~ B) \/ (~ A /\ B). Proof. unfold decidable; tauto. Qed. -(** Results formulated with iff, used in FSetDecide. - Negation are expanded since it is unclear whether setoid rewrite - will always perform conversion. *) +(** Results formulated with iff, used in FSetDecide. + Negation are expanded since it is unclear whether setoid rewrite + will always perform conversion. *) (** We begin with lemmas that, when read from left to right, can be understood as ways to eliminate uses of [not]. *) diff --git a/theories/Logic/DecidableType.v b/theories/Logic/DecidableType.v index fed25ad74..625f776bf 100644 --- a/theories/Logic/DecidableType.v +++ b/theories/Logic/DecidableType.v @@ -14,7 +14,7 @@ Unset Strict Implicit. (** * Types with Equalities, and nothing more (for subtyping purpose) *) -Module Type EqualityType. +Module Type EqualityType. Parameter Inline t : Type. @@ -27,11 +27,11 @@ Module Type EqualityType. Hint Immediate eq_sym. Hint Resolve eq_refl eq_trans. -End EqualityType. +End EqualityType. (** * Types with decidable Equalities (but no ordering) *) -Module Type DecidableType. +Module Type DecidableType. Parameter Inline t : Type. @@ -46,7 +46,7 @@ Module Type DecidableType. Hint Immediate eq_sym. Hint Resolve eq_refl eq_trans. -End DecidableType. +End DecidableType. (** * Additional notions about keys and datas used in FMap *) @@ -58,21 +58,21 @@ Module KeyDecidableType(D:DecidableType). Notation key:=t. Definition eqk (p p':key*elt) := eq (fst p) (fst p'). - Definition eqke (p p':key*elt) := + Definition eqke (p p':key*elt) := eq (fst p) (fst p') /\ (snd p) = (snd p'). Hint Unfold eqk eqke. Hint Extern 2 (eqke ?a ?b) => split. (* eqke is stricter than eqk *) - + Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'. Proof. unfold eqk, eqke; intuition. Qed. (* eqk, eqke are equalities *) - + Lemma eqk_refl : forall e, eqk e e. Proof. auto. Qed. @@ -96,7 +96,7 @@ Module KeyDecidableType(D:DecidableType). Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl. Hint Immediate eqk_sym eqke_sym. - Lemma InA_eqke_eqk : + Lemma InA_eqke_eqk : forall x m, InA eqke x m -> InA eqk x m. Proof. unfold eqke; induction 1; intuition. @@ -134,22 +134,22 @@ Module KeyDecidableType(D:DecidableType). Lemma In_eq : forall l x y, eq x y -> In x l -> In y l. Proof. destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto. - Qed. + Qed. Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l. Proof. inversion 1. inversion_clear H0; eauto. destruct H1; simpl in *; intuition. - Qed. + Qed. - Lemma In_inv_2 : forall k k' e e' l, + Lemma In_inv_2 : forall k k' e e' l, InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l. - Proof. + Proof. inversion_clear 1; compute in H0; intuition. Qed. - Lemma In_inv_3 : forall x x' l, + Lemma In_inv_3 : forall x x' l, InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l. Proof. inversion_clear 1; compute in H0; intuition. diff --git a/theories/Logic/DecidableTypeEx.v b/theories/Logic/DecidableTypeEx.v index 57a2248b3..022102f70 100644 --- a/theories/Logic/DecidableTypeEx.v +++ b/theories/Logic/DecidableTypeEx.v @@ -14,7 +14,7 @@ Unset Strict Implicit. (** * Examples of Decidable Type structures. *) -(** A particular case of [DecidableType] where +(** A particular case of [DecidableType] where the equality is the usual one of Coq. *) Module Type UsualDecidableType. @@ -32,13 +32,13 @@ Module UDT_to_DT (U:UsualDecidableType) <: DecidableType := U. (** an shortcut for easily building a UsualDecidableType *) -Module Type MiniDecidableType. +Module Type MiniDecidableType. Parameter Inline t : Type. Parameter eq_dec : forall x y:t, { x=y }+{ x<>y }. -End MiniDecidableType. +End MiniDecidableType. Module Make_UDT (M:MiniDecidableType) <: UsualDecidableType. - Definition t:=M.t. + Definition t:=M.t. Definition eq := @eq t. Definition eq_refl := @refl_equal t. Definition eq_sym := @sym_eq t. @@ -57,7 +57,7 @@ Module Positive_as_DT <: UsualDecidableType := Positive_as_OT. Module N_as_DT <: UsualDecidableType := N_as_OT. Module Z_as_DT <: UsualDecidableType := Z_as_OT. -(** From two decidable types, we can build a new DecidableType +(** From two decidable types, we can build a new DecidableType over their cartesian product. *) Module PairDecidableType(D1 D2:DecidableType) <: DecidableType. @@ -67,17 +67,17 @@ Module PairDecidableType(D1 D2:DecidableType) <: DecidableType. Definition eq x y := D1.eq (fst x) (fst y) /\ D2.eq (snd x) (snd y). Lemma eq_refl : forall x : t, eq x x. - Proof. + Proof. intros (x1,x2); red; simpl; auto. Qed. Lemma eq_sym : forall x y : t, eq x y -> eq y x. - Proof. + Proof. intros (x1,x2) (y1,y2); unfold eq; simpl; intuition. Qed. Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. - Proof. + Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq; simpl; intuition eauto. Qed. @@ -99,10 +99,10 @@ Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType. Definition eq_trans := @trans_eq t. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. - intros (x1,x2) (y1,y2); - destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2); - unfold eq, D1.eq, D2.eq in *; simpl; - (left; f_equal; auto; fail) || + intros (x1,x2) (y1,y2); + destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2); + unfold eq, D1.eq, D2.eq in *; simpl; + (left; f_equal; auto; fail) || (right; intro H; injection H; auto). Defined. diff --git a/theories/Logic/Description.v b/theories/Logic/Description.v index 41cde8aa5..a8a56ae74 100644 --- a/theories/Logic/Description.v +++ b/theories/Logic/Description.v @@ -17,5 +17,5 @@ Require Import ChoiceFacts. Set Implicit Arguments. Axiom constructive_definite_description : - forall (A : Type) (P : A->Prop), + forall (A : Type) (P : A->Prop), (exists! x, P x) -> { x : A | P x }. diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v index 95a07f2f3..18f3181b6 100644 --- a/theories/Logic/Diaconescu.v +++ b/theories/Logic/Diaconescu.v @@ -59,7 +59,7 @@ Definition PredicateExtensionality := Require Import ClassicalFacts. Variable pred_extensionality : PredicateExtensionality. - + Lemma prop_ext : forall A B:Prop, (A <-> B) -> A = B. Proof. intros A B H. @@ -99,11 +99,11 @@ Lemma AC_bool_subset_to_bool : (exists b : bool, P b) -> exists b : bool, P b /\ R P b /\ (forall b':bool, R P b' -> b = b')). Proof. - destruct (guarded_rel_choice _ _ + destruct (guarded_rel_choice _ _ (fun Q:bool -> Prop => exists y : _, Q y) (fun (Q:bool -> Prop) (y:bool) => Q y)) as (R,(HRsub,HR)). exact (fun _ H => H). - exists R; intros P HP. + exists R; intros P HP. destruct (HR P HP) as (y,(Hy,Huni)). exists y; firstorder. Qed. @@ -190,7 +190,7 @@ Lemma projT1_injective : a1=a2 -> a1'=a2'. Proof. intro Heq ; unfold a1', a2', A'. rewrite Heq. - replace (or_introl (a2=a2) (refl_equal a2)) + replace (or_introl (a2=a2) (refl_equal a2)) with (or_intror (a2=a2) (refl_equal a2)). reflexivity. apply proof_irrelevance. @@ -210,10 +210,10 @@ Qed. Theorem proof_irrel_rel_choice_imp_eq_dec : a1=a2 \/ ~a1=a2. Proof. - destruct - (rel_choice A' bool + destruct + (rel_choice A' bool (fun x y => projT1 x = a1 /\ y = true \/ projT1 x = a2 /\ y = false)) - as (R,(HRsub,HR)). + as (R,(HRsub,HR)). apply decide. destruct (HR a1') as (b1,(Ha1'b1,_Huni1)). destruct (HRsub a1' b1 Ha1'b1) as [(_, Hb1true)|(Ha1a2, _Hb1false)]. @@ -235,18 +235,18 @@ Declare Implicit Tactic auto. Lemma proof_irrel_rel_choice_imp_eq_dec' : a1=a2 \/ ~a1=a2. Proof. - assert (decide: forall x:A, x=a1 \/ x=a2 -> + assert (decide: forall x:A, x=a1 \/ x=a2 -> exists y:bool, x=a1 /\ y=true \/ x=a2 /\ y=false). intros a [Ha1|Ha2]; [exists true | exists false]; auto. - assert (guarded_rel_choice := - rel_choice_and_proof_irrel_imp_guarded_rel_choice - rel_choice + assert (guarded_rel_choice := + rel_choice_and_proof_irrel_imp_guarded_rel_choice + rel_choice proof_irrelevance). - destruct - (guarded_rel_choice A bool + destruct + (guarded_rel_choice A bool (fun x => x=a1 \/ x=a2) (fun x y => x=a1 /\ y=true \/ x=a2 /\ y=false)) - as (R,(HRsub,HR)). + as (R,(HRsub,HR)). apply decide. destruct (HR a1) as (b1,(Ha1b1,_Huni1)). left; reflexivity. destruct (HRsub a1 b1 Ha1b1) as [(_, Hb1true)|(Ha1a2, _Hb1false)]. @@ -273,8 +273,8 @@ Section ExtensionalEpsilon_imp_EM. Variable epsilon : forall A : Type, inhabited A -> (A -> Prop) -> A. -Hypothesis epsilon_spec : - forall (A:Type) (i:inhabited A) (P:A->Prop), +Hypothesis epsilon_spec : + forall (A:Type) (i:inhabited A) (P:A->Prop), (exists x, P x) -> P (epsilon A i P). Hypothesis epsilon_extensionality : @@ -288,9 +288,9 @@ Proof. intro P. pose (B := fun y => y=false \/ P). pose (C := fun y => y=true \/ P). - assert (B (eps B)) as [Hfalse|HP] + assert (B (eps B)) as [Hfalse|HP] by (apply epsilon_spec; exists false; left; reflexivity). - assert (C (eps C)) as [Htrue|HP] + assert (C (eps C)) as [Htrue|HP] by (apply epsilon_spec; exists true; left; reflexivity). right; intro HP. assert (forall y, B y <-> C y) by (intro y; split; intro; right; assumption). diff --git a/theories/Logic/Epsilon.v b/theories/Logic/Epsilon.v index ead91c9ec..d433be944 100644 --- a/theories/Logic/Epsilon.v +++ b/theories/Logic/Epsilon.v @@ -17,12 +17,12 @@ Set Implicit Arguments. (** Hilbert's epsilon: operator and specification in one statement *) -Axiom epsilon_statement : +Axiom epsilon_statement : forall (A : Type) (P : A->Prop), inhabited A -> { x : A | (exists x, P x) -> P x }. Lemma constructive_indefinite_description : - forall (A : Type) (P : A->Prop), + forall (A : Type) (P : A->Prop), (exists x, P x) -> { x : A | P x }. Proof. apply epsilon_imp_constructive_indefinite_description. @@ -45,7 +45,7 @@ Proof. Qed. Lemma constructive_definite_description : - forall (A : Type) (P : A->Prop), + forall (A : Type) (P : A->Prop), (exists! x, P x) -> { x : A | P x }. Proof. apply iota_imp_constructive_definite_description. @@ -57,7 +57,7 @@ Qed. Definition epsilon (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (epsilon_statement P i). -Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : +Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists x, P x) -> P (epsilon i P) := proj2_sig (epsilon_statement P i). @@ -66,7 +66,7 @@ Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : Definition iota (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (iota_statement P i). -Definition iota_spec (A : Type) (i:inhabited A) (P : A->Prop) : +Definition iota_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists! x:A, P x) -> P (iota i P) := proj2_sig (iota_statement P i). diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v index 74d9726a6..a4b4b5b4a 100644 --- a/theories/Logic/EqdepFacts.v +++ b/theories/Logic/EqdepFacts.v @@ -45,7 +45,7 @@ Table of contents: (** * Definition of dependent equality and equivalence with equality of dependent pairs *) Section Dependent_Equality. - + Variable U : Type. Variable P : U -> Type. @@ -119,7 +119,7 @@ Lemma equiv_eqex_eqdep : forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), existT P p x = existT P q y <-> eq_dep p x q y. Proof. - split. + split. (* -> *) apply eq_sigT_eq_dep. (* <- *) @@ -142,27 +142,27 @@ Hint Immediate eq_dep_sym: core. (** * Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K *) Section Equivalences. - + Variable U:Type. - + (** Invariance by Substitution of Reflexive Equality Proofs *) - - Definition Eq_rect_eq := + + Definition Eq_rect_eq := forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. - + (** Injectivity of Dependent Equality *) - - Definition Eq_dep_eq := + + Definition Eq_dep_eq := forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y. - + (** Uniqueness of Identity Proofs (UIP) *) - - Definition UIP_ := + + Definition UIP_ := forall (x y:U) (p1 p2:x = y), p1 = p2. - + (** Uniqueness of Reflexive Identity Proofs *) - Definition UIP_refl_ := + Definition UIP_refl_ := forall (x:U) (p:x = x), p = refl_equal x. (** Streicher's axiom K *) @@ -198,7 +198,7 @@ Section Equivalences. elim p1 using eq_indd. apply eq_dep_intro. Qed. - + (** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *) Lemma UIP__UIP_refl : UIP_ -> UIP_refl_. @@ -216,7 +216,7 @@ Section Equivalences. (** We finally recover from K the Invariance by Substitution of Reflexive Equality Proofs *) - + Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq. Proof. intro Streicher_K; red; intros. @@ -233,20 +233,20 @@ Section Equivalences. Typically, [eq_rect_eq] allows to prove UIP and Streicher's K what does not seem possible with [eq_rec_eq]. In particular, the proof of [UIP] requires to use [eq_rect_eq] on [fun y -> x=y] which is in [Type] but not - in [Set]. + in [Set]. *) End Equivalences. Section Corollaries. - + Variable U:Type. - + (** UIP implies the injectivity of equality on dependent pairs in Type *) - + Definition Inj_dep_pair := forall (P:U -> Type) (p:U) (x y:P p), existT P p x = existT P p y -> x = y. - + Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq U -> Inj_dep_pair. Proof. intro eq_dep_eq; red; intros. @@ -260,7 +260,7 @@ End Corollaries. Notation Inj_dep_pairS := Inj_dep_pair. Notation Inj_dep_pairT := Inj_dep_pair. Notation eq_dep_eq__inj_pairT2 := eq_dep_eq__inj_pair2. - + (************************************************************************) (** * Definition of the functor that builds properties of dependent equalities assuming axiom eq_rect_eq *) @@ -274,11 +274,11 @@ Module Type EqdepElimination. End EqdepElimination. Module EqdepTheory (M:EqdepElimination). - + Section Axioms. - + Variable U:Type. - + (** Invariance by Substitution of Reflexive Equality Proofs *) Lemma eq_rect_eq : diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v index 1943c1629..c7cb9b0d4 100644 --- a/theories/Logic/Eqdep_dec.v +++ b/theories/Logic/Eqdep_dec.v @@ -38,7 +38,7 @@ Set Implicit Arguments. Section EqdepDec. Variable A : Type. - + Let comp (x y y':A) (eq1:x = y) (eq2:x = y') : y = y' := eq_ind _ (fun a => a = y') eq2 _ eq1. @@ -49,7 +49,7 @@ Section EqdepDec. Qed. Variable eq_dec : forall x y:A, x = y \/ x <> y. - + Variable x : A. Let nu (y:A) (u:x = y) : x = y := @@ -63,13 +63,13 @@ Section EqdepDec. unfold nu in |- *. case (eq_dec x y); intros. reflexivity. - + case n; trivial. Qed. Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (refl_equal x)) v. - + Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u. Proof. @@ -88,7 +88,7 @@ Section EqdepDec. reflexivity. Qed. - Theorem K_dec : + Theorem K_dec : forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p. Proof. intros. @@ -118,10 +118,10 @@ Section EqdepDec. case (eq_dec x x). intro e. elim e using K_dec; trivial. - + intros. case n; trivial. - + case H. reflexivity. Qed. @@ -173,13 +173,13 @@ Unset Implicit Arguments. (** The signature of decidable sets in [Type] *) Module Type DecidableType. - + Parameter U:Type. Axiom eq_dec : forall x y:U, {x = y} + {x <> y}. End DecidableType. -(** The module [DecidableEqDep] collects equality properties for decidable +(** The module [DecidableEqDep] collects equality properties for decidable set in [Type] *) Module DecidableEqDep (M:DecidableType). @@ -247,7 +247,7 @@ Module Type DecidableSet. End DecidableSet. -(** The module [DecidableEqDepSet] collects equality properties for decidable +(** The module [DecidableEqDepSet] collects equality properties for decidable set in [Set] *) Module DecidableEqDepSet (M:DecidableSet). @@ -307,11 +307,11 @@ End DecidableEqDepSet. (** From decidability to inj_pair2 **) Lemma inj_pair2_eq_dec : forall A:Type, (forall x y:A, {x=y}+{x<>y}) -> ( forall (P:A -> Type) (p:A) (x y:P p), existT P p x = existT P p y -> x = y ). -Proof. +Proof. intros A eq_dec. apply eq_dep_eq__inj_pair2. apply eq_rect_eq__eq_dep_eq. - unfold Eq_rect_eq. + unfold Eq_rect_eq. apply eq_rect_eq_dec. apply eq_dec. Qed. diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v index 31b633c25..bf29c63dd 100644 --- a/theories/Logic/FunctionalExtensionality.v +++ b/theories/Logic/FunctionalExtensionality.v @@ -13,7 +13,7 @@ (** The converse of functional extensionality. *) -Lemma equal_f : forall {A B : Type} {f g : A -> B}, +Lemma equal_f : forall {A B : Type} {f g : A -> B}, f = g -> forall x, f x = g x. Proof. intros. @@ -23,11 +23,11 @@ Qed. (** Statements of functional extensionality for simple and dependent functions. *) -Axiom functional_extensionality_dep : forall {A} {B : A -> Type}, - forall (f g : forall x : A, B x), +Axiom functional_extensionality_dep : forall {A} {B : A -> Type}, + forall (f g : forall x : A, B x), (forall x, f x = g x) -> f = g. -Lemma functional_extensionality {A B} (f g : A -> B) : +Lemma functional_extensionality {A B} (f g : A -> B) : (forall x, f x = g x) -> f = g. Proof. intros ; eauto using @functional_extensionality_dep. @@ -37,8 +37,8 @@ Qed. Tactic Notation "extensionality" ident(x) := match goal with - [ |- ?X = ?Y ] => - (apply (@functional_extensionality _ _ X Y) || + [ |- ?X = ?Y ] => + (apply (@functional_extensionality _ _ X Y) || apply (@functional_extensionality_dep _ _ X Y)) ; intro x end. @@ -51,7 +51,7 @@ Proof. extensionality x. reflexivity. Qed. - + Lemma eta_expansion {A B} (f : A -> B) : f = fun x => f x. Proof. intros A B f. apply (eta_expansion_dep f). diff --git a/theories/Logic/IndefiniteDescription.v b/theories/Logic/IndefiniteDescription.v index ce9405f85..3651c1b2f 100644 --- a/theories/Logic/IndefiniteDescription.v +++ b/theories/Logic/IndefiniteDescription.v @@ -19,11 +19,11 @@ Require Import ChoiceFacts. Set Implicit Arguments. Axiom constructive_indefinite_description : - forall (A : Type) (P : A->Prop), + forall (A : Type) (P : A->Prop), (exists x, P x) -> { x : A | P x }. Lemma constructive_definite_description : - forall (A : Type) (P : A->Prop), + forall (A : Type) (P : A->Prop), (exists! x, P x) -> { x : A | P x }. Proof. intros; apply constructive_indefinite_description; firstorder. diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v index 7d9e11296..127be1134 100644 --- a/theories/Logic/JMeq.v +++ b/theories/Logic/JMeq.v @@ -43,13 +43,13 @@ Qed. Axiom JMeq_eq : forall (A:Type) (x y:A), JMeq x y -> x = y. -Lemma JMeq_ind : forall (A:Type) (x:A) (P:A -> Prop), +Lemma JMeq_ind : forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y, JMeq x y -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := H'); trivial. Qed. -Lemma JMeq_rec : forall (A:Type) (x:A) (P:A -> Set), +Lemma JMeq_rec : forall (A:Type) (x:A) (P:A -> Set), P x -> forall y, JMeq x y -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := H'); trivial. @@ -61,7 +61,7 @@ Proof. intros A x P H y H'; case JMeq_eq with (1 := H'); trivial. Qed. -Lemma JMeq_ind_r : forall (A:Type) (x:A) (P:A -> Prop), +Lemma JMeq_ind_r : forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y, JMeq y x -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := JMeq_sym H'); trivial. diff --git a/theories/Logic/ProofIrrelevanceFacts.v b/theories/Logic/ProofIrrelevanceFacts.v index dd3178ebe..4c48d95cd 100644 --- a/theories/Logic/ProofIrrelevanceFacts.v +++ b/theories/Logic/ProofIrrelevanceFacts.v @@ -21,8 +21,8 @@ Module ProofIrrelevanceTheory (M:ProofIrrelevance). (** Proof-irrelevance implies uniqueness of reflexivity proofs *) Module Eq_rect_eq. - Lemma eq_rect_eq : - forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), + Lemma eq_rect_eq : + forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof. intros; rewrite M.proof_irrelevance with (p1:=h) (p2:=refl_equal p). diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v index 9ad6b7220..49fa12224 100644 --- a/theories/Logic/RelationalChoice.v +++ b/theories/Logic/RelationalChoice.v @@ -13,5 +13,5 @@ Axiom relational_choice : forall (A B : Type) (R : A->B->Prop), (forall x : A, exists y : B, R x y) -> - exists R' : A->B->Prop, + exists R' : A->B->Prop, subrelation R' R /\ forall x : A, exists! y : B, R' x y. diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v index eaf3f126a..e02f2817c 100644 --- a/theories/NArith/BinNat.v +++ b/theories/NArith/BinNat.v @@ -45,7 +45,7 @@ Definition Ndouble_plus_one x := (** Operation x -> 2*x *) -Definition Ndouble n := +Definition Ndouble n := match n with | N0 => N0 | Npos p => Npos (xO p) @@ -130,12 +130,12 @@ Infix ">" := Ngt : N_scope. (** Min and max *) -Definition Nmin (n n' : N) := match Ncompare n n' with +Definition Nmin (n n' : N) := match Ncompare n n' with | Lt | Eq => n | Gt => n' end. -Definition Nmax (n n' : N) := match Ncompare n n' with +Definition Nmax (n n' : N) := match Ncompare n n' with | Lt | Eq => n' | Gt => n end. @@ -149,7 +149,7 @@ Lemma N_ind_double : (forall a, P a -> P (Ndouble_plus_one a)) -> P a. Proof. intros; elim a. trivial. - simple induction p. intros. + simple induction p. intros. apply (H1 (Npos p0)); trivial. intros; apply (H0 (Npos p0)); trivial. intros; apply (H1 N0); assumption. @@ -162,7 +162,7 @@ Lemma N_rec_double : (forall a, P a -> P (Ndouble_plus_one a)) -> P a. Proof. intros; elim a. trivial. - simple induction p. intros. + simple induction p. intros. apply (H1 (Npos p0)); trivial. intros; apply (H0 (Npos p0)); trivial. intros; apply (H1 N0); assumption. @@ -354,7 +354,7 @@ destruct p; intros Hp H. contradiction Hp; reflexivity. destruct n; destruct m; reflexivity || (try discriminate H). injection H; clear H; intro H; rewrite Pmult_reg_r with (1 := H); reflexivity. -Qed. +Qed. (** Properties of comparison *) @@ -373,7 +373,7 @@ Qed. Theorem Ncompare_eq_correct : forall n m:N, (n ?= m) = Eq <-> n = m. Proof. -split; intros; +split; intros; [ apply Ncompare_Eq_eq; auto | subst; apply Ncompare_refl ]. Qed. diff --git a/theories/NArith/BinPos.v b/theories/NArith/BinPos.v index af281b73f..21ff55c19 100644 --- a/theories/NArith/BinPos.v +++ b/theories/NArith/BinPos.v @@ -32,15 +32,15 @@ Bind Scope positive_scope with positive. Arguments Scope xO [positive_scope]. Arguments Scope xI [positive_scope]. -(** Postfix notation for positive numbers, allowing to mimic - the position of bits in a big-endian representation. - For instance, we can write 1~1~0 instead of (xO (xI xH)) +(** Postfix notation for positive numbers, allowing to mimic + the position of bits in a big-endian representation. + For instance, we can write 1~1~0 instead of (xO (xI xH)) for the number 6 (which is 110 in binary notation). *) -Notation "p ~ 1" := (xI p) +Notation "p ~ 1" := (xI p) (at level 7, left associativity, format "p '~' '1'") : positive_scope. -Notation "p ~ 0" := (xO p) +Notation "p ~ 0" := (xO p) (at level 7, left associativity, format "p '~' '0'") : positive_scope. Open Local Scope positive_scope. @@ -76,7 +76,7 @@ Fixpoint Pplus (x y:positive) : positive := | 1, q~0 => q~1 | 1, 1 => 1~0 end - + with Pplus_carry (x y:positive) : positive := match x, y with | p~1, q~1 => (Pplus_carry p q)~1 @@ -178,7 +178,7 @@ Fixpoint Pminus_mask (x y:positive) {struct y} : positive_mask := | 1, 1 => IsNul | 1, _ => IsNeg end - + with Pminus_mask_carry (x y:positive) {struct y} : positive_mask := match x, y with | p~1, q~1 => Pdouble_plus_one_mask (Pminus_mask_carry p q) @@ -255,13 +255,13 @@ Notation "x < y < z" := (x < y /\ y < z) : positive_scope. Notation "x < y <= z" := (x < y /\ y <= z) : positive_scope. -Definition Pmin (p p' : positive) := match Pcompare p p' Eq with - | Lt | Eq => p +Definition Pmin (p p' : positive) := match Pcompare p p' Eq with + | Lt | Eq => p | Gt => p' end. -Definition Pmax (p p' : positive) := match Pcompare p p' Eq with - | Lt | Eq => p' +Definition Pmax (p p' : positive) := match Pcompare p p' Eq with + | Lt | Eq => p' | Gt => p end. @@ -380,14 +380,14 @@ Theorem Pplus_comm : forall p q:positive, p + q = q + p. Proof. induction p; destruct q; simpl; f_equal; auto. rewrite 2 Pplus_carry_spec; f_equal; auto. -Qed. +Qed. (** Permutation of [Pplus] and [Psucc] *) Theorem Pplus_succ_permute_r : forall p q:positive, p + Psucc q = Psucc (p + q). Proof. - induction p; destruct q; simpl; f_equal; + induction p; destruct q; simpl; f_equal; auto using Pplus_one_succ_r; rewrite Pplus_carry_spec; auto. Qed. @@ -432,10 +432,10 @@ Qed. Lemma Pplus_reg_r : forall p q r:positive, p + r = q + r -> p = q. Proof. intros p q r; revert p q; induction r. - intros [p|p| ] [q|q| ] H; simpl; destr_eq H; - f_equal; auto using Pplus_carry_plus; + intros [p|p| ] [q|q| ] H; simpl; destr_eq H; + f_equal; auto using Pplus_carry_plus; contradict H; auto using Pplus_carry_no_neutral. - intros [p|p| ] [q|q| ] H; simpl; destr_eq H; f_equal; auto; + intros [p|p| ] [q|q| ] H; simpl; destr_eq H; f_equal; auto; contradict H; auto using Pplus_no_neutral. intros p q H; apply Psucc_inj; do 2 rewrite Pplus_one_succ_r; assumption. Qed. @@ -465,11 +465,11 @@ Qed. Theorem Pplus_assoc : forall p q r:positive, p + (q + r) = p + q + r. Proof. induction p. - intros [q|q| ] [r|r| ]; simpl; f_equal; auto; - rewrite ?Pplus_carry_spec, ?Pplus_succ_permute_r, + intros [q|q| ] [r|r| ]; simpl; f_equal; auto; + rewrite ?Pplus_carry_spec, ?Pplus_succ_permute_r, ?Pplus_succ_permute_l, ?Pplus_one_succ_r; f_equal; auto. intros [q|q| ] [r|r| ]; simpl; f_equal; auto; - rewrite ?Pplus_carry_spec, ?Pplus_succ_permute_r, + rewrite ?Pplus_carry_spec, ?Pplus_succ_permute_r, ?Pplus_succ_permute_l, ?Pplus_one_succ_r; f_equal; auto. intros p r; rewrite <- 2 Pplus_one_succ_l, Pplus_succ_permute_l; auto. Qed. @@ -493,7 +493,7 @@ Lemma Pplus_xO_double_minus_one : forall p q:positive, Pdouble_minus_one (p + q) = p~0 + Pdouble_minus_one q. Proof. induction p as [p IHp| p IHp| ]; destruct q; simpl; - rewrite ?Pplus_carry_spec, ?Pdouble_minus_one_o_succ_eq_xI, + rewrite ?Pplus_carry_spec, ?Pdouble_minus_one_o_succ_eq_xI, ?Pplus_xI_double_minus_one; try reflexivity. rewrite IHp; auto. rewrite <- Psucc_o_double_minus_one_eq_xO, Pplus_one_succ_l; reflexivity. @@ -503,7 +503,7 @@ Qed. Lemma Pplus_diag : forall p:positive, p + p = p~0. Proof. - induction p as [p IHp| p IHp| ]; simpl; + induction p as [p IHp| p IHp| ]; simpl; try rewrite ?Pplus_carry_spec, ?IHp; reflexivity. Qed. @@ -534,10 +534,10 @@ Fixpoint peanoView p : PeanoView p := | p~1 => peanoView_xI p (peanoView p) end. -Definition PeanoView_iter (P:positive->Type) +Definition PeanoView_iter (P:positive->Type) (a:P 1) (f:forall p, P p -> P (Psucc p)) := (fix iter p (q:PeanoView p) : P p := - match q in PeanoView p return P p with + match q in PeanoView p return P p with | PeanoOne => a | PeanoSucc _ q => f _ (iter _ q) end). @@ -545,23 +545,23 @@ Definition PeanoView_iter (P:positive->Type) Require Import Eqdep_dec EqdepFacts. Theorem eq_dep_eq_positive : - forall (P:positive->Type) (p:positive) (x y:P p), + forall (P:positive->Type) (p:positive) (x y:P p), eq_dep positive P p x p y -> x = y. Proof. apply eq_dep_eq_dec. decide equality. Qed. -Theorem PeanoViewUnique : forall p (q q':PeanoView p), q = q'. +Theorem PeanoViewUnique : forall p (q q':PeanoView p), q = q'. Proof. - intros. + intros. induction q as [ | p q IHq ]. apply eq_dep_eq_positive. cut (1=1). pattern 1 at 1 2 5, q'. destruct q'. trivial. destruct p0; intros; discriminate. trivial. apply eq_dep_eq_positive. - cut (Psucc p=Psucc p). pattern (Psucc p) at 1 2 5, q'. destruct q'. + cut (Psucc p=Psucc p). pattern (Psucc p) at 1 2 5, q'. destruct q'. intro. destruct p; discriminate. intro. unfold p0 in H. apply Psucc_inj in H. generalize q'. rewrite H. intro. @@ -570,12 +570,12 @@ Proof. trivial. Qed. -Definition Prect (P:positive->Type) (a:P 1) (f:forall p, P p -> P (Psucc p)) +Definition Prect (P:positive->Type) (a:P 1) (f:forall p, P p -> P (Psucc p)) (p:positive) := PeanoView_iter P a f p (peanoView p). -Theorem Prect_succ : forall (P:positive->Type) (a:P 1) - (f:forall p, P p -> P (Psucc p)) (p:positive), +Theorem Prect_succ : forall (P:positive->Type) (a:P 1) + (f:forall p, P p -> P (Psucc p)) (p:positive), Prect P a f (Psucc p) = f _ (Prect P a f p). Proof. intros. @@ -584,7 +584,7 @@ Proof. trivial. Qed. -Theorem Prect_base : forall (P:positive->Type) (a:P 1) +Theorem Prect_base : forall (P:positive->Type) (a:P 1) (f:forall p, P p -> P (Psucc p)), Prect P a f 1 = a. Proof. trivial. @@ -744,7 +744,7 @@ Qed. Theorem Pcompare_Eq_eq : forall p q:positive, (p ?= q) Eq = Eq -> p = q. Proof. - induction p; intros [q| q| ] H; simpl in *; auto; + induction p; intros [q| q| ] H; simpl in *; auto; try discriminate H; try (f_equal; auto; fail). destruct (Pcompare_not_Eq p q) as (H',_); elim H'; auto. destruct (Pcompare_not_Eq p q) as (_,H'); elim H'; auto. @@ -821,7 +821,7 @@ Lemma Pcompare_antisym : forall (p q:positive) (r:comparison), CompOpp ((p ?= q) r) = (q ?= p) (CompOpp r). Proof. - induction p as [p IHp|p IHp| ]; intros [q|q| ] r; simpl; auto; + induction p as [p IHp|p IHp| ]; intros [q|q| ] r; simpl; auto; rewrite IHp; auto. Qed. @@ -949,14 +949,14 @@ Qed. Theorem Pminus_mask_carry_spec : forall p q : positive, Pminus_mask_carry p q = Ppred_mask (Pminus_mask p q). Proof. - induction p as [p IHp|p IHp| ]; destruct q; simpl; + induction p as [p IHp|p IHp| ]; destruct q; simpl; try reflexivity; try rewrite IHp; destruct (Pminus_mask p q) as [|[r|r| ]|] || destruct p; auto. Qed. Theorem Pminus_succ_r : forall p q : positive, p - (Psucc q) = Ppred (p - q). Proof. - intros p q; unfold Pminus; + intros p q; unfold Pminus; rewrite Pminus_mask_succ_r, Pminus_mask_carry_spec. destruct (Pminus_mask p q) as [|[r|r| ]|]; auto. Qed. @@ -995,11 +995,11 @@ Proof. induction p as [p IHp| p IHp| ]; simpl; try rewrite IHp; auto. Qed. -Lemma Pminus_mask_IsNeg : forall p q:positive, +Lemma Pminus_mask_IsNeg : forall p q:positive, Pminus_mask p q = IsNeg -> Pminus_mask_carry p q = IsNeg. Proof. - induction p as [p IHp|p IHp| ]; intros [q|q| ] H; simpl in *; auto; - try discriminate; unfold Pdouble_mask, Pdouble_plus_one_mask in H; + induction p as [p IHp|p IHp| ]; intros [q|q| ] H; simpl in *; auto; + try discriminate; unfold Pdouble_mask, Pdouble_plus_one_mask in H; specialize IHp with q. destruct (Pminus_mask p q); try discriminate; rewrite IHp; auto. destruct (Pminus_mask p q); simpl; auto; try discriminate. @@ -1028,9 +1028,9 @@ Lemma Pminus_mask_Gt : Pminus_mask p q = IsPos h /\ q + h = p /\ (h = 1 \/ Pminus_mask_carry p q = IsPos (Ppred h)). Proof. - induction p as [p IHp| p IHp| ]; intros [q| q| ] H; simpl in *; + induction p as [p IHp| p IHp| ]; intros [q| q| ] H; simpl in *; try discriminate H. - (* p~1, q~1 *) + (* p~1, q~1 *) destruct (IHp q H) as (r & U & V & W); exists (r~0); rewrite ?U, ?V; auto. repeat split; auto; right. destruct (ZL11 r) as [EQ|NE]; [|destruct W as [|W]; [elim NE; auto|]]. @@ -1091,10 +1091,10 @@ Qed. (** Number of digits in a number *) -Fixpoint Psize (p:positive) : nat := - match p with +Fixpoint Psize (p:positive) : nat := + match p with | 1 => S O - | p~1 => S (Psize p) + | p~1 => S (Psize p) | p~0 => S (Psize p) end. diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v index e9bc4b266..ef381c7f2 100644 --- a/theories/NArith/Ndec.v +++ b/theories/NArith/Ndec.v @@ -45,7 +45,7 @@ Proof. Qed. Lemma Pcompare_Peqb : forall p p', Pcompare p p' Eq = Eq -> Peqb p p' = true. -Proof. +Proof. intros; rewrite <- (Pcompare_Eq_eq _ _ H). apply Peqb_correct. Qed. @@ -69,7 +69,7 @@ Proof. Qed. Lemma Ncompare_Neqb : forall n n', Ncompare n n' = Eq -> Neqb n n' = true. -Proof. +Proof. intros; rewrite <- (Ncompare_Eq_eq _ _ H). apply Neqb_correct. Qed. @@ -107,7 +107,7 @@ Lemma Nodd_not_double : Nodd a -> forall a0, Neqb (Ndouble a0) a = false. Proof. intros. elim (sumbool_of_bool (Neqb (Ndouble a0) a)). intro H0. - rewrite <- (Neqb_complete _ _ H0) in H. + rewrite <- (Neqb_complete _ _ H0) in H. unfold Nodd in H. rewrite (Ndouble_bit0 a0) in H. discriminate H. trivial. @@ -128,7 +128,7 @@ Lemma Neven_not_double_plus_one : Neven a -> forall a0, Neqb (Ndouble_plus_one a0) a = false. Proof. intros. elim (sumbool_of_bool (Neqb (Ndouble_plus_one a0) a)). intro H0. - rewrite <- (Neqb_complete _ _ H0) in H. + rewrite <- (Neqb_complete _ _ H0) in H. unfold Neven in H. rewrite (Ndouble_plus_one_bit0 a0) in H. discriminate H. @@ -391,8 +391,8 @@ Lemma Nmin_Nmin' : forall a b, Nmin a b = Nmin' a b. Proof. unfold Nmin, Nmin', Nleb; intros. rewrite nat_of_Ncompare. - generalize (leb_compare (nat_of_N a) (nat_of_N b)); - destruct (nat_compare (nat_of_N a) (nat_of_N b)); + generalize (leb_compare (nat_of_N a) (nat_of_N b)); + destruct (nat_compare (nat_of_N a) (nat_of_N b)); destruct (leb (nat_of_N a) (nat_of_N b)); intuition. lapply H1; intros; discriminate. lapply H1; intros; discriminate. @@ -421,7 +421,7 @@ Qed. Lemma Nmin_le_3 : forall a b c, Nleb a (Nmin b c) = true -> Nleb a b = true. Proof. - intros; rewrite Nmin_Nmin' in *. + intros; rewrite Nmin_Nmin' in *. unfold Nmin' in *; elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. assumption. intro H0. rewrite H0 in H. apply Nltb_leb_weak. apply Nleb_ltb_trans with (b := c); assumption. @@ -430,7 +430,7 @@ Qed. Lemma Nmin_le_4 : forall a b c, Nleb a (Nmin b c) = true -> Nleb a c = true. Proof. - intros; rewrite Nmin_Nmin' in *. + intros; rewrite Nmin_Nmin' in *. unfold Nmin' in *; elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. apply Nleb_trans with (b := b); assumption. intro H0. rewrite H0 in H. assumption. @@ -447,7 +447,7 @@ Qed. Lemma Nmin_lt_3 : forall a b c, Nleb (Nmin b c) a = false -> Nleb b a = false. Proof. - intros; rewrite Nmin_Nmin' in *. + intros; rewrite Nmin_Nmin' in *. unfold Nmin' in *. intros. elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. assumption. intro H0. rewrite H0 in H. apply Nltb_trans with (b := c); assumption. @@ -456,7 +456,7 @@ Qed. Lemma Nmin_lt_4 : forall a b c, Nleb (Nmin b c) a = false -> Nleb c a = false. Proof. - intros; rewrite Nmin_Nmin' in *. + intros; rewrite Nmin_Nmin' in *. unfold Nmin' in *. elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. apply Nltb_leb_trans with (b := b); assumption. intro H0. rewrite H0 in H. assumption. diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v index ea5f02bba..b1f2668e6 100644 --- a/theories/NArith/Ndigits.v +++ b/theories/NArith/Ndigits.v @@ -27,7 +27,7 @@ Fixpoint Pxor (p1 p2:positive) {struct p1} : N := | xO p1, xI p2 => Ndouble_plus_one (Pxor p1 p2) | xI p1, xH => Npos (xO p1) | xI p1, xO p2 => Ndouble_plus_one (Pxor p1 p2) - | xI p1, xI p2 => Ndouble (Pxor p1 p2) + | xI p1, xI p2 => Ndouble (Pxor p1 p2) end. Definition Nxor (n n':N) := @@ -65,7 +65,7 @@ Proof. simpl. rewrite IHp; reflexivity. Qed. -(** Checking whether a particular bit is set on not *) +(** Checking whether a particular bit is set on not *) Fixpoint Pbit (p:positive) : nat -> bool := match p with @@ -134,13 +134,13 @@ Qed. (** End of auxilliary results *) -(** This part is aimed at proving that if two numbers produce +(** This part is aimed at proving that if two numbers produce the same stream of bits, then they are equal. *) Lemma Nbit_faithful_1 : forall a:N, eqf (Nbit N0) (Nbit a) -> N0 = a. Proof. destruct a. trivial. - induction p as [p IHp| p IHp| ]; intro H. + induction p as [p IHp| p IHp| ]; intro H. absurd (N0 = Npos p). discriminate. exact (IHp (fun n => H (S n))). absurd (N0 = Npos p). discriminate. @@ -196,7 +196,7 @@ Proof. assert (Npos p = Npos p') by exact (IHp (Npos p') H0). inversion H1. reflexivity. assumption. - intros. apply Nbit_faithful_3. intros. + intros. apply Nbit_faithful_3. intros. assert (Npos p = Npos p') by exact (IHp (Npos p') H0). inversion H1. reflexivity. assumption. @@ -257,7 +257,7 @@ Proof. generalize (fun p1 p2 => H (Npos p1) (Npos p2)); clear H; intro H. unfold xorf in *. destruct a as [|p]. simpl Nbit; rewrite false_xorb. reflexivity. - destruct a' as [|p0]. + destruct a' as [|p0]. simpl Nbit; rewrite xorb_false. reflexivity. destruct p. destruct p0; simpl Nbit in *. rewrite <- H; simpl; case (Pxor p p0); trivial. @@ -273,13 +273,13 @@ Qed. Lemma Nxor_semantics : forall a a':N, eqf (Nbit (Nxor a a')) (xorf (Nbit a) (Nbit a')). Proof. - unfold eqf. intros; generalize a, a'. induction n. + unfold eqf. intros; generalize a, a'. induction n. apply Nxor_sem_5. apply Nxor_sem_6; assumption. Qed. -(** Consequences: +(** Consequences: - only equal numbers lead to a null xor - - xor is associative + - xor is associative *) Lemma Nxor_eq : forall a a':N, Nxor a a' = N0 -> a = a'. @@ -306,7 +306,7 @@ Proof. apply eqf_sym, Nxor_semantics. Qed. -(** Checking whether a number is odd, i.e. +(** Checking whether a number is odd, i.e. if its lower bit is set. *) Definition Nbit0 (n:N) := @@ -380,8 +380,8 @@ Lemma Nneg_bit0 : forall a a':N, Nbit0 (Nxor a a') = true -> Nbit0 a = negb (Nbit0 a'). Proof. - intros. - rewrite <- true_xorb, <- H, Nxor_bit0, xorb_assoc, xorb_nilpotent, xorb_false. + intros. + rewrite <- true_xorb, <- H, Nxor_bit0, xorb_assoc, xorb_nilpotent, xorb_false. reflexivity. Qed. @@ -402,7 +402,7 @@ Lemma Nsame_bit0 : forall (a a':N) (p:positive), Nxor a a' = Npos (xO p) -> Nbit0 a = Nbit0 a'. Proof. - intros. rewrite <- (xorb_false (Nbit0 a)). + intros. rewrite <- (xorb_false (Nbit0 a)). assert (H0: Nbit0 (Npos (xO p)) = false) by reflexivity. rewrite <- H0, <- H, Nxor_bit0, <- xorb_assoc, xorb_nilpotent, false_xorb. reflexivity. Qed. @@ -430,7 +430,7 @@ Proof. assert (H1: Nbit0 (Nxor a a') = false) by (rewrite H2; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1. simpl. rewrite H, H0. reflexivity. - assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity). + assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H2. discriminate H2. Qed. @@ -443,7 +443,7 @@ Proof. assert (H1: Nbit0 (Nxor a a') = false) by (rewrite H2; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1. simpl. rewrite H, H0. reflexivity. - assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity). + assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H2. discriminate H2. Qed. @@ -534,7 +534,7 @@ Proof. rewrite (Nless_def_2 a' a'') in H0. rewrite (Nless_def_2 a a') in H. rewrite (Nless_def_2 a a''). exact (IHa _ _ H H0). Qed. - + Lemma Nless_total : forall a a', {Nless a a' = true} + {Nless a' a = true} + {a = a'}. Proof. @@ -558,7 +558,7 @@ Qed. (** Number of digits in a number *) -Definition Nsize (n:N) : nat := match n with +Definition Nsize (n:N) : nat := match n with | N0 => 0%nat | Npos p => Psize p end. @@ -566,35 +566,35 @@ Definition Nsize (n:N) : nat := match n with (** conversions between N and bit vectors. *) -Fixpoint P2Bv (p:positive) : Bvector (Psize p) := - match p return Bvector (Psize p) with +Fixpoint P2Bv (p:positive) : Bvector (Psize p) := + match p return Bvector (Psize p) with | xH => Bvect_true 1%nat | xO p => Bcons false (Psize p) (P2Bv p) | xI p => Bcons true (Psize p) (P2Bv p) end. Definition N2Bv (n:N) : Bvector (Nsize n) := - match n as n0 return Bvector (Nsize n0) with + match n as n0 return Bvector (Nsize n0) with | N0 => Bnil | Npos p => P2Bv p end. -Fixpoint Bv2N (n:nat)(bv:Bvector n) {struct bv} : N := - match bv with +Fixpoint Bv2N (n:nat)(bv:Bvector n) {struct bv} : N := + match bv with | Vnil => N0 | Vcons false n bv => Ndouble (Bv2N n bv) - | Vcons true n bv => Ndouble_plus_one (Bv2N n bv) + | Vcons true n bv => Ndouble_plus_one (Bv2N n bv) end. Lemma Bv2N_N2Bv : forall n, Bv2N _ (N2Bv n) = n. -Proof. +Proof. destruct n. simpl; auto. induction p; simpl in *; auto; rewrite IHp; simpl; auto. Qed. -(** The opposite composition is not so simple: if the considered - bit vector has some zeros on its right, they will disappear during +(** The opposite composition is not so simple: if the considered + bit vector has some zeros on its right, they will disappear during the return [Bv2N] translation: *) Lemma Bv2N_Nsize : forall n (bv:Bvector n), Nsize (Bv2N n bv) <= n. @@ -603,16 +603,16 @@ induction n; intros. rewrite (V0_eq _ bv); simpl; auto. rewrite (VSn_eq _ _ bv); simpl. specialize IHn with (Vtail _ _ bv). -destruct (Vhead _ _ bv); - destruct (Bv2N n (Vtail bool n bv)); +destruct (Vhead _ _ bv); + destruct (Bv2N n (Vtail bool n bv)); simpl; auto with arith. Qed. (** In the previous lemma, we can only replace the inequality by an equality whenever the highest bit is non-null. *) -Lemma Bv2N_Nsize_1 : forall n (bv:Bvector (S n)), - Bsign _ bv = true <-> +Lemma Bv2N_Nsize_1 : forall n (bv:Bvector (S n)), + Bsign _ bv = true <-> Nsize (Bv2N _ bv) = (S n). Proof. induction n; intro. @@ -621,18 +621,18 @@ rewrite (V0_eq _ (Vtail _ _ bv)); simpl. destruct (Vhead _ _ bv); simpl; intuition; try discriminate. rewrite (VSn_eq _ _ bv); simpl. generalize (IHn (Vtail _ _ bv)); clear IHn. -destruct (Vhead _ _ bv); - destruct (Bv2N (S n) (Vtail bool (S n) bv)); +destruct (Vhead _ _ bv); + destruct (Bv2N (S n) (Vtail bool (S n) bv)); simpl; intuition; try discriminate. Qed. -(** To state nonetheless a second result about composition of - conversions, we define a conversion on a given number of bits : *) +(** To state nonetheless a second result about composition of + conversions, we define a conversion on a given number of bits : *) -Fixpoint N2Bv_gen (n:nat)(a:N) { struct n } : Bvector n := - match n return Bvector n with +Fixpoint N2Bv_gen (n:nat)(a:N) { struct n } : Bvector n := + match n return Bvector n with | 0 => Bnil - | S n => match a with + | S n => match a with | N0 => Bvect_false (S n) | Npos xH => Bcons true _ (Bvect_false n) | Npos (xO p) => Bcons false _ (N2Bv_gen n (Npos p)) @@ -649,10 +649,10 @@ auto. induction p; simpl; intros; auto; congruence. Qed. -(** In fact, if [k] is large enough, [N2Bv_gen k a] contains all digits of +(** In fact, if [k] is large enough, [N2Bv_gen k a] contains all digits of [a] plus some zeros. *) -Lemma N2Bv_N2Bv_gen_above : forall (a:N)(k:nat), +Lemma N2Bv_N2Bv_gen_above : forall (a:N)(k:nat), N2Bv_gen (Nsize a + k) a = Vextend _ _ _ (N2Bv a) (Bvect_false k). Proof. destruct a; simpl. @@ -662,7 +662,7 @@ Qed. (** Here comes now the second composition result. *) -Lemma N2Bv_Bv2N : forall n (bv:Bvector n), +Lemma N2Bv_Bv2N : forall n (bv:Bvector n), N2Bv_gen n (Bv2N n bv) = bv. Proof. induction n; intros. @@ -670,21 +670,21 @@ rewrite (V0_eq _ bv); simpl; auto. rewrite (VSn_eq _ _ bv); simpl. generalize (IHn (Vtail _ _ bv)); clear IHn. unfold Bcons. -destruct (Bv2N _ (Vtail _ _ bv)); - destruct (Vhead _ _ bv); intro H; rewrite <- H; simpl; trivial; +destruct (Bv2N _ (Vtail _ _ bv)); + destruct (Vhead _ _ bv); intro H; rewrite <- H; simpl; trivial; induction n; simpl; auto. Qed. (** accessing some precise bits. *) -Lemma Nbit0_Blow : forall n, forall (bv:Bvector (S n)), +Lemma Nbit0_Blow : forall n, forall (bv:Bvector (S n)), Nbit0 (Bv2N _ bv) = Blow _ bv. Proof. intros. unfold Blow. rewrite (VSn_eq _ _ bv) at 1. simpl. -destruct (Bv2N n (Vtail bool n bv)); simpl; +destruct (Bv2N n (Vtail bool n bv)); simpl; destruct (Vhead bool n bv); auto. Qed. @@ -699,7 +699,7 @@ Proof. apply (IHbv p); auto with arith. Defined. -Lemma Bnth_Nbit : forall n (bv:Bvector n) p (H:p<n), +Lemma Bnth_Nbit : forall n (bv:Bvector n) p (H:p<n), Bnth _ bv p H = Nbit (Bv2N _ bv) p. Proof. induction bv; intros. @@ -726,7 +726,7 @@ Qed. (** Xor is the same in the two worlds. *) -Lemma Nxor_BVxor : forall n (bv bv' : Bvector n), +Lemma Nxor_BVxor : forall n (bv bv' : Bvector n), Bv2N _ (BVxor _ bv bv') = Nxor (Bv2N _ bv) (Bv2N _ bv'). Proof. induction n. @@ -735,7 +735,7 @@ rewrite (V0_eq _ bv), (V0_eq _ bv'); simpl; auto. intros. rewrite (VSn_eq _ _ bv), (VSn_eq _ _ bv'); simpl; auto. rewrite IHn. -destruct (Vhead bool n bv); destruct (Vhead bool n bv'); +destruct (Vhead bool n bv); destruct (Vhead bool n bv'); destruct (Bv2N n (Vtail bool n bv)); destruct (Bv2N n (Vtail bool n bv')); simpl; auto. Qed. diff --git a/theories/NArith/Ndist.v b/theories/NArith/Ndist.v index 678d37c1e..92559ff67 100644 --- a/theories/NArith/Ndist.v +++ b/theories/NArith/Ndist.v @@ -34,7 +34,7 @@ Definition Nplength (a:N) := Lemma Nplength_infty : forall a:N, Nplength a = infty -> a = N0. Proof. - simple induction a; trivial. + simple induction a; trivial. unfold Nplength in |- *; intros; discriminate H. Qed. @@ -42,7 +42,7 @@ Lemma Nplength_zeros : forall (a:N) (n:nat), Nplength a = ni n -> forall k:nat, k < n -> Nbit a k = false. Proof. - simple induction a; trivial. + simple induction a; trivial. simple induction p. simple induction n. intros. inversion H1. simple induction k. simpl in H1. discriminate H1. intros. simpl in H1. discriminate H1. @@ -116,11 +116,11 @@ Qed. Lemma ni_min_assoc : forall d d' d'':natinf, ni_min (ni_min d d') d'' = ni_min d (ni_min d' d''). Proof. - simple induction d; trivial. simple induction d'; trivial. + simple induction d; trivial. simple induction d'; trivial. simple induction d''; trivial. unfold ni_min in |- *. intro. cut (min (min n n0) n1 = min n (min n0 n1)). intro. rewrite H. reflexivity. - generalize n0 n1. elim n; trivial. + generalize n0 n1. elim n; trivial. simple induction n3; trivial. simple induction n5; trivial. intros. simpl in |- *. auto. Qed. @@ -250,10 +250,10 @@ Proof. Qed. -(** We define an ultrametric distance between [N] numbers: - $d(a,a')=1/2^pd(a,a')$, - where $pd(a,a')$ is the number of identical bits at the beginning - of $a$ and $a'$ (infinity if $a=a'$). +(** We define an ultrametric distance between [N] numbers: + $d(a,a')=1/2^pd(a,a')$, + where $pd(a,a')$ is the number of identical bits at the beginning + of $a$ and $a'$ (infinity if $a=a'$). Instead of working with $d$, we work with $pd$, namely [Npdist]: *) @@ -286,7 +286,7 @@ Qed. This follows from the fact that $a ~Ra~|a| = 1/2^{\texttt{Nplength}}(a))$ is an ultrametric norm, i.e. that $|a-a'| \leq max (|a-a''|, |a''-a'|)$, or equivalently that $|a+b|<=max(|a|,|b|)$, i.e. that - min $(\texttt{Nplength}(a), \texttt{Nplength}(b)) \leq + min $(\texttt{Nplength}(a), \texttt{Nplength}(b)) \leq \texttt{Nplength} (a~\texttt{xor}~ b)$ (lemma [Nplength_ultra]). *) diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v index 36a1f1d8f..0016d035f 100644 --- a/theories/NArith/Nnat.v +++ b/theories/NArith/Nnat.v @@ -39,7 +39,7 @@ Definition N_of_nat (n:nat) := Lemma N_of_nat_of_N : forall a:N, N_of_nat (nat_of_N a) = a. Proof. destruct a as [| p]. reflexivity. - simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *. + simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *. rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. rewrite nat_of_P_inj with (1 := H). reflexivity. Qed. @@ -66,14 +66,14 @@ Proof. apply N_of_nat_of_N. Qed. -Lemma nat_of_Ndouble_plus_one : +Lemma nat_of_Ndouble_plus_one : forall a, nat_of_N (Ndouble_plus_one a) = S (2*(nat_of_N a)). Proof. destruct a; simpl nat_of_N; auto. apply nat_of_P_xI. Qed. -Lemma N_of_double_plus_one : +Lemma N_of_double_plus_one : forall n, N_of_nat (S (2*n)) = Ndouble_plus_one (N_of_nat n). Proof. intros. @@ -97,14 +97,14 @@ Proof. apply N_of_nat_of_N. Qed. -Lemma nat_of_Nplus : +Lemma nat_of_Nplus : forall a a', nat_of_N (Nplus a a') = (nat_of_N a)+(nat_of_N a'). Proof. destruct a; destruct a'; simpl; auto. apply nat_of_P_plus_morphism. Qed. -Lemma N_of_plus : +Lemma N_of_plus : forall n n', N_of_nat (n+n') = Nplus (N_of_nat n) (N_of_nat n'). Proof. intros. @@ -138,14 +138,14 @@ Proof. apply N_of_nat_of_N. Qed. -Lemma nat_of_Nmult : +Lemma nat_of_Nmult : forall a a', nat_of_N (Nmult a a') = (nat_of_N a)*(nat_of_N a'). Proof. destruct a; destruct a'; simpl; auto. apply nat_of_P_mult_morphism. Qed. -Lemma N_of_mult : +Lemma N_of_mult : forall n n', N_of_nat (n*n') = Nmult (N_of_nat n) (N_of_nat n'). Proof. intros. @@ -155,7 +155,7 @@ Proof. apply N_of_nat_of_N. Qed. -Lemma nat_of_Ndiv2 : +Lemma nat_of_Ndiv2 : forall a, nat_of_N (Ndiv2 a) = div2 (nat_of_N a). Proof. destruct a; simpl in *; auto. @@ -164,9 +164,9 @@ Proof. rewrite div2_double_plus_one; auto. rewrite nat_of_P_xO. rewrite div2_double; auto. -Qed. +Qed. -Lemma N_of_div2 : +Lemma N_of_div2 : forall n, N_of_nat (div2 n) = Ndiv2 (N_of_nat n). Proof. intros. @@ -175,7 +175,7 @@ Proof. apply N_of_nat_of_N. Qed. -Lemma nat_of_Ncompare : +Lemma nat_of_Ncompare : forall a a', Ncompare a a' = nat_compare (nat_of_N a) (nat_of_N a'). Proof. destruct a; destruct a'; simpl. @@ -187,7 +187,7 @@ Proof. apply nat_of_P_compare_morphism. Qed. -Lemma N_of_nat_compare : +Lemma N_of_nat_compare : forall n n', nat_compare n n' = Ncompare (N_of_nat n) (N_of_nat n'). Proof. intros. @@ -321,17 +321,17 @@ Qed. Lemma Z_of_N_of_nat : forall n:nat, Z_of_N (N_of_nat n) = Z_of_nat n. Proof. destruct n; simpl; auto. -Qed. +Qed. Lemma Z_of_N_pos : forall p:positive, Z_of_N (Npos p) = Zpos p. Proof. destruct p; simpl; auto. -Qed. +Qed. Lemma Z_of_N_abs : forall z:Z, Z_of_N (Zabs_N z) = Zabs z. Proof. destruct z; simpl; auto. -Qed. +Qed. Lemma Z_of_N_le_0 : forall n, (0 <= Z_of_N n)%Z. Proof. @@ -348,22 +348,22 @@ Proof. destruct n; destruct m; auto. Qed. -Lemma Z_of_N_minus : forall n m:N, Z_of_N (n-m) = Zmax 0 (Z_of_N n - Z_of_N m). +Lemma Z_of_N_minus : forall n m:N, Z_of_N (n-m) = Zmax 0 (Z_of_N n - Z_of_N m). Proof. intros; do 3 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nminus; apply inj_minus. Qed. -Lemma Z_of_N_succ : forall n:N, Z_of_N (Nsucc n) = Zsucc (Z_of_N n). +Lemma Z_of_N_succ : forall n:N, Z_of_N (Nsucc n) = Zsucc (Z_of_N n). Proof. intros; do 2 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nsucc; apply inj_S. Qed. -Lemma Z_of_N_min : forall n m:N, Z_of_N (Nmin n m) = Zmin (Z_of_N n) (Z_of_N m). +Lemma Z_of_N_min : forall n m:N, Z_of_N (Nmin n m) = Zmin (Z_of_N n) (Z_of_N m). Proof. intros; do 3 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nmin; apply inj_min. Qed. -Lemma Z_of_N_max : forall n m:N, Z_of_N (Nmax n m) = Zmax (Z_of_N n) (Z_of_N m). +Lemma Z_of_N_max : forall n m:N, Z_of_N (Nmax n m) = Zmax (Z_of_N n) (Z_of_N m). Proof. intros; do 3 rewrite <- Z_of_nat_of_N; rewrite nat_of_Nmax; apply inj_max. Qed. diff --git a/theories/NArith/Pnat.v b/theories/NArith/Pnat.v index bf42c5e99..f989e01d0 100644 --- a/theories/NArith/Pnat.v +++ b/theories/NArith/Pnat.v @@ -11,7 +11,7 @@ Require Import BinPos. (**********************************************************************) -(** Properties of the injection from binary positive numbers to Peano +(** Properties of the injection from binary positive numbers to Peano natural numbers *) (** Original development by Pierre Crégut, CNET, Lannion, France *) @@ -50,7 +50,7 @@ Proof. intro x; induction x as [p IHp| p IHp| ]; intro y; [ destruct y as [p0| p0| ] | destruct y as [p0| p0| ] - | destruct y as [p| p| ] ]; simpl in |- *; auto with arith; + | destruct y as [p| p| ] ]; simpl in |- *; auto with arith; intro m; [ rewrite IHp; rewrite plus_assoc; trivial with arith | rewrite IHp; rewrite plus_assoc; trivial with arith @@ -75,11 +75,11 @@ intro x; induction x as [p IHp| p IHp| ]; intro y; | destruct y as [p| p| ] ]; simpl in |- *; auto with arith; [ intros m; rewrite Pmult_nat_plus_carry_morphism; rewrite IHp; rewrite plus_assoc_reverse; rewrite plus_assoc_reverse; - rewrite (plus_permute m (Pmult_nat p (m + m))); + rewrite (plus_permute m (Pmult_nat p (m + m))); trivial with arith | intros m; rewrite IHp; apply plus_assoc | intros m; rewrite Pmult_nat_succ_morphism; - rewrite (plus_comm (m + Pmult_nat p (m + m))); + rewrite (plus_comm (m + Pmult_nat p (m + m))); apply plus_assoc_reverse | intros m; rewrite IHp; apply plus_permute | intros m; rewrite Pmult_nat_succ_morphism; apply plus_assoc_reverse ]. @@ -110,7 +110,7 @@ Proof. intro p; change 2 with (1 + 1) in |- *; rewrite Pmult_nat_r_plus_morphism; trivial. Qed. - + (** [nat_of_P] is a morphism for multiplication *) Theorem nat_of_P_mult_morphism : @@ -133,11 +133,11 @@ Proof. intro y; induction y as [p H| p H| ]; [ destruct H as [x H1]; exists (S x + S x); unfold nat_of_P in |- *; simpl in |- *; change 2 with (1 + 1) in |- *; - rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H1; + rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H1; rewrite H1; auto with arith | destruct H as [x H2]; exists (x + S x); unfold nat_of_P in |- *; simpl in |- *; change 2 with (1 + 1) in |- *; - rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H2; + rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H2; rewrite H2; auto with arith | exists 0; auto with arith ]. Qed. @@ -182,7 +182,7 @@ intro x; induction x as [p H| p H| ]; intro y; destruct y as [q| q| ]; apply ZL7; apply H; assumption | simpl in |- *; discriminate H2 | unfold nat_of_P in |- *; simpl in |- *; apply lt_n_S; rewrite ZL6; - elim (ZL4 q); intros h H3; rewrite H3; simpl in |- *; + elim (ZL4 q); intros h H3; rewrite H3; simpl in |- *; apply lt_O_Sn | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 q); intros h H3; rewrite H3; simpl in |- *; rewrite <- plus_n_Sm; @@ -314,7 +314,7 @@ Proof. Qed. (**********************************************************************) -(** Properties of the shifted injection from Peano natural numbers to +(** Properties of the shifted injection from Peano natural numbers to binary positive numbers *) (** Composition of [P_of_succ_nat] and [nat_of_P] is successor on [nat] *) @@ -366,7 +366,7 @@ intros; rewrite P_of_succ_nat_o_nat_of_P_eq_succ, Ppred_succ; auto. Qed. (**********************************************************************) -(** Extra properties of the injection from binary positive numbers to Peano +(** Extra properties of the injection from binary positive numbers to Peano natural numbers *) (** [nat_of_P] is a morphism for subtraction on positive numbers *) @@ -384,14 +384,14 @@ Qed. Lemma ZL16 : forall p q:positive, nat_of_P p - nat_of_P q < nat_of_P p. Proof. intros p q; elim (ZL4 p); elim (ZL4 q); intros h H1 i H2; rewrite H1; - rewrite H2; simpl in |- *; unfold lt in |- *; apply le_n_S; + rewrite H2; simpl in |- *; unfold lt in |- *; apply le_n_S; apply le_minus. Qed. Lemma ZL17 : forall p q:positive, nat_of_P p < nat_of_P (p + q). Proof. intros p q; rewrite nat_of_P_plus_morphism; unfold lt in |- *; elim (ZL4 q); - intros k H; rewrite H; rewrite plus_comm; simpl in |- *; + intros k H; rewrite H; rewrite plus_comm; simpl in |- *; apply le_n_S; apply le_plus_r. Qed. @@ -410,7 +410,7 @@ intros; apply nat_of_P_lt_Lt_compare_complement_morphism; [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p); rewrite plus_assoc; rewrite le_plus_minus_r; [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l; - apply nat_of_P_lt_Lt_compare_morphism; + apply nat_of_P_lt_Lt_compare_morphism; assumption | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption ] @@ -454,7 +454,7 @@ intros x y z H; apply nat_of_P_inj; rewrite nat_of_P_mult_morphism; [ do 2 rewrite nat_of_P_mult_morphism; do 3 rewrite (mult_comm (nat_of_P x)); apply mult_minus_distr_r | apply nat_of_P_gt_Gt_compare_complement_morphism; - do 2 rewrite nat_of_P_mult_morphism; unfold gt in |- *; + do 2 rewrite nat_of_P_mult_morphism; unfold gt in |- *; elim (ZL4 x); intros h H1; rewrite H1; apply mult_S_lt_compat_l; exact (nat_of_P_gt_Gt_compare_morphism y z H) ] | assumption ]. diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v index a08c6e62f..3a64a8dc1 100644 --- a/theories/Numbers/BigNumPrelude.v +++ b/theories/Numbers/BigNumPrelude.v @@ -30,8 +30,8 @@ Declare ML Module "numbers_syntax_plugin". *) -Open Local Scope Z_scope. - +Open Local Scope Z_scope. + (* For compatibility of scripts, weaker version of some lemmas of Zdiv *) Lemma Zlt0_not_eq : forall n, 0<n -> n<>0. @@ -45,14 +45,14 @@ Definition Z_div_plus_l a b c H := Zdiv.Z_div_plus_full_l a b c (Zlt0_not_eq _ H (* Automation *) -Hint Extern 2 (Zle _ _) => +Hint Extern 2 (Zle _ _) => (match goal with |- Zpos _ <= Zpos _ => exact (refl_equal _) | H: _ <= ?p |- _ <= ?p => apply Zle_trans with (2 := H) | H: _ < ?p |- _ <= ?p => apply Zlt_le_weak; apply Zle_lt_trans with (2 := H) end). -Hint Extern 2 (Zlt _ _) => +Hint Extern 2 (Zlt _ _) => (match goal with |- Zpos _ < Zpos _ => exact (refl_equal _) | H: _ <= ?p |- _ <= ?p => apply Zlt_le_trans with (2 := H) @@ -62,13 +62,13 @@ Hint Extern 2 (Zlt _ _) => Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. -(************************************** +(************************************** Properties of order and product **************************************) - Theorem beta_lex: forall a b c d beta, - a * beta + b <= c * beta + d -> - 0 <= b < beta -> 0 <= d < beta -> + Theorem beta_lex: forall a b c d beta, + a * beta + b <= c * beta + d -> + 0 <= b < beta -> 0 <= d < beta -> a <= c. Proof. intros a b c d beta H1 (H3, H4) (H5, H6). @@ -80,15 +80,15 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. Theorem beta_lex_inv: forall a b c d beta, a < c -> 0 <= b < beta -> - 0 <= d < beta -> - a * beta + b < c * beta + d. + 0 <= d < beta -> + a * beta + b < c * beta + d. Proof. intros a b c d beta H1 (H3, H4) (H5, H6). case (Zle_or_lt (c * beta + d) (a * beta + b)); auto with zarith. intros H7; contradict H1;apply Zle_not_lt;apply beta_lex with (1 := H7);auto. Qed. - Lemma beta_mult : forall h l beta, + Lemma beta_mult : forall h l beta, 0 <= h < beta -> 0 <= l < beta -> 0 <= h*beta+l < beta^2. Proof. intros h l beta H1 H2;split. auto with zarith. @@ -96,7 +96,7 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. apply beta_lex_inv;auto with zarith. Qed. - Lemma Zmult_lt_b : + Lemma Zmult_lt_b : forall b x y, 0 <= x < b -> 0 <= y < b -> 0 <= x * y <= b^2 - 2*b + 1. Proof. intros b x y (Hx1,Hx2) (Hy1,Hy2);split;auto with zarith. @@ -106,17 +106,17 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. Qed. Lemma sum_mul_carry : forall xh xl yh yl wc cc beta, - 1 < beta -> + 1 < beta -> 0 <= wc < beta -> 0 <= xh < beta -> 0 <= xl < beta -> 0 <= yh < beta -> 0 <= yl < beta -> 0 <= cc < beta^2 -> - wc*beta^2 + cc = xh*yl + xl*yh -> + wc*beta^2 + cc = xh*yl + xl*yh -> 0 <= wc <= 1. Proof. - intros xh xl yh yl wc cc beta U H1 H2 H3 H4 H5 H6 H7. + intros xh xl yh yl wc cc beta U H1 H2 H3 H4 H5 H6 H7. assert (H8 := Zmult_lt_b beta xh yl H2 H5). assert (H9 := Zmult_lt_b beta xl yh H3 H4). split;auto with zarith. @@ -134,7 +134,7 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. apply Zle_lt_trans with ((beta-1)*(beta-1)+(beta-1)); auto with zarith. apply Zplus_le_compat; auto with zarith. apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); + repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); rewrite Zpower_2; auto with zarith. Qed. @@ -149,7 +149,7 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. apply Zle_lt_trans with ((beta-1)*(beta-1)+(2*beta-2));auto with zarith. apply Zplus_le_compat; auto with zarith. apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); + repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); rewrite Zpower_2; auto with zarith. Qed. @@ -201,9 +201,9 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. apply Zplus_le_lt_compat; auto with zarith. replace b with ((b - a) + a); try ring. rewrite Zpower_exp; auto with zarith. - pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); + pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); try rewrite <- Zmult_minus_distr_r. - rewrite (Zmult_comm (2 ^(b - a))); rewrite Zmult_mod_distr_l; + rewrite (Zmult_comm (2 ^(b - a))); rewrite Zmult_mod_distr_l; auto with zarith. rewrite (Zmult_comm (2 ^a)); apply Zmult_le_compat_r; auto with zarith. match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; @@ -224,22 +224,22 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. split; auto with zarith. assert (0 <= 2 ^a * r); auto with zarith. apply Zplus_le_0_compat; auto with zarith. - match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; + match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. pattern (2 ^ b) at 2;replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a); try ring. apply Zplus_le_lt_compat; auto with zarith. replace b with ((b - a) + a); try ring. rewrite Zpower_exp; auto with zarith. - pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); + pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); try rewrite <- Zmult_minus_distr_r. repeat rewrite (fun x => Zmult_comm x (2 ^ a)); rewrite Zmult_mod_distr_l; auto with zarith. apply Zmult_le_compat_l; auto with zarith. - match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; + match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. Qed. - Theorem Zdiv_shift_r: + Theorem Zdiv_shift_r: forall a b r t, 0 <= a <= b -> 0 <= r -> 0 <= t < 2 ^a -> (r * 2 ^a + t) / (2 ^ b) = (r * 2 ^a) / (2 ^ b). Proof. @@ -253,7 +253,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. rewrite <- Zmod_shift_r; auto with zarith. rewrite (Zmult_comm (2 ^ b)); rewrite Z_div_plus_full_l; auto with zarith. rewrite (fun x y => @Zdiv_small (x mod y)); auto with zarith. - match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; + match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. Qed. @@ -264,8 +264,8 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. a * 2^p = a / 2^(n - p) * 2^n + (a*2^p) mod 2^n. Proof. intros n p a H1 H2. - pattern (a*2^p) at 1;replace (a*2^p) with - (a*2^p/2^n * 2^n + a*2^p mod 2^n). + pattern (a*2^p) at 1;replace (a*2^p) with + (a*2^p/2^n * 2^n + a*2^p mod 2^n). 2:symmetry;rewrite (Zmult_comm (a*2^p/2^n));apply Z_div_mod_eq. replace (a * 2 ^ p / 2 ^ n) with (a / 2 ^ (n - p));trivial. replace (2^n) with (2^(n-p)*2^p). @@ -279,8 +279,8 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Qed. - Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n -> - ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) = + Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n -> + ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) = a mod 2 ^ p. Proof. intros. @@ -312,16 +312,16 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Lemma div_le_0 : forall p x, 0 <= x -> 0 <= x / 2 ^ p. Proof. intros p x Hle;destruct (Z_le_gt_dec 0 p). - apply Zdiv_le_lower_bound;auto with zarith. + apply Zdiv_le_lower_bound;auto with zarith. replace (2^p) with 0. destruct x;compute;intro;discriminate. destruct p;trivial;discriminate z. Qed. - + Lemma div_lt : forall p x y, 0 <= x < y -> x / 2^p < y. Proof. intros p x y H;destruct (Z_le_gt_dec 0 p). - apply Zdiv_lt_upper_bound;auto with zarith. + apply Zdiv_lt_upper_bound;auto with zarith. apply Zlt_le_trans with y;auto with zarith. rewrite <- (Zmult_1_r y);apply Zmult_le_compat;auto with zarith. assert (0 < 2^p);auto with zarith. @@ -357,7 +357,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. compute; auto. Qed. - Lemma Zdiv_gcd_zero : forall a b, b / Zgcd a b = 0 -> b <> 0 -> + Lemma Zdiv_gcd_zero : forall a b, b / Zgcd a b = 0 -> b <> 0 -> Zgcd a b = 0. Proof. intros. @@ -369,7 +369,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. intros; subst k; simpl in *; subst b; elim H0; auto. Qed. - Lemma Zgcd_mult_rel_prime : forall a b c, + Lemma Zgcd_mult_rel_prime : forall a b c, Zgcd a c = 1 -> Zgcd b c = 1 -> Zgcd (a*b) c = 1. Proof. intros. @@ -378,7 +378,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Qed. Lemma Zcompare_gt : forall (A:Type)(a a':A)(p q:Z), - match (p?=q)%Z with Gt => a | _ => a' end = + match (p?=q)%Z with Gt => a | _ => a' end = if Z_le_gt_dec p q then a' else a. Proof. intros. diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v index b7a427532..32d150331 100644 --- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v +++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v @@ -12,8 +12,8 @@ (** * Signature and specification of a bounded integer structure *) -(** This file specifies how to represent [Z/nZ] when [n=2^d], - [d] being the number of digits of these bounded integers. *) +(** This file specifies how to represent [Z/nZ] when [n=2^d], + [d] being the number of digits of these bounded integers. *) Set Implicit Arguments. @@ -33,7 +33,7 @@ Section Z_nZ_Op. Record znz_op := mk_znz_op { (* Conversion functions with Z *) - znz_digits : positive; + znz_digits : positive; znz_zdigits: znz; znz_to_Z : znz -> Z; znz_of_pos : positive -> N * znz; (* Euclidean division by [2^digits] *) @@ -78,12 +78,12 @@ Section Z_nZ_Op. znz_div : znz -> znz -> znz * znz; znz_mod_gt : znz -> znz -> znz; (* specialized version of [znz_mod] *) - znz_mod : znz -> znz -> znz; + znz_mod : znz -> znz -> znz; znz_gcd_gt : znz -> znz -> znz; (* specialized version of [znz_gcd] *) - znz_gcd : znz -> znz -> znz; + znz_gcd : znz -> znz -> znz; (* [znz_add_mul_div p i j] is a combination of the [(digits-p)] - low bits of [i] above the [p] high bits of [j]: + low bits of [i] above the [p] high bits of [j]: [znz_add_mul_div p i j = i*2^p+j/2^(digits-p)] *) znz_add_mul_div : znz -> znz -> znz -> znz; (* [znz_pos_mod p i] is [i mod 2^p] *) @@ -135,7 +135,7 @@ Section Z_nZ_Spec. Let w_mul_c := w_op.(znz_mul_c). Let w_mul := w_op.(znz_mul). Let w_square_c := w_op.(znz_square_c). - + Let w_div21 := w_op.(znz_div21). Let w_div_gt := w_op.(znz_div_gt). Let w_div := w_op.(znz_div). @@ -229,25 +229,25 @@ Section Z_nZ_Spec. spec_div : forall a b, 0 < [|b|] -> let (q,r) := w_div a b in [|a|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]; - + 0 <= [|r|] < [|b|]; + spec_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> [|w_mod_gt a b|] = [|a|] mod [|b|]; spec_mod : forall a b, 0 < [|b|] -> [|w_mod a b|] = [|a|] mod [|b|]; - + spec_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]; spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|w_gcd a b|]; - + (* shift operations *) spec_head00: forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits; spec_head0 : forall x, 0 < [|x|] -> - wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB; + wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB; spec_tail00: forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits; - spec_tail0 : forall x, 0 < [|x|] -> - exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|w_tail0 x|]) ; + spec_tail0 : forall x, 0 < [|x|] -> + exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|w_tail0 x|]) ; spec_add_mul_div : forall x y p, [|p|] <= Zpos w_digits -> [| w_add_mul_div p x y |] = @@ -272,23 +272,23 @@ End Z_nZ_Spec. (** Generic construction of double words *) Section WW. - + Variable w : Type. Variable w_op : znz_op w. Variable op_spec : znz_spec w_op. - + Let wB := base w_op.(znz_digits). Let w_to_Z := w_op.(znz_to_Z). Let w_eq0 := w_op.(znz_eq0). Let w_0 := w_op.(znz_0). - Definition znz_W0 h := + Definition znz_W0 h := if w_eq0 h then W0 else WW h w_0. - Definition znz_0W l := + Definition znz_0W l := if w_eq0 l then W0 else WW w_0 l. - Definition znz_WW h l := + Definition znz_WW h l := if w_eq0 h then znz_0W l else WW h l. Lemma spec_W0 : forall h, @@ -300,7 +300,7 @@ Section WW. unfold w_0; rewrite op_spec.(spec_0); auto with zarith. Qed. - Lemma spec_0W : forall l, + Lemma spec_0W : forall l, zn2z_to_Z wB w_to_Z (znz_0W l) = w_to_Z l. Proof. unfold zn2z_to_Z, znz_0W, w_to_Z; simpl; intros. @@ -309,7 +309,7 @@ Section WW. unfold w_0; rewrite op_spec.(spec_0); auto with zarith. Qed. - Lemma spec_WW : forall h l, + Lemma spec_WW : forall h l, zn2z_to_Z wB w_to_Z (znz_WW h l) = (w_to_Z h)*wB + w_to_Z l. Proof. unfold znz_WW, w_to_Z; simpl; intros. @@ -324,7 +324,7 @@ End WW. (** Injecting [Z] numbers into a cyclic structure *) Section znz_of_pos. - + Variable w : Type. Variable w_op : znz_op w. Variable op_spec : znz_spec w_op. @@ -349,7 +349,7 @@ Section znz_of_pos. apply Zle_trans with X; auto with zarith end. match goal with |- ?X <= _ => - pattern X at 1; rewrite <- (Zmult_1_l); + pattern X at 1; rewrite <- (Zmult_1_l); apply Zmult_le_compat_r; auto with zarith end. case p1; simpl; intros; red; simpl; intros; discriminate. diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v index 125fd3f12..589159390 100644 --- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v +++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v @@ -17,9 +17,9 @@ Require Import CyclicAxioms. (** * From [CyclicType] to [NZAxiomsSig] *) -(** A [Z/nZ] representation given by a module type [CyclicType] - implements [NZAxiomsSig], e.g. the common properties between - N and Z with no ordering. Notice that the [n] in [Z/nZ] is +(** A [Z/nZ] representation given by a module type [CyclicType] + implements [NZAxiomsSig], e.g. the common properties between + N and Z with no ordering. Notice that the [n] in [Z/nZ] is a power of 2. *) @@ -98,7 +98,7 @@ Notation "x * y" := (NZmul x y) : IntScope. Theorem gt_wB_1 : 1 < wB. Proof. -unfold base. +unfold base. apply Zpower_gt_1; unfold Zlt; auto with zarith. Qed. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v index d60af33ec..b4f6a8160 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v @@ -36,10 +36,10 @@ Section DoubleAdd. Definition ww_succ_c x := match x with | W0 => C0 ww_1 - | WW xh xl => + | WW xh xl => match w_succ_c xl with | C0 l => C0 (WW xh l) - | C1 l => + | C1 l => match w_succ_c xh with | C0 h => C0 (WW h w_0) | C1 h => C1 W0 @@ -47,13 +47,13 @@ Section DoubleAdd. end end. - Definition ww_succ x := + Definition ww_succ x := match x with | W0 => ww_1 | WW xh xl => match w_succ_c xl with | C0 l => WW xh l - | C1 l => w_W0 (w_succ xh) + | C1 l => w_W0 (w_succ xh) end end. @@ -63,12 +63,12 @@ Section DoubleAdd. | _, W0 => C0 x | WW xh xl, WW yh yl => match w_add_c xl yl with - | C0 l => + | C0 l => match w_add_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (w_WW h l) - end - | C1 l => + end + | C1 l => match w_add_carry_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (w_WW h l) @@ -85,12 +85,12 @@ Section DoubleAdd. | _, W0 => f0 x | WW xh xl, WW yh yl => match w_add_c xl yl with - | C0 l => + | C0 l => match w_add_c xh yh with | C0 h => f0 (WW h l) | C1 h => f1 (w_WW h l) - end - | C1 l => + end + | C1 l => match w_add_carry_c xh yh with | C0 h => f0 (WW h l) | C1 h => f1 (w_WW h l) @@ -118,12 +118,12 @@ Section DoubleAdd. | WW xh xl, W0 => ww_succ_c (WW xh xl) | WW xh xl, WW yh yl => match w_add_carry_c xl yl with - | C0 l => + | C0 l => match w_add_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (WW h l) end - | C1 l => + | C1 l => match w_add_carry_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (w_WW h l) @@ -131,7 +131,7 @@ Section DoubleAdd. end end. - Definition ww_add_carry x y := + Definition ww_add_carry x y := match x, y with | W0, W0 => ww_1 | W0, WW yh yl => ww_succ (WW yh yl) @@ -146,7 +146,7 @@ Section DoubleAdd. (*Section DoubleProof.*) Variable w_digits : positive. Variable w_to_Z : w -> Z. - + Notation wB := (base w_digits). Notation wwB := (base (ww_digits w_digits)). @@ -157,11 +157,11 @@ Section DoubleAdd. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Variable spec_w_0 : [|w_0|] = 0. @@ -172,7 +172,7 @@ Section DoubleAdd. Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. Variable spec_w_succ_c : forall x, [+|w_succ_c x|] = [|x|] + 1. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. - Variable spec_w_add_carry_c : + Variable spec_w_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1. Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB. Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. @@ -187,11 +187,11 @@ Section DoubleAdd. rewrite <- Zplus_assoc;rewrite <- H;rewrite Zmult_1_l. assert ([|l|] = 0). generalize (spec_to_Z xl)(spec_to_Z l);omega. rewrite H0;generalize (spec_w_succ_c xh);destruct (w_succ_c xh) as [h|h]; - intro H1;unfold interp_carry in H1. + intro H1;unfold interp_carry in H1. simpl;rewrite H1;rewrite spec_w_0;ring. unfold interp_carry;simpl ww_to_Z;rewrite wwB_wBwB. assert ([|xh|] = wB - 1). generalize (spec_to_Z xh)(spec_to_Z h);omega. - rewrite H2;ring. + rewrite H2;ring. Qed. Lemma spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]]. @@ -222,12 +222,12 @@ Section DoubleAdd. Proof. destruct x as [ |xh xl];simpl;trivial. apply spec_f0;trivial. - destruct y as [ |yh yl];simpl. + destruct y as [ |yh yl];simpl. apply spec_f0;simpl;rewrite Zplus_0_r;trivial. generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; intros H;unfold interp_carry in H. generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; - intros H1;unfold interp_carry in *. + intros H1;unfold interp_carry in *. apply spec_f0. simpl;rewrite H;rewrite H1;ring. apply spec_f1. simpl;rewrite spec_w_WW;rewrite H. rewrite Zplus_assoc;rewrite wwB_wBwB. rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. @@ -236,12 +236,12 @@ Section DoubleAdd. as [h|h]; intros H1;unfold interp_carry in *. apply spec_f0;simpl;rewrite H1. rewrite Zmult_plus_distr_l. rewrite <- Zplus_assoc;rewrite H;ring. - apply spec_f1. simpl;rewrite spec_w_WW;rewrite wwB_wBwB. - rewrite Zplus_assoc; rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. + apply spec_f1. simpl;rewrite spec_w_WW;rewrite wwB_wBwB. + rewrite Zplus_assoc; rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. rewrite Zmult_1_l in H1;rewrite H1. rewrite Zmult_plus_distr_l. rewrite <- Zplus_assoc;rewrite H;ring. Qed. - + End Cont. Lemma spec_ww_add_carry_c : @@ -251,16 +251,16 @@ Section DoubleAdd. exact (spec_ww_succ_c y). destruct y as [ |yh yl];simpl. rewrite Zplus_0_r;exact (spec_ww_succ_c (WW xh xl)). - replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) + replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. - generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) + generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H. generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. unfold interp_carry;repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) - as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. + generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) + as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. unfold interp_carry;rewrite spec_w_WW; repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. Qed. @@ -287,9 +287,9 @@ Section DoubleAdd. rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial. destruct y as [ |yh yl]. change [[W0]] with 0;rewrite Zplus_0_r. - rewrite Zmod_small;trivial. + rewrite Zmod_small;trivial. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)). - simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) + simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring. generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; unfold interp_carry;intros H;simpl;rewrite <- H. @@ -305,14 +305,14 @@ Section DoubleAdd. exact (spec_ww_succ y). destruct y as [ |yh yl]. change [[W0]] with 0;rewrite Zplus_0_r. exact (spec_ww_succ (WW xh xl)). - simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) + simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. - generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) + generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) as [l|l];unfold interp_carry;intros H;rewrite <- H;simpl ww_to_Z. rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial. rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial. - Qed. + Qed. (* End DoubleProof. *) End DoubleAdd. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v index 37b9f47b4..82480fa2e 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v @@ -29,8 +29,8 @@ Section DoubleBase. Variable w_zdigits: w. Variable w_add: w -> w -> zn2z w. Variable w_to_Z : w -> Z. - Variable w_compare : w -> w -> comparison. - + Variable w_compare : w -> w -> comparison. + Definition ww_digits := xO w_digits. Definition ww_zdigits := w_add w_zdigits w_zdigits. @@ -46,7 +46,7 @@ Section DoubleBase. | W0, W0 => W0 | _, _ => WW xh xl end. - + Definition ww_W0 h : zn2z (zn2z w) := match h with | W0 => W0 @@ -58,10 +58,10 @@ Section DoubleBase. | W0 => W0 | _ => WW W0 l end. - - Definition double_WW (n:nat) := - match n return word w n -> word w n -> word w (S n) with - | O => w_WW + + Definition double_WW (n:nat) := + match n return word w n -> word w n -> word w (S n) with + | O => w_WW | S n => fun (h l : zn2z (word w n)) => match h, l with @@ -70,8 +70,8 @@ Section DoubleBase. end end. - Fixpoint double_digits (n:nat) : positive := - match n with + Fixpoint double_digits (n:nat) : positive := + match n with | O => w_digits | S n => xO (double_digits n) end. @@ -80,7 +80,7 @@ Section DoubleBase. Fixpoint double_to_Z (n:nat) : word w n -> Z := match n return word w n -> Z with - | O => w_to_Z + | O => w_to_Z | S n => zn2z_to_Z (double_wB n) (double_to_Z n) end. @@ -98,21 +98,21 @@ Section DoubleBase. end. Definition double_0 n : word w n := - match n return word w n with + match n return word w n with | O => w_0 | S _ => W0 end. - + Definition double_split (n:nat) (x:zn2z (word w n)) := - match x with - | W0 => - match n return word w n * word w n with + match x with + | W0 => + match n return word w n * word w n with | O => (w_0,w_0) | S _ => (W0, W0) end | WW h l => (h,l) end. - + Definition ww_compare x y := match x, y with | W0, W0 => Eq @@ -148,15 +148,15 @@ Section DoubleBase. end end. - + Section DoubleProof. Notation wB := (base w_digits). Notation wwB := (base ww_digits). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z x) (at level 0, x at level 99). - Notation "[+[ c ]]" := + Notation "[+[ c ]]" := (interp_carry 1 wwB ww_to_Z c) (at level 0, x at level 99). - Notation "[-[ c ]]" := + Notation "[-[ c ]]" := (interp_carry (-1) wwB ww_to_Z c) (at level 0, x at level 99). Notation "[! n | x !]" := (double_to_Z n x) (at level 0, x at level 99). @@ -188,7 +188,7 @@ Section DoubleBase. Proof. simpl;rewrite spec_w_Bm1;rewrite wwB_wBwB;ring. Qed. Lemma lt_0_wB : 0 < wB. - Proof. + Proof. unfold base;apply Zpower_gt_0. unfold Zlt;reflexivity. unfold Zle;intros H;discriminate H. Qed. @@ -197,25 +197,25 @@ Section DoubleBase. Proof. rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_lt_0_compat;apply lt_0_wB. Qed. Lemma wB_pos: 1 < wB. - Proof. + Proof. unfold base;apply Zlt_le_trans with (2^1). unfold Zlt;reflexivity. apply Zpower_le_monotone. unfold Zlt;reflexivity. split;unfold Zle;intros H. discriminate H. clear spec_w_0W w_0W spec_w_Bm1 spec_to_Z spec_w_WW w_WW. destruct w_digits; discriminate H. Qed. - - Lemma wwB_pos: 1 < wwB. + + Lemma wwB_pos: 1 < wwB. Proof. assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Zmult_1_r 1). rewrite Zpower_2. apply Zmult_lt_compat2;(split;[unfold Zlt;reflexivity|trivial]). - apply Zlt_le_weak;trivial. + apply Zlt_le_weak;trivial. Qed. Theorem wB_div_2: 2 * (wB / 2) = wB. Proof. - clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W + clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W spec_to_Z;unfold base. assert (2 ^ Zpos w_digits = 2 * (2 ^ (Zpos w_digits - 1))). pattern 2 at 2; rewrite <- Zpower_1_r. @@ -228,7 +228,7 @@ Section DoubleBase. Theorem wwB_div_2 : wwB / 2 = wB / 2 * wB. Proof. - clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W + clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W spec_to_Z. rewrite wwB_wBwB; rewrite Zpower_2. pattern wB at 1; rewrite <- wB_div_2; auto. @@ -236,11 +236,11 @@ Section DoubleBase. repeat (rewrite (Zmult_comm 2); rewrite Z_div_mult); auto with zarith. Qed. - Lemma mod_wwB : forall z x, + Lemma mod_wwB : forall z x, (z*wB + [|x|]) mod wwB = (z mod wB)*wB + [|x|]. Proof. intros z x. - rewrite Zplus_mod. + rewrite Zplus_mod. pattern wwB at 1;rewrite wwB_wBwB; rewrite Zpower_2. rewrite Zmult_mod_distr_r;try apply lt_0_wB. rewrite (Zmod_small [|x|]). @@ -260,8 +260,8 @@ Section DoubleBase. destruct (spec_to_Z x);trivial. Qed. - Lemma wB_div_plus : forall x y p, - 0 <= p -> + Lemma wB_div_plus : forall x y p, + 0 <= p -> ([|x|]*wB + [|y|]) / 2^(Zpos w_digits + p) = [|x|] / 2^p. Proof. clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. @@ -277,7 +277,7 @@ Section DoubleBase. assert (0 < Zpos w_digits). compute;reflexivity. unfold ww_digits;rewrite Zpos_xO;auto with zarith. Qed. - + Lemma w_to_Z_wwB : forall x, x < wB -> x < wwB. Proof. intros x H;apply Zlt_trans with wB;trivial;apply lt_wB_wwB. @@ -298,7 +298,7 @@ Section DoubleBase. Proof. intros n;unfold double_wB;simpl. unfold base;rewrite (Zpos_xO (double_digits n)). - replace (2 * Zpos (double_digits n)) with + replace (2 * Zpos (double_digits n)) with (Zpos (double_digits n) + Zpos (double_digits n)). symmetry; apply Zpower_exp;intro;discriminate. ring. @@ -327,7 +327,7 @@ Section DoubleBase. unfold base; auto with zarith. Qed. - Lemma spec_double_to_Z : + Lemma spec_double_to_Z : forall n (x:word w n), 0 <= [!n | x!] < double_wB n. Proof. clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. @@ -347,7 +347,7 @@ Section DoubleBase. Qed. Lemma spec_get_low: - forall n x, + forall n x, [!n | x!] < wB -> [|get_low n x|] = [!n | x!]. Proof. clear spec_w_1 spec_w_Bm1. @@ -380,19 +380,19 @@ Section DoubleBase. Qed. Lemma spec_extend_aux : forall n x, [!S n|extend_aux n x!] = [[x]]. - Proof. induction n;simpl;trivial. Qed. + Proof. induction n;simpl;trivial. Qed. Lemma spec_extend : forall n x, [!S n|extend n x!] = [|x|]. - Proof. + Proof. intros n x;assert (H:= spec_w_0W x);unfold extend. - destruct (w_0W x);simpl;trivial. + destruct (w_0W x);simpl;trivial. rewrite <- H;exact (spec_extend_aux n (WW w0 w1)). Qed. Lemma spec_double_0 : forall n, [!n|double_0 n!] = 0. Proof. destruct n;trivial. Qed. - Lemma spec_double_split : forall n x, + Lemma spec_double_split : forall n x, let (h,l) := double_split n x in [!S n|x!] = [!n|h!] * double_wB n + [!n|l!]. Proof. @@ -401,9 +401,9 @@ Section DoubleBase. rewrite spec_w_0;trivial. Qed. - Lemma wB_lex_inv: forall a b c d, - a < c -> - a * wB + [|b|] < c * wB + [|d|]. + Lemma wB_lex_inv: forall a b c d, + a < c -> + a * wB + [|b|] < c * wB + [|d|]. Proof. intros a b c d H1; apply beta_lex_inv with (1 := H1); auto. Qed. @@ -420,7 +420,7 @@ Section DoubleBase. intros H;rewrite spec_w_0 in H. rewrite <- H;simpl;rewrite <- spec_w_0;apply spec_w_compare. change 0 with (0*wB+0);pattern 0 at 2;rewrite <- spec_w_0. - apply wB_lex_inv;trivial. + apply wB_lex_inv;trivial. absurd (0 <= [|yh|]). apply Zgt_not_le;trivial. destruct (spec_to_Z yh);trivial. generalize (spec_w_compare xh w_0);destruct (w_compare xh w_0); @@ -429,8 +429,8 @@ Section DoubleBase. absurd (0 <= [|xh|]). apply Zgt_not_le;apply Zlt_gt;trivial. destruct (spec_to_Z xh);trivial. apply Zlt_gt;change 0 with (0*wB+0);pattern 0 at 2;rewrite <- spec_w_0. - apply wB_lex_inv;apply Zgt_lt;trivial. - + apply wB_lex_inv;apply Zgt_lt;trivial. + generalize (spec_w_compare xh yh);destruct (w_compare xh yh);intros H. rewrite H;generalize (spec_w_compare xl yl);destruct (w_compare xl yl); intros H1;[rewrite H1|apply Zplus_lt_compat_l|apply Zplus_gt_compat_l]; @@ -439,7 +439,7 @@ Section DoubleBase. apply Zlt_gt;apply wB_lex_inv;apply Zgt_lt;trivial. Qed. - + End DoubleProof. End DoubleBase. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v index b590e9b3c..db3b622b0 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v @@ -22,7 +22,7 @@ Require Import DoubleMul. Require Import DoubleSqrt. Require Import DoubleLift. Require Import DoubleDivn1. -Require Import DoubleDiv. +Require Import DoubleDiv. Require Import CyclicAxioms. Open Local Scope Z_scope. @@ -80,7 +80,7 @@ Section Z_2nZ. Let w_gcd_gt := w_op.(znz_gcd_gt). Let w_gcd := w_op.(znz_gcd). - Let w_add_mul_div := w_op.(znz_add_mul_div). + Let w_add_mul_div := w_op.(znz_add_mul_div). Let w_pos_mod := w_op.(znz_pos_mod). @@ -93,7 +93,7 @@ Section Z_2nZ. Let wB := base w_digits. Let w_Bm2 := w_pred w_Bm1. - + Let ww_1 := ww_1 w_0 w_1. Let ww_Bm1 := ww_Bm1 w_Bm1. @@ -112,16 +112,16 @@ Section Z_2nZ. Let ww_of_pos p := match w_of_pos p with | (N0, l) => (N0, WW w_0 l) - | (Npos ph,l) => + | (Npos ph,l) => let (n,h) := w_of_pos ph in (n, w_WW h l) end. Let head0 := - Eval lazy beta delta [ww_head0] in + Eval lazy beta delta [ww_head0] in ww_head0 w_0 w_0W w_compare w_head0 w_add2 w_zdigits _ww_zdigits. Let tail0 := - Eval lazy beta delta [ww_tail0] in + Eval lazy beta delta [ww_tail0] in ww_tail0 w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits. Let ww_WW := Eval lazy beta delta [ww_WW] in (@ww_WW w). @@ -132,7 +132,7 @@ Section Z_2nZ. Let compare := Eval lazy beta delta[ww_compare] in ww_compare w_0 w_compare. - Let eq0 (x:zn2z w) := + Let eq0 (x:zn2z w) := match x with | W0 => true | _ => false @@ -147,7 +147,7 @@ Section Z_2nZ. Let opp_carry := Eval lazy beta delta [ww_opp_carry] in ww_opp_carry w_WW ww_Bm1 w_opp_carry. - + (* ** Additions ** *) Let succ_c := @@ -157,16 +157,16 @@ Section Z_2nZ. Eval lazy beta delta [ww_add_c] in ww_add_c w_WW w_add_c w_add_carry_c. Let add_carry_c := - Eval lazy beta iota delta [ww_add_carry_c ww_succ_c] in + Eval lazy beta iota delta [ww_add_carry_c ww_succ_c] in ww_add_carry_c w_0 w_WW ww_1 w_succ_c w_add_c w_add_carry_c. - Let succ := + Let succ := Eval lazy beta delta [ww_succ] in ww_succ w_W0 ww_1 w_succ_c w_succ. Let add := Eval lazy beta delta [ww_add] in ww_add w_add_c w_add w_add_carry. - Let add_carry := + Let add_carry := Eval lazy beta iota delta [ww_add_carry ww_succ] in ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ w_add w_add_carry. @@ -174,9 +174,9 @@ Section Z_2nZ. Let pred_c := Eval lazy beta delta [ww_pred_c] in ww_pred_c w_Bm1 w_WW ww_Bm1 w_pred_c. - + Let sub_c := - Eval lazy beta iota delta [ww_sub_c ww_opp_c] in + Eval lazy beta iota delta [ww_sub_c ww_opp_c] in ww_sub_c w_0 w_WW w_opp_c w_opp_carry w_sub_c w_sub_carry_c. Let sub_carry_c := @@ -186,8 +186,8 @@ Section Z_2nZ. Let pred := Eval lazy beta delta [ww_pred] in ww_pred w_Bm1 w_WW ww_Bm1 w_pred_c w_pred. - Let sub := - Eval lazy beta iota delta [ww_sub ww_opp] in + Let sub := + Eval lazy beta iota delta [ww_sub ww_opp] in ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry. Let sub_carry := @@ -204,7 +204,7 @@ Section Z_2nZ. Let karatsuba_c := Eval lazy beta iota delta [ww_karatsuba_c double_mul_c kara_prod] in - ww_karatsuba_c w_0 w_1 w_WW w_W0 w_compare w_add w_sub w_mul_c + ww_karatsuba_c w_0 w_1 w_WW w_W0 w_compare w_add w_sub w_mul_c add_c add add_carry sub_c sub. Let mul := @@ -219,7 +219,7 @@ Section Z_2nZ. Let div32 := Eval lazy beta iota delta [w_div32] in - w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c + w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c. Let div21 := @@ -234,40 +234,40 @@ Section Z_2nZ. Let div_gt := Eval lazy beta delta [ww_div_gt] in - ww_div_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp + ww_div_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits. Let div := Eval lazy beta delta [ww_div] in ww_div ww_1 compare div_gt. - + Let mod_gt := Eval lazy beta delta [ww_mod_gt] in ww_mod_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_mod_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits add_mul_div w_zdigits. - Let mod_ := + Let mod_ := Eval lazy beta delta [ww_mod] in ww_mod compare mod_gt. - Let pos_mod := - Eval lazy beta delta [ww_pos_mod] in + Let pos_mod := + Eval lazy beta delta [ww_pos_mod] in ww_pos_mod w_0 w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits. - Let is_even := + Let is_even := Eval lazy beta delta [ww_is_even] in ww_is_even w_is_even. - Let sqrt2 := + Let sqrt2 := Eval lazy beta delta [ww_sqrt2] in ww_sqrt2 w_is_even w_compare w_0 w_1 w_Bm1 w_0W w_sub w_square_c w_div21 w_add_mul_div w_zdigits w_add_c w_sqrt2 w_pred pred_c pred add_c add sub_c add_mul_div. - Let sqrt := + Let sqrt := Eval lazy beta delta [ww_sqrt] in ww_sqrt w_is_even w_0 w_sub w_add_mul_div w_zdigits _ww_zdigits w_sqrt2 pred add_mul_div head0 compare low. - Let gcd_gt_fix := + Let gcd_gt_fix := Eval cbv beta delta [ww_gcd_gt_aux ww_gcd_gt_body] in ww_gcd_gt_aux w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt @@ -278,7 +278,7 @@ Section Z_2nZ. Eval lazy beta delta [gcd_cont] in gcd_cont ww_1 w_1 w_compare. Let gcd_gt := - Eval lazy beta delta [ww_gcd_gt] in + Eval lazy beta delta [ww_gcd_gt] in ww_gcd_gt w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont. Let gcd := @@ -286,18 +286,18 @@ Section Z_2nZ. ww_gcd compare w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont. (* ** Record of operators on 2 words *) - - Definition mk_zn2z_op := + + Definition mk_zn2z_op := mk_znz_op _ww_digits _ww_zdigits to_Z ww_of_pos head0 tail0 W0 ww_1 ww_Bm1 compare eq0 opp_c opp opp_carry - succ_c add_c add_carry_c - succ add add_carry - pred_c sub_c sub_carry_c + succ_c add_c add_carry_c + succ add add_carry + pred_c sub_c sub_carry_c pred sub sub_carry - mul_c mul square_c + mul_c mul square_c div21 div_gt div mod_gt mod_ gcd_gt gcd @@ -307,17 +307,17 @@ Section Z_2nZ. sqrt2 sqrt. - Definition mk_zn2z_op_karatsuba := + Definition mk_zn2z_op_karatsuba := mk_znz_op _ww_digits _ww_zdigits to_Z ww_of_pos head0 tail0 W0 ww_1 ww_Bm1 compare eq0 opp_c opp opp_carry - succ_c add_c add_carry_c - succ add add_carry - pred_c sub_c sub_carry_c + succ_c add_c add_carry_c + succ add add_carry + pred_c sub_c sub_carry_c pred sub sub_carry - karatsuba_c mul square_c + karatsuba_c mul square_c div21 div_gt div mod_gt mod_ gcd_gt gcd @@ -330,7 +330,7 @@ Section Z_2nZ. (* Proof *) Variable op_spec : znz_spec w_op. - Hint Resolve + Hint Resolve (spec_to_Z op_spec) (spec_of_pos op_spec) (spec_0 op_spec) @@ -358,13 +358,13 @@ Section Z_2nZ. (spec_square_c op_spec) (spec_div21 op_spec) (spec_div_gt op_spec) - (spec_div op_spec) + (spec_div op_spec) (spec_mod_gt op_spec) - (spec_mod op_spec) + (spec_mod op_spec) (spec_gcd_gt op_spec) - (spec_gcd op_spec) - (spec_head0 op_spec) - (spec_tail0 op_spec) + (spec_gcd op_spec) + (spec_head0 op_spec) + (spec_tail0 op_spec) (spec_add_mul_div op_spec) (spec_pos_mod) (spec_is_even) @@ -417,20 +417,20 @@ Section Z_2nZ. Let spec_ww_Bm1 : [|ww_Bm1|] = wwB - 1. Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed. - Let spec_ww_compare : + Let spec_ww_compare : forall x y, match compare x y with | Eq => [|x|] = [|y|] | Lt => [|x|] < [|y|] | Gt => [|x|] > [|y|] end. - Proof. - refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto. - exact (spec_compare op_spec). + Proof. + refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto. + exact (spec_compare op_spec). Qed. Let spec_ww_eq0 : forall x, eq0 x = true -> [|x|] = 0. - Proof. destruct x;simpl;intros;trivial;discriminate. Qed. + Proof. destruct x;simpl;intros;trivial;discriminate. Qed. Let spec_ww_opp_c : forall x, [-|opp_c x|] = -[|x|]. Proof. @@ -440,7 +440,7 @@ Section Z_2nZ. Let spec_ww_opp : forall x, [|opp x|] = (-[|x|]) mod wwB. Proof. - refine(spec_ww_opp w_0 w_0 W0 w_opp_c w_opp_carry w_opp + refine(spec_ww_opp w_0 w_0 W0 w_opp_c w_opp_carry w_opp w_digits w_to_Z _ _ _ _ _); auto. Qed. @@ -480,25 +480,25 @@ Section Z_2nZ. Let spec_ww_add_carry : forall x y, [|add_carry x y|]=([|x|]+[|y|]+1)mod wwB. Proof. - refine (spec_ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ + refine (spec_ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ w_add w_add_carry w_digits w_to_Z _ _ _ _ _ _ _ _);wwauto. Qed. Let spec_ww_pred_c : forall x, [-|pred_c x|] = [|x|] - 1. Proof. - refine (spec_ww_pred_c w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_digits w_to_Z + refine (spec_ww_pred_c w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_digits w_to_Z _ _ _ _ _);wwauto. Qed. Let spec_ww_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|]. Proof. - refine (spec_ww_sub_c w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c + refine (spec_ww_sub_c w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _);wwauto. Qed. Let spec_ww_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|]-[|y|]-1. Proof. - refine (spec_ww_sub_carry_c w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c + refine (spec_ww_sub_carry_c w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c w_sub_c w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _ _);wwauto. Qed. @@ -533,17 +533,17 @@ Section Z_2nZ. _ _ _ _ _ _ _ _ _ _ _ _); wwauto. unfold w_digits; apply spec_more_than_1_digit; auto. exact (spec_compare op_spec). - Qed. + Qed. Let spec_ww_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wwB. Proof. refine (spec_ww_mul w_W0 w_add w_mul_c w_mul add w_digits w_to_Z _ _ _ _ _); - wwauto. + wwauto. Qed. Let spec_ww_square_c : forall x, [[square_c x]] = [|x|] * [|x|]. Proof. - refine (spec_ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add + refine (spec_ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add add_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _ _);wwauto. Qed. @@ -574,7 +574,7 @@ Section Z_2nZ. 0 <= [|r|] < [|b|]. Proof. refine (spec_ww_div21 w_0 w_0W div32 ww_1 compare sub w_digits w_to_Z - _ _ _ _ _ _ _);wwauto. + _ _ _ _ _ _ _);wwauto. Qed. Let spec_add2: forall x y, @@ -602,7 +602,7 @@ Section Z_2nZ. unfold wB, base; auto with zarith. Qed. - Let spec_ww_digits: + Let spec_ww_digits: [|_ww_zdigits|] = Zpos (xO w_digits). Proof. unfold w_to_Z, _ww_zdigits. @@ -615,7 +615,7 @@ Section Z_2nZ. Let spec_ww_head00 : forall x, [|x|] = 0 -> [|head0 x|] = Zpos _ww_digits. Proof. - refine (spec_ww_head00 w_0 w_0W + refine (spec_ww_head00 w_0 w_0W w_compare w_head0 w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); auto. exact (spec_compare op_spec). @@ -626,8 +626,8 @@ Section Z_2nZ. Let spec_ww_head0 : forall x, 0 < [|x|] -> wwB/ 2 <= 2 ^ [|head0 x|] * [|x|] < wwB. Proof. - refine (spec_ww_head0 w_0 w_0W w_compare w_head0 - w_add2 w_zdigits _ww_zdigits + refine (spec_ww_head0 w_0 w_0W w_compare w_head0 + w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_zdigits op_spec). @@ -635,7 +635,7 @@ Section Z_2nZ. Let spec_ww_tail00 : forall x, [|x|] = 0 -> [|tail0 x|] = Zpos _ww_digits. Proof. - refine (spec_ww_tail00 w_0 w_0W + refine (spec_ww_tail00 w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); wwauto. exact (spec_compare op_spec). @@ -647,7 +647,7 @@ Section Z_2nZ. Let spec_ww_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * 2 ^ [|tail0 x|]. Proof. - refine (spec_ww_tail0 (w_digits := w_digits) w_0 w_0W w_compare w_tail0 + refine (spec_ww_tail0 (w_digits := w_digits) w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_zdigits op_spec). @@ -659,19 +659,19 @@ Section Z_2nZ. ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos _ww_digits) - [|p|]))) mod wwB. Proof. - refine (@spec_ww_add_mul_div w w_0 w_WW w_W0 w_0W compare w_add_mul_div + refine (@spec_ww_add_mul_div w w_0 w_WW w_W0 w_0W compare w_add_mul_div sub w_digits w_zdigits low w_to_Z _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_zdigits op_spec). Qed. - Let spec_ww_div_gt : forall a b, + Let spec_ww_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> let (q,r) := div_gt a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. -refine -(@spec_ww_div_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 +refine +(@spec_ww_div_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ @@ -707,14 +707,14 @@ refine refine (spec_ww_div w_digits ww_1 compare div_gt w_to_Z _ _ _ _);auto. Qed. - Let spec_ww_mod_gt : forall a b, + Let spec_ww_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> [|mod_gt a b|] = [|a|] mod [|b|]. Proof. - refine (@spec_ww_mod_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 + refine (@spec_ww_mod_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_mod_gt - w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div - w_zdigits w_to_Z + w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div + w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_div_gt op_spec). @@ -731,12 +731,12 @@ refine Let spec_ww_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|gcd_gt a b|]. Proof. - refine (@spec_ww_gcd_gt w w_digits W0 w_to_Z _ + refine (@spec_ww_gcd_gt w w_digits W0 w_to_Z _ w_0 w_0 w_eq0 w_gcd_gt _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);auto. refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0 - w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z + w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_div21 op_spec). @@ -753,7 +753,7 @@ refine _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);auto. refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0 - w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z + w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_div21 op_spec). @@ -798,7 +798,7 @@ refine Let spec_ww_sqrt : forall x, [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2. Proof. - refine (@spec_ww_sqrt w w_is_even w_0 w_1 w_Bm1 + refine (@spec_ww_sqrt w w_is_even w_0 w_1 w_Bm1 w_sub w_add_mul_div w_digits w_zdigits _ww_zdigits w_sqrt2 pred add_mul_div head0 compare _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto. @@ -814,7 +814,7 @@ refine apply mk_znz_spec;auto. exact spec_ww_add_mul_div. - refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW + refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_pos_mod op_spec). @@ -828,7 +828,7 @@ refine Proof. apply mk_znz_spec;auto. exact spec_ww_add_mul_div. - refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW + refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_pos_mod op_spec). @@ -838,10 +838,10 @@ refine rewrite <- Zpos_xO; exact spec_ww_digits. Qed. -End Z_2nZ. - +End Z_2nZ. + Section MulAdd. - + Variable w: Type. Variable op: znz_op w. Variable sop: znz_spec op. @@ -870,7 +870,7 @@ Section MulAdd. End MulAdd. -(** Modular versions of DoubleCyclic *) +(** Modular versions of DoubleCyclic *) Module DoubleCyclic (C:CyclicType) <: CyclicType. Definition w := zn2z C.w. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v index d3dfd2505..03c611442 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v @@ -41,13 +41,13 @@ Section POS_MOD. Variable ww_zdigits : zn2z w. - Definition ww_pos_mod p x := + Definition ww_pos_mod p x := let zdigits := w_0W w_zdigits in match x with | W0 => W0 | WW xh xl => match ww_compare p zdigits with - | Eq => w_WW w_0 xl + | Eq => w_WW w_0 xl | Lt => w_WW w_0 (w_pos_mod (low p) xl) | Gt => match ww_compare p ww_zdigits with @@ -87,7 +87,7 @@ Section POS_MOD. | Lt => [[x]] < [[y]] | Gt => [[x]] > [[y]] end. - Variable spec_ww_sub: forall x y, + Variable spec_ww_sub: forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits. @@ -106,7 +106,7 @@ Section POS_MOD. unfold ww_pos_mod; case w1. simpl; rewrite Zmod_small; split; auto with zarith. intros xh xl; generalize (spec_ww_compare p (w_0W w_zdigits)); - case ww_compare; + case ww_compare; rewrite spec_w_0W; rewrite spec_zdigits; fold wB; intros H1. rewrite H1; simpl ww_to_Z. @@ -135,13 +135,13 @@ Section POS_MOD. autorewrite with w_rewrite rm10. rewrite Zmod_mod; auto with zarith. generalize (spec_ww_compare p ww_zdigits); - case ww_compare; rewrite spec_ww_zdigits; + case ww_compare; rewrite spec_ww_zdigits; rewrite spec_zdigits; intros H2. replace (2^[[p]]) with wwB. rewrite Zmod_small; auto with zarith. unfold base; rewrite H2. rewrite spec_ww_digits; auto. - assert (HH0: [|low (ww_sub p (w_0W w_zdigits))|] = + assert (HH0: [|low (ww_sub p (w_0W w_zdigits))|] = [[p]] - Zpos w_digits). rewrite spec_low. rewrite spec_ww_sub. @@ -152,11 +152,11 @@ generalize (spec_ww_compare p ww_zdigits); apply Zlt_le_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_le_lin; auto with zarith. exists wB; unfold base; rewrite <- Zpower_exp; auto with zarith. - rewrite spec_ww_digits; + rewrite spec_ww_digits; apply f_equal with (f := Zpower 2); rewrite Zpos_xO; auto with zarith. simpl ww_to_Z; autorewrite with w_rewrite. rewrite spec_pos_mod; rewrite HH0. - pattern [|xh|] at 2; + pattern [|xh|] at 2; rewrite Z_div_mod_eq with (b := 2 ^ ([[p]] - Zpos w_digits)); auto with zarith. rewrite (fun x => (Zmult_comm (2 ^ x))); rewrite Zmult_plus_distr_l. @@ -196,7 +196,7 @@ generalize (spec_ww_compare p ww_zdigits); split; auto with zarith. rewrite Zpos_xO; auto with zarith. Qed. - + End POS_MOD. Section DoubleDiv32. @@ -222,24 +222,24 @@ Section DoubleDiv32. match w_compare a1 b1 with | Lt => let (q,r) := w_div21 a1 a2 b1 in - match ww_sub_c (w_WW r a3) (w_mul_c q b2) with + match ww_sub_c (w_WW r a3) (w_mul_c q b2) with | C0 r1 => (q,r1) | C1 r1 => let q := w_pred q in - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2))) (fun r2 => (q,r2)) r1 (WW b1 b2) end | Eq => - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2))) (fun r => (w_Bm1,r)) (WW (w_sub a2 b2) a3) (WW b1 b2) | Gt => (w_0, W0) (* cas absurde *) end. - (* Proof *) + (* Proof *) Variable w_digits : positive. Variable w_to_Z : w -> Z. @@ -253,8 +253,8 @@ Section DoubleDiv32. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). @@ -273,7 +273,7 @@ Section DoubleDiv32. | Gt => [|x|] > [|y|] end. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. - Variable spec_w_add_carry_c : + Variable spec_w_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1. Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. @@ -315,8 +315,8 @@ Section DoubleDiv32. wB/2 <= [|b1|] -> [[WW a1 a2]] < [[WW b1 b2]] -> let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ + [|a1|] * wwB + [|a2|] * wB + [|a3|] = + [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]. Proof. intros a1 a2 a3 b1 b2 Hle Hlt. @@ -327,17 +327,17 @@ Section DoubleDiv32. match w_compare a1 b1 with | Lt => let (q,r) := w_div21 a1 a2 b1 in - match ww_sub_c (w_WW r a3) (w_mul_c q b2) with + match ww_sub_c (w_WW r a3) (w_mul_c q b2) with | C0 r1 => (q,r1) | C1 r1 => let q := w_pred q in - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2))) (fun r2 => (q,r2)) r1 (WW b1 b2) end | Eq => - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2))) (fun r => (w_Bm1,r)) (WW (w_sub a2 b2) a3) (WW b1 b2) @@ -360,7 +360,7 @@ Section DoubleDiv32. [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]);eauto. rewrite H0;intros r. - repeat + repeat (rewrite spec_ww_add;eauto || rewrite spec_w_Bm1 || rewrite spec_w_Bm2); simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. assert (0<= ([[r]] + ([|b1|] * wB + [|b2|])) - wwB < [|b1|] * wB + [|b2|]). @@ -385,7 +385,7 @@ Section DoubleDiv32. 1 ([[r]] + ([|b1|] * wB + [|b2|]) - wwB));zarith;try (ring;fail). split. rewrite H1;rewrite Hcmp;ring. trivial. Spec_ww_to_Z (WW b1 b2). simpl in HH4;zarith. - rewrite H0;intros r;repeat + rewrite H0;intros r;repeat (rewrite spec_w_Bm1 || rewrite spec_w_Bm2); simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. assert ([[r]]=([|a2|]-[|b2|])*wB+[|a3|]+([|b1|]*wB+[|b2|])). zarith. @@ -409,7 +409,7 @@ Section DoubleDiv32. as [r1|r1];repeat (rewrite spec_w_WW || rewrite spec_mul_c); unfold interp_carry;intros H1. rewrite H1. - split. ring. split. + split. ring. split. rewrite <- H1;destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z r1);trivial. apply Zle_lt_trans with ([|r|] * wB + [|a3|]). assert ( 0 <= [|q|] * [|b2|]);zarith. @@ -418,7 +418,7 @@ Section DoubleDiv32. rewrite <- H1;ring. Spec_ww_to_Z r1; assert (0 <= [|r|]*wB). zarith. assert (0 < [|q|] * [|b2|]). zarith. - assert (0 < [|q|]). + assert (0 < [|q|]). apply Zmult_lt_0_reg_r_2 with [|b2|];zarith. eapply spec_ww_add_c_cont with (P := fun (x y:zn2z w) (res:w*zn2z w) => @@ -440,18 +440,18 @@ Section DoubleDiv32. wwB * 1 + ([|r|] * wB + [|a3|] - [|q|] * [|b2|] + 2 * ([|b1|] * wB + [|b2|]))). rewrite H7;rewrite H2;ring. - assert - ([|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) + assert + ([|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) < [|b1|]*wB + [|b2|]). Spec_ww_to_Z r2;omega. Spec_ww_to_Z (WW b1 b2). simpl in HH5. - assert - (0 <= [|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) + assert + (0 <= [|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) < wwB). split;try omega. replace (2*([|b1|]*wB+[|b2|])) with ((2*[|b1|])*wB+2*[|b2|]). 2:ring. assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB). rewrite wwB_wBwB; rewrite Zpower_2; zarith. omega. - rewrite <- (Zmod_unique + rewrite <- (Zmod_unique ([[r2]] + ([|b1|] * wB + [|b2|])) wwB 1 @@ -486,7 +486,7 @@ Section DoubleDiv21. Definition ww_div21 a1 a2 b := match a1 with - | W0 => + | W0 => match ww_compare a2 b with | Gt => (ww_1, ww_sub a2 b) | Eq => (ww_1, W0) @@ -529,8 +529,8 @@ Section DoubleDiv21. Notation wwB := (base (ww_digits w_digits)). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Variable spec_w_0 : [|w_0|] = 0. @@ -540,8 +540,8 @@ Section DoubleDiv21. wB/2 <= [|b1|] -> [[WW a1 a2]] < [[WW b1 b2]] -> let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ + [|a1|] * wwB + [|a2|] * wB + [|a3|] = + [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]. Variable spec_ww_1 : [[ww_1]] = 1. Variable spec_ww_compare : forall x y, @@ -591,10 +591,10 @@ Section DoubleDiv21. intros Hlt H; match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] => generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U); intros q1 r H0 - end; (assert (Eq1: wB / 2 <= [|b1|]);[ + end; (assert (Eq1: wB / 2 <= [|b1|]);[ apply (@beta_lex (wB / 2) 0 [|b1|] [|b2|] wB); auto with zarith; autorewrite with rm10;repeat rewrite (Zmult_comm wB); - rewrite <- wwB_div_2; trivial + rewrite <- wwB_div_2; trivial | generalize (H0 Eq1 Hlt);clear H0;destruct r as [ |r1 r2];simpl; try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Zplus_0_r; intros (H1,H2) ]). @@ -611,10 +611,10 @@ Section DoubleDiv21. rewrite <- wwB_wBwB;rewrite H1. rewrite spec_w_0 in H4;rewrite Zplus_0_r in H4. repeat rewrite Zmult_plus_distr_l. rewrite <- (Zmult_assoc [|r1|]). - rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H4;simpl;ring. + rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H4;simpl;ring. split;[rewrite wwB_wBwB | split;zarith]. - replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|])) - with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]). + replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|])) + with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]). rewrite H1;ring. rewrite wwB_wBwB;ring. change [|a4|] with (0*wB+[|a4|]);apply beta_lex_inv;zarith. assert (1 <= wB/2);zarith. @@ -624,7 +624,7 @@ Section DoubleDiv21. intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end. split;trivial. replace (([|a1h|] * wB + [|a1l|]) * wwB + ([|a3|] * wB + [|a4|])) with - (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB + [|a4|]); + (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB + [|a4|]); [rewrite H1 | rewrite wwB_wBwB;ring]. replace (([|q1|]*([|b1|]*wB+[|b2|])+([|r1|]*wB+[|r2|]))*wB+[|a4|]) with (([|q1|]*([|b1|]*wB+[|b2|]))*wB+([|r1|]*wwB+[|r2|]*wB+[|a4|])); @@ -666,22 +666,22 @@ Section DoubleDivGt. Eval lazy beta iota delta [ww_sub ww_opp] in let p := w_head0 bh in match w_compare p w_0 with - | Gt => + | Gt => let b1 := w_add_mul_div p bh bl in let b2 := w_add_mul_div p bl w_0 in let a1 := w_add_mul_div p w_0 ah in let a2 := w_add_mul_div p ah al in let a3 := w_add_mul_div p al w_0 in let (q,r) := w_div32 a1 a2 a3 b1 b2 in - (WW w_0 q, ww_add_mul_div + (WW w_0 q, ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r) | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry (WW ah al) (WW bh bl)) end. - Definition ww_div_gt a b := - Eval lazy beta iota delta [ww_div_gt_aux double_divn1 + Definition ww_div_gt a b := + Eval lazy beta iota delta [ww_div_gt_aux double_divn1 double_divn1_p double_divn1_p_aux double_divn1_0 double_divn1_0_aux double_split double_0 double_WW] in match a, b with @@ -691,11 +691,11 @@ Section DoubleDivGt. if w_eq0 ah then let (q,r) := w_div_gt al bl in (WW w_0 q, w_0W r) - else + else match w_compare w_0 bh with - | Eq => + | Eq => let(q,r):= - double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl in (q, w_0W r) | Lt => ww_div_gt_aux ah al bh bl @@ -707,7 +707,7 @@ Section DoubleDivGt. Eval lazy beta iota delta [ww_sub ww_opp] in let p := w_head0 bh in match w_compare p w_0 with - | Gt => + | Gt => let b1 := w_add_mul_div p bh bl in let b2 := w_add_mul_div p bl w_0 in let a1 := w_add_mul_div p w_0 ah in @@ -716,13 +716,13 @@ Section DoubleDivGt. let (q,r) := w_div32 a1 a2 a3 b1 b2 in ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r - | _ => + | _ => ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry (WW ah al) (WW bh bl) end. - Definition ww_mod_gt a b := - Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 + Definition ww_mod_gt a b := + Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 double_modn1_p double_modn1_p_aux double_modn1_0 double_modn1_0_aux double_split double_0 double_WW snd] in match a, b with @@ -730,10 +730,10 @@ Section DoubleDivGt. | _, W0 => W0 | WW ah al, WW bh bl => if w_eq0 ah then w_0W (w_mod_gt al bl) - else + else match w_compare w_0 bh with - | Eq => - w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | Eq => + w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl) | Lt => ww_mod_gt_aux ah al bh bl | Gt => W0 (* cas absurde *) @@ -741,14 +741,14 @@ Section DoubleDivGt. end. Definition ww_gcd_gt_body (cont: w->w->w->w->zn2z w) (ah al bh bl: w) := - Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 + Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 double_modn1_p double_modn1_p_aux double_modn1_0 double_modn1_0_aux double_split double_0 double_WW snd] in match w_compare w_0 bh with | Eq => match w_compare w_0 bl with | Eq => WW ah al (* normalement n'arrive pas si forme normale *) - | Lt => + | Lt => let m := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl in WW w_0 (w_gcd_gt bl m) @@ -757,14 +757,14 @@ Section DoubleDivGt. | Lt => let m := ww_mod_gt_aux ah al bh bl in match m with - | W0 => WW bh bl + | W0 => WW bh bl | WW mh ml => match w_compare w_0 mh with | Eq => match w_compare w_0 ml with | Eq => WW bh bl - | _ => - let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | _ => + let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW bh bl) ml in WW w_0 (w_gcd_gt ml r) end @@ -779,18 +779,18 @@ Section DoubleDivGt. end | Gt => W0 (* absurde *) end. - - Fixpoint ww_gcd_gt_aux - (p:positive) (cont: w -> w -> w -> w -> zn2z w) (ah al bh bl : w) + + Fixpoint ww_gcd_gt_aux + (p:positive) (cont: w -> w -> w -> w -> zn2z w) (ah al bh bl : w) {struct p} : zn2z w := - ww_gcd_gt_body + ww_gcd_gt_body (fun mh ml rh rl => match p with | xH => cont mh ml rh rl | xO p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl | xI p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl end) ah al bh bl. - + (* Proof *) Variable w_to_Z : w -> Z. @@ -816,7 +816,7 @@ Section DoubleDivGt. | Gt => [|x|] > [|y|] end. Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. - + Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|]. Variable spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB. Variable spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1. @@ -854,8 +854,8 @@ Section DoubleDivGt. wB/2 <= [|b1|] -> [[WW a1 a2]] < [[WW b1 b2]] -> let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ + [|a1|] * wwB + [|a2|] * wB + [|a3|] = + [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]. Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits. @@ -899,14 +899,14 @@ Section DoubleDivGt. change (let (q, r) := let p := w_head0 bh in match w_compare p w_0 with - | Gt => + | Gt => let b1 := w_add_mul_div p bh bl in let b2 := w_add_mul_div p bl w_0 in let a1 := w_add_mul_div p w_0 ah in let a2 := w_add_mul_div p ah al in let a3 := w_add_mul_div p al w_0 in let (q,r) := w_div32 a1 a2 a3 b1 b2 in - (WW w_0 q, ww_add_mul_div + (WW w_0 q, ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r) | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c @@ -945,11 +945,11 @@ Section DoubleDivGt. (spec_add_mul_div bl w_0 Hb); rewrite spec_w_0; repeat rewrite Zmult_0_l;repeat rewrite Zplus_0_l; rewrite Zdiv_0_l;repeat rewrite Zplus_0_r. - Spec_w_to_Z ah;Spec_w_to_Z bh. + Spec_w_to_Z ah;Spec_w_to_Z bh. unfold base;repeat rewrite Zmod_shift_r;zarith. assert (H3:=to_Z_div_minus_p ah HHHH);assert(H4:=to_Z_div_minus_p al HHHH); assert (H5:=to_Z_div_minus_p bl HHHH). - rewrite Zmult_comm in Hh. + rewrite Zmult_comm in Hh. assert (2^[|w_head0 bh|] < wB). unfold base;apply Zpower_lt_monotone;zarith. unfold base in H0;rewrite Zmod_small;zarith. fold wB; rewrite (Zmod_small ([|bh|] * 2 ^ [|w_head0 bh|]));zarith. @@ -964,15 +964,15 @@ Section DoubleDivGt. (w_add_mul_div (w_head0 bh) al w_0) (w_add_mul_div (w_head0 bh) bh bl) (w_add_mul_div (w_head0 bh) bl w_0)) as (q,r). - rewrite V1;rewrite V2. rewrite Zmult_plus_distr_l. - rewrite <- (Zplus_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)). + rewrite V1;rewrite V2. rewrite Zmult_plus_distr_l. + rewrite <- (Zplus_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)). unfold base;rewrite <- shift_unshift_mod;zarith. fold wB. replace ([|bh|] * 2 ^ [|w_head0 bh|] * wB + [|bl|] * 2 ^ [|w_head0 bh|]) with ([[WW bh bl]] * 2^[|w_head0 bh|]). 2:simpl;ring. fold wwB. rewrite wwB_wBwB. rewrite Zpower_2. rewrite U1;rewrite U2;rewrite U3. - rewrite Zmult_assoc. rewrite Zmult_plus_distr_l. + rewrite Zmult_assoc. rewrite Zmult_plus_distr_l. rewrite (Zplus_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)). - rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. + rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. unfold base;repeat rewrite <- shift_unshift_mod;zarith. fold wB. replace ([|ah|] * 2 ^ [|w_head0 bh|] * wB + [|al|] * 2 ^ [|w_head0 bh|]) with ([[WW ah al]] * 2^[|w_head0 bh|]). 2:simpl;ring. @@ -1027,7 +1027,7 @@ Section DoubleDivGt. [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]. Proof. - intros a b Hgt Hpos;unfold ww_div_gt. + intros a b Hgt Hpos;unfold ww_div_gt. change (let (q,r) := match a, b with | W0, _ => (W0,W0) | _, W0 => (W0,W0) @@ -1035,23 +1035,23 @@ Section DoubleDivGt. if w_eq0 ah then let (q,r) := w_div_gt al bl in (WW w_0 q, w_0W r) - else + else match w_compare w_0 bh with - | Eq => + | Eq => let(q,r):= - double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl in (q, w_0W r) | Lt => ww_div_gt_aux ah al bh bl | Gt => (W0,W0) (* cas absurde *) end - end in [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]). + end in [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]). destruct a as [ |ah al]. simpl in Hgt;omega. destruct b as [ |bh bl]. simpl in Hpos;omega. Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl. assert (H:=@spec_eq0 ah);destruct (w_eq0 ah). simpl ww_to_Z;rewrite H;trivial. simpl in Hgt;rewrite H in Hgt;trivial. - assert ([|bh|] <= 0). + assert ([|bh|] <= 0). apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;rewrite H1;simpl in Hgt. simpl. simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos. @@ -1066,7 +1066,7 @@ Section DoubleDivGt. w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hpos). unfold double_to_Z,double_wB,double_digits in H2. - destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl). rewrite spec_w_0W;unfold ww_to_Z;trivial. @@ -1104,26 +1104,26 @@ Section DoubleDivGt. rewrite Zmult_comm in H;destruct H. symmetry;apply Zmod_unique with [|q|];trivial. Qed. - + Lemma spec_ww_mod_gt_eq : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> [[ww_mod_gt a b]] = [[snd (ww_div_gt a b)]]. Proof. intros a b Hgt Hpos. - change (ww_mod_gt a b) with + change (ww_mod_gt a b) with (match a, b with | W0, _ => W0 | _, W0 => W0 | WW ah al, WW bh bl => if w_eq0 ah then w_0W (w_mod_gt al bl) - else + else match w_compare w_0 bh with - | Eq => - w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | Eq => + w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl) | Lt => ww_mod_gt_aux ah al bh bl | Gt => W0 (* cas absurde *) end end). - change (ww_div_gt a b) with + change (ww_div_gt a b) with (match a, b with | W0, _ => (W0,W0) | _, W0 => (W0,W0) @@ -1131,11 +1131,11 @@ Section DoubleDivGt. if w_eq0 ah then let (q,r) := w_div_gt al bl in (WW w_0 q, w_0W r) - else + else match w_compare w_0 bh with - | Eq => + | Eq => let(q,r):= - double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl in (q, w_0W r) | Lt => ww_div_gt_aux ah al bh bl @@ -1147,7 +1147,7 @@ Section DoubleDivGt. Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl. assert (H:=@spec_eq0 ah);destruct (w_eq0 ah). simpl in Hgt;rewrite H in Hgt;trivial. - assert ([|bh|] <= 0). + assert ([|bh|] <= 0). apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt. simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos. @@ -1155,7 +1155,7 @@ Section DoubleDivGt. destruct (w_div_gt al bl);simpl;rewrite spec_w_0W;trivial. clear H. assert (H2 := spec_compare w_0 bh);destruct (w_compare w_0 bh). - rewrite (@spec_double_modn1_aux w w_zdigits w_0 w_WW w_head0 w_add_mul_div + rewrite (@spec_double_modn1_aux w w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_w_0 spec_compare 1 (WW ah al) bl). destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl);simpl;trivial. @@ -1174,7 +1174,7 @@ Section DoubleDivGt. rewrite Zmult_comm;trivial. Qed. - Lemma Zis_gcd_mod : forall a b d, + Lemma Zis_gcd_mod : forall a b d, 0 < b -> Zis_gcd b (a mod b) d -> Zis_gcd a b d. Proof. intros a b d H H1; apply Zis_gcd_for_euclid with (a/b). @@ -1182,12 +1182,12 @@ Section DoubleDivGt. ring_simplify (b * (a / b) + a mod b - a / b * b);trivial. zarith. Qed. - Lemma spec_ww_gcd_gt_aux_body : + Lemma spec_ww_gcd_gt_aux_body : forall ah al bh bl n cont, - [[WW bh bl]] <= 2^n -> + [[WW bh bl]] <= 2^n -> [[WW ah al]] > [[WW bh bl]] -> - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^(n-1) -> + (forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^(n-1) -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> Zis_gcd [[WW ah al]] [[WW bh bl]] [[ww_gcd_gt_body cont ah al bh bl]]. Proof. @@ -1196,7 +1196,7 @@ Section DoubleDivGt. | Eq => match w_compare w_0 bl with | Eq => WW ah al (* normalement n'arrive pas si forme normale *) - | Lt => + | Lt => let m := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl in WW w_0 (w_gcd_gt bl m) @@ -1205,14 +1205,14 @@ Section DoubleDivGt. | Lt => let m := ww_mod_gt_aux ah al bh bl in match m with - | W0 => WW bh bl + | W0 => WW bh bl | WW mh ml => match w_compare w_0 mh with | Eq => match w_compare w_0 ml with | Eq => WW bh bl - | _ => - let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | _ => + let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW bh bl) ml in WW w_0 (w_gcd_gt ml r) end @@ -1227,10 +1227,10 @@ Section DoubleDivGt. end | Gt => W0 (* absurde *) end). - assert (Hbh := spec_compare w_0 bh);destruct (w_compare w_0 bh). + assert (Hbh := spec_compare w_0 bh);destruct (w_compare w_0 bh). simpl ww_to_Z in *. rewrite spec_w_0 in Hbh;rewrite <- Hbh; rewrite Zmult_0_l;rewrite Zplus_0_l. - assert (Hbl := spec_compare w_0 bl); destruct (w_compare w_0 bl). + assert (Hbl := spec_compare w_0 bl); destruct (w_compare w_0 bl). rewrite spec_w_0 in Hbl;rewrite <- Hbl;apply Zis_gcd_0. simpl;rewrite spec_w_0;rewrite Zmult_0_l;rewrite Zplus_0_l. rewrite spec_w_0 in Hbl. @@ -1239,54 +1239,54 @@ Section DoubleDivGt. rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hbl). - apply spec_gcd_gt. - rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply spec_gcd_gt. + rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. + apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. rewrite spec_w_0 in Hbl;Spec_w_to_Z bl;elimtype False;omega. rewrite spec_w_0 in Hbh;assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh). - assert (H2 : 0 < [[WW bh bl]]). + assert (H2 : 0 < [[WW bh bl]]). simpl;Spec_w_to_Z bl. apply Zlt_le_trans with ([|bh|]*wB);zarith. apply Zmult_lt_0_compat;zarith. apply Zis_gcd_mod;trivial. rewrite <- H. simpl in *;destruct (ww_mod_gt_aux ah al bh bl) as [ |mh ml]. - simpl;apply Zis_gcd_0;zarith. - assert (Hmh := spec_compare w_0 mh);destruct (w_compare w_0 mh). + simpl;apply Zis_gcd_0;zarith. + assert (Hmh := spec_compare w_0 mh);destruct (w_compare w_0 mh). simpl;rewrite spec_w_0 in Hmh; rewrite <- Hmh;simpl. - assert (Hml := spec_compare w_0 ml);destruct (w_compare w_0 ml). + assert (Hml := spec_compare w_0 ml);destruct (w_compare w_0 ml). rewrite <- Hml;rewrite spec_w_0;simpl;apply Zis_gcd_0. - simpl;rewrite spec_w_0;simpl. + simpl;rewrite spec_w_0;simpl. rewrite spec_w_0 in Hml. apply Zis_gcd_mod;zarith. change ([|bh|] * wB + [|bl|]) with (double_to_Z w_digits w_to_Z 1 (WW bh bl)). rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW bh bl) ml Hml). - apply spec_gcd_gt. - rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply spec_gcd_gt. + rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. + apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. rewrite spec_w_0 in Hml;Spec_w_to_Z ml;elimtype False;omega. rewrite spec_w_0 in Hmh. assert ([[WW bh bl]] > [[WW mh ml]]). - rewrite H;simpl; apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + rewrite H;simpl; apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. assert (H1:= spec_ww_mod_gt_aux _ _ _ H0 Hmh). - assert (H3 : 0 < [[WW mh ml]]). + assert (H3 : 0 < [[WW mh ml]]). simpl;Spec_w_to_Z ml. apply Zlt_le_trans with ([|mh|]*wB);zarith. apply Zmult_lt_0_compat;zarith. apply Zis_gcd_mod;zarith. simpl in *;rewrite <- H1. destruct (ww_mod_gt_aux bh bl mh ml) as [ |rh rl]. simpl; apply Zis_gcd_0. simpl;apply Hcont. simpl in H1;rewrite H1. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. - apply Zle_trans with (2^n/2). - apply Zdiv_le_lower_bound;zarith. + apply Zle_trans with (2^n/2). + apply Zdiv_le_lower_bound;zarith. apply Zle_trans with ([|bh|] * wB + [|bl|]);zarith. assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Zlt_gt _ _ H3)). assert (H4' : 0 <= [[WW bh bl]]/[[WW mh ml]]). apply Zge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1. pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3'. destruct (Zle_lt_or_eq _ _ H4'). - assert (H6' : [[WW bh bl]] mod [[WW mh ml]] = + assert (H6' : [[WW bh bl]] mod [[WW mh ml]] = [[WW bh bl]] - [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). simpl;pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3';ring. simpl in H6'. assert ([[WW mh ml]] <= [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). @@ -1304,10 +1304,10 @@ Section DoubleDivGt. rewrite spec_w_0 in Hbh;Spec_w_to_Z bh;elimtype False;zarith. Qed. - Lemma spec_ww_gcd_gt_aux : + Lemma spec_ww_gcd_gt_aux : forall p cont n, - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + (forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^n -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] -> @@ -1334,7 +1334,7 @@ Section DoubleDivGt. apply Zle_trans with (2 ^ (Zpos p + n -1));zarith. apply Zpower_le_monotone2;zarith. apply Zle_trans with (2 ^ (2*Zpos p + n -1));zarith. - apply Zpower_le_monotone2;zarith. + apply Zpower_le_monotone2;zarith. apply spec_ww_gcd_gt_aux_body with (n := n+1);trivial. rewrite Zplus_comm;trivial. ring_simplify (n + 1 - 1);trivial. @@ -1352,16 +1352,16 @@ Section DoubleDiv. Variable ww_div_gt : zn2z w -> zn2z w -> zn2z w * zn2z w. Variable ww_mod_gt : zn2z w -> zn2z w -> zn2z w. - Definition ww_div a b := - match ww_compare a b with - | Gt => ww_div_gt a b + Definition ww_div a b := + match ww_compare a b with + | Gt => ww_div_gt a b | Eq => (ww_1, W0) | Lt => (W0, a) end. - Definition ww_mod a b := - match ww_compare a b with - | Gt => ww_mod_gt a b + Definition ww_mod a b := + match ww_compare a b with + | Gt => ww_mod_gt a b | Eq => W0 | Lt => a end. @@ -1401,7 +1401,7 @@ Section DoubleDiv. Proof. intros a b Hpos;unfold ww_div. assert (H:=spec_ww_compare a b);destruct (ww_compare a b). - simpl;rewrite spec_ww_1;split;zarith. + simpl;rewrite spec_ww_1;split;zarith. simpl;split;[ring|Spec_ww_to_Z a;zarith]. apply spec_ww_div_gt;trivial. Qed. @@ -1409,7 +1409,7 @@ Section DoubleDiv. Lemma spec_ww_mod : forall a b, 0 < [[b]] -> [[ww_mod a b]] = [[a]] mod [[b]]. Proof. - intros a b Hpos;unfold ww_mod. + intros a b Hpos;unfold ww_mod. assert (H := spec_ww_compare a b);destruct (ww_compare a b). simpl;apply Zmod_unique with 1;try rewrite H;zarith. Spec_ww_to_Z a;symmetry;apply Zmod_small;zarith. @@ -1424,8 +1424,8 @@ Section DoubleDiv. Variable w_gcd_gt : w -> w -> w. Variable _ww_digits : positive. Variable spec_ww_digits_ : _ww_digits = xO w_digits. - Variable ww_gcd_gt_fix : - positive -> (w -> w -> w -> w -> zn2z w) -> + Variable ww_gcd_gt_fix : + positive -> (w -> w -> w -> w -> zn2z w) -> w -> w -> w -> w -> zn2z w. Variable spec_w_0 : [|w_0|] = 0. @@ -1440,10 +1440,10 @@ Section DoubleDiv. Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. Variable spec_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]. - Variable spec_gcd_gt_fix : + Variable spec_gcd_gt_fix : forall p cont n, - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + (forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^n -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] -> @@ -1451,20 +1451,20 @@ Section DoubleDiv. Zis_gcd [[WW ah al]] [[WW bh bl]] [[ww_gcd_gt_fix p cont ah al bh bl]]. - Definition gcd_cont (xh xl yh yl:w) := + Definition gcd_cont (xh xl yh yl:w) := match w_compare w_1 yl with - | Eq => ww_1 + | Eq => ww_1 | _ => WW xh xl end. - Lemma spec_gcd_cont : forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + Lemma spec_gcd_cont : forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 1 -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[gcd_cont xh xl yh yl]]. Proof. intros xh xl yh yl Hgt' Hle. simpl in Hle. assert ([|yh|] = 0). - change 1 with (0*wB+1) in Hle. + change 1 with (0*wB+1) in Hle. assert (0 <= 1 < wB). split;zarith. apply wB_pos. assert (H1:= beta_lex _ _ _ _ _ Hle (spec_to_Z yl) H). Spec_w_to_Z yh;zarith. @@ -1478,15 +1478,15 @@ Section DoubleDiv. rewrite H0;simpl;apply Zis_gcd_0;trivial. Qed. - + Variable cont : w -> w -> w -> w -> zn2z w. - Variable spec_cont : forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + Variable spec_cont : forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 1 -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]. - - Definition ww_gcd_gt a b := - match a, b with + + Definition ww_gcd_gt a b := + match a, b with | W0, _ => b | _, W0 => a | WW ah al, WW bh bl => @@ -1509,8 +1509,8 @@ Section DoubleDiv. destruct a as [ |ah al]. simpl;apply Zis_gcd_sym;apply Zis_gcd_0. destruct b as [ |bh bl]. simpl;apply Zis_gcd_0. simpl in Hgt. generalize (@spec_eq0 ah);destruct (w_eq0 ah);intros. - simpl;rewrite H in Hgt;trivial;rewrite H;trivial;rewrite spec_w_0;simpl. - assert ([|bh|] <= 0). + simpl;rewrite H in Hgt;trivial;rewrite H;trivial;rewrite spec_w_0;simpl. + assert ([|bh|] <= 0). apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. Spec_w_to_Z bh;assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt. rewrite H1;simpl;auto. clear H. @@ -1522,7 +1522,7 @@ Section DoubleDiv. Lemma spec_ww_gcd : forall a b, Zis_gcd [[a]] [[b]] [[ww_gcd a b]]. Proof. intros a b. - change (ww_gcd a b) with + change (ww_gcd a b) with (match ww_compare a b with | Gt => ww_gcd_gt a b | Eq => a diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v index 1f1d609f1..fd6718e4e 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v @@ -31,19 +31,19 @@ Section GENDIVN1. Variable w_div21 : w -> w -> w -> w * w. Variable w_compare : w -> w -> comparison. Variable w_sub : w -> w -> w. - - + + (* ** For proofs ** *) Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). + + Notation wB := (base w_digits). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[! n | x !]" := (double_to_Z w_digits w_to_Z n x) + Notation "[! n | x !]" := (double_to_Z w_digits w_to_Z n x) (at level 0, x at level 99). Notation "[[ x ]]" := (zn2z_to_Z wB w_to_Z x) (at level 0, x at level 99). - + Variable spec_to_Z : forall x, 0 <= [| x |] < wB. Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits. Variable spec_0 : [|w_0|] = 0. @@ -68,10 +68,10 @@ Section GENDIVN1. | Lt => [|x|] < [|y|] | Gt => [|x|] > [|y|] end. - Variable spec_sub: forall x y, + Variable spec_sub: forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. - + Section DIVAUX. Variable b2p : w. @@ -85,10 +85,10 @@ Section GENDIVN1. Fixpoint double_divn1_0 (n:nat) : w -> word w n -> word w n * w := match n return w -> word w n -> word w n * w with - | O => fun r x => w_div21 r x b2p - | S n => double_divn1_0_aux n (double_divn1_0 n) + | O => fun r x => w_div21 r x b2p + | S n => double_divn1_0_aux n (double_divn1_0 n) end. - + Lemma spec_split : forall (n : nat) (x : zn2z (word w n)), let (h, l) := double_split w_0 n x in [!S n | x!] = [!n | h!] * double_wB w_digits n + [!n | l!]. @@ -132,11 +132,11 @@ Section GENDIVN1. induction n;simpl;intros;trivial. unfold double_modn1_0_aux, double_divn1_0_aux. destruct (double_split w_0 n x) as (hh,hl). - rewrite (IHn r hh). + rewrite (IHn r hh). destruct (double_divn1_0 n r hh) as (qh,rh);simpl. rewrite IHn. destruct (double_divn1_0 n rh hl);trivial. Qed. - + Variable p : w. Variable p_bounded : [|p|] <= Zpos w_digits. @@ -148,18 +148,18 @@ Section GENDIVN1. intros;apply spec_add_mul_div;auto. Qed. - Definition double_divn1_p_aux n - (divn1 : w -> word w n -> word w n -> word w n * w) r h l := + Definition double_divn1_p_aux n + (divn1 : w -> word w n -> word w n -> word w n * w) r h l := let (hh,hl) := double_split w_0 n h in - let (lh,ll) := double_split w_0 n l in + let (lh,ll) := double_split w_0 n l in let (qh,rh) := divn1 r hh hl in let (ql,rl) := divn1 rh hl lh in (double_WW w_WW n qh ql, rl). Fixpoint double_divn1_p (n:nat) : w -> word w n -> word w n -> word w n * w := match n return w -> word w n -> word w n -> word w n * w with - | O => fun r h l => w_div21 r (w_add_mul_div p h l) b2p - | S n => double_divn1_p_aux n (double_divn1_p n) + | O => fun r h l => w_div21 r (w_add_mul_div p h l) b2p + | S n => double_divn1_p_aux n (double_divn1_p n) end. Lemma p_lt_double_digits : forall n, [|p|] <= Zpos (double_digits w_digits n). @@ -175,8 +175,8 @@ Section GENDIVN1. Lemma spec_double_divn1_p : forall n r h l, [|r|] < [|b2p|] -> let (q,r') := double_divn1_p n r h l in - [|r|] * double_wB w_digits n + - ([!n|h!]*2^[|p|] + + [|r|] * double_wB w_digits n + + ([!n|h!]*2^[|p|] + [!n|l!] / (2^(Zpos(double_digits w_digits n) - [|p|]))) mod double_wB w_digits n = [!n|q!] * [|b2p|] + [|r'|] /\ 0 <= [|r'|] < [|b2p|]. @@ -198,26 +198,26 @@ Section GENDIVN1. ([!n|lh!] * double_wB w_digits n + [!n|ll!]) / 2^(Zpos (double_digits w_digits (S n)) - [|p|])) mod (double_wB w_digits n * double_wB w_digits n)) with - (([|r|] * double_wB w_digits n + ([!n|hh!] * 2^[|p|] + + (([|r|] * double_wB w_digits n + ([!n|hh!] * 2^[|p|] + [!n|hl!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod double_wB w_digits n) * double_wB w_digits n + - ([!n|hl!] * 2^[|p|] + - [!n|lh!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod + ([!n|hl!] * 2^[|p|] + + [!n|lh!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod double_wB w_digits n). generalize (IHn r hh hl H);destruct (double_divn1_p n r hh hl) as (qh,rh); intros (H3,H4);rewrite H3. - assert ([|rh|] < [|b2p|]). omega. + assert ([|rh|] < [|b2p|]). omega. replace (([!n|qh!] * [|b2p|] + [|rh|]) * double_wB w_digits n + ([!n|hl!] * 2 ^ [|p|] + [!n|lh!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])) mod - double_wB w_digits n) with + double_wB w_digits n) with ([!n|qh!] * [|b2p|] *double_wB w_digits n + ([|rh|]*double_wB w_digits n + ([!n|hl!] * 2 ^ [|p|] + [!n|lh!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])) mod double_wB w_digits n)). 2:ring. generalize (IHn rh hl lh H0);destruct (double_divn1_p n rh hl lh) as (ql,rl); intros (H5,H6);rewrite H5. - split;[rewrite spec_double_WW;trivial;ring|trivial]. + split;[rewrite spec_double_WW;trivial;ring|trivial]. assert (Uhh := spec_double_to_Z w_digits w_to_Z spec_to_Z n hh); unfold double_wB,base in Uhh. assert (Uhl := spec_double_to_Z w_digits w_to_Z spec_to_Z n hl); @@ -228,37 +228,37 @@ Section GENDIVN1. unfold double_wB,base in Ull. unfold double_wB,base. assert (UU:=p_lt_double_digits n). - rewrite Zdiv_shift_r;auto with zarith. - 2:change (Zpos (double_digits w_digits (S n))) + rewrite Zdiv_shift_r;auto with zarith. + 2:change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n));auto with zarith. replace (2 ^ (Zpos (double_digits w_digits (S n)) - [|p|])) with (2^(Zpos (double_digits w_digits n) - [|p|])*2^Zpos (double_digits w_digits n)). rewrite Zdiv_mult_cancel_r;auto with zarith. - rewrite Zmult_plus_distr_l with (p:= 2^[|p|]). + rewrite Zmult_plus_distr_l with (p:= 2^[|p|]). pattern ([!n|hl!] * 2^[|p|]) at 2; rewrite (shift_unshift_mod (Zpos(double_digits w_digits n))([|p|])([!n|hl!])); auto with zarith. - rewrite Zplus_assoc. - replace + rewrite Zplus_assoc. + replace ([!n|hh!] * 2^Zpos (double_digits w_digits n)* 2^[|p|] + ([!n|hl!] / 2^(Zpos (double_digits w_digits n)-[|p|])* 2^Zpos(double_digits w_digits n))) - with - (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl / + with + (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl / 2^(Zpos (double_digits w_digits n)-[|p|])) * 2^Zpos(double_digits w_digits n));try (ring;fail). rewrite <- Zplus_assoc. rewrite <- (Zmod_shift_r ([|p|]));auto with zarith. - replace + replace (2 ^ Zpos (double_digits w_digits n) * 2 ^ Zpos (double_digits w_digits n)) with (2 ^ (Zpos (double_digits w_digits n) + Zpos (double_digits w_digits n))). rewrite (Zmod_shift_r (Zpos (double_digits w_digits n)));auto with zarith. replace (2 ^ (Zpos (double_digits w_digits n) + Zpos (double_digits w_digits n))) - with (2^Zpos(double_digits w_digits n) *2^Zpos(double_digits w_digits n)). + with (2^Zpos(double_digits w_digits n) *2^Zpos(double_digits w_digits n)). rewrite (Zmult_comm (([!n|hh!] * 2 ^ [|p|] + [!n|hl!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])))). rewrite Zmult_mod_distr_l;auto with zarith. - ring. + ring. rewrite Zpower_exp;auto with zarith. assert (0 < Zpos (double_digits w_digits n)). unfold Zlt;reflexivity. auto with zarith. @@ -267,24 +267,24 @@ Section GENDIVN1. split;auto with zarith. apply Zdiv_lt_upper_bound;auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace ([|p|] + (Zpos (double_digits w_digits n) - [|p|])) with + replace ([|p|] + (Zpos (double_digits w_digits n) - [|p|])) with (Zpos(double_digits w_digits n));auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (double_digits w_digits (S n)) - [|p|]) with - (Zpos (double_digits w_digits n) - [|p|] + + replace (Zpos (double_digits w_digits (S n)) - [|p|]) with + (Zpos (double_digits w_digits n) - [|p|] + Zpos (double_digits w_digits n));trivial. - change (Zpos (double_digits w_digits (S n))) with + change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n)). ring. Qed. Definition double_modn1_p_aux n (modn1 : w -> word w n -> word w n -> w) r h l:= let (hh,hl) := double_split w_0 n h in - let (lh,ll) := double_split w_0 n l in + let (lh,ll) := double_split w_0 n l in modn1 (modn1 r hh hl) hl lh. Fixpoint double_modn1_p (n:nat) : w -> word w n -> word w n -> w := match n return w -> word w n -> word w n -> w with - | O => fun r h l => snd (w_div21 r (w_add_mul_div p h l) b2p) + | O => fun r h l => snd (w_div21 r (w_add_mul_div p h l) b2p) | S n => double_modn1_p_aux n (double_modn1_p n) end. @@ -302,8 +302,8 @@ Section GENDIVN1. Fixpoint high (n:nat) : word w n -> w := match n return word w n -> w with - | O => fun a => a - | S n => + | O => fun a => a + | S n => fun (a:zn2z (word w n)) => match a with | W0 => w_0 @@ -314,20 +314,20 @@ Section GENDIVN1. Lemma spec_double_digits:forall n, Zpos w_digits <= Zpos (double_digits w_digits n). Proof. induction n;simpl;auto with zarith. - change (Zpos (xO (double_digits w_digits n))) with + change (Zpos (xO (double_digits w_digits n))) with (2*Zpos (double_digits w_digits n)). assert (0 < Zpos w_digits);auto with zarith. exact (refl_equal Lt). Qed. - Lemma spec_high : forall n (x:word w n), + Lemma spec_high : forall n (x:word w n), [|high n x|] = [!n|x!] / 2^(Zpos (double_digits w_digits n) - Zpos w_digits). Proof. induction n;intros. unfold high,double_digits,double_to_Z. replace (Zpos w_digits - Zpos w_digits) with 0;try ring. simpl. rewrite <- (Zdiv_unique [|x|] 1 [|x|] 0);auto with zarith. - assert (U2 := spec_double_digits n). + assert (U2 := spec_double_digits n). assert (U3 : 0 < Zpos w_digits). exact (refl_equal Lt). destruct x;unfold high;fold high. unfold double_to_Z,zn2z_to_Z;rewrite spec_0. @@ -337,31 +337,31 @@ Section GENDIVN1. simpl [!S n|WW w0 w1!]. unfold double_wB,base;rewrite Zdiv_shift_r;auto with zarith. replace (2 ^ (Zpos (double_digits w_digits (S n)) - Zpos w_digits)) with - (2^(Zpos (double_digits w_digits n) - Zpos w_digits) * + (2^(Zpos (double_digits w_digits n) - Zpos w_digits) * 2^Zpos (double_digits w_digits n)). rewrite Zdiv_mult_cancel_r;auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (double_digits w_digits n) - Zpos w_digits + + replace (Zpos (double_digits w_digits n) - Zpos w_digits + Zpos (double_digits w_digits n)) with (Zpos (double_digits w_digits (S n)) - Zpos w_digits);trivial. - change (Zpos (double_digits w_digits (S n))) with + change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n));ring. - change (Zpos (double_digits w_digits (S n))) with + change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n)); auto with zarith. Qed. - - Definition double_divn1 (n:nat) (a:word w n) (b:w) := + + Definition double_divn1 (n:nat) (a:word w n) (b:w) := let p := w_head0 b in match w_compare p w_0 with | Gt => let b2p := w_add_mul_div p b w_0 in let ha := high n a in let k := w_sub w_zdigits p in - let lsr_n := w_add_mul_div k w_0 in + let lsr_n := w_add_mul_div k w_0 in let r0 := w_add_mul_div p w_0 ha in let (q,r) := double_divn1_p b2p p n r0 a (double_0 w_0 n) in (q, lsr_n r) - | _ => double_divn1_0 b n w_0 a + | _ => double_divn1_0 b n w_0 a end. Lemma spec_double_divn1 : forall n a b, @@ -392,21 +392,21 @@ Section GENDIVN1. apply Zmult_le_compat;auto with zarith. assert (wB <= 2^[|w_head0 b|]). unfold base;apply Zpower_le_monotone;auto with zarith. omega. - assert ([|w_add_mul_div (w_head0 b) b w_0|] = + assert ([|w_add_mul_div (w_head0 b) b w_0|] = 2 ^ [|w_head0 b|] * [|b|]). rewrite (spec_add_mul_div b w_0); auto with zarith. rewrite spec_0;rewrite Zdiv_0_l; try omega. rewrite Zplus_0_r; rewrite Zmult_comm. rewrite Zmod_small; auto with zarith. assert (H5 := spec_to_Z (high n a)). - assert + assert ([|w_add_mul_div (w_head0 b) w_0 (high n a)|] <[|w_add_mul_div (w_head0 b) b w_0|]). rewrite H4. rewrite spec_add_mul_div;auto with zarith. rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. assert (([|high n a|]/2^(Zpos w_digits - [|w_head0 b|])) < wB). - apply Zdiv_lt_upper_bound;auto with zarith. + apply Zdiv_lt_upper_bound;auto with zarith. apply Zlt_le_trans with wB;auto with zarith. pattern wB at 1;replace wB with (wB*1);try ring. apply Zmult_le_compat;auto with zarith. @@ -420,8 +420,8 @@ Section GENDIVN1. apply Zmult_le_compat;auto with zarith. pattern 2 at 1;rewrite <- Zpower_1_r. apply Zpower_le_monotone;split;auto with zarith. - rewrite <- H4 in H0. - assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith. + rewrite <- H4 in H0. + assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith. assert (H7:= spec_double_divn1_p H0 Hb3 n a (double_0 w_0 n) H6). destruct (double_divn1_p (w_add_mul_div (w_head0 b) b w_0) (w_head0 b) n (w_add_mul_div (w_head0 b) w_0 (high n a)) a @@ -436,7 +436,7 @@ Section GENDIVN1. rewrite Zmod_small;auto with zarith. rewrite spec_high. rewrite Zdiv_Zdiv;auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (double_digits w_digits n) - Zpos w_digits + + replace (Zpos (double_digits w_digits n) - Zpos w_digits + (Zpos w_digits - [|w_head0 b|])) with (Zpos (double_digits w_digits n) - [|w_head0 b|]);trivial;ring. assert (H8 := Zpower_gt_0 2 (Zpos w_digits - [|w_head0 b|]));auto with zarith. @@ -448,11 +448,11 @@ Section GENDIVN1. rewrite H8 in H7;unfold double_wB,base in H7. rewrite <- shift_unshift_mod in H7;auto with zarith. rewrite H4 in H7. - assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|] + assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|] = [|r|]/2^[|w_head0 b|]). rewrite spec_add_mul_div. rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. - replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|]) + replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|]) with ([|w_head0 b|]). rewrite Zmod_small;auto with zarith. assert (H9 := spec_to_Z r). @@ -474,11 +474,11 @@ Section GENDIVN1. split. rewrite <- (Z_div_mult [!n|a!] (2^[|w_head0 b|]));auto with zarith. rewrite H71;rewrite H9. - replace ([!n|q!] * (2 ^ [|w_head0 b|] * [|b|])) + replace ([!n|q!] * (2 ^ [|w_head0 b|] * [|b|])) with ([!n|q!] *[|b|] * 2^[|w_head0 b|]); try (ring;fail). rewrite Z_div_plus_l;auto with zarith. - assert (H10 := spec_to_Z + assert (H10 := spec_to_Z (w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r));split; auto with zarith. rewrite H9. @@ -487,19 +487,19 @@ Section GENDIVN1. exact (spec_double_to_Z w_digits w_to_Z spec_to_Z n a). Qed. - - Definition double_modn1 (n:nat) (a:word w n) (b:w) := + + Definition double_modn1 (n:nat) (a:word w n) (b:w) := let p := w_head0 b in match w_compare p w_0 with | Gt => let b2p := w_add_mul_div p b w_0 in let ha := high n a in let k := w_sub w_zdigits p in - let lsr_n := w_add_mul_div k w_0 in + let lsr_n := w_add_mul_div k w_0 in let r0 := w_add_mul_div p w_0 ha in let r := double_modn1_p b2p p n r0 a (double_0 w_0 n) in lsr_n r - | _ => double_modn1_0 b n w_0 a + | _ => double_modn1_0 b n w_0 a end. Lemma spec_double_modn1_aux : forall n a b, @@ -525,4 +525,4 @@ Section GENDIVN1. destruct H1 as (h1,h2);rewrite h1;ring. Qed. -End GENDIVN1. +End GENDIVN1. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v index d9c234093..28dff1a29 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v @@ -61,13 +61,13 @@ Section DoubleLift. (* 0 < p < ww_digits *) - Definition ww_add_mul_div p x y := + Definition ww_add_mul_div p x y := let zdigits := w_0W w_zdigits in match x, y with | W0, W0 => W0 | W0, WW yh yl => match ww_compare p zdigits with - | Eq => w_0W yh + | Eq => w_0W yh | Lt => w_0W (w_add_mul_div (low p) w_0 yh) | Gt => let n := low (ww_sub p zdigits) in @@ -75,15 +75,15 @@ Section DoubleLift. end | WW xh xl, W0 => match ww_compare p zdigits with - | Eq => w_W0 xl + | Eq => w_W0 xl | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl w_0) | Gt => let n := low (ww_sub p zdigits) in - w_W0 (w_add_mul_div n xl w_0) + w_W0 (w_add_mul_div n xl w_0) end | WW xh xl, WW yh yl => match ww_compare p zdigits with - | Eq => w_WW xl yh + | Eq => w_WW xl yh | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl yh) | Gt => let n := low (ww_sub p zdigits) in @@ -93,7 +93,7 @@ Section DoubleLift. Section DoubleProof. Variable w_to_Z : w -> Z. - + Notation wB := (base w_digits). Notation wwB := (base (ww_digits w_digits)). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). @@ -122,21 +122,21 @@ Section DoubleLift. Variable spec_w_head0 : forall x, 0 < [|x|] -> wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB. Variable spec_w_tail00 : forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits. - Variable spec_w_tail0 : forall x, 0 < [|x|] -> + Variable spec_w_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2* y + 1) * (2 ^ [|w_tail0 x|]). Variable spec_w_add_mul_div : forall x y p, [|p|] <= Zpos w_digits -> [| w_add_mul_div p x y |] = ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB. - Variable spec_w_add: forall x y, + Variable spec_w_add: forall x y, [[w_add x y]] = [|x|] + [|y|]. - Variable spec_ww_sub: forall x y, + Variable spec_ww_sub: forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits. Variable spec_low: forall x, [| low x|] = [[x]] mod wB. - + Variable spec_ww_zdigits : [[ww_zdigits]] = Zpos ww_Digits. Hint Resolve div_le_0 div_lt w_to_Z_wwB: lift. @@ -168,7 +168,7 @@ Section DoubleLift. rewrite spec_w_0; auto with zarith. rewrite spec_w_0; auto with zarith. Qed. - + Lemma spec_ww_head0 : forall x, 0 < [[x]] -> wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB. Proof. @@ -179,7 +179,7 @@ Section DoubleLift. assert (H0 := spec_compare w_0 xh);rewrite spec_w_0 in H0. destruct (w_compare w_0 xh). rewrite <- H0. simpl Zplus. rewrite <- H0 in H;simpl in H. - case (spec_to_Z w_zdigits); + case (spec_to_Z w_zdigits); case (spec_to_Z (w_head0 xl)); intros HH1 HH2 HH3 HH4. rewrite spec_w_add. rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith. @@ -209,7 +209,7 @@ Section DoubleLift. rewrite <- Zmult_assoc; apply Zmult_lt_compat_l; zarith. rewrite <- (Zplus_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith. apply Zmult_lt_reg_r with (2 ^ p); zarith. - rewrite <- Zpower_exp;zarith. + rewrite <- Zpower_exp;zarith. rewrite Zmult_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith. assert (H1 := spec_to_Z xh);zarith. Qed. @@ -293,8 +293,8 @@ Section DoubleLift. Qed. Hint Rewrite Zdiv_0_l Zmult_0_l Zplus_0_l Zmult_0_r Zplus_0_r - spec_w_W0 spec_w_0W spec_w_WW spec_w_0 - (wB_div w_digits w_to_Z spec_to_Z) + spec_w_W0 spec_w_0W spec_w_WW spec_w_0 + (wB_div w_digits w_to_Z spec_to_Z) (wB_div_plus w_digits w_to_Z spec_to_Z) : w_rewrite. Ltac w_rewrite := autorewrite with w_rewrite;trivial. @@ -303,12 +303,12 @@ Section DoubleLift. [[p]] <= Zpos (xO w_digits) -> [[match ww_compare p zdigits with | Eq => w_WW xl yh - | Lt => w_WW (w_add_mul_div (low p) xh xl) + | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl yh) | Gt => let n := low (ww_sub p zdigits) in w_WW (w_add_mul_div n xl yh) (w_add_mul_div n yh yl) - end]] = + end]] = ([[WW xh xl]] * (2^[[p]]) + [[WW yh yl]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB. Proof. @@ -317,7 +317,7 @@ Section DoubleLift. case (spec_to_w_Z p); intros Hv1 Hv2. replace (Zpos (xO w_digits)) with (Zpos w_digits + Zpos w_digits). 2 : rewrite Zpos_xO;ring. - replace (Zpos w_digits + Zpos w_digits - [[p]]) with + replace (Zpos w_digits + Zpos w_digits - [[p]]) with (Zpos w_digits + (Zpos w_digits - [[p]])). 2:ring. intros Hp; assert (Hxh := spec_to_Z xh);assert (Hxl:=spec_to_Z xl); assert (Hx := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)); @@ -330,7 +330,7 @@ Section DoubleLift. fold wB. rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc;rewrite <- Zplus_assoc. rewrite <- Zpower_2. - rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|]. + rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|]. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xl yh)). ring. simpl ww_to_Z; w_rewrite;zarith. assert (HH0: [|low p|] = [[p]]). @@ -353,7 +353,7 @@ Section DoubleLift. rewrite Zmult_plus_distr_l. pattern ([|xl|] * 2 ^ [[p]]) at 2; rewrite shift_unshift_mod with (n:= Zpos w_digits);fold wB;zarith. - replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring. + replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring. rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. unfold base at 5;rewrite <- Zmod_shift_r;zarith. unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); @@ -387,8 +387,8 @@ Section DoubleLift. lazy zeta; simpl ww_to_Z; w_rewrite;zarith. repeat rewrite spec_w_add_mul_div;zarith. rewrite HH0. - pattern wB at 5;replace wB with - (2^(([[p]] - Zpos w_digits) + pattern wB at 5;replace wB with + (2^(([[p]] - Zpos w_digits) + (Zpos w_digits - ([[p]] - Zpos w_digits)))). rewrite Zpower_exp;zarith. rewrite Zmult_assoc. rewrite Z_div_plus_l;zarith. @@ -401,28 +401,28 @@ Section DoubleLift. repeat rewrite <- Zplus_assoc. unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); fold wB;fold wwB;zarith. - unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits) + unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits) (b:= Zpos w_digits);fold wB;fold wwB;zarith. rewrite wwB_wBwB; rewrite Zpower_2; rewrite Zmult_mod_distr_r;zarith. rewrite Zmult_plus_distr_l. - replace ([|xh|] * wB * 2 ^ u) with + replace ([|xh|] * wB * 2 ^ u) with ([|xh|]*2^u*wB). 2:ring. - repeat rewrite <- Zplus_assoc. + repeat rewrite <- Zplus_assoc. rewrite (Zplus_comm ([|xh|] * 2 ^ u * wB)). rewrite Z_mod_plus;zarith. rewrite Z_mod_mult;zarith. unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. - unfold u; split;zarith. + unfold u; split;zarith. split;zarith. unfold u; apply Zdiv_lt_upper_bound;zarith. rewrite <- Zpower_exp;zarith. - fold u. - ring_simplify (u + (Zpos w_digits - u)); fold + fold u. + ring_simplify (u + (Zpos w_digits - u)); fold wB;zarith. unfold ww_digits;rewrite Zpos_xO;zarith. unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. unfold u; split;zarith. unfold u; split;zarith. apply Zdiv_lt_upper_bound;zarith. rewrite <- Zpower_exp;zarith. - fold u. + fold u. ring_simplify (u + (Zpos w_digits - u)); fold wB; auto with zarith. unfold u;zarith. unfold u;zarith. @@ -446,7 +446,7 @@ Section DoubleLift. clear H1;w_rewrite);simpl ww_add_mul_div. replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial]. intros Heq;rewrite <- Heq;clear Heq; auto. - generalize (spec_ww_compare p (w_0W w_zdigits)); + generalize (spec_ww_compare p (w_0W w_zdigits)); case ww_compare; intros H1; w_rewrite. rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. generalize H1; w_rewrite; rewrite spec_zdigits; clear H1; intros H1. @@ -459,7 +459,7 @@ Section DoubleLift. rewrite HH0; auto with zarith. replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial]. intros Heq;rewrite <- Heq;clear Heq. - generalize (spec_ww_compare p (w_0W w_zdigits)); + generalize (spec_ww_compare p (w_0W w_zdigits)); case ww_compare; intros H1; w_rewrite. rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. rewrite Zpos_xO in H;zarith. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v index cc3221401..b215f6a86 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v @@ -45,7 +45,7 @@ Section DoubleMul. (* (xh*B+xl) (yh*B + yl) xh*yh = hh = |hhh|hhl|B2 xh*yl +xl*yh = cc = |cch|ccl|B - xl*yl = ll = |llh|lll + xl*yl = ll = |llh|lll *) Definition double_mul_c (cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w) x y := @@ -56,7 +56,7 @@ Section DoubleMul. let hh := w_mul_c xh yh in let ll := w_mul_c xl yl in let (wc,cc) := cross xh xl yh yl hh ll in - match cc with + match cc with | W0 => WW (ww_add hh (w_W0 wc)) ll | WW cch ccl => match ww_add_c (w_W0 ccl) ll with @@ -67,8 +67,8 @@ Section DoubleMul. end. Definition ww_mul_c := - double_mul_c - (fun xh xl yh yl hh ll=> + double_mul_c + (fun xh xl yh yl hh ll=> match ww_add_c (w_mul_c xh yl) (w_mul_c xl yh) with | C0 cc => (w_0, cc) | C1 cc => (w_1, cc) @@ -77,11 +77,11 @@ Section DoubleMul. Definition w_2 := w_add w_1 w_1. Definition kara_prod xh xl yh yl hh ll := - match ww_add_c hh ll with + match ww_add_c hh ll with C0 m => match w_compare xl xh with Eq => (w_0, m) - | Lt => + | Lt => match w_compare yl yh with Eq => (w_0, m) | Lt => (w_0, ww_sub m (w_mul_c (w_sub xh xl) (w_sub yh yl))) @@ -89,7 +89,7 @@ Section DoubleMul. C1 m1 => (w_1, m1) | C0 m1 => (w_0, m1) end end - | Gt => + | Gt => match w_compare yl yh with Eq => (w_0, m) | Lt => match ww_add_c m (w_mul_c (w_sub xl xh) (w_sub yh yl)) with @@ -101,17 +101,17 @@ Section DoubleMul. | C1 m => match w_compare xl xh with Eq => (w_1, m) - | Lt => + | Lt => match w_compare yl yh with Eq => (w_1, m) | Lt => match ww_sub_c m (w_mul_c (w_sub xh xl) (w_sub yh yl)) with C0 m1 => (w_1, m1) | C1 m1 => (w_0, m1) - end + end | Gt => match ww_add_c m (w_mul_c (w_sub xh xl) (w_sub yl yh)) with C1 m1 => (w_2, m1) | C0 m1 => (w_1, m1) end end - | Gt => + | Gt => match w_compare yl yh with Eq => (w_1, m) | Lt => match ww_add_c m (w_mul_c (w_sub xl xh) (w_sub yh yl)) with @@ -129,8 +129,8 @@ Section DoubleMul. Definition ww_mul x y := match x, y with | W0, _ => W0 - | _, W0 => W0 - | WW xh xl, WW yh yl => + | _, W0 => W0 + | WW xh xl, WW yh yl => let ccl := w_add (w_mul xh yl) (w_mul xl yh) in ww_add (w_W0 ccl) (w_mul_c xl yl) end. @@ -161,9 +161,9 @@ Section DoubleMul. Variable w_mul_add : w -> w -> w -> w * w. Fixpoint double_mul_add_n1 (n:nat) : word w n -> w -> w -> w * word w n := - match n return word w n -> w -> w -> w * word w n with - | O => w_mul_add - | S n1 => + match n return word w n -> w -> w -> w * word w n with + | O => w_mul_add + | S n1 => let mul_add := double_mul_add_n1 n1 in fun x y r => match x with @@ -183,11 +183,11 @@ Section DoubleMul. Variable wn_0W : wn -> zn2z wn. Variable wn_WW : wn -> wn -> zn2z wn. Variable w_mul_add_n1 : wn -> w -> w -> w*wn. - Fixpoint double_mul_add_mn1 (m:nat) : + Fixpoint double_mul_add_mn1 (m:nat) : word wn m -> w -> w -> w*word wn m := - match m return word wn m -> w -> w -> w*word wn m with - | O => w_mul_add_n1 - | S m1 => + match m return word wn m -> w -> w -> w*word wn m with + | O => w_mul_add_n1 + | S m1 => let mul_add := double_mul_add_mn1 m1 in fun x y r => match x with @@ -207,11 +207,11 @@ Section DoubleMul. | WW h l => match w_add_c l r with | C0 lr => (h,lr) - | C1 lr => (w_succ h, lr) + | C1 lr => (w_succ h, lr) end end. - + (*Section DoubleProof. *) Variable w_digits : positive. Variable w_to_Z : w -> Z. @@ -225,11 +225,11 @@ Section DoubleMul. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Notation "[|| x ||]" := @@ -269,8 +269,8 @@ Section DoubleMul. forall x y, [[ww_add_carry x y]] = ([[x]] + [[y]] + 1) mod wwB. Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]]. - - + + Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB. Proof. intros x;apply spec_ww_to_Z;auto. Qed. @@ -281,21 +281,21 @@ Section DoubleMul. Ltac zarith := auto with zarith mult. Lemma wBwB_lex: forall a b c d, - a * wB^2 + [[b]] <= c * wB^2 + [[d]] -> + a * wB^2 + [[b]] <= c * wB^2 + [[d]] -> a <= c. - Proof. + Proof. intros a b c d H; apply beta_lex with [[b]] [[d]] (wB^2);zarith. Qed. - Lemma wBwB_lex_inv: forall a b c d, - a < c -> - a * wB^2 + [[b]] < c * wB^2 + [[d]]. + Lemma wBwB_lex_inv: forall a b c d, + a < c -> + a * wB^2 + [[b]] < c * wB^2 + [[d]]. Proof. intros a b c d H; apply beta_lex_inv; zarith. Qed. Lemma sum_mul_carry : forall xh xl yh yl wc cc, - [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] -> + [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] -> 0 <= [|wc|] <= 1. Proof. intros. @@ -303,14 +303,14 @@ Section DoubleMul. apply wB_pos. Qed. - Theorem mult_add_ineq: forall xH yH crossH, + Theorem mult_add_ineq: forall xH yH crossH, 0 <= [|xH|] * [|yH|] + [|crossH|] < wwB. Proof. intros;rewrite wwB_wBwB;apply mult_add_ineq;zarith. Qed. - + Hint Resolve mult_add_ineq : mult. - + Lemma spec_mul_aux : forall xh xl yh yl wc (cc:zn2z w) hh ll, [[hh]] = [|xh|] * [|yh|] -> [[ll]] = [|xl|] * [|yl|] -> @@ -325,9 +325,9 @@ Section DoubleMul. end||] = ([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|]). Proof. intros;assert (U1 := wB_pos w_digits). - replace (([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|])) with + replace (([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|])) with ([|xh|]*[|yh|]*wB^2 + ([|xh|]*[|yl|] + [|xl|]*[|yh|])*wB + [|xl|]*[|yl|]). - 2:ring. rewrite <- H1;rewrite <- H;rewrite <- H0. + 2:ring. rewrite <- H1;rewrite <- H;rewrite <- H0. assert (H2 := sum_mul_carry _ _ _ _ _ _ H1). destruct cc as [ | cch ccl]; simpl zn2z_to_Z; simpl ww_to_Z. rewrite spec_ww_add;rewrite spec_w_W0;rewrite Zmod_small; @@ -346,7 +346,7 @@ Section DoubleMul. rewrite <- Zmult_plus_distr_l. assert (((2 * wB - 4) + 2)*wB <= ([|wc|] * wB + [|cch|])*wB). apply Zmult_le_compat;zarith. - rewrite Zmult_plus_distr_l in H3. + rewrite Zmult_plus_distr_l in H3. intros. assert (U2 := spec_to_Z ccl);omega. generalize (spec_ww_add_c (w_W0 ccl) ll);destruct (ww_add_c (w_W0 ccl) ll) as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Zmult_1_l; @@ -363,8 +363,8 @@ Section DoubleMul. (forall xh xl yh yl hh ll, [[hh]] = [|xh|]*[|yh|] -> [[ll]] = [|xl|]*[|yl|] -> - let (wc,cc) := cross xh xl yh yl hh ll in - [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]) -> + let (wc,cc) := cross xh xl yh yl hh ll in + [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]) -> forall x y, [||double_mul_c cross x y||] = [[x]] * [[y]]. Proof. intros cross Hcross x y;destruct x as [ |xh xl];simpl;trivial. @@ -376,7 +376,7 @@ Section DoubleMul. rewrite <- wwB_wBwB;trivial. Qed. - Lemma spec_ww_mul_c : forall x y, [||ww_mul_c x y||] = [[x]] * [[y]]. + Lemma spec_ww_mul_c : forall x y, [||ww_mul_c x y||] = [[x]] * [[y]]. Proof. intros x y;unfold ww_mul_c;apply spec_double_mul_c. intros xh xl yh yl hh ll H1 H2. @@ -402,9 +402,9 @@ Section DoubleMul. let (wc,cc) := kara_prod xh xl yh yl hh ll in [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]. Proof. - intros xh xl yh yl hh ll H H0; rewrite <- kara_prod_aux; + intros xh xl yh yl hh ll H H0; rewrite <- kara_prod_aux; rewrite <- H; rewrite <- H0; unfold kara_prod. - assert (Hxh := (spec_to_Z xh)); assert (Hxl := (spec_to_Z xl)); + assert (Hxh := (spec_to_Z xh)); assert (Hxl := (spec_to_Z xl)); assert (Hyh := (spec_to_Z yh)); assert (Hyl := (spec_to_Z yl)). generalize (spec_ww_add_c hh ll); case (ww_add_c hh ll); intros z Hz; rewrite <- Hz; unfold interp_carry; assert (Hz1 := (spec_ww_to_Z z)). @@ -412,7 +412,7 @@ Section DoubleMul. try rewrite Hxlh; try rewrite spec_w_0; try (ring; fail). generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh. rewrite Hylh; rewrite spec_w_0; try (ring; fail). - rewrite spec_w_0; try (ring; fail). + rewrite spec_w_0; try (ring; fail). repeat (rewrite spec_ww_sub || rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). split; auto with zarith. @@ -508,8 +508,8 @@ Section DoubleMul. repeat rewrite Zmod_small; auto with zarith; try (ring; fail). Qed. - Lemma sub_carry : forall xh xl yh yl z, - 0 <= z -> + Lemma sub_carry : forall xh xl yh yl z, + 0 <= z -> [|xh|]*[|yl|] + [|xl|]*[|yh|] = wwB + z -> z < wwB. Proof. @@ -519,7 +519,7 @@ Section DoubleMul. generalize (Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)). rewrite <- wwB_wBwB;intros H1 H2. assert (H3 := wB_pos w_digits). - assert (2*wB <= wwB). + assert (2*wB <= wwB). rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat;zarith. omega. Qed. @@ -528,7 +528,7 @@ Section DoubleMul. let H:= fresh "H" in assert (H:= spec_ww_to_Z x). - Ltac Zmult_lt_b x y := + Ltac Zmult_lt_b x y := let H := fresh "H" in assert (H := Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)). @@ -582,7 +582,7 @@ Section DoubleMul. Variable w_mul_add : w -> w -> w -> w * w. Variable spec_w_mul_add : forall x y r, let (h,l):= w_mul_add x y r in - [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. + [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. Lemma spec_double_mul_add_n1 : forall n x y r, let (h,l) := double_mul_add_n1 w_mul_add n x y r in @@ -590,7 +590,7 @@ Section DoubleMul. Proof. induction n;intros x y r;trivial. exact (spec_w_mul_add x y r). - unfold double_mul_add_n1;destruct x as[ |xh xl]; + unfold double_mul_add_n1;destruct x as[ |xh xl]; fold(double_mul_add_n1 w_mul_add). rewrite spec_w_0;rewrite spec_extend;simpl;trivial. assert(H:=IHn xl y r);destruct (double_mul_add_n1 w_mul_add n xl y r)as(rl,l). @@ -599,13 +599,13 @@ Section DoubleMul. rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc;rewrite <- H. rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite U;ring. - Qed. - + Qed. + End DoubleMulAddn1Proof. - Lemma spec_w_mul_add : forall x y r, + Lemma spec_w_mul_add : forall x y r, let (h,l):= w_mul_add x y r in - [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. + [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. Proof. intros x y r;unfold w_mul_add;assert (H:=spec_w_mul_c x y); destruct (w_mul_c x y) as [ |h l];simpl;rewrite <- H. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v index c72abed61..ac2232cc0 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v @@ -52,7 +52,7 @@ Section DoubleSqrt. Let wwBm1 := ww_Bm1 w_Bm1. - Definition ww_is_even x := + Definition ww_is_even x := match x with | W0 => true | WW xh xl => w_is_even xl @@ -62,7 +62,7 @@ Section DoubleSqrt. match w_compare x z with | Eq => match w_compare y z with - Eq => (C1 w_1, w_0) + Eq => (C1 w_1, w_0) | Gt => (C1 w_1, w_sub y z) | Lt => (C1 w_0, y) end @@ -120,7 +120,7 @@ Section DoubleSqrt. let ( q, r) := w_sqrt2 x1 x2 in let (q1, r1) := w_div2s r y1 q in match q1 with - C0 q1 => + C0 q1 => let q2 := w_square_c q1 in let a := WW q q1 in match r1 with @@ -132,9 +132,9 @@ Section DoubleSqrt. | C0 r2 => match ww_sub_c (WW r2 y2) q2 with C0 r3 => (a, C0 r3) - | C1 r3 => + | C1 r3 => let a2 := ww_add_mul_div (w_0W w_1) a W0 in - match ww_pred_c a2 with + match ww_pred_c a2 with C0 a3 => (ww_pred a, ww_add_c a3 r3) | C1 a3 => @@ -166,20 +166,20 @@ Section DoubleSqrt. | Gt => match ww_add_mul_div p x W0 with W0 => W0 - | WW x1 x2 => + | WW x1 x2 => let (r, _) := w_sqrt2 x1 x2 in - WW w_0 (w_add_mul_div - (w_sub w_zdigits + WW w_0 (w_add_mul_div + (w_sub w_zdigits (low (ww_add_mul_div (ww_pred ww_zdigits) W0 p))) w_0 r) end - | _ => + | _ => match x with W0 => W0 | WW x1 x2 => WW w_0 (fst (w_sqrt2 x1 x2)) end end. - + Variable w_to_Z : w -> Z. @@ -192,11 +192,11 @@ Section DoubleSqrt. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Notation "[|| x ||]" := @@ -274,7 +274,7 @@ Section DoubleSqrt. Lemma spec_ww_is_even : forall x, if ww_is_even x then [[x]] mod 2 = 0 else [[x]] mod 2 = 1. -clear spec_more_than_1_digit. +clear spec_more_than_1_digit. intros x; case x; simpl ww_is_even. simpl. rewrite Zmod_small; auto with zarith. @@ -377,8 +377,8 @@ intros x; case x; simpl ww_is_even. end. rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. destruct (spec_to_Z w1) as [H1 H2];auto with zarith. - split; auto with zarith. - apply Zdiv_lt_upper_bound; auto with zarith. + split; auto with zarith. + apply Zdiv_lt_upper_bound; auto with zarith. rewrite Hp; ring. Qed. @@ -400,7 +400,7 @@ intros x; case x; simpl ww_is_even. rewrite Zmax_right; auto with zarith. rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. destruct (spec_to_Z w1) as [H1 H2];auto with zarith. - split; auto with zarith. + split; auto with zarith. unfold base. match goal with |- _ < _ ^ ?X => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; @@ -432,7 +432,7 @@ intros x; case x; simpl ww_is_even. intros w1. rewrite spec_ww_add_mul_div; auto with zarith. autorewrite with w_rewrite rm10. - rewrite spec_w_0W; rewrite spec_w_1. + rewrite spec_w_0W; rewrite spec_w_1. rewrite Zpower_1_r; auto with zarith. rewrite Zmult_comm; auto. rewrite spec_w_0W; rewrite spec_w_1; auto with zarith. @@ -456,7 +456,7 @@ intros x; case x; simpl ww_is_even. match goal with |- 0 <= ?X - 1 => assert (0 < X); auto with zarith end. - apply Zpower_gt_0; auto with zarith. + apply Zpower_gt_0; auto with zarith. match goal with |- 0 <= ?X - 1 => assert (0 < X); auto with zarith; red; reflexivity end. @@ -540,7 +540,7 @@ intros x; case x; simpl ww_is_even. rewrite add_mult_div_2_plus_1; unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -557,7 +557,7 @@ intros x; case x; simpl ww_is_even. unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -590,7 +590,7 @@ intros x; case x; simpl ww_is_even. rewrite H1; unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -609,7 +609,7 @@ intros x; case x; simpl ww_is_even. rewrite H1; unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -680,7 +680,7 @@ intros x; case x; simpl ww_is_even. rewrite Zsquare_mult; replace (p * p) with ((- p) * (- p)); try ring. apply Zmult_le_0_compat; auto with zarith. Qed. - + Lemma spec_split: forall x, [|fst (split x)|] * wB + [|snd (split x)|] = [[x]]. intros x; case x; simpl; autorewrite with w_rewrite; @@ -749,7 +749,7 @@ intros x; case x; simpl ww_is_even. match goal with |- ?X <= ?Y => replace Y with (2 * (wB/ 2 - 1)); auto with zarith end. - pattern wB at 2; rewrite <- wB_div_2; auto with zarith. + pattern wB at 2; rewrite <- wB_div_2; auto with zarith. match type of H1 with ?X = _ => assert (U5: X < wB / 4 * wB) end. @@ -762,9 +762,9 @@ intros x; case x; simpl ww_is_even. destruct (spec_to_Z w3);auto with zarith. generalize (@spec_w_div2s c w0 w4 U1 H2). case (w_div2s c w0 w4). - intros c0; case c0; intros w5; + intros c0; case c0; intros w5; repeat (rewrite C0_id || rewrite C1_plus_wB). - intros c1; case c1; intros w6; + intros c1; case c1; intros w6; repeat (rewrite C0_id || rewrite C1_plus_wB). intros (H3, H4). match goal with |- context [ww_sub_c ?y ?z] => @@ -1036,7 +1036,7 @@ intros x; case x; simpl ww_is_even. end. apply Zle_not_lt; rewrite <- H3; auto with zarith. rewrite Zmult_plus_distr_l. - apply Zlt_le_trans with ((2 * [|w4|]) * wB + 0); + apply Zlt_le_trans with ((2 * [|w4|]) * wB + 0); auto with zarith. apply beta_lex_inv; auto with zarith. destruct (spec_to_Z w0);auto with zarith. @@ -1117,9 +1117,9 @@ intros x; case x; simpl ww_is_even. auto with zarith. simpl ww_to_Z. assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z x);auto with zarith. - Qed. - - Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2. + Qed. + + Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2. pattern wwB at 1; rewrite wwB_wBwB; rewrite Zpower_2. rewrite <- wB_div_2. match goal with |- context[(2 * ?X) * (2 * ?Z)] => @@ -1132,7 +1132,7 @@ intros x; case x; simpl ww_is_even. Lemma spec_ww_head1 - : forall x : zn2z w, + : forall x : zn2z w, (ww_is_even (ww_head1 x) = true) /\ (0 < [[x]] -> wwB / 4 <= 2 ^ [[ww_head1 x]] * [[x]] < wwB). assert (U := wB_pos w_digits). @@ -1165,7 +1165,7 @@ intros x; case x; simpl ww_is_even. rewrite Hp. rewrite Zminus_mod; auto with zarith. rewrite H2; repeat rewrite Zmod_small; auto with zarith. - intros H3; rewrite Hp. + intros H3; rewrite Hp. case (spec_ww_head0 x); auto; intros Hv3 Hv4. assert (Hu: forall u, 0 < u -> 2 * 2 ^ (u - 1) = 2 ^u). intros u Hu. @@ -1187,7 +1187,7 @@ intros x; case x; simpl ww_is_even. apply sym_equal; apply Zdiv_unique with 0; auto with zarith. rewrite Zmult_assoc; rewrite wB_div_4; auto with zarith. - rewrite wwB_wBwB; ring. + rewrite wwB_wBwB; ring. Qed. Lemma spec_ww_sqrt : forall x, @@ -1196,14 +1196,14 @@ intros x; case x; simpl ww_is_even. intro x; unfold ww_sqrt. generalize (spec_ww_is_zero x); case (ww_is_zero x). simpl ww_to_Z; simpl Zpower; unfold Zpower_pos; simpl; - auto with zarith. + auto with zarith. intros H1. generalize (spec_ww_compare (ww_head1 x) W0); case ww_compare; simpl ww_to_Z; autorewrite with rm10. generalize H1; case x. intros HH; contradict HH; simpl ww_to_Z; auto with zarith. intros w0 w1; simpl ww_to_Z; autorewrite with w_rewrite rm10. - intros H2; case (spec_ww_head1 (WW w0 w1)); intros H3 H4 H5. + intros H2; case (spec_ww_head1 (WW w0 w1)); intros H3 H4 H5. generalize (H4 H2); clear H4; rewrite H5; clear H5; autorewrite with rm10. intros (H4, H5). assert (V: wB/4 <= [|w0|]). @@ -1239,7 +1239,7 @@ intros x; case x; simpl ww_is_even. apply Zle_not_lt; unfold base. apply Zle_trans with (2 ^ [[ww_head1 x]]). apply Zpower_le_monotone; auto with zarith. - pattern (2 ^ [[ww_head1 x]]) at 1; + pattern (2 ^ [[ww_head1 x]]) at 1; rewrite <- (Zmult_1_r (2 ^ [[ww_head1 x]])). apply Zmult_le_compat_l; auto with zarith. generalize (spec_ww_add_mul_div x W0 (ww_head1 x) Hv2); @@ -1281,13 +1281,13 @@ intros x; case x; simpl ww_is_even. rewrite Zmod_small; auto with zarith. split; auto with zarith. apply Zlt_le_trans with (Zpos (xO w_digits)); auto with zarith. - unfold base; apply Zpower2_le_lin; auto with zarith. + unfold base; apply Zpower2_le_lin; auto with zarith. assert (Hv4: [[ww_head1 x]]/2 < wB). apply Zle_lt_trans with (Zpos w_digits). apply Zmult_le_reg_r with 2; auto with zarith. repeat rewrite (fun x => Zmult_comm x 2). rewrite <- Hv0; rewrite <- Zpos_xO; auto. - unfold base; apply Zpower2_lt_lin; auto with zarith. + unfold base; apply Zpower2_lt_lin; auto with zarith. assert (Hv5: [[(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))]] = [[ww_head1 x]]/2). rewrite spec_ww_add_mul_div. @@ -1328,14 +1328,14 @@ intros x; case x; simpl ww_is_even. rewrite tmp; clear tmp. apply Zpower_le_monotone3; auto with zarith. split; auto with zarith. - pattern [|w2|] at 2; + pattern [|w2|] at 2; rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith. match goal with |- ?X <= ?X + ?Y => assert (0 <= Y); auto with zarith end. case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith. - case c; unfold interp_carry; autorewrite with rm10; + case c; unfold interp_carry; autorewrite with rm10; intros w3; assert (V3 := spec_to_Z w3);auto with zarith. apply Zmult_lt_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith. rewrite H4. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v index 638bf6916..d3a08c6e0 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v @@ -39,7 +39,7 @@ Section DoubleSub. Definition ww_opp_c x := match x with | W0 => C0 W0 - | WW xh xl => + | WW xh xl => match w_opp_c xl with | C0 _ => match w_opp_c xh with @@ -53,7 +53,7 @@ Section DoubleSub. Definition ww_opp x := match x with | W0 => W0 - | WW xh xl => + | WW xh xl => match w_opp_c xl with | C0 _ => WW (w_opp xh) w_0 | C1 l => WW (w_opp_carry xh) l @@ -72,14 +72,14 @@ Section DoubleSub. | WW xh xl => match w_pred_c xl with | C0 l => C0 (w_WW xh l) - | C1 _ => - match w_pred_c xh with + | C1 _ => + match w_pred_c xh with | C0 h => C0 (WW h w_Bm1) | C1 _ => C1 ww_Bm1 end end end. - + Definition ww_pred x := match x with | W0 => ww_Bm1 @@ -89,19 +89,19 @@ Section DoubleSub. | C1 l => WW (w_pred xh) w_Bm1 end end. - + Definition ww_sub_c x y := match y, x with | W0, _ => C0 x | WW yh yl, W0 => ww_opp_c (WW yh yl) | WW yh yl, WW xh xl => match w_sub_c xl yl with - | C0 l => + | C0 l => match w_sub_c xh yh with | C0 h => C0 (w_WW h l) | C1 h => C1 (WW h l) end - | C1 l => + | C1 l => match w_sub_carry_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (WW h l) @@ -109,7 +109,7 @@ Section DoubleSub. end end. - Definition ww_sub x y := + Definition ww_sub x y := match y, x with | W0, _ => x | WW yh yl, W0 => ww_opp (WW yh yl) @@ -127,7 +127,7 @@ Section DoubleSub. | WW yh yl, W0 => C1 (ww_opp_carry (WW yh yl)) | WW yh yl, WW xh xl => match w_sub_carry_c xl yl with - | C0 l => + | C0 l => match w_sub_c xh yh with | C0 h => C0 (w_WW h l) | C1 h => C1 (WW h l) @@ -155,7 +155,7 @@ Section DoubleSub. (*Section DoubleProof.*) Variable w_digits : positive. Variable w_to_Z : w -> Z. - + Notation wB := (base w_digits). Notation wwB := (base (ww_digits w_digits)). @@ -166,13 +166,13 @@ Section DoubleSub. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - + Variable spec_w_0 : [|w_0|] = 0. Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1. Variable spec_ww_Bm1 : [[ww_Bm1]] = wwB - 1. @@ -187,7 +187,7 @@ Section DoubleSub. Variable spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|]. Variable spec_sub_carry_c : forall x y, [-|w_sub_carry_c x y|] = [|x|] - [|y|] - 1. - + Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB. Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. Variable spec_sub_carry : @@ -197,12 +197,12 @@ Section DoubleSub. Lemma spec_ww_opp_c : forall x, [-[ww_opp_c x]] = -[[x]]. Proof. destruct x as [ |xh xl];simpl. reflexivity. - rewrite Zopp_plus_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl) + rewrite Zopp_plus_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H; - rewrite Zopp_mult_distr_l. + rewrite Zopp_mult_distr_l. assert ([|l|] = 0). assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. - rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh) + rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh) as [h|h];intros H1;unfold interp_carry in *;rewrite <- H1. assert ([|h|] = 0). assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega. @@ -216,7 +216,7 @@ Section DoubleSub. Proof. destruct x as [ |xh xl];simpl. reflexivity. rewrite Zopp_plus_distr;rewrite Zopp_mult_distr_l. - generalize (spec_opp_c xl);destruct (w_opp_c xl) + generalize (spec_opp_c xl);destruct (w_opp_c xl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. rewrite spec_w_0;rewrite Zplus_0_r;rewrite wwB_wBwB. assert ([|l|] = 0). @@ -247,7 +247,7 @@ Section DoubleSub. assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. rewrite H0;change ([|xh|] + -1) with ([|xh|] - 1). generalize (spec_pred_c xh);destruct (w_pred_c xh) as [h|h]; - intros H1;unfold interp_carry in H1;rewrite <- H1. + intros H1;unfold interp_carry in H1;rewrite <- H1. simpl;rewrite spec_w_Bm1;ring. assert ([|h|] = wB - 1). assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega. @@ -258,14 +258,14 @@ Section DoubleSub. Proof. destruct y as [ |yh yl];simpl. ring. destruct x as [ |xh xl];simpl. exact (spec_ww_opp_c (WW yh yl)). - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|])). 2:ring. generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl) as [l|l];intros H; unfold interp_carry in H;rewrite <- H. generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1;simpl ww_to_Z; @@ -275,37 +275,37 @@ Section DoubleSub. Lemma spec_ww_sub_carry_c : forall x y, [-[ww_sub_carry_c x y]] = [[x]] - [[y]] - 1. Proof. - destruct y as [ |yh yl];simpl. + destruct y as [ |yh yl];simpl. unfold Zminus;simpl;rewrite Zplus_0_r;exact (spec_ww_pred_c x). destruct x as [ |xh xl]. unfold interp_carry;rewrite spec_w_WW;simpl ww_to_Z;rewrite wwB_wBwB; repeat rewrite spec_opp_carry;ring. simpl ww_to_Z. - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|]-1)). 2:ring. - generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl) + generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H. generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1;try rewrite spec_w_WW; simpl ww_to_Z; try rewrite wwB_wBwB;ring. - Qed. - + Qed. + Lemma spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB. Proof. - destruct x as [ |xh xl];simpl. + destruct x as [ |xh xl];simpl. apply Zmod_unique with (-1). apply spec_ww_to_Z;trivial. rewrite spec_ww_Bm1;ring. replace ([|xh|]*wB + [|xl|] - 1) with ([|xh|]*wB + ([|xl|] - 1)). 2:ring. generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l];intro H; unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. - rewrite Zmod_small. apply spec_w_WW. + rewrite Zmod_small. apply spec_w_WW. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh l)). - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. change ([|xh|] + -1) with ([|xh|] - 1). assert ([|l|] = wB - 1). assert (H1:= spec_to_Z l);assert (H2:= spec_to_Z xl);omega. @@ -318,7 +318,7 @@ Section DoubleSub. destruct y as [ |yh yl];simpl. ring_simplify ([[x]] - 0);rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial. destruct x as [ |xh xl];simpl. exact (spec_ww_opp (WW yh yl)). - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|])). 2:ring. generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl)as[l|l];intros H; unfold interp_carry in H;rewrite <- H. @@ -338,7 +338,7 @@ Section DoubleSub. apply spec_ww_to_Z;trivial. fold (ww_opp_carry (WW yh yl)). rewrite (spec_ww_opp_carry (WW yh yl));simpl ww_to_Z;ring. - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|] - 1)). 2:ring. generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl)as[l|l]; intros H;unfold interp_carry in H;rewrite <- H;rewrite spec_w_WW. @@ -354,4 +354,4 @@ End DoubleSub. - + diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v index 73fd266e4..3bd4b8127 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v @@ -37,10 +37,10 @@ Section Zn2Z. Variable znz : Type. - (** From a type [znz] representing a cyclic structure Z/nZ, + (** From a type [znz] representing a cyclic structure Z/nZ, we produce a representation of Z/2nZ by pairs of elements of [znz] - (plus a special case for zero). High half of the new number comes - first. + (plus a special case for zero). High half of the new number comes + first. *) Inductive zn2z := @@ -57,10 +57,10 @@ End Zn2Z. Implicit Arguments W0 [znz]. -(** From a cyclic representation [w], we iterate the [zn2z] construct - [n] times, gaining the type of binary trees of depth at most [n], - whose leafs are either W0 (if depth < n) or elements of w - (if depth = n). +(** From a cyclic representation [w], we iterate the [zn2z] construct + [n] times, gaining the type of binary trees of depth at most [n], + whose leafs are either W0 (if depth < n) or elements of w + (if depth = n). *) Fixpoint word (w:Type) (n:nat) : Type := diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v index 3835c6cde..6e71bad82 100644 --- a/theories/Numbers/Cyclic/Int31/Cyclic31.v +++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v @@ -34,9 +34,9 @@ Section Basics. Lemma iszero_eq0 : forall x, iszero x = true -> x=0. Proof. destruct x; simpl; intros. - repeat - match goal with H:(if ?d then _ else _) = true |- _ => - destruct d; try discriminate + repeat + match goal with H:(if ?d then _ else _) = true |- _ => + destruct d; try discriminate end. reflexivity. Qed. @@ -46,26 +46,26 @@ Section Basics. intros x H Eq; rewrite Eq in H; simpl in *; discriminate. Qed. - Lemma sneakl_shiftr : forall x, + Lemma sneakl_shiftr : forall x, x = sneakl (firstr x) (shiftr x). Proof. destruct x; simpl; auto. Qed. - Lemma sneakr_shiftl : forall x, + Lemma sneakr_shiftl : forall x, x = sneakr (firstl x) (shiftl x). Proof. destruct x; simpl; auto. Qed. - Lemma twice_zero : forall x, + Lemma twice_zero : forall x, twice x = 0 <-> twice_plus_one x = 1. Proof. - destruct x; simpl in *; split; + destruct x; simpl in *; split; intro H; injection H; intros; subst; auto. Qed. - Lemma twice_or_twice_plus_one : forall x, + Lemma twice_or_twice_plus_one : forall x, x = twice (shiftr x) \/ x = twice_plus_one (shiftr x). Proof. intros; case_eq (firstr x); intros. @@ -79,13 +79,13 @@ Section Basics. Definition nshiftr n x := iter_nat n _ shiftr x. - Lemma nshiftr_S : + Lemma nshiftr_S : forall n x, nshiftr (S n) x = shiftr (nshiftr n x). Proof. reflexivity. Qed. - Lemma nshiftr_S_tail : + Lemma nshiftr_S_tail : forall n x, nshiftr (S n) x = nshiftr n (shiftr x). Proof. induction n; simpl; auto. @@ -103,7 +103,7 @@ Section Basics. destruct x; simpl; auto. Qed. - Lemma nshiftr_above_size : forall k x, size<=k -> + Lemma nshiftr_above_size : forall k x, size<=k -> nshiftr k x = 0. Proof. intros. @@ -117,13 +117,13 @@ Section Basics. Definition nshiftl n x := iter_nat n _ shiftl x. - Lemma nshiftl_S : + Lemma nshiftl_S : forall n x, nshiftl (S n) x = shiftl (nshiftl n x). Proof. reflexivity. Qed. - Lemma nshiftl_S_tail : + Lemma nshiftl_S_tail : forall n x, nshiftl (S n) x = nshiftl n (shiftl x). Proof. induction n; simpl; auto. @@ -141,7 +141,7 @@ Section Basics. destruct x; simpl; auto. Qed. - Lemma nshiftl_above_size : forall k x, size<=k -> + Lemma nshiftl_above_size : forall k x, size<=k -> nshiftl k x = 0. Proof. intros. @@ -151,27 +151,27 @@ Section Basics. simpl; rewrite nshiftl_S, IHn; auto. Qed. - Lemma firstr_firstl : + Lemma firstr_firstl : forall x, firstr x = firstl (nshiftl (pred size) x). Proof. destruct x; simpl; auto. Qed. - Lemma firstl_firstr : + Lemma firstl_firstr : forall x, firstl x = firstr (nshiftr (pred size) x). Proof. destruct x; simpl; auto. Qed. - + (** More advanced results about [nshiftr] *) - Lemma nshiftr_predsize_0_firstl : forall x, + Lemma nshiftr_predsize_0_firstl : forall x, nshiftr (pred size) x = 0 -> firstl x = D0. Proof. destruct x; compute; intros H; injection H; intros; subst; auto. Qed. - Lemma nshiftr_0_propagates : forall n p x, n <= p -> + Lemma nshiftr_0_propagates : forall n p x, n <= p -> nshiftr n x = 0 -> nshiftr p x = 0. Proof. intros. @@ -181,7 +181,7 @@ Section Basics. simpl; rewrite nshiftr_S; rewrite IHn0; auto. Qed. - Lemma nshiftr_0_firstl : forall n x, n < size -> + Lemma nshiftr_0_firstl : forall n x, n < size -> nshiftr n x = 0 -> firstl x = D0. Proof. intros. @@ -194,8 +194,8 @@ Section Basics. (** Not used for the moment. Are they really useful ? *) Lemma int31_ind_sneakl : forall P : int31->Prop, - P 0 -> - (forall x d, P x -> P (sneakl d x)) -> + P 0 -> + (forall x d, P x -> P (sneakl d x)) -> forall x, P x. Proof. intros. @@ -210,10 +210,10 @@ Section Basics. change x with (nshiftr (size-size) x); auto. Qed. - Lemma int31_ind_twice : forall P : int31->Prop, - P 0 -> - (forall x, P x -> P (twice x)) -> - (forall x, P x -> P (twice_plus_one x)) -> + Lemma int31_ind_twice : forall P : int31->Prop, + P 0 -> + (forall x, P x -> P (twice x)) -> + (forall x, P x -> P (twice_plus_one x)) -> forall x, P x. Proof. induction x using int31_ind_sneakl; auto. @@ -224,21 +224,21 @@ Section Basics. (** * Some generic results about [recr] *) Section Recr. - + (** [recr] satisfies the fixpoint equation used for its definition. *) Variable (A:Type)(case0:A)(caserec:digits->int31->A->A). - - Lemma recr_aux_eqn : forall n x, iszero x = false -> - recr_aux (S n) A case0 caserec x = + + Lemma recr_aux_eqn : forall n x, iszero x = false -> + recr_aux (S n) A case0 caserec x = caserec (firstr x) (shiftr x) (recr_aux n A case0 caserec (shiftr x)). Proof. intros; simpl; rewrite H; auto. Qed. - Lemma recr_aux_converges : + Lemma recr_aux_converges : forall n p x, n <= size -> n <= p -> - recr_aux n A case0 caserec (nshiftr (size - n) x) = + recr_aux n A case0 caserec (nshiftr (size - n) x) = recr_aux p A case0 caserec (nshiftr (size - n) x). Proof. induction n. @@ -255,8 +255,8 @@ Section Basics. apply IHn; auto with arith. Qed. - Lemma recr_eqn : forall x, iszero x = false -> - recr A case0 caserec x = + Lemma recr_eqn : forall x, iszero x = false -> + recr A case0 caserec x = caserec (firstr x) (shiftr x) (recr A case0 caserec (shiftr x)). Proof. intros. @@ -265,11 +265,11 @@ Section Basics. rewrite (recr_aux_converges size (S size)); auto with arith. rewrite recr_aux_eqn; auto. Qed. - - (** [recr] is usually equivalent to a variant [recrbis] + + (** [recr] is usually equivalent to a variant [recrbis] written without [iszero] check. *) - Fixpoint recrbis_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) + Fixpoint recrbis_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) (i:int31) : A := match n with | O => case0 @@ -277,7 +277,7 @@ Section Basics. let si := shiftr i in caserec (firstr i) si (recrbis_aux next A case0 caserec si) end. - + Definition recrbis := recrbis_aux size. Hypothesis case0_caserec : caserec D0 0 case0 = case0. @@ -291,8 +291,8 @@ Section Basics. replace (recrbis_aux n A case0 caserec 0) with case0; auto. clear H IHn; induction n; simpl; congruence. Qed. - - Lemma recrbis_equiv : forall x, + + Lemma recrbis_equiv : forall x, recrbis A case0 caserec x = recr A case0 caserec x. Proof. intros; apply recrbis_aux_equiv; auto. @@ -348,7 +348,7 @@ Section Basics. rewrite incr_eqn1; destruct x; simpl; auto. Qed. - Lemma incr_twice_plus_one_firstl : + Lemma incr_twice_plus_one_firstl : forall x, firstl x = D0 -> incr (twice_plus_one x) = twice (incr x). Proof. intros. @@ -356,9 +356,9 @@ Section Basics. f_equal; f_equal. destruct x; simpl in *; rewrite H; auto. Qed. - - (** The previous result is actually true even without the - constraint on [firstl], but this is harder to prove + + (** The previous result is actually true even without the + constraint on [firstl], but this is harder to prove (see later). *) End Incr. @@ -369,9 +369,9 @@ Section Basics. (** Variant of [phi] via [recrbis] *) - Let Phi := fun b (_:int31) => + Let Phi := fun b (_:int31) => match b with D0 => Zdouble | D1 => Zdouble_plus_one end. - + Definition phibis_aux n x := recrbis_aux n _ Z0 Phi x. Lemma phibis_aux_equiv : forall x, phibis_aux size x = phi x. @@ -382,7 +382,7 @@ Section Basics. (** Recursive equations satisfied by [phi] *) - Lemma phi_eqn1 : forall x, firstr x = D0 -> + Lemma phi_eqn1 : forall x, firstr x = D0 -> phi x = Zdouble (phi (shiftr x)). Proof. intros. @@ -392,7 +392,7 @@ Section Basics. rewrite H; auto. Qed. - Lemma phi_eqn2 : forall x, firstr x = D1 -> + Lemma phi_eqn2 : forall x, firstr x = D1 -> phi x = Zdouble_plus_one (phi (shiftr x)). Proof. intros. @@ -402,7 +402,7 @@ Section Basics. rewrite H; auto. Qed. - Lemma phi_twice_firstl : forall x, firstl x = D0 -> + Lemma phi_twice_firstl : forall x, firstl x = D0 -> phi (twice x) = Zdouble (phi x). Proof. intros. @@ -411,7 +411,7 @@ Section Basics. destruct x; simpl in *; rewrite H; auto. Qed. - Lemma phi_twice_plus_one_firstl : forall x, firstl x = D0 -> + Lemma phi_twice_plus_one_firstl : forall x, firstl x = D0 -> phi (twice_plus_one x) = Zdouble_plus_one (phi x). Proof. intros. @@ -427,23 +427,23 @@ Section Basics. Lemma phibis_aux_pos : forall n x, (0 <= phibis_aux n x)%Z. Proof. induction n. - simpl; unfold phibis_aux; simpl; auto with zarith. + simpl; unfold phibis_aux; simpl; auto with zarith. intros. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux n (shiftr x)). destruct (firstr x). specialize IHn with (shiftr x); rewrite Zdouble_mult; omega. specialize IHn with (shiftr x); rewrite Zdouble_plus_one_mult; omega. Qed. - Lemma phibis_aux_bounded : - forall n x, n <= size -> + Lemma phibis_aux_bounded : + forall n x, n <= size -> (phibis_aux n (nshiftr (size-n) x) < 2 ^ (Z_of_nat n))%Z. Proof. induction n. simpl; unfold phibis_aux; simpl; auto with zarith. intros. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux n (shiftr (nshiftr (size - S n) x))). assert (shiftr (nshiftr (size - S n) x) = nshiftr (size-n) x). replace (size - n)%nat with (S (size - (S n))) by omega. @@ -468,8 +468,8 @@ Section Basics. apply phibis_aux_bounded; auto. Qed. - Lemma phibis_aux_lowerbound : - forall n x, firstr (nshiftr n x) = D1 -> + Lemma phibis_aux_lowerbound : + forall n x, firstr (nshiftr n x) = D1 -> (2 ^ Z_of_nat n <= phibis_aux (S n) x)%Z. Proof. induction n. @@ -480,7 +480,7 @@ Section Basics. intros. remember (S n) as m. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux m (shiftr x)). subst m. rewrite inj_S, Zpower_Zsucc; auto with zarith. @@ -488,13 +488,13 @@ Section Basics. apply IHn. rewrite <- nshiftr_S_tail; auto. destruct (firstr x). - change (Zdouble (phibis_aux (S n) (shiftr x))) with + change (Zdouble (phibis_aux (S n) (shiftr x))) with (2*(phibis_aux (S n) (shiftr x)))%Z. omega. rewrite Zdouble_plus_one_mult; omega. Qed. - Lemma phi_lowerbound : + Lemma phi_lowerbound : forall x, firstl x = D1 -> (2^(Z_of_nat (pred size)) <= phi x)%Z. Proof. intros. @@ -508,9 +508,9 @@ Section Basics. Section EqShiftL. - (** After killing [n] bits at the left, are the numbers equal ?*) + (** After killing [n] bits at the left, are the numbers equal ?*) - Definition EqShiftL n x y := + Definition EqShiftL n x y := nshiftl n x = nshiftl n y. Lemma EqShiftL_zero : forall x y, EqShiftL O x y <-> x = y. @@ -523,7 +523,7 @@ Section Basics. red; intros; rewrite 2 nshiftl_above_size; auto. Qed. - Lemma EqShiftL_le : forall k k' x y, k <= k' -> + Lemma EqShiftL_le : forall k k' x y, k <= k' -> EqShiftL k x y -> EqShiftL k' x y. Proof. unfold EqShiftL; intros. @@ -534,18 +534,18 @@ Section Basics. rewrite 2 nshiftl_S; f_equal; auto. Qed. - Lemma EqShiftL_firstr : forall k x y, k < size -> + Lemma EqShiftL_firstr : forall k x y, k < size -> EqShiftL k x y -> firstr x = firstr y. Proof. intros. rewrite 2 firstr_firstl. f_equal. - apply EqShiftL_le with k; auto. + apply EqShiftL_le with k; auto. unfold size. auto with arith. Qed. - Lemma EqShiftL_twice : forall k x y, + Lemma EqShiftL_twice : forall k x y, EqShiftL k (twice x) (twice y) <-> EqShiftL (S k) x y. Proof. intros; unfold EqShiftL. @@ -553,7 +553,7 @@ Section Basics. Qed. (** * From int31 to list of digits. *) - + (** Lower (=rightmost) bits comes first. *) Definition i2l := recrbis _ nil (fun d _ rec => d::rec). @@ -561,10 +561,10 @@ Section Basics. Lemma i2l_length : forall x, length (i2l x) = size. Proof. intros; reflexivity. - Qed. + Qed. - Fixpoint lshiftl l x := - match l with + Fixpoint lshiftl l x := + match l with | nil => x | d::l => sneakl d (lshiftl l x) end. @@ -576,19 +576,19 @@ Section Basics. destruct x; compute; auto. Qed. - Lemma i2l_sneakr : forall x d, + Lemma i2l_sneakr : forall x d, i2l (sneakr d x) = tail (i2l x) ++ d::nil. Proof. destruct x; compute; auto. Qed. - Lemma i2l_sneakl : forall x d, + Lemma i2l_sneakl : forall x d, i2l (sneakl d x) = d :: removelast (i2l x). Proof. destruct x; compute; auto. Qed. - Lemma i2l_l2i : forall l, length l = size -> + Lemma i2l_l2i : forall l, length l = size -> i2l (l2i l) = l. Proof. repeat (destruct l as [ |? l]; [intros; discriminate | ]). @@ -596,9 +596,9 @@ Section Basics. intros _; compute; auto. Qed. - Fixpoint cstlist (A:Type)(a:A) n := - match n with - | O => nil + Fixpoint cstlist (A:Type)(a:A) n := + match n with + | O => nil | S n => a::cstlist _ a n end. @@ -612,7 +612,7 @@ Section Basics. induction (i2l x); simpl; f_equal; auto. rewrite H0; clear H0. reflexivity. - + intros. rewrite nshiftl_S. unfold shiftl; rewrite i2l_sneakl. @@ -657,10 +657,10 @@ Section Basics. f_equal; auto. Qed. - (** This equivalence allows to prove easily the following delicate + (** This equivalence allows to prove easily the following delicate result *) - Lemma EqShiftL_twice_plus_one : forall k x y, + Lemma EqShiftL_twice_plus_one : forall k x y, EqShiftL k (twice_plus_one x) (twice_plus_one y) <-> EqShiftL (S k) x y. Proof. intros. @@ -683,7 +683,7 @@ Section Basics. subst lx n; rewrite i2l_length; omega. Qed. - Lemma EqShiftL_shiftr : forall k x y, EqShiftL k x y -> + Lemma EqShiftL_shiftr : forall k x y, EqShiftL k x y -> EqShiftL (S k) (shiftr x) (shiftr y). Proof. intros. @@ -704,41 +704,41 @@ Section Basics. omega. Qed. - Lemma EqShiftL_incrbis : forall n k x y, n<=size -> + Lemma EqShiftL_incrbis : forall n k x y, n<=size -> (n+k=S size)%nat -> - EqShiftL k x y -> + EqShiftL k x y -> EqShiftL k (incrbis_aux n x) (incrbis_aux n y). Proof. induction n; simpl; intros. red; auto. - destruct (eq_nat_dec k size). + destruct (eq_nat_dec k size). subst k; apply EqShiftL_size; auto. - unfold incrbis_aux; simpl; + unfold incrbis_aux; simpl; fold (incrbis_aux n (shiftr x)); fold (incrbis_aux n (shiftr y)). rewrite (EqShiftL_firstr k x y); auto; try omega. case_eq (firstr y); intros. rewrite EqShiftL_twice_plus_one. apply EqShiftL_shiftr; auto. - + rewrite EqShiftL_twice. apply IHn; try omega. apply EqShiftL_shiftr; auto. Qed. - Lemma EqShiftL_incr : forall x y, + Lemma EqShiftL_incr : forall x y, EqShiftL 1 x y -> EqShiftL 1 (incr x) (incr y). Proof. intros. rewrite <- 2 incrbis_aux_equiv. apply EqShiftL_incrbis; auto. Qed. - + End EqShiftL. (** * More equations about [incr] *) - Lemma incr_twice_plus_one : + Lemma incr_twice_plus_one : forall x, incr (twice_plus_one x) = twice (incr x). Proof. intros. @@ -757,7 +757,7 @@ Section Basics. destruct (incr (shiftr x)); simpl; discriminate. Qed. - Lemma incr_inv : forall x y, + Lemma incr_inv : forall x y, incr x = twice_plus_one y -> x = twice y. Proof. intros. @@ -777,7 +777,7 @@ Section Basics. (** First, recursive equations *) - Lemma phi_inv_double_plus_one : forall z, + Lemma phi_inv_double_plus_one : forall z, phi_inv (Zdouble_plus_one z) = twice_plus_one (phi_inv z). Proof. destruct z; simpl; auto. @@ -789,14 +789,14 @@ Section Basics. auto. Qed. - Lemma phi_inv_double : forall z, + Lemma phi_inv_double : forall z, phi_inv (Zdouble z) = twice (phi_inv z). Proof. destruct z; simpl; auto. rewrite incr_twice_plus_one; auto. Qed. - Lemma phi_inv_incr : forall z, + Lemma phi_inv_incr : forall z, phi_inv (Zsucc z) = incr (phi_inv z). Proof. destruct z. @@ -816,19 +816,19 @@ Section Basics. rewrite incr_twice_plus_one; auto. Qed. - (** [phi_inv o inv], the always-exact and easy-to-prove trip : + (** [phi_inv o inv], the always-exact and easy-to-prove trip : from int31 to Z and then back to int31. *) - Lemma phi_inv_phi_aux : - forall n x, n <= size -> - phi_inv (phibis_aux n (nshiftr (size-n) x)) = + Lemma phi_inv_phi_aux : + forall n x, n <= size -> + phi_inv (phibis_aux n (nshiftr (size-n) x)) = nshiftr (size-n) x. Proof. induction n. intros; simpl. rewrite nshiftr_size; auto. intros. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux n (shiftr (nshiftr (size-S n) x))). assert (shiftr (nshiftr (size - S n) x) = nshiftr (size-n) x). replace (size - n)%nat with (S (size - (S n))); auto; omega. @@ -863,10 +863,10 @@ Section Basics. (** * [positive_to_int31] *) - (** A variant of [p2i] with [twice] and [twice_plus_one] instead of + (** A variant of [p2i] with [twice] and [twice_plus_one] instead of [2*i] and [2*i+1] *) - Fixpoint p2ibis n p : (N*int31)%type := + Fixpoint p2ibis n p : (N*int31)%type := match n with | O => (Npos p, On) | S n => match p with @@ -876,7 +876,7 @@ Section Basics. end end. - Lemma p2ibis_bounded : forall n p, + Lemma p2ibis_bounded : forall n p, nshiftr n (snd (p2ibis n p)) = 0. Proof. induction n. @@ -906,20 +906,20 @@ Section Basics. replace (shiftr In) with 0; auto. apply nshiftr_n_0. Qed. - + Lemma p2ibis_spec : forall n p, n<=size -> - Zpos p = ((Z_of_N (fst (p2ibis n p)))*2^(Z_of_nat n) + + Zpos p = ((Z_of_N (fst (p2ibis n p)))*2^(Z_of_nat n) + phi (snd (p2ibis n p)))%Z. Proof. induction n; intros. simpl; rewrite Pmult_1_r; auto. - replace (2^(Z_of_nat (S n)))%Z with (2*2^(Z_of_nat n))%Z by - (rewrite <- Zpower_Zsucc, <- Zpos_P_of_succ_nat; + replace (2^(Z_of_nat (S n)))%Z with (2*2^(Z_of_nat n))%Z by + (rewrite <- Zpower_Zsucc, <- Zpos_P_of_succ_nat; auto with zarith). rewrite (Zmult_comm 2). assert (n<=size) by omega. - destruct p; simpl; [ | | auto]; - specialize (IHn p H0); + destruct p; simpl; [ | | auto]; + specialize (IHn p H0); generalize (p2ibis_bounded n p); destruct (p2ibis n p) as (r,i); simpl in *; intros. @@ -937,25 +937,25 @@ Section Basics. (** We now prove that this [p2ibis] is related to [phi_inv_positive] *) - Lemma phi_inv_positive_p2ibis : forall n p, (n<=size)%nat -> + Lemma phi_inv_positive_p2ibis : forall n p, (n<=size)%nat -> EqShiftL (size-n) (phi_inv_positive p) (snd (p2ibis n p)). Proof. induction n. intros. apply EqShiftL_size; auto. intros. - simpl p2ibis; destruct p; [ | | red; auto]; - specialize IHn with p; - destruct (p2ibis n p); simpl snd in *; simpl phi_inv_positive; - rewrite ?EqShiftL_twice_plus_one, ?EqShiftL_twice; - replace (S (size - S n))%nat with (size - n)%nat by omega; + simpl p2ibis; destruct p; [ | | red; auto]; + specialize IHn with p; + destruct (p2ibis n p); simpl snd in *; simpl phi_inv_positive; + rewrite ?EqShiftL_twice_plus_one, ?EqShiftL_twice; + replace (S (size - S n))%nat with (size - n)%nat by omega; apply IHn; omega. Qed. (** This gives the expected result about [phi o phi_inv], at least for the positive case. *) - Lemma phi_phi_inv_positive : forall p, + Lemma phi_phi_inv_positive : forall p, phi (phi_inv_positive p) = (Zpos p) mod (2^(Z_of_nat size)). Proof. intros. @@ -975,12 +975,12 @@ Section Basics. Lemma double_twice_firstl : forall x, firstl x = D0 -> Twon*x = twice x. Proof. - intros. + intros. unfold mul31. rewrite <- Zdouble_mult, <- phi_twice_firstl, phi_inv_phi; auto. Qed. - Lemma double_twice_plus_one_firstl : forall x, firstl x = D0 -> + Lemma double_twice_plus_one_firstl : forall x, firstl x = D0 -> Twon*x+In = twice_plus_one x. Proof. intros. @@ -989,14 +989,14 @@ Section Basics. rewrite phi_twice_firstl, <- Zdouble_plus_one_mult, <- phi_twice_plus_one_firstl, phi_inv_phi; auto. Qed. - - Lemma p2i_p2ibis : forall n p, (n<=size)%nat -> + + Lemma p2i_p2ibis : forall n p, (n<=size)%nat -> p2i n p = p2ibis n p. Proof. induction n; simpl; auto; intros. - destruct p; auto; specialize IHn with p; - generalize (p2ibis_bounded n p); - rewrite IHn; try omega; destruct (p2ibis n p); simpl; intros; + destruct p; auto; specialize IHn with p; + generalize (p2ibis_bounded n p); + rewrite IHn; try omega; destruct (p2ibis n p); simpl; intros; f_equal; auto. apply double_twice_plus_one_firstl. apply (nshiftr_0_firstl n); auto; omega. @@ -1004,7 +1004,7 @@ Section Basics. apply (nshiftr_0_firstl n); auto; omega. Qed. - Lemma positive_to_int31_phi_inv_positive : forall p, + Lemma positive_to_int31_phi_inv_positive : forall p, snd (positive_to_int31 p) = phi_inv_positive p. Proof. intros; unfold positive_to_int31. @@ -1014,8 +1014,8 @@ Section Basics. apply (phi_inv_positive_p2ibis size); auto. Qed. - Lemma positive_to_int31_spec : forall p, - Zpos p = ((Z_of_N (fst (positive_to_int31 p)))*2^(Z_of_nat size) + + Lemma positive_to_int31_spec : forall p, + Zpos p = ((Z_of_N (fst (positive_to_int31 p)))*2^(Z_of_nat size) + phi (snd (positive_to_int31 p)))%Z. Proof. unfold positive_to_int31. @@ -1023,11 +1023,11 @@ Section Basics. apply p2ibis_spec; auto. Qed. - (** Thanks to the result about [phi o phi_inv_positive], we can - now establish easily the most general results about + (** Thanks to the result about [phi o phi_inv_positive], we can + now establish easily the most general results about [phi o twice] and so one. *) - - Lemma phi_twice : forall x, + + Lemma phi_twice : forall x, phi (twice x) = (Zdouble (phi x)) mod 2^(Z_of_nat size). Proof. intros. @@ -1041,7 +1041,7 @@ Section Basics. compute in H; elim H; auto. Qed. - Lemma phi_twice_plus_one : forall x, + Lemma phi_twice_plus_one : forall x, phi (twice_plus_one x) = (Zdouble_plus_one (phi x)) mod 2^(Z_of_nat size). Proof. intros. @@ -1055,14 +1055,14 @@ Section Basics. compute in H; elim H; auto. Qed. - Lemma phi_incr : forall x, + Lemma phi_incr : forall x, phi (incr x) = (Zsucc (phi x)) mod 2^(Z_of_nat size). Proof. intros. pattern x at 1; rewrite <- (phi_inv_phi x). rewrite <- phi_inv_incr. assert (0 <= Zsucc (phi x))%Z. - change (Zsucc (phi x)) with ((phi x)+1)%Z; + change (Zsucc (phi x)) with ((phi x)+1)%Z; generalize (phi_bounded x); omega. destruct (Zsucc (phi x)). simpl; auto. @@ -1070,10 +1070,10 @@ Section Basics. compute in H; elim H; auto. Qed. - (** With the previous results, we can deal with [phi o phi_inv] even + (** With the previous results, we can deal with [phi o phi_inv] even in the negative case *) - Lemma phi_phi_inv_negative : + Lemma phi_phi_inv_negative : forall p, phi (incr (complement_negative p)) = (Zneg p) mod 2^(Z_of_nat size). Proof. induction p. @@ -1091,11 +1091,11 @@ Section Basics. rewrite incr_twice_plus_one, phi_twice. remember (phi (incr (complement_negative p))) as q. rewrite Zdouble_mult, IHp, Zmult_mod_idemp_r; auto with zarith. - + simpl; auto. Qed. - Lemma phi_phi_inv : + Lemma phi_phi_inv : forall z, phi (phi_inv z) = z mod 2 ^ (Z_of_nat size). Proof. destruct z. @@ -1120,7 +1120,7 @@ Let w_pos_mod p i := end. (** Parity test *) -Let w_iseven i := +Let w_iseven i := let (_,r) := i/2 in match r ?= 0 with Eq => true | _ => false end. @@ -1181,14 +1181,14 @@ Definition int31_op := (mk_znz_op End Int31_Op. Section Int31_Spec. - + Open Local Scope Z_scope. Notation "[| x |]" := (phi x) (at level 0, x at level 99). Notation Local wB := (2 ^ (Z_of_nat size)). - - Lemma wB_pos : wB > 0. + + Lemma wB_pos : wB > 0. Proof. auto with zarith. Qed. @@ -1216,12 +1216,12 @@ Section Int31_Spec. Proof. reflexivity. Qed. - + Lemma spec_1 : [| 1 |] = 1. Proof. reflexivity. Qed. - + Lemma spec_Bm1 : [| Tn |] = wB - 1. Proof. reflexivity. @@ -1252,16 +1252,16 @@ Section Int31_Spec. destruct (Z_lt_le_dec (X+Y) wB). contradict H1; auto using Zmod_small with zarith. rewrite <- (Z_mod_plus_full (X+Y) (-1) wB). - rewrite Zmod_small; romega. + rewrite Zmod_small; romega. generalize (Zcompare_Eq_eq ((X+Y) mod wB) (X+Y)); intros Heq. - destruct Zcompare; intros; + destruct Zcompare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. Lemma spec_succ_c : forall x, [+|add31c x 1|] = [|x|] + 1. Proof. - intros; apply spec_add_c. + intros; apply spec_add_c. Qed. Lemma spec_add_carry_c : forall x y, [+|add31carryc x y|] = [|x|] + [|y|] + 1. @@ -1279,7 +1279,7 @@ Section Int31_Spec. rewrite Zmod_small; romega. generalize (Zcompare_Eq_eq ((X+Y+1) mod wB) (X+Y+1)); intros Heq. - destruct Zcompare; intros; + destruct Zcompare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1304,7 +1304,7 @@ Section Int31_Spec. (** Substraction *) Lemma spec_sub_c : forall x y, [-|sub31c x y|] = [|x|] - [|y|]. - Proof. + Proof. unfold sub31c, sub31, interp_carry; intros. rewrite phi_phi_inv. generalize (phi_bounded x)(phi_bounded y); intros. @@ -1337,7 +1337,7 @@ Section Int31_Spec. contradict H1; apply Zmod_small; romega. generalize (Zcompare_Eq_eq ((X-Y-1) mod wB) (X-Y-1)); intros Heq. - destruct Zcompare; intros; + destruct Zcompare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1355,7 +1355,7 @@ Section Int31_Spec. Qed. Lemma spec_opp_c : forall x, [-|sub31c 0 x|] = -[|x|]. - Proof. + Proof. intros; apply spec_sub_c. Qed. @@ -1402,7 +1402,7 @@ Section Int31_Spec. change (wB*wB) with (wB^2); ring. unfold phi_inv2. - destruct x; unfold zn2z_to_Z; rewrite ?phi_phi_inv; + destruct x; unfold zn2z_to_Z; rewrite ?phi_phi_inv; change base with wB; auto. Qed. @@ -1426,7 +1426,7 @@ Section Int31_Spec. intros; apply spec_mul_c. Qed. - (** Division *) + (** Division *) Lemma spec_div21 : forall a1 a2 b, wB/2 <= [|b|] -> @@ -1537,7 +1537,7 @@ Section Int31_Spec. intros (H,_); compute in H; elim H; auto. Qed. - Lemma iter_int31_iter_nat : forall A f i a, + Lemma iter_int31_iter_nat : forall A f i a, iter_int31 i A f a = iter_nat (Zabs_nat [|i|]) A f a. Proof. intros. @@ -1548,17 +1548,17 @@ Section Int31_Spec. revert i a; induction size. simpl; auto. simpl; intros. - case_eq (firstr i); intros H; rewrite 2 IHn; + case_eq (firstr i); intros H; rewrite 2 IHn; unfold phibis_aux; simpl; rewrite H; fold (phibis_aux n (shiftr i)); - generalize (phibis_aux_pos n (shiftr i)); intros; - set (z := phibis_aux n (shiftr i)) in *; clearbody z; + generalize (phibis_aux_pos n (shiftr i)); intros; + set (z := phibis_aux n (shiftr i)) in *; clearbody z; rewrite <- iter_nat_plus. f_equal. rewrite Zdouble_mult, Zmult_comm, <- Zplus_diag_eq_mult_2. symmetry; apply Zabs_nat_Zplus; auto with zarith. - change (iter_nat (S (Zabs_nat z + Zabs_nat z)) A f a = + change (iter_nat (S (Zabs_nat z + Zabs_nat z)) A f a = iter_nat (Zabs_nat (Zdouble_plus_one z)) A f a); f_equal. rewrite Zdouble_plus_one_mult, Zmult_comm, <- Zplus_diag_eq_mult_2. rewrite Zabs_nat_Zplus; auto with zarith. @@ -1566,13 +1566,13 @@ Section Int31_Spec. change (Zabs_nat 1) with 1%nat; omega. Qed. - Fixpoint addmuldiv31_alt n i j := - match n with - | O => i + Fixpoint addmuldiv31_alt n i j := + match n with + | O => i | S n => addmuldiv31_alt n (sneakl (firstl j) i) (shiftl j) end. - Lemma addmuldiv31_equiv : forall p x y, + Lemma addmuldiv31_equiv : forall p x y, addmuldiv31 p x y = addmuldiv31_alt (Zabs_nat [|p|]) x y. Proof. intros. @@ -1588,7 +1588,7 @@ Section Int31_Spec. Qed. Lemma spec_add_mul_div : forall x y p, [|p|] <= Zpos 31 -> - [| addmuldiv31 p x y |] = + [| addmuldiv31 p x y |] = ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos 31) - [|p|]))) mod wB. Proof. intros. @@ -1626,7 +1626,7 @@ Section Int31_Spec. replace (31-Z_of_nat n) with (Zsucc(31-Zsucc(Z_of_nat n))) by ring. rewrite Zpower_Zsucc, <- Zdiv_Zdiv; auto with zarith. rewrite Zmult_comm, Z_div_mult; auto with zarith. - + rewrite phi_twice_plus_one, Zdouble_plus_one_mult. rewrite phi_twice; auto. change (Zdouble [|y|]) with (2*[|y|]). @@ -1644,7 +1644,7 @@ Section Int31_Spec. unfold wB'. rewrite <- Zpower_Zsucc, <- inj_S by (auto with zarith). f_equal. rewrite H1. - replace wB with (2^(Z_of_nat n)*2^(31-Z_of_nat n)) by + replace wB with (2^(Z_of_nat n)*2^(31-Z_of_nat n)) by (rewrite <- Zpower_exp; auto with zarith; f_equal; unfold size; ring). unfold Zminus; rewrite Zopp_mult_distr_l. rewrite Z_div_plus; auto with zarith. @@ -1669,8 +1669,8 @@ Section Int31_Spec. apply Zlt_le_trans with wB; auto with zarith. apply Zpower_le_monotone; auto with zarith. intros. - case_eq ([|p|] ?= 31); intros; - [ apply H; rewrite (Zcompare_Eq_eq _ _ H0); auto with zarith | | + case_eq ([|p|] ?= 31); intros; + [ apply H; rewrite (Zcompare_Eq_eq _ _ H0); auto with zarith | | apply H; change ([|p|]>31)%Z in H0; auto with zarith ]. change ([|p|]<31) in H0. rewrite spec_add_mul_div by auto with zarith. @@ -1701,16 +1701,16 @@ Section Int31_Spec. simpl; auto. Qed. - Fixpoint head031_alt n x := - match n with + Fixpoint head031_alt n x := + match n with | O => 0%nat - | S n => match firstl x with + | S n => match firstl x with | D0 => S (head031_alt n (shiftl x)) | D1 => 0%nat end end. - Lemma head031_equiv : + Lemma head031_equiv : forall x, [|head031 x|] = Z_of_nat (head031_alt size x). Proof. intros. @@ -1720,10 +1720,10 @@ Section Int31_Spec. unfold head031, recl. change On with (phi_inv (Z_of_nat (31-size))). - replace (head031_alt size x) with + replace (head031_alt size x) with (head031_alt size x + (31 - size))%nat by (apply plus_0_r; auto). assert (size <= 31)%nat by auto with arith. - + revert x H; induction size; intros. simpl; auto. unfold recl_aux; fold recl_aux. @@ -1748,7 +1748,7 @@ Section Int31_Spec. change [|In|] with 1. replace (31-n)%nat with (S (31 - S n))%nat by omega. rewrite inj_S; ring. - + clear - H H2. rewrite (sneakr_shiftl x) in H. rewrite H2 in H. @@ -1793,7 +1793,7 @@ Section Int31_Spec. rewrite (sneakr_shiftl x), H1, H; auto. rewrite <- nshiftl_S_tail; auto. - + change (2^(Z_of_nat 0)) with 1; rewrite Zmult_1_l. generalize (phi_bounded x); unfold size; split; auto with zarith. change (2^(Z_of_nat 31)/2) with (2^(Z_of_nat (pred size))). @@ -1809,16 +1809,16 @@ Section Int31_Spec. simpl; auto. Qed. - Fixpoint tail031_alt n x := - match n with + Fixpoint tail031_alt n x := + match n with | O => 0%nat - | S n => match firstr x with + | S n => match firstr x with | D0 => S (tail031_alt n (shiftr x)) | D1 => 0%nat end end. - Lemma tail031_equiv : + Lemma tail031_equiv : forall x, [|tail031 x|] = Z_of_nat (tail031_alt size x). Proof. intros. @@ -1828,10 +1828,10 @@ Section Int31_Spec. unfold tail031, recr. change On with (phi_inv (Z_of_nat (31-size))). - replace (tail031_alt size x) with + replace (tail031_alt size x) with (tail031_alt size x + (31 - size))%nat by (apply plus_0_r; auto). assert (size <= 31)%nat by auto with arith. - + revert x H; induction size; intros. simpl; auto. unfold recr_aux; fold recr_aux. @@ -1856,7 +1856,7 @@ Section Int31_Spec. change [|In|] with 1. replace (31-n)%nat with (S (31 - S n))%nat by omega. rewrite inj_S; ring. - + clear - H H2. rewrite (sneakl_shiftr x) in H. rewrite H2 in H. @@ -1864,7 +1864,7 @@ Section Int31_Spec. rewrite (iszero_eq0 _ H0) in H; discriminate. Qed. - Lemma spec_tail0 : forall x, 0 < [|x|] -> + Lemma spec_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail031 x|]). Proof. intros. @@ -1882,23 +1882,23 @@ Section Int31_Spec. case_eq (firstr x); intros. rewrite (inj_S (tail031_alt n (shiftr x))), Zpower_Zsucc; auto with zarith. destruct (IHn (shiftr x)) as (y & Hy1 & Hy2). - + rewrite phi_nz; rewrite phi_nz in H; contradict H. rewrite (sneakl_shiftr x), H1, H; auto. rewrite <- nshiftr_S_tail; auto. - + exists y; split; auto. rewrite phi_eqn1; auto. rewrite Zdouble_mult, Hy2; ring. - + exists [|shiftr x|]. split. generalize (phi_bounded (shiftr x)); auto with zarith. rewrite phi_eqn2; auto. rewrite Zdouble_plus_one_mult; simpl; ring. Qed. - + (* Sqrt *) (* Direct transcription of an old proof @@ -1910,23 +1910,23 @@ Section Int31_Spec. intros H1; rewrite Zmod_eq_full; auto with zarith. Qed. - Lemma sqrt_main_trick j k: 0 <= j -> 0 <= k -> + Lemma sqrt_main_trick j k: 0 <= j -> 0 <= k -> (j * k) + j <= ((j + k)/2 + 1) ^ 2. Proof. - intros j k Hj; generalize Hj k; pattern j; apply natlike_ind; + intros j k Hj; generalize Hj k; pattern j; apply natlike_ind; auto; clear k j Hj. intros _ k Hk; repeat rewrite Zplus_0_l. apply Zmult_le_0_compat; generalize (Z_div_pos k 2); auto with zarith. intros j Hj Hrec _ k Hk; pattern k; apply natlike_ind; auto; clear k Hk. rewrite Zmult_0_r, Zplus_0_r, Zplus_0_l. - generalize (sqr_pos (Zsucc j / 2)) (quotient_by_2 (Zsucc j)); + generalize (sqr_pos (Zsucc j / 2)) (quotient_by_2 (Zsucc j)); unfold Zsucc. rewrite Zpower_2, Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. auto with zarith. intros k Hk _. replace ((Zsucc j + Zsucc k) / 2) with ((j + k)/2 + 1). generalize (Hrec Hj k Hk) (quotient_by_2 (j + k)). - unfold Zsucc; repeat rewrite Zpower_2; + unfold Zsucc; repeat rewrite Zpower_2; repeat rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. repeat rewrite Zmult_1_l; repeat rewrite Zmult_1_r. auto with zarith. @@ -1991,7 +1991,7 @@ Section Int31_Spec. Qed. Lemma sqrt31_step_def rec i j: - sqrt31_step rec i j = + sqrt31_step rec i j = match (fst (i/j) ?= j)%int31 with Lt => rec i (fst ((j + fst(i/j))/2))%int31 | _ => j @@ -2008,8 +2008,8 @@ Section Int31_Spec. rewrite H1; ring. Qed. - Lemma sqrt31_step_correct rec i j: - 0 < [|i|] -> 0 < [|j|] -> [|i|] < ([|j|] + 1) ^ 2 -> + Lemma sqrt31_step_correct rec i j: + 0 < [|i|] -> 0 < [|j|] -> [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < wB -> (forall j1 : int31, 0 < [|j1|] < [|j|] -> [|i|] < ([|j1|] + 1) ^ 2 -> @@ -2018,14 +2018,14 @@ Section Int31_Spec. Proof. assert (Hp2: 0 < [|2|]) by exact (refl_equal Lt). intros rec i j Hi Hj Hij H31 Hrec; rewrite sqrt31_step_def. - generalize (spec_compare (fst (i/j)%int31) j); case compare31; + generalize (spec_compare (fst (i/j)%int31) j); case compare31; rewrite div31_phi; auto; intros Hc; try (split; auto; apply sqrt_test_true; auto with zarith; fail). apply Hrec; repeat rewrite div31_phi; auto with zarith. replace [|(j + fst (i / j)%int31)|] with ([|j|] + [|i|] / [|j|]). split. case (Zle_lt_or_eq 1 [|j|]); auto with zarith; intros Hj1. - replace ([|j|] + [|i|]/[|j|]) with + replace ([|j|] + [|i|]/[|j|]) with (1 * 2 + (([|j|] - 2) + [|i|] / [|j|])); try ring. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= [|i|]/ [|j|]) by (apply Z_div_pos; auto with zarith). @@ -2048,7 +2048,7 @@ Section Int31_Spec. Lemma iter31_sqrt_correct n rec i j: 0 < [|i|] -> 0 < [|j|] -> [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < 2 ^ (Z_of_nat size) -> - (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> + (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> [|i|] < ([|j1|] + 1) ^ 2 -> 2 * [|j1|] < 2 ^ (Z_of_nat size) -> [|rec i j1|] ^ 2 <= [|i|] < ([|rec i j1|] + 1) ^ 2) -> [|iter31_sqrt n rec i j|] ^ 2 <= [|i|] < ([|iter31_sqrt n rec i j|] + 1) ^ 2. @@ -2098,7 +2098,7 @@ Section Int31_Spec. Qed. Lemma sqrt312_step_def rec ih il j: - sqrt312_step rec ih il j = + sqrt312_step rec ih il j = match (ih ?= j)%int31 with Eq => j | Gt => j @@ -2116,7 +2116,7 @@ Section Int31_Spec. simpl; case compare31; auto. Qed. - Lemma sqrt312_lower_bound ih il j: + Lemma sqrt312_lower_bound ih il j: phi2 ih il < ([|j|] + 1) ^ 2 -> [|ih|] <= [|j|]. Proof. intros ih il j H1. @@ -2140,11 +2140,11 @@ Section Int31_Spec. simpl fst; apply trans_equal with (1 := Hq); ring. Qed. - Lemma sqrt312_step_correct rec ih il j: - 2 ^ 29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> + Lemma sqrt312_step_correct rec ih il j: + 2 ^ 29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> (forall j1, 0 < [|j1|] < [|j|] -> phi2 ih il < ([|j1|] + 1) ^ 2 -> [|rec ih il j1|] ^ 2 <= phi2 ih il < ([|rec ih il j1|] + 1) ^ 2) -> - [|sqrt312_step rec ih il j|] ^ 2 <= phi2 ih il + [|sqrt312_step rec ih il j|] ^ 2 <= phi2 ih il < ([|sqrt312_step rec ih il j|] + 1) ^ 2. Proof. assert (Hp2: (0 < [|2|])%Z) by exact (refl_equal Lt). @@ -2174,7 +2174,7 @@ Section Int31_Spec. case (Zle_lt_or_eq 1 ([|j|])); auto with zarith; intros Hf2. 2: contradict Hc; apply Zle_not_lt; rewrite <- Hf2, Zdiv_1_r; auto with zarith. assert (Hf3: 0 < ([|j|] + phi2 ih il / [|j|]) / 2). - replace ([|j|] + phi2 ih il/ [|j|])%Z with + replace ([|j|] + phi2 ih il/ [|j|])%Z with (1 * 2 + (([|j|] - 2) + phi2 ih il / [|j|])); try ring. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= ([|j|] - 2 + phi2 ih il / [|j|]) / 2) ; auto with zarith. @@ -2213,7 +2213,7 @@ Section Int31_Spec. rewrite div31_phi; change (phi 2) with 2%Z; auto. change (2 ^Z_of_nat size) with (base/2 + phi v30). assert (phi r / 2 < base/2); auto with zarith. - apply Zmult_gt_0_lt_reg_r with 2; auto with zarith. + apply Zmult_gt_0_lt_reg_r with 2; auto with zarith. change (base/2 * 2) with base. apply Zle_lt_trans with (phi r). rewrite Zmult_comm; apply Z_mult_div_ge; auto with zarith. @@ -2234,12 +2234,12 @@ Section Int31_Spec. apply Zge_le; apply Z_div_ge; auto with zarith. Qed. - Lemma iter312_sqrt_correct n rec ih il j: - 2^29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> - (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> - phi2 ih il < ([|j1|] + 1) ^ 2 -> + Lemma iter312_sqrt_correct n rec ih il j: + 2^29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> + (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> + phi2 ih il < ([|j1|] + 1) ^ 2 -> [|rec ih il j1|] ^ 2 <= phi2 ih il < ([|rec ih il j1|] + 1) ^ 2) -> - [|iter312_sqrt n rec ih il j|] ^ 2 <= phi2 ih il + [|iter312_sqrt n rec ih il j|] ^ 2 <= phi2 ih il < ([|iter312_sqrt n rec ih il j|] + 1) ^ 2. Proof. intros n; elim n; unfold iter312_sqrt; fold iter312_sqrt; clear n. @@ -2265,7 +2265,7 @@ Section Int31_Spec. Proof. intros ih il Hih; unfold sqrt312. change [||WW ih il||] with (phi2 ih il). - assert (Hbin: forall s, s * s + 2* s + 1 = (s + 1) ^ 2) by + assert (Hbin: forall s, s * s + 2* s + 1 = (s + 1) ^ 2) by (intros s; ring). assert (Hb: 0 <= base) by (red; intros HH; discriminate). assert (Hi2: phi2 ih il < (phi Tn + 1) ^ 2). @@ -2428,9 +2428,9 @@ Section Int31_Spec. apply Zcompare_Eq_eq. now destruct ([|x|] ?= 0). Qed. - + (* Even *) - + Let w_is_even := int31_op.(znz_is_even). Lemma spec_is_even : forall x, @@ -2460,13 +2460,13 @@ Section Int31_Spec. exact spec_more_than_1_digit. exact spec_0. - exact spec_1. + exact spec_1. exact spec_Bm1. exact spec_compare. exact spec_eq0. - exact spec_opp_c. + exact spec_opp_c. exact spec_opp. exact spec_opp_carry. @@ -2500,7 +2500,7 @@ Section Int31_Spec. exact spec_head00. exact spec_head0. - exact spec_tail00. + exact spec_tail00. exact spec_tail0. exact spec_add_mul_div. diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v index 12c0cc264..1168e7fd6 100644 --- a/theories/Numbers/Cyclic/Int31/Int31.v +++ b/theories/Numbers/Cyclic/Int31/Int31.v @@ -17,7 +17,7 @@ Require Export DoubleType. Unset Boxed Definitions. -(** * 31-bit integers *) +(** * 31-bit integers *) (** This file contains basic definitions of a 31-bit integer arithmetic. In fact it is more general than that. The only reason @@ -36,8 +36,8 @@ Definition size := 31%nat. Inductive digits : Type := D0 | D1. (** The type of 31-bit integers *) - -(** The type [int31] has a unique constructor [I31] that expects + +(** The type [int31] has a unique constructor [I31] that expects 31 arguments of type [digits]. *) Inductive int31 : Type := I31 : nfun digits size int31. @@ -69,26 +69,26 @@ Definition Twon : int31 := Eval compute in (napply_cst _ _ D0 (size-2) I31) D1 D (** * Bits manipulation *) -(** [sneakr b x] shifts [x] to the right by one bit. +(** [sneakr b x] shifts [x] to the right by one bit. Rightmost digit is lost while leftmost digit becomes [b]. - Pseudo-code is + Pseudo-code is [ match x with (I31 d0 ... dN) => I31 b d0 ... d(N-1) end ] *) Definition sneakr : digits -> int31 -> int31 := Eval compute in fun b => int31_rect _ (napply_except_last _ _ (size-1) (I31 b)). -(** [sneakl b x] shifts [x] to the left by one bit. +(** [sneakl b x] shifts [x] to the left by one bit. Leftmost digit is lost while rightmost digit becomes [b]. - Pseudo-code is + Pseudo-code is [ match x with (I31 d0 ... dN) => I31 d1 ... dN b end ] *) -Definition sneakl : digits -> int31 -> int31 := Eval compute in +Definition sneakl : digits -> int31 -> int31 := Eval compute in fun b => int31_rect _ (fun _ => napply_then_last _ _ b (size-1) I31). -(** [shiftl], [shiftr], [twice] and [twice_plus_one] are direct +(** [shiftl], [shiftr], [twice] and [twice_plus_one] are direct consequences of [sneakl] and [sneakr]. *) Definition shiftl := sneakl D0. @@ -96,31 +96,31 @@ Definition shiftr := sneakr D0. Definition twice := sneakl D0. Definition twice_plus_one := sneakl D1. -(** [firstl x] returns the leftmost digit of number [x]. +(** [firstl x] returns the leftmost digit of number [x]. Pseudo-code is [ match x with (I31 d0 ... dN) => d0 end ] *) -Definition firstl : int31 -> digits := Eval compute in +Definition firstl : int31 -> digits := Eval compute in int31_rect _ (fun d => napply_discard _ _ d (size-1)). -(** [firstr x] returns the rightmost digit of number [x]. +(** [firstr x] returns the rightmost digit of number [x]. Pseudo-code is [ match x with (I31 d0 ... dN) => dN end ] *) -Definition firstr : int31 -> digits := Eval compute in +Definition firstr : int31 -> digits := Eval compute in int31_rect _ (napply_discard _ _ (fun d=>d) (size-1)). -(** [iszero x] is true iff [x = I31 D0 ... D0]. Pseudo-code is +(** [iszero x] is true iff [x = I31 D0 ... D0]. Pseudo-code is [ match x with (I31 D0 ... D0) => true | _ => false end ] *) -Definition iszero : int31 -> bool := Eval compute in - let f d b := match d with D0 => b | D1 => false end +Definition iszero : int31 -> bool := Eval compute in + let f d b := match d with D0 => b | D1 => false end in int31_rect _ (nfold_bis _ _ f true size). -(* NB: DO NOT transform the above match in a nicer (if then else). +(* NB: DO NOT transform the above match in a nicer (if then else). It seems to work, but later "unfold iszero" takes forever. *) -(** [base] is [2^31], obtained via iterations of [Zdouble]. - It can also be seen as the smallest b > 0 s.t. phi_inv b = 0 +(** [base] is [2^31], obtained via iterations of [Zdouble]. + It can also be seen as the smallest b > 0 s.t. phi_inv b = 0 (see below) *) Definition base := Eval compute in @@ -140,7 +140,7 @@ Fixpoint recl_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) caserec (firstl i) si (recl_aux next A case0 caserec si) end. -Fixpoint recr_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) +Fixpoint recr_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) (i:int31) : A := match n with | O => case0 @@ -159,22 +159,22 @@ Definition recr := recr_aux size. (** From int31 to Z, we simply iterates [Zdouble] or [Zdouble_plus_one]. *) -Definition phi : int31 -> Z := +Definition phi : int31 -> Z := recr Z (0%Z) (fun b _ => match b with D0 => Zdouble | D1 => Zdouble_plus_one end). -(** From positive to int31. An abstract definition could be : - [ phi_inv (2n) = 2*(phi_inv n) /\ +(** From positive to int31. An abstract definition could be : + [ phi_inv (2n) = 2*(phi_inv n) /\ phi_inv 2n+1 = 2*(phi_inv n) + 1 ] *) -Fixpoint phi_inv_positive p := +Fixpoint phi_inv_positive p := match p with | xI q => twice_plus_one (phi_inv_positive q) | xO q => twice (phi_inv_positive q) | xH => In end. -(** The negative part : 2-complement *) +(** The negative part : 2-complement *) Fixpoint complement_negative p := match p with @@ -186,9 +186,9 @@ Fixpoint complement_negative p := (** A simple incrementation function *) Definition incr : int31 -> int31 := - recr int31 In - (fun b si rec => match b with - | D0 => sneakl D1 si + recr int31 In + (fun b si rec => match b with + | D0 => sneakl D1 si | D1 => sneakl D0 rec end). (** We can now define the conversion from Z to int31. *) @@ -196,11 +196,11 @@ Definition incr : int31 -> int31 := Definition phi_inv : Z -> int31 := fun n => match n with | Z0 => On - | Zpos p => phi_inv_positive p + | Zpos p => phi_inv_positive p | Zneg p => incr (complement_negative p) end. -(** [phi_inv2] is similar to [phi_inv] but returns a double word +(** [phi_inv2] is similar to [phi_inv] but returns a double word [zn2z int31] *) Definition phi_inv2 n := @@ -211,7 +211,7 @@ Definition phi_inv2 n := (** [phi2] is similar to [phi] but takes a double word (two args) *) -Definition phi2 nh nl := +Definition phi2 nh nl := ((phi nh)*base+(phi nl))%Z. (** * Addition *) @@ -227,11 +227,11 @@ Notation "n + m" := (add31 n m) : int31_scope. (* mode, (phi n)+(phi m) is computed twice*) (* it may be considered to optimize it *) -Definition add31c (n m : int31) := +Definition add31c (n m : int31) := let npm := n+m in - match (phi npm ?= (phi n)+(phi m))%Z with - | Eq => C0 npm - | _ => C1 npm + match (phi npm ?= (phi n)+(phi m))%Z with + | Eq => C0 npm + | _ => C1 npm end. Notation "n '+c' m" := (add31c n m) (at level 50, no associativity) : int31_scope. @@ -254,7 +254,7 @@ Notation "n - m" := (sub31 n m) : int31_scope. (** Subtraction with carry (thus exact) *) -Definition sub31c (n m : int31) := +Definition sub31c (n m : int31) := let nmm := n-m in match (phi nmm ?= (phi n)-(phi m))%Z with | Eq => C0 nmm @@ -290,13 +290,13 @@ Notation "n '*c' m" := (mul31c n m) (at level 40, no associativity) : int31_scop (** Division of a double size word modulo [2^31] *) -Definition div3121 (nh nl m : int31) := +Definition div3121 (nh nl m : int31) := let (q,r) := Zdiv_eucl (phi2 nh nl) (phi m) in (phi_inv q, phi_inv r). (** Division modulo [2^31] *) -Definition div31 (n m : int31) := +Definition div31 (n m : int31) := let (q,r) := Zdiv_eucl (phi n) (phi m) in (phi_inv q, phi_inv r). Notation "n / m" := (div31 n m) : int31_scope. @@ -308,12 +308,12 @@ Definition compare31 (n m : int31) := ((phi n)?=(phi m))%Z. Notation "n ?= m" := (compare31 n m) (at level 70, no associativity) : int31_scope. -(** Computing the [i]-th iterate of a function: +(** Computing the [i]-th iterate of a function: [iter_int31 i A f = f^i] *) Definition iter_int31 i A f := - recr (A->A) (fun x => x) - (fun b si rec => match b with + recr (A->A) (fun x => x) + (fun b si rec => match b with | D0 => fun x => rec (rec x) | D1 => fun x => f (rec (rec x)) end) @@ -322,9 +322,9 @@ Definition iter_int31 i A f := (** Combining the [(31-p)] low bits of [i] above the [p] high bits of [j]: [addmuldiv31 p i j = i*2^p+j/2^(31-p)] (modulo [2^31]) *) -Definition addmuldiv31 p i j := - let (res, _ ) := - iter_int31 p (int31*int31) +Definition addmuldiv31 p i j := + let (res, _ ) := + iter_int31 p (int31*int31) (fun ij => let (i,j) := ij in (sneakl (firstl j) i, shiftl j)) (i,j) in @@ -346,7 +346,7 @@ Register addmuldiv31 as int31 addmuldiv in "coq_int31" by True. Definition gcd31 (i j:int31) := (fix euler (guard:nat) (i j:int31) {struct guard} := - match guard with + match guard with | O => In | S p => match j ?= On with | Eq => i @@ -370,17 +370,17 @@ Eval lazy delta [Twon] in | _ => j end. -Fixpoint iter31_sqrt (n: nat) (rec: int31 -> int31 -> int31) +Fixpoint iter31_sqrt (n: nat) (rec: int31 -> int31 -> int31) (i j: int31) {struct n} : int31 := - sqrt31_step + sqrt31_step (match n with O => rec | S n => (iter31_sqrt n (iter31_sqrt n rec)) end) i j. -Definition sqrt31 i := +Definition sqrt31 i := Eval lazy delta [On In Twon] in - match compare31 In i with + match compare31 In i with Gt => On | Eq => In | Lt => iter31_sqrt 31 (fun i j => j) i (fst (i/Twon)) @@ -388,7 +388,7 @@ Eval lazy delta [On In Twon] in Definition v30 := Eval compute in (addmuldiv31 (phi_inv (Z_of_nat size - 1)) In On). -Definition sqrt312_step (rec: int31 -> int31 -> int31 -> int31) +Definition sqrt312_step (rec: int31 -> int31 -> int31 -> int31) (ih il j: int31) := Eval lazy delta [Twon v30] in match ih ?= j with Eq => j | Gt => j | _ => @@ -401,28 +401,28 @@ Eval lazy delta [Twon v30] in | _ => j end end. -Fixpoint iter312_sqrt (n: nat) - (rec: int31 -> int31 -> int31 -> int31) +Fixpoint iter312_sqrt (n: nat) + (rec: int31 -> int31 -> int31 -> int31) (ih il j: int31) {struct n} : int31 := - sqrt312_step + sqrt312_step (match n with O => rec | S n => (iter312_sqrt n (iter312_sqrt n rec)) end) ih il j. -Definition sqrt312 ih il := +Definition sqrt312 ih il := Eval lazy delta [On In] in let s := iter312_sqrt 31 (fun ih il j => j) ih il Tn in match s *c s with W0 => (On, C0 On) (* impossible *) | WW ih1 il1 => match il -c il1 with - C0 il2 => + C0 il2 => match ih ?= ih1 with Gt => (s, C1 il2) | _ => (s, C0 il2) end - | C1 il2 => + | C1 il2 => match (ih - In) ?= ih1 with (* we could parametrize ih - 1 *) Gt => (s, C1 il2) | _ => (s, C0 il2) @@ -431,7 +431,7 @@ Eval lazy delta [On In] in end. -Fixpoint p2i n p : (N*int31)%type := +Fixpoint p2i n p : (N*int31)%type := match n with | O => (Npos p, On) | S n => match p with @@ -444,26 +444,26 @@ Fixpoint p2i n p : (N*int31)%type := Definition positive_to_int31 (p:positive) := p2i size p. (** Constant 31 converted into type int31. - It is used as default answer for numbers of zeros + It is used as default answer for numbers of zeros in [head0] and [tail0] *) Definition T31 : int31 := Eval compute in phi_inv (Z_of_nat size). Definition head031 (i:int31) := - recl _ (fun _ => T31) - (fun b si rec n => match b with + recl _ (fun _ => T31) + (fun b si rec n => match b with | D0 => rec (add31 n In) | D1 => n end) i On. Definition tail031 (i:int31) := - recr _ (fun _ => T31) - (fun b si rec n => match b with + recr _ (fun _ => T31) + (fun b si rec n => match b with | D0 => rec (add31 n In) | D1 => n end) i On. Register head031 as int31 head0 in "coq_int31" by True. -Register tail031 as int31 tail0 in "coq_int31" by True. +Register tail031 as int31 tail0 in "coq_int31" by True. diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v index 7373acc9a..1b1283400 100644 --- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v +++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v @@ -8,11 +8,11 @@ (* $Id$ *) -(** * Type [Z] viewed modulo a particular constant corresponds to [Z/nZ] +(** * Type [Z] viewed modulo a particular constant corresponds to [Z/nZ] as defined abstractly in CyclicAxioms. *) -(** Even if the construction provided here is not reused for building - the efficient arbitrary precision numbers, it provides a simple +(** Even if the construction provided here is not reused for building + the efficient arbitrary precision numbers, it provides a simple implementation of CyclicAxioms, hence ensuring its coherence. *) Set Implicit Arguments. @@ -56,9 +56,9 @@ Section ZModulo. destruct 1; auto. Qed. Let digits_gt_1 := spec_more_than_1_digit. - + Lemma wB_pos : wB > 0. - Proof. + Proof. unfold wB, base; auto with zarith. Qed. Hint Resolve wB_pos. @@ -79,7 +79,7 @@ Section ZModulo. auto. Qed. - Definition znz_of_pos x := + Definition znz_of_pos x := let (q,r) := Zdiv_eucl_POS x wB in (N_of_Z q, r). Lemma spec_of_pos : forall p, @@ -90,10 +90,10 @@ Section ZModulo. destruct (Zdiv_eucl_POS p wB); simpl; destruct 1. unfold znz_to_Z; rewrite Zmod_small; auto. assert (0 <= z). - replace z with (Zpos p / wB) by + replace z with (Zpos p / wB) by (symmetry; apply Zdiv_unique with z0; auto). apply Z_div_pos; auto with zarith. - replace (Z_of_N (N_of_Z z)) with z by + replace (Z_of_N (N_of_Z z)) with z by (destruct z; simpl; auto; elim H1; auto). rewrite Zmult_comm; auto. Qed. @@ -110,7 +110,7 @@ Section ZModulo. Definition znz_0 := 0. Definition znz_1 := 1. Definition znz_Bm1 := wB - 1. - + Lemma spec_0 : [|znz_0|] = 0. Proof. unfold znz_to_Z, znz_0. @@ -121,7 +121,7 @@ Section ZModulo. Proof. unfold znz_to_Z, znz_1. apply Zmod_small; split; auto with zarith. - unfold wB, base. + unfold wB, base. apply Zlt_trans with (Zpos digits); auto. apply Zpower2_lt_lin; auto with zarith. Qed. @@ -138,7 +138,7 @@ Section ZModulo. Definition znz_compare x y := Zcompare [|x|] [|y|]. - Lemma spec_compare : forall x y, + Lemma spec_compare : forall x y, match znz_compare x y with | Eq => [|x|] = [|y|] | Lt => [|x|] < [|y|] @@ -150,19 +150,19 @@ Section ZModulo. intros; apply Zcompare_Eq_eq; auto. Qed. - Definition znz_eq0 x := + Definition znz_eq0 x := match [|x|] with Z0 => true | _ => false end. - + Lemma spec_eq0 : forall x, znz_eq0 x = true -> [|x|] = 0. Proof. unfold znz_eq0; intros; now destruct [|x|]. Qed. - Definition znz_opp_c x := + Definition znz_opp_c x := if znz_eq0 x then C0 0 else C1 (- x). Definition znz_opp x := - x. Definition znz_opp_carry x := - x - 1. - + Lemma spec_opp_c : forall x, [-|znz_opp_c x|] = -[|x|]. Proof. intros; unfold znz_opp_c, znz_to_Z; auto. @@ -180,7 +180,7 @@ Section ZModulo. change ((- x) mod wB = (0 - (x mod wB)) mod wB). rewrite Zminus_mod_idemp_r; simpl; auto. Qed. - + Lemma spec_opp_carry : forall x, [|znz_opp_carry x|] = wB - [|x|] - 1. Proof. intros; unfold znz_opp_carry, znz_to_Z; auto. @@ -194,15 +194,15 @@ Section ZModulo. generalize (Z_mod_lt x wB wB_pos); omega. Qed. - Definition znz_succ_c x := - let y := Zsucc x in + Definition znz_succ_c x := + let y := Zsucc x in if znz_eq0 y then C1 0 else C0 y. - Definition znz_add_c x y := - let z := [|x|] + [|y|] in + Definition znz_add_c x y := + let z := [|x|] + [|y|] in if Z_lt_le_dec z wB then C0 z else C1 (z-wB). - Definition znz_add_carry_c x y := + Definition znz_add_carry_c x y := let z := [|x|]+[|y|]+1 in if Z_lt_le_dec z wB then C0 z else C1 (z-wB). @@ -210,7 +210,7 @@ Section ZModulo. Definition znz_add := Zplus. Definition znz_add_carry x y := x + y + 1. - Lemma Zmod_equal : + Lemma Zmod_equal : forall x y z, z>0 -> (x-y) mod z = 0 -> x mod z = y mod z. Proof. intros. @@ -225,12 +225,12 @@ Section ZModulo. Proof. intros; unfold znz_succ_c, znz_to_Z, Zsucc. case_eq (znz_eq0 (x+1)); intros; unfold interp_carry. - + rewrite Zmult_1_l. replace (wB + 0 mod wB) with wB by auto with zarith. symmetry; rewrite Zeq_plus_swap. assert ((x+1) mod wB = 0) by (apply spec_eq0; auto). - replace (wB-1) with ((wB-1) mod wB) by + replace (wB-1) with ((wB-1) mod wB) by (apply Zmod_small; generalize wB_pos; omega). rewrite <- Zminus_mod_idemp_l; rewrite Z_mod_same; simpl; auto. apply Zmod_equal; auto. @@ -289,15 +289,15 @@ Section ZModulo. rewrite Zplus_mod_idemp_l; auto. Qed. - Definition znz_pred_c x := + Definition znz_pred_c x := if znz_eq0 x then C1 (wB-1) else C0 (x-1). - Definition znz_sub_c x y := - let z := [|x|]-[|y|] in + Definition znz_sub_c x y := + let z := [|x|]-[|y|] in if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z. - Definition znz_sub_carry_c x y := - let z := [|x|]-[|y|]-1 in + Definition znz_sub_carry_c x y := + let z := [|x|]-[|y|]-1 in if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z. Definition znz_pred := Zpred. @@ -323,7 +323,7 @@ Section ZModulo. Proof. intros; unfold znz_sub_c, znz_to_Z, interp_carry. destruct Z_lt_le_dec. - replace ((wB + (x mod wB - y mod wB)) mod wB) with + replace ((wB + (x mod wB - y mod wB)) mod wB) with (wB + (x mod wB - y mod wB)). omega. symmetry; apply Zmod_small. @@ -337,7 +337,7 @@ Section ZModulo. Proof. intros; unfold znz_sub_carry_c, znz_to_Z, interp_carry. destruct Z_lt_le_dec. - replace ((wB + (x mod wB - y mod wB - 1)) mod wB) with + replace ((wB + (x mod wB - y mod wB - 1)) mod wB) with (wB + (x mod wB - y mod wB -1)). omega. symmetry; apply Zmod_small. @@ -358,7 +358,7 @@ Section ZModulo. intros; unfold znz_sub, znz_to_Z; apply Zminus_mod. Qed. - Lemma spec_sub_carry : + Lemma spec_sub_carry : forall x y, [|znz_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB. Proof. intros; unfold znz_sub_carry, znz_to_Z. @@ -367,15 +367,15 @@ Section ZModulo. rewrite Zminus_mod_idemp_l. auto. Qed. - - Definition znz_mul_c x y := + + Definition znz_mul_c x y := let (h,l) := Zdiv_eucl ([|x|]*[|y|]) wB in if znz_eq0 h then if znz_eq0 l then W0 else WW h l else WW h l. Definition znz_mul := Zmult. Definition znz_square_c x := znz_mul_c x x. - + Lemma spec_mul_c : forall x y, [|| znz_mul_c x y ||] = [|x|] * [|y|]. Proof. intros; unfold znz_mul_c, zn2z_to_Z. @@ -426,7 +426,7 @@ Section ZModulo. destruct Zdiv_eucl as (q,r); destruct 1; intros. injection H1; clear H1; intros. assert ([|r|]=r). - apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; + apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; auto with zarith. assert ([|q|]=q). apply Zmod_small. @@ -453,7 +453,7 @@ Section ZModulo. Definition znz_mod x y := [|x|] mod [|y|]. Definition znz_mod_gt x y := [|x|] mod [|y|]. - + Lemma spec_mod : forall a b, 0 < [|b|] -> [|znz_mod a b|] = [|a|] mod [|b|]. Proof. @@ -469,7 +469,7 @@ Section ZModulo. Proof. intros; apply spec_mod; auto. Qed. - + Definition znz_gcd x y := Zgcd [|x|] [|y|]. Definition znz_gcd_gt x y := Zgcd [|x|] [|y|]. @@ -516,7 +516,7 @@ Section ZModulo. intros. apply spec_gcd; auto. Qed. - Definition znz_div21 a1 a2 b := + Definition znz_div21 a1 a2 b := Zdiv_eucl ([|a1|]*wB+[|a2|]) [|b|]. Lemma spec_div21 : forall a1 a2 b, @@ -537,7 +537,7 @@ Section ZModulo. destruct Zdiv_eucl as (q,r); destruct 1; intros. injection H4; clear H4; intros. assert ([|r|]=r). - apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; + apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; auto with zarith. assert ([|q|]=q). apply Zmod_small. @@ -576,7 +576,7 @@ Section ZModulo. apply Zmod_le; auto with zarith. Qed. - Definition znz_is_even x := + Definition znz_is_even x := if Z_eq_dec ([|x|] mod 2) 0 then true else false. Lemma spec_is_even : forall x, @@ -586,7 +586,7 @@ Section ZModulo. generalize (Z_mod_lt [|x|] 2); omega. Qed. - Definition znz_sqrt x := Zsqrt_plain [|x|]. + Definition znz_sqrt x := Zsqrt_plain [|x|]. Lemma spec_sqrt : forall x, [|znz_sqrt x|] ^ 2 <= [|x|] < ([|znz_sqrt x|] + 1) ^ 2. Proof. @@ -609,12 +609,12 @@ Section ZModulo. generalize wB_pos; auto with zarith. Qed. - Definition znz_sqrt2 x y := - let z := [|x|]*wB+[|y|] in - match z with + Definition znz_sqrt2 x y := + let z := [|x|]*wB+[|y|] in + match z with | Z0 => (0, C0 0) - | Zpos p => - let (s,r,_,_) := sqrtrempos p in + | Zpos p => + let (s,r,_,_) := sqrtrempos p in (s, if Z_lt_le_dec r wB then C0 r else C1 (r-wB)) | Zneg _ => (0, C0 0) end. @@ -651,7 +651,7 @@ Section ZModulo. rewrite Zpower_2; auto with zarith. replace [|r-wB|] with (r-wB) by (symmetry; apply Zmod_small; auto with zarith). rewrite Zpower_2; omega. - + assert (0<=Zneg p). rewrite Heqz; generalize wB_pos; auto with zarith. compute in H0; elim H0; auto. @@ -665,8 +665,8 @@ Section ZModulo. apply two_power_pos_correct. Qed. - Definition znz_head0 x := match [|x|] with - | Z0 => znz_zdigits + Definition znz_head0 x := match [|x|] with + | Z0 => znz_zdigits | Zpos p => znz_zdigits - log_inf p - 1 | _ => 0 end. @@ -695,7 +695,7 @@ Section ZModulo. change (Zpos x~0) with (2*(Zpos x)) in H. replace p with (Zsucc (p-1)) in H; auto with zarith. rewrite Zpower_Zsucc in H; auto with zarith. - + simpl; intros; destruct p; compute; auto with zarith. Qed. @@ -730,8 +730,8 @@ Section ZModulo. by ring. unfold wB, base, znz_zdigits; auto with zarith. apply Zmult_le_compat; auto with zarith. - - apply Zlt_le_trans + + apply Zlt_le_trans with (2^(znz_zdigits - log_inf p - 1)*(2^(Zsucc (log_inf p)))). apply Zmult_lt_compat_l; auto with zarith. rewrite <- Zpower_exp; auto with zarith. @@ -740,17 +740,17 @@ Section ZModulo. unfold wB, base, znz_zdigits; auto with zarith. Qed. - Fixpoint Ptail p := match p with + Fixpoint Ptail p := match p with | xO p => (Ptail p)+1 | _ => 0 - end. + end. Lemma Ptail_pos : forall p, 0 <= Ptail p. Proof. induction p; simpl; auto with zarith. Qed. Hint Resolve Ptail_pos. - + Lemma Ptail_bounded : forall p d, Zpos p < 2^(Zpos d) -> Ptail p < Zpos d. Proof. induction p; try (compute; auto; fail). @@ -775,7 +775,7 @@ Section ZModulo. Qed. Definition znz_tail0 x := - match [|x|] with + match [|x|] with | Z0 => znz_zdigits | Zpos p => Ptail p | Zneg _ => 0 @@ -788,7 +788,7 @@ Section ZModulo. apply spec_zdigits. Qed. - Lemma spec_tail0 : forall x, 0 < [|x|] -> + Lemma spec_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|znz_tail0 x|]). Proof. intros; unfold znz_tail0. @@ -818,7 +818,7 @@ Section ZModulo. (** Let's now group everything in two records *) - Definition zmod_op := mk_znz_op + Definition zmod_op := mk_znz_op (znz_digits : positive) (znz_zdigits: znz) (znz_to_Z : znz -> Z) @@ -859,11 +859,11 @@ Section ZModulo. (znz_div_gt : znz -> znz -> znz * znz) (znz_div : znz -> znz -> znz * znz) - (znz_mod_gt : znz -> znz -> znz) - (znz_mod : znz -> znz -> znz) + (znz_mod_gt : znz -> znz -> znz) + (znz_mod : znz -> znz -> znz) (znz_gcd_gt : znz -> znz -> znz) - (znz_gcd : znz -> znz -> znz) + (znz_gcd : znz -> znz -> znz) (znz_add_mul_div : znz -> znz -> znz -> znz) (znz_pos_mod : znz -> znz -> znz) @@ -878,54 +878,54 @@ Section ZModulo. spec_more_than_1_digit spec_0 - spec_1 - spec_Bm1 - - spec_compare - spec_eq0 - - spec_opp_c - spec_opp - spec_opp_carry - - spec_succ_c - spec_add_c - spec_add_carry_c - spec_succ - spec_add - spec_add_carry - - spec_pred_c - spec_sub_c - spec_sub_carry_c - spec_pred - spec_sub - spec_sub_carry - - spec_mul_c - spec_mul - spec_square_c - - spec_div21 - spec_div_gt - spec_div - - spec_mod_gt - spec_mod - - spec_gcd_gt - spec_gcd - - spec_head00 - spec_head0 - spec_tail00 - spec_tail0 - - spec_add_mul_div - spec_pos_mod - - spec_is_even - spec_sqrt2 + spec_1 + spec_Bm1 + + spec_compare + spec_eq0 + + spec_opp_c + spec_opp + spec_opp_carry + + spec_succ_c + spec_add_c + spec_add_carry_c + spec_succ + spec_add + spec_add_carry + + spec_pred_c + spec_sub_c + spec_sub_carry_c + spec_pred + spec_sub + spec_sub_carry + + spec_mul_c + spec_mul + spec_square_c + + spec_div21 + spec_div_gt + spec_div + + spec_mod_gt + spec_mod + + spec_gcd_gt + spec_gcd + + spec_head00 + spec_head0 + spec_tail00 + spec_tail0 + + spec_add_mul_div + spec_pos_mod + + spec_is_even + spec_sqrt2 spec_sqrt. End ZModulo. @@ -934,7 +934,7 @@ End ZModulo. Module Type PositiveNotOne. Parameter p : positive. - Axiom not_one : p<> 1%positive. + Axiom not_one : p<> 1%positive. End PositiveNotOne. Module ZModuloCyclicType (P:PositiveNotOne) <: CyclicType. diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v index cbf6f701f..dc2225634 100644 --- a/theories/Numbers/Integer/BigZ/ZMake.v +++ b/theories/Numbers/Integer/BigZ/ZMake.v @@ -17,31 +17,31 @@ Require Import ZSig. Open Scope Z_scope. -(** * ZMake - - A generic transformation from a structure of natural numbers +(** * ZMake + + A generic transformation from a structure of natural numbers [NSig.NType] to a structure of integers [ZSig.ZType]. *) Module Make (N:NType) <: ZType. - - Inductive t_ := + + Inductive t_ := | Pos : N.t -> t_ | Neg : N.t -> t_. - + Definition t := t_. Definition zero := Pos N.zero. Definition one := Pos N.one. Definition minus_one := Neg N.one. - Definition of_Z x := + Definition of_Z x := match x with | Zpos x => Pos (N.of_N (Npos x)) | Z0 => zero | Zneg x => Neg (N.of_N (Npos x)) end. - + Definition to_Z x := match x with | Pos nx => N.to_Z nx @@ -99,13 +99,13 @@ Module Make (N:NType) <: ZType. unfold compare, to_Z; intros x y; case x; case y; clear x y; intros x y; auto; generalize (N.spec_pos x) (N.spec_pos y). generalize (N.spec_compare y x); case N.compare; auto with zarith. - generalize (N.spec_compare y N.zero); case N.compare; + generalize (N.spec_compare y N.zero); case N.compare; try rewrite N.spec_0; auto with zarith. generalize (N.spec_compare x N.zero); case N.compare; rewrite N.spec_0; auto with zarith. generalize (N.spec_compare x N.zero); case N.compare; rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare N.zero y); case N.compare; + generalize (N.spec_compare N.zero y); case N.compare; try rewrite N.spec_0; auto with zarith. generalize (N.spec_compare N.zero x); case N.compare; rewrite N.spec_0; auto with zarith. @@ -114,7 +114,7 @@ Module Make (N:NType) <: ZType. generalize (N.spec_compare x y); case N.compare; auto with zarith. Qed. - Definition eq_bool x y := + Definition eq_bool x y := match compare x y with | Eq => true | _ => false @@ -128,9 +128,9 @@ Module Make (N:NType) <: ZType. Definition cmp_sign x y := match x, y with - | Pos nx, Neg ny => - if N.eq_bool ny N.zero then Eq else Gt - | Neg nx, Pos ny => + | Pos nx, Neg ny => + if N.eq_bool ny N.zero then Eq else Gt + | Neg nx, Pos ny => if N.eq_bool nx N.zero then Eq else Lt | _, _ => Eq end. @@ -150,7 +150,7 @@ Module Make (N:NType) <: ZType. rewrite N.spec_0; unfold to_Z. generalize (N.spec_pos x) (N.spec_pos y); auto with zarith. Qed. - + Definition to_N x := match x with | Pos nx => nx @@ -164,9 +164,9 @@ Module Make (N:NType) <: ZType. simpl; rewrite Zabs_eq; auto. simpl; rewrite Zabs_non_eq; simpl; auto with zarith. Qed. - - Definition opp x := - match x with + + Definition opp x := + match x with | Pos nx => Neg nx | Neg nx => Pos nx end. @@ -174,7 +174,7 @@ Module Make (N:NType) <: ZType. Theorem spec_opp: forall x, to_Z (opp x) = - to_Z x. intros x; case x; simpl; auto with zarith. Qed. - + Definition succ x := match x with | Pos n => Pos (N.succ n) @@ -188,7 +188,7 @@ Module Make (N:NType) <: ZType. Theorem spec_succ: forall n, to_Z (succ n) = to_Z n + 1. intros x; case x; clear x; intros x. exact (N.spec_succ x). - simpl; generalize (N.spec_compare N.zero x); case N.compare; + simpl; generalize (N.spec_compare N.zero x); case N.compare; rewrite N.spec_0; simpl. intros HH; rewrite <- HH; rewrite N.spec_1; ring. intros HH; rewrite N.spec_pred; auto with zarith. @@ -212,7 +212,7 @@ Module Make (N:NType) <: ZType. end | Neg nx, Neg ny => Neg (N.add nx ny) end. - + Theorem spec_add: forall x y, to_Z (add x y) = to_Z x + to_Z y. unfold add, to_Z; intros [x | x] [y | y]. exact (N.spec_add x y). @@ -239,7 +239,7 @@ Module Make (N:NType) <: ZType. Theorem spec_pred: forall x, to_Z (pred x) = to_Z x - 1. unfold pred, to_Z, minus_one; intros [x | x]. - generalize (N.spec_compare N.zero x); case N.compare; + generalize (N.spec_compare N.zero x); case N.compare; rewrite N.spec_0; try rewrite N.spec_1; auto with zarith. intros H; exact (N.spec_pred _ H). generalize (N.spec_pos x); auto with zarith. @@ -248,7 +248,7 @@ Module Make (N:NType) <: ZType. Definition sub x y := match x, y with - | Pos nx, Pos ny => + | Pos nx, Pos ny => match N.compare nx ny with | Gt => Pos (N.sub nx ny) | Eq => zero @@ -256,7 +256,7 @@ Module Make (N:NType) <: ZType. end | Pos nx, Neg ny => Pos (N.add nx ny) | Neg nx, Pos ny => Neg (N.add nx ny) - | Neg nx, Neg ny => + | Neg nx, Neg ny => match N.compare nx ny with | Gt => Neg (N.sub nx ny) | Eq => zero @@ -278,7 +278,7 @@ Module Make (N:NType) <: ZType. intros; rewrite N.spec_sub; try ring; auto with zarith. Qed. - Definition mul x y := + Definition mul x y := match x, y with | Pos nx, Pos ny => Pos (N.mul nx ny) | Pos nx, Neg ny => Neg (N.mul nx ny) @@ -291,7 +291,7 @@ Module Make (N:NType) <: ZType. unfold mul, to_Z; intros [x | x] [y | y]; rewrite N.spec_mul; ring. Qed. - Definition square x := + Definition square x := match x with | Pos nx => Pos (N.square nx) | Neg nx => Pos (N.square nx) @@ -304,7 +304,7 @@ Module Make (N:NType) <: ZType. Definition power_pos x p := match x with | Pos nx => Pos (N.power_pos nx p) - | Neg nx => + | Neg nx => match p with | xH => x | xO _ => Pos (N.power_pos nx p) @@ -315,7 +315,7 @@ Module Make (N:NType) <: ZType. Theorem spec_power_pos: forall x n, to_Z (power_pos x n) = to_Z x ^ Zpos n. assert (F0: forall x, (-x)^2 = x^2). intros x; rewrite Zpower_2; ring. - unfold power_pos, to_Z; intros [x | x] [p | p |]; + unfold power_pos, to_Z; intros [x | x] [p | p |]; try rewrite N.spec_power_pos; try ring. assert (F: 0 <= 2 * Zpos p). assert (0 <= Zpos p); auto with zarith. @@ -336,7 +336,7 @@ Module Make (N:NType) <: ZType. end. - Theorem spec_sqrt: forall x, 0 <= to_Z x -> + Theorem spec_sqrt: forall x, 0 <= to_Z x -> to_Z (sqrt x) ^ 2 <= to_Z x < (to_Z (sqrt x) + 1) ^ 2. unfold to_Z, sqrt; intros [x | x] H. exact (N.spec_sqrt x). @@ -381,7 +381,7 @@ Module Make (N:NType) <: ZType. generalize (N.spec_pos y); auto with zarith. generalize (N.spec_div_eucl x y HH); case N.div_eucl; auto. intros q r; generalize (N.spec_pos x) HH; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); + case_eq (N.to_Z x); case_eq (N.to_Z y); try (intros; apply False_ind; auto with zarith; fail). intros p He1 He2 _ _ H1; injection H1; intros H2 H3. generalize (N.spec_compare N.zero r); case N.compare; @@ -407,13 +407,13 @@ Module Make (N:NType) <: ZType. assert (N.to_Z r = (Zpos p1 mod (Zpos p))). unfold Zmod, Zdiv_eucl; rewrite <- H3; auto. case (Z_mod_lt (Zpos p1) (Zpos p)); auto with zarith. - rewrite N.spec_0; intros H2; generalize (N.spec_pos r); + rewrite N.spec_0; intros H2; generalize (N.spec_pos r); intros; apply False_ind; auto with zarith. assert (HH: 0 < N.to_Z y). generalize (N.spec_pos y); auto with zarith. generalize (N.spec_div_eucl x y HH); case N.div_eucl; auto. intros q r; generalize (N.spec_pos x) HH; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); + case_eq (N.to_Z x); case_eq (N.to_Z y); try (intros; apply False_ind; auto with zarith; fail). intros p He1 He2 _ _ H1; injection H1; intros H2 H3. generalize (N.spec_compare N.zero r); case N.compare; @@ -443,7 +443,7 @@ Module Make (N:NType) <: ZType. generalize (N.spec_pos y); auto with zarith. generalize (N.spec_div_eucl x y H1); case N.div_eucl; auto. intros q r; generalize (N.spec_pos x) H1; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); + case_eq (N.to_Z x); case_eq (N.to_Z y); try (intros; apply False_ind; auto with zarith; fail). change (-0) with 0; lazy iota beta; auto. intros p _ _ _ _ H2; injection H2. @@ -478,7 +478,7 @@ Module Make (N:NType) <: ZType. | Pos nx, Pos ny => Pos (N.gcd nx ny) | Pos nx, Neg ny => Pos (N.gcd nx ny) | Neg nx, Pos ny => Pos (N.gcd nx ny) - | Neg nx, Neg ny => Pos (N.gcd nx ny) + | Neg nx, Neg ny => Pos (N.gcd nx ny) end. Theorem spec_gcd: forall a b, to_Z (gcd a b) = Zgcd (to_Z a) (to_Z b). diff --git a/theories/Numbers/Integer/SpecViaZ/ZSig.v b/theories/Numbers/Integer/SpecViaZ/ZSig.v index 4e4593983..00e292db0 100644 --- a/theories/Numbers/Integer/SpecViaZ/ZSig.v +++ b/theories/Numbers/Integer/SpecViaZ/ZSig.v @@ -58,7 +58,7 @@ Module Type ZType. Parameter spec_eq_bool: forall x y, if eq_bool x y then [x] = [y] else [x] <> [y]. - + Parameter succ : t -> t. Parameter spec_succ: forall n, [succ n] = [n] + 1. @@ -93,21 +93,21 @@ Module Type ZType. Parameter sqrt : t -> t. - Parameter spec_sqrt: forall x, 0 <= [x] -> + Parameter spec_sqrt: forall x, 0 <= [x] -> [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. Parameter div_eucl : t -> t -> t * t. Parameter spec_div_eucl: forall x y, [y] <> 0 -> let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. - + Parameter div : t -> t -> t. Parameter spec_div: forall x y, [y] <> 0 -> [div x y] = [x] / [y]. Parameter modulo : t -> t -> t. - Parameter spec_modulo: forall x y, [y] <> 0 -> + Parameter spec_modulo: forall x y, [y] <> 0 -> [modulo x y] = [x] mod [y]. Parameter gcd : t -> t -> t. diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v index 4d1054553..030c589ff 100644 --- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v +++ b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v @@ -27,7 +27,7 @@ Infix "-" := Z.sub : IntScope. Infix "*" := Z.mul : IntScope. Notation "- x" := (Z.opp x) : IntScope. -Hint Rewrite +Hint Rewrite Z.spec_0 Z.spec_1 Z.spec_add Z.spec_sub Z.spec_pred Z.spec_succ Z.spec_mul Z.spec_opp Z.spec_of_Z : Zspec. @@ -91,7 +91,7 @@ Section Induction. Variable A : Z.t -> Prop. Hypothesis A_wd : predicate_wd Z.eq A. Hypothesis A0 : A 0. -Hypothesis AS : forall n, A n <-> A (Z.succ n). +Hypothesis AS : forall n, A n <-> A (Z.succ n). Add Morphism A with signature Z.eq ==> iff as A_morph. Proof. apply A_wd. Qed. @@ -214,7 +214,7 @@ Proof. Qed. Add Morphism Z.compare with signature Z.eq ==> Z.eq ==> (@eq comparison) as compare_wd. -Proof. +Proof. intros x x' Hx y y' Hy. rewrite 2 spec_compare_alt; unfold Z.eq in *; rewrite Hx, Hy; intuition. Qed. diff --git a/theories/Numbers/NaryFunctions.v b/theories/Numbers/NaryFunctions.v index feb7a4916..a8adf49af 100644 --- a/theories/Numbers/NaryFunctions.v +++ b/theories/Numbers/NaryFunctions.v @@ -16,19 +16,19 @@ Require Import List. (** * Generic dependently-typed operators about [n]-ary functions *) -(** The type of [n]-ary function: [nfun A n B] is +(** The type of [n]-ary function: [nfun A n B] is [A -> ... -> A -> B] with [n] occurences of [A] in this type. *) -Fixpoint nfun A n B := +Fixpoint nfun A n B := match n with - | O => B + | O => B | S n => A -> (nfun A n B) - end. + end. Notation " A ^^ n --> B " := (nfun A n B) (at level 50, n at next level) : type_scope. -(** [napply_cst _ _ a n f] iterates [n] times the application of a +(** [napply_cst _ _ a n f] iterates [n] times the application of a particular constant [a] to the [n]-ary function [f]. *) Fixpoint napply_cst (A B:Type)(a:A) n : (A^^n-->B) -> B := @@ -40,47 +40,47 @@ Fixpoint napply_cst (A B:Type)(a:A) n : (A^^n-->B) -> B := (** A generic transformation from an n-ary function to another one.*) -Fixpoint nfun_to_nfun (A B C:Type)(f:B -> C) n : +Fixpoint nfun_to_nfun (A B C:Type)(f:B -> C) n : (A^^n-->B) -> (A^^n-->C) := - match n return (A^^n-->B) -> (A^^n-->C) with + match n return (A^^n-->B) -> (A^^n-->C) with | O => f | S n => fun g a => nfun_to_nfun _ _ _ f n (g a) end. -(** [napply_except_last _ _ n f] expects [n] arguments of type [A], - applies [n-1] of them to [f] and discard the last one. *) +(** [napply_except_last _ _ n f] expects [n] arguments of type [A], + applies [n-1] of them to [f] and discard the last one. *) -Definition napply_except_last (A B:Type) := +Definition napply_except_last (A B:Type) := nfun_to_nfun A B (A->B) (fun b a => b). -(** [napply_then_last _ _ a n f] expects [n] arguments of type [A], - applies them to [f] and then apply [a] to the result. *) +(** [napply_then_last _ _ a n f] expects [n] arguments of type [A], + applies them to [f] and then apply [a] to the result. *) -Definition napply_then_last (A B:Type)(a:A) := +Definition napply_then_last (A B:Type)(a:A) := nfun_to_nfun A (A->B) B (fun fab => fab a). -(** [napply_discard _ b n] expects [n] arguments, discards then, +(** [napply_discard _ b n] expects [n] arguments, discards then, and returns [b]. *) Fixpoint napply_discard (A B:Type)(b:B) n : A^^n-->B := - match n return A^^n-->B with + match n return A^^n-->B with | O => b | S n => fun _ => napply_discard _ _ b n end. (** A fold function *) -Fixpoint nfold A B (f:A->B->B)(b:B) n : (A^^n-->B) := - match n return (A^^n-->B) with +Fixpoint nfold A B (f:A->B->B)(b:B) n : (A^^n-->B) := + match n return (A^^n-->B) with | O => b | S n => fun a => (nfold _ _ f (f a b) n) end. -(** [n]-ary products : [nprod A n] is [A*...*A*unit], +(** [n]-ary products : [nprod A n] is [A*...*A*unit], with [n] occurrences of [A] in this type. *) -Fixpoint nprod A n : Type := match n with +Fixpoint nprod A n : Type := match n with | O => unit | S n => (A * nprod A n)%type end. @@ -89,54 +89,54 @@ Notation "A ^ n" := (nprod A n) : type_scope. (** [n]-ary curryfication / uncurryfication *) -Fixpoint ncurry (A B:Type) n : (A^n -> B) -> (A^^n-->B) := - match n return (A^n -> B) -> (A^^n-->B) with +Fixpoint ncurry (A B:Type) n : (A^n -> B) -> (A^^n-->B) := + match n return (A^n -> B) -> (A^^n-->B) with | O => fun x => x tt | S n => fun f a => ncurry _ _ n (fun p => f (a,p)) end. -Fixpoint nuncurry (A B:Type) n : (A^^n-->B) -> (A^n -> B) := +Fixpoint nuncurry (A B:Type) n : (A^^n-->B) -> (A^n -> B) := match n return (A^^n-->B) -> (A^n -> B) with | O => fun x _ => x | S n => fun f p => let (x,p) := p in nuncurry _ _ n (f x) p end. -(** Earlier functions can also be defined via [ncurry/nuncurry]. +(** Earlier functions can also be defined via [ncurry/nuncurry]. For instance : *) Definition nfun_to_nfun_bis A B C (f:B->C) n : - (A^^n-->B) -> (A^^n-->C) := + (A^^n-->B) -> (A^^n-->C) := fun anb => ncurry _ _ n (fun an => f ((nuncurry _ _ n anb) an)). -(** We can also us it to obtain another [fold] function, +(** We can also us it to obtain another [fold] function, equivalent to the previous one, but with a nicer expansion (see for instance Int31.iszero). *) -Fixpoint nfold_bis A B (f:A->B->B)(b:B) n : (A^^n-->B) := - match n return (A^^n-->B) with +Fixpoint nfold_bis A B (f:A->B->B)(b:B) n : (A^^n-->B) := + match n return (A^^n-->B) with | O => b - | S n => fun a => + | S n => fun a => nfun_to_nfun_bis _ _ _ (f a) n (nfold_bis _ _ f b n) end. (** From [nprod] to [list] *) -Fixpoint nprod_to_list (A:Type) n : A^n -> list A := - match n with +Fixpoint nprod_to_list (A:Type) n : A^n -> list A := + match n with | O => fun _ => nil | S n => fun p => let (x,p) := p in x::(nprod_to_list _ n p) end. (** From [list] to [nprod] *) -Fixpoint nprod_of_list (A:Type)(l:list A) : A^(length l) := - match l return A^(length l) with +Fixpoint nprod_of_list (A:Type)(l:list A) : A^(length l) := + match l return A^(length l) with | nil => tt | x::l => (x, nprod_of_list _ l) end. (** This gives an additional way to write the fold *) -Definition nfold_list (A B:Type)(f:A->B->B)(b:B) n : (A^^n-->B) := +Definition nfold_list (A B:Type)(f:A->B->B)(b:B) n : (A^^n-->B) := ncurry _ _ n (fun p => fold_right f b (nprod_to_list _ _ p)). diff --git a/theories/Numbers/NatInt/NZAxioms.v b/theories/Numbers/NatInt/NZAxioms.v index 1ef780986..a9c023856 100644 --- a/theories/Numbers/NatInt/NZAxioms.v +++ b/theories/Numbers/NatInt/NZAxioms.v @@ -23,7 +23,7 @@ Parameter Inline NZadd : NZ -> NZ -> NZ. Parameter Inline NZsub : NZ -> NZ -> NZ. Parameter Inline NZmul : NZ -> NZ -> NZ. -(* Unary subtraction (opp) is not defined on natural numbers, so we have +(* Unary subtraction (opp) is not defined on natural numbers, so we have it for integers only *) Axiom NZeq_equiv : equiv NZ NZeq. diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v index 5212e6381..f02baca2c 100644 --- a/theories/Numbers/Natural/Abstract/NOrder.v +++ b/theories/Numbers/Natural/Abstract/NOrder.v @@ -309,7 +309,7 @@ Proof NZgt_wf. Theorem lt_wf_0 : well_founded lt. Proof. -setoid_replace lt with (fun n m : N => 0 <= n /\ n < m) +setoid_replace lt with (fun n m : N => 0 <= n /\ n < m) using relation (@relations_eq N N). apply lt_wf. intros x y; split. diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml index 7424d877b..c22680be3 100644 --- a/theories/Numbers/Natural/BigN/NMake_gen.ml +++ b/theories/Numbers/Natural/BigN/NMake_gen.ml @@ -15,7 +15,7 @@ (*s The two parameters that control the generation: *) -let size = 6 (* how many times should we repeat the Z/nZ --> Z/2nZ +let size = 6 (* how many times should we repeat the Z/nZ --> Z/2nZ process before relying on a generic construct *) let gen_proof = true (* should we generate proofs ? *) @@ -27,18 +27,18 @@ let c = "N" let pz n = if n == 0 then "w_0" else "W0" let rec gen2 n = if n == 0 then "1" else if n == 1 then "2" else "2 * " ^ (gen2 (n - 1)) -let rec genxO n s = +let rec genxO n s = if n == 0 then s else " (xO" ^ (genxO (n - 1) s) ^ ")" -(* NB: in ocaml >= 3.10, we could use Printf.ifprintf for printing to - /dev/null, but for being compatible with earlier ocaml and not - relying on system-dependent stuff like open_out "/dev/null", +(* NB: in ocaml >= 3.10, we could use Printf.ifprintf for printing to + /dev/null, but for being compatible with earlier ocaml and not + relying on system-dependent stuff like open_out "/dev/null", let's use instead a magical hack *) (* Standard printer, with a final newline *) let pr s = Printf.printf (s^^"\n") (* Printing to /dev/null *) -let pn = (fun s -> Obj.magic (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> ()) +let pn = (fun s -> Obj.magic (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> ()) : ('a, out_channel, unit) format -> 'a) (* Proof printer : prints iff gen_proof is true *) let pp = if gen_proof then pr else pn @@ -51,7 +51,7 @@ let pp0 = if gen_proof then pr0 else pn (*s The actual printing *) -let _ = +let _ = pr "(************************************************************************)"; pr "(* v * The Coq Proof Assistant / The Coq Development Team *)"; @@ -67,7 +67,7 @@ let _ = pr ""; pr "(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*)"; pr ""; - pr "(** Remark: File automatically generated by NMake_gen.ml, DO NOT EDIT ! *)"; + pr "(** Remark: File automatically generated by NMake_gen.ml, DO NOT EDIT ! *)"; pr ""; pr "Require Import BigNumPrelude."; pr "Require Import ZArith."; @@ -132,7 +132,7 @@ let _ = pr ""; pr " Inductive %s_ :=" t; - for i = 0 to size do + for i = 0 to size do pr " | %s%i : w%i -> %s_" c i i t done; pr " | %sn : forall n, word w%i (S n) -> %s_." c size t; @@ -167,7 +167,7 @@ let _ = pr " Definition to_N x := Zabs_N (to_Z x)."; pr ""; - + pr " Definition eq x y := (to_Z x = to_Z y)."; pr ""; @@ -191,7 +191,7 @@ let _ = for i = 0 to size do pp " Let nmake_op%i := nmake_op _ w%i_op." i i; pp " Let eval%in n := znz_to_Z (nmake_op%i n)." i i; - if i == 0 then + if i == 0 then pr " Let extend%i := DoubleBase.extend (WW w_0)." i else pr " Let extend%i := DoubleBase.extend (WW (W0: w%i))." i i; @@ -280,7 +280,7 @@ let _ = pp " Let w0_spec: znz_spec w0_op := W0.w_spec."; for i = 1 to 3 do - pp " Let w%i_spec: znz_spec w%i_op := mk_znz2_spec w%i_spec." i i (i-1) + pp " Let w%i_spec: znz_spec w%i_op := mk_znz2_spec w%i_spec." i i (i-1) done; for i = 4 to size + 3 do pp " Let w%i_spec : znz_spec w%i_op := mk_znz2_karatsuba_spec w%i_spec." i i (i-1) @@ -309,14 +309,14 @@ let _ = for i = 0 to size do - pp " Theorem digits_w%i: znz_digits w%i_op = znz_digits (nmake_op _ w0_op %i)." i i i; + pp " Theorem digits_w%i: znz_digits w%i_op = znz_digits (nmake_op _ w0_op %i)." i i i; if i == 0 then pp " auto." else pp " rewrite digits_nmake; rewrite <- digits_w%i; auto." (i - 1); pp " Qed."; pp ""; - pp " Let spec_double_eval%in: forall n, eval%in n = DoubleBase.double_to_Z (znz_digits w%i_op) (znz_to_Z w%i_op) n." i i i i; + pp " Let spec_double_eval%in: forall n, eval%in n = DoubleBase.double_to_Z (znz_digits w%i_op) (znz_to_Z w%i_op) n." i i i i; pp " Proof."; pp " intros n; exact (nmake_double n w%i w%i_op)." i i; pp " Qed."; @@ -325,7 +325,7 @@ let _ = for i = 0 to size do for j = 0 to (size - i) do - pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i j (i + j) i j; + pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i j (i + j) i j; pp " Proof."; if j == 0 then if i == 0 then @@ -346,7 +346,7 @@ let _ = end; pp " Qed."; pp ""; - pp " Let spec_eval%in%i: forall x, [%s%i x] = eval%in %i x." i j c (i + j) i j; + pp " Let spec_eval%in%i: forall x, [%s%i x] = eval%in %i x." i j c (i + j) i j; pp " Proof."; if j == 0 then pp " intros x; rewrite spec_double_eval%in; unfold DoubleBase.double_to_Z, to_Z; auto." i @@ -363,7 +363,7 @@ let _ = pp " Qed."; if i + j <> size then begin - pp " Let spec_extend%in%i: forall x, [%s%i x] = [%s%i (extend%i %i x)]." i (i + j + 1) c i c (i + j + 1) i j; + pp " Let spec_extend%in%i: forall x, [%s%i x] = [%s%i (extend%i %i x)]." i (i + j + 1) c i c (i + j + 1) i j; if j == 0 then begin pp " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." i (i + j); @@ -393,7 +393,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_eval%in%i: forall x, [%sn 0 x] = eval%in %i x." i (size - i + 1) c i (size - i + 1); + pp " Let spec_eval%in%i: forall x, [%sn 0 x] = eval%in %i x." i (size - i + 1) c i (size - i + 1); pp " Proof."; pp " intros x; case x."; pp " auto."; @@ -405,7 +405,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_eval%in%i: forall x, [%sn 1 x] = eval%in %i x." i (size - i + 2) c i (size - i + 2); + pp " Let spec_eval%in%i: forall x, [%sn 1 x] = eval%in %i x." i (size - i + 2) c i (size - i + 2); pp " intros x; case x."; pp " auto."; pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (size + 2); @@ -430,7 +430,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_eval%in: forall n x, [%sn n x] = eval%in (S n) x." size c size; + pp " Let spec_eval%in: forall n x, [%sn n x] = eval%in (S n) x." size c size; pp " intros n; elim n; clear n."; pp " exact spec_eval%in1." size; pp " intros n Hrec x; case x; clear x."; @@ -446,7 +446,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_extend%in: forall n x, [%s%i x] = [%sn n (extend%i n x)]." size c size c size ; + pp " Let spec_extend%in: forall n x, [%s%i x] = [%sn n (extend%i n x)]." size c size c size ; pp " intros n; elim n; clear n."; pp " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." size size; pp " unfold to_Z."; @@ -578,14 +578,14 @@ let _ = pr " | %s%i wx, %s%i wy => f%i (extend%i %i wx) wy" c i c j j i (j - i - 1); done; if i == size then - pr " | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy" c size c size - else + pr " | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy" c size c size + else pr " | %s%i wx, %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c i c size i (size - i - 1); done; for i = 0 to size do if i == size then - pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)" c c size size - else + pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)" c c size size + else pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n (extend%i %i wy))" c c i size i (size - i - 1); done; pr " | %sn n wx, Nn m wy =>" c; @@ -611,14 +611,14 @@ let _ = done; if i == size then pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size; done; pp " intros n x y; case y; clear y."; for i = 0 to size do if i == size then pp " intros y; rewrite (spec_extend%in n); apply Pfnn." size - else + else pp " intros y; rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size; done; pp " intros m y; rewrite <- (spec_cast_l n m x); "; @@ -644,7 +644,7 @@ let _ = pr " match y with"; for j = 0 to i - 1 do pr " | %s%i wy =>" c j; - if j == 0 then + if j == 0 then pr " if w0_eq0 wy then ft0 x else"; pr " f%i wx (extend%i %i wy)" i j (i - j -1); done; @@ -653,8 +653,8 @@ let _ = pr " | %s%i wy => f%i (extend%i %i wx) wy" c j j i (j - i - 1); done; if i == size then - pr " | %sn m wy => fnn m (extend%i m wx) wy" c size - else + pr " | %sn m wy => fnn m (extend%i m wx) wy" c size + else pr " | %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c size i (size - i - 1); pr" end"; done; @@ -665,8 +665,8 @@ let _ = if i == 0 then pr " if w0_eq0 wy then ft0 x else"; if i == size then - pr " fnn n wx (extend%i n wy)" size - else + pr " fnn n wx (extend%i n wy)" size + else pr " fnn n wx (extend%i n (extend%i %i wy))" size i (size - i - 1); done; pr " | %sn m wy =>" c; @@ -707,7 +707,7 @@ let _ = done; if i == size then pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size; done; pp " intros n x y; case y; clear y."; @@ -721,7 +721,7 @@ let _ = end; if i == size then pp " rewrite (spec_extend%in n); apply Pfnn." size - else + else pp " rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size; done; pp " intros m y; rewrite <- (spec_cast_l n m x); "; @@ -748,14 +748,14 @@ let _ = pr " | %s%i wx, %s%i wy => f%in %i wx wy" c i c j i (j - i - 1); done; if i == size then - pr " | %s%i wx, %sn m wy => f%in m wx wy" c size c size - else + pr " | %s%i wx, %sn m wy => f%in m wx wy" c size c size + else pr " | %s%i wx, %sn m wy => f%in m (extend%i %i wx) wy" c i c size i (size - i - 1); done; for i = 0 to size do if i == size then - pr " | %sn n wx, %s%i wy => fn%i n wx wy" c c size size - else + pr " | %sn n wx, %s%i wy => fn%i n wx wy" c c size size + else pr " | %sn n wx, %s%i wy => fn%i n wx (extend%i %i wy)" c c i size i (size - i - 1); done; pr " | %sn n wx, %sn m wy => fnm n m wx wy" c c; @@ -779,14 +779,14 @@ let _ = done; if i == size then pp " intros m y; rewrite spec_eval%in; apply Pf%in." size size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size; done; pp " intros n x y; case y; clear y."; for i = 0 to size do if i == size then pp " intros y; rewrite spec_eval%in; apply Pfn%i." size size - else + else pp " intros y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size; done; pp " intros m y; apply Pfnm."; @@ -820,8 +820,8 @@ let _ = pr " | %s%i wy => f%in %i wx wy" c j i (j - i - 1); done; if i == size then - pr " | %sn m wy => f%in m wx wy" c size - else + pr " | %sn m wy => f%in m wx wy" c size + else pr " | %sn m wy => f%in m (extend%i %i wx) wy" c size i (size - i - 1); pr " end"; done; @@ -832,8 +832,8 @@ let _ = if i == 0 then pr " if w0_eq0 wy then ft0 x else"; if i == size then - pr " fn%i n wx wy" size - else + pr " fn%i n wx wy" size + else pr " fn%i n wx (extend%i %i wy)" size i (size - i - 1); done; pr " | %sn m wy => fnm n m wx wy" c; @@ -869,7 +869,7 @@ let _ = done; if i == size then pp " intros m y; rewrite spec_eval%in; apply Pf%in." size size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size; done; pp " intros n x y; case y; clear y."; @@ -883,7 +883,7 @@ let _ = end; if i == size then pp " rewrite spec_eval%in; apply Pfn%i." size size - else + else pp " rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size; done; pp " intros m y; apply Pfnm."; @@ -902,20 +902,20 @@ let _ = pr " (***************************************************************)"; pr ""; - pr " Definition reduce_0 (x:w) := %s0 x." c; + pr " Definition reduce_0 (x:w) := %s0 x." c; pr " Definition reduce_1 :="; pr " Eval lazy beta iota delta[reduce_n1] in"; pr " reduce_n1 _ _ zero w0_eq0 %s0 %s1." c c; for i = 2 to size do pr " Definition reduce_%i :=" i; pr " Eval lazy beta iota delta[reduce_n1] in"; - pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i %s%i." + pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i %s%i." (i-1) (i-1) c i done; pr " Definition reduce_%i :=" (size+1); pr " Eval lazy beta iota delta[reduce_n1] in"; - pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i (%sn 0)." - size size c; + pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i (%sn 0)." + size size c; pr " Definition reduce_n n := "; pr " Eval lazy beta iota delta[reduce_n] in"; @@ -940,7 +940,7 @@ let _ = pp " intros x1 y1."; pp " generalize (spec_w%i_eq0 x1); " (i - 1); pp " case w%i_eq0; intros H1; auto." (i - 1); - if i <> 1 then + if i <> 1 then pp " rewrite spec_reduce_%i." (i - 1); pp " unfold to_Z; rewrite znz_to_Z_%i." i; pp " unfold to_Z in H1; rewrite H1; auto."; @@ -983,19 +983,19 @@ let _ = for i = 0 to size-1 do pr " | %s%i wx =>" c i; pr " match w%i_succ_c wx with" i; - pr " | C0 r => %s%i r" c i; + pr " | C0 r => %s%i r" c i; pr " | C1 r => %s%i (WW one%i r)" c (i+1) i; pr " end"; done; pr " | %s%i wx =>" c size; pr " match w%i_succ_c wx with" size; - pr " | C0 r => %s%i r" c size; + pr " | C0 r => %s%i r" c size; pr " | C1 r => %sn 0 (WW one%i r)" c size ; pr " end"; pr " | %sn n wx =>" c; pr " let op := make_op n in"; pr " match op.(znz_succ_c) wx with"; - pr " | C0 r => %sn n r" c; + pr " | C0 r => %sn n r" c; pr " | C1 r => %sn (S n) (WW op.(znz_1) r)" c; pr " end"; pr " end."; @@ -1033,7 +1033,7 @@ let _ = pr ""; for i = 0 to size do - pr " Definition w%i_add_c := znz_add_c w%i_op." i i; + pr " Definition w%i_add_c := znz_add_c w%i_op." i i; pr " Definition w%i_add x y :=" i; pr " match w%i_add_c x y with" i; pr " | C0 r => %s%i r" c i; @@ -1057,7 +1057,7 @@ let _ = pp " Proof."; pp " intros n m; unfold to_Z, w%i_add, w%i_add_c." i i; pp " generalize (spec_add_c w%i_spec n m); case znz_add_c; auto." i; - pp " intros ww H; rewrite <- H."; + pp " intros ww H; rewrite <- H."; pp " rewrite znz_to_Z_%i; unfold interp_carry;" (i + 1); pp " apply f_equal2 with (f := Zplus); auto;"; pp " apply f_equal2 with (f := Zmult); auto;"; @@ -1070,7 +1070,7 @@ let _ = pp " Proof."; pp " intros k n m; unfold to_Z, addn."; pp " generalize (spec_add_c (wn_spec k) n m); case znz_add_c; auto."; - pp " intros ww H; rewrite <- H."; + pp " intros ww H; rewrite <- H."; pp " rewrite (znz_to_Z_n k); unfold interp_carry;"; pp " apply f_equal2 with (f := Zplus); auto;"; pp " apply f_equal2 with (f := Zmult); auto;"; @@ -1116,14 +1116,14 @@ let _ = for i = 0 to size do pr " | %s%i wx =>" c i; pr " match w%i_pred_c wx with" i; - pr " | C0 r => reduce_%i r" i; + pr " | C0 r => reduce_%i r" i; pr " | C1 r => zero"; pr " end"; done; pr " | %sn n wx =>" c; pr " let op := make_op n in"; pr " match op.(znz_pred_c) wx with"; - pr " | C0 r => reduce_n n r"; + pr " | C0 r => reduce_n n r"; pr " | C1 r => zero"; pr " end"; pr " end."; @@ -1153,7 +1153,7 @@ let _ = pp " unfold to_Z in H1; auto with zarith."; pp " Qed."; pp " "; - + pp " Let spec_pred0: forall x, [x] = 0 -> [pred x] = 0."; pp " Proof."; pp " intros x; case x; unfold pred."; @@ -1187,7 +1187,7 @@ let _ = done; pr ""; - for i = 0 to size do + for i = 0 to size do pr " Definition w%i_sub x y :=" i; pr " match w%i_sub_c x y with" i; pr " | C0 r => reduce_%i r" i; @@ -1209,7 +1209,7 @@ let _ = pp " Proof."; pp " intros n m; unfold w%i_sub, w%i_sub_c." i i; pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c; " i; - if i == 0 then + if i == 0 then pp " intros x; auto." else pp " intros x; try rewrite spec_reduce_%i; auto." i; @@ -1219,7 +1219,7 @@ let _ = pp " Qed."; pp ""; done; - + pp " Let spec_wn_sub: forall n x y, [%sn n y] <= [%sn n x] -> [subn n x y] = [%sn n x] - [%sn n y]." c c c c; pp " Proof."; pp " intros k n m; unfold subn."; @@ -1299,7 +1299,7 @@ let _ = pr " Definition comparen_%i :=" i; pr " compare_mn_1 w%i w%i %s compare_%i (compare_%i %s) compare_%i." i i (pz i) i i (pz i) i done; - pr ""; + pr ""; pr " Definition comparenm n m wx wy :="; pr " let mn := Max.max n m in"; @@ -1337,7 +1337,7 @@ let _ = pp " unfold compare_%i, to_Z; exact (spec_compare w%i_spec)." i i; pp " Qed."; pp ""; - + pp " Let spec_comparen_%i:" i; pp " forall (n : nat) (x : word w%i n) (y : w%i)," i i; pp " match comparen_%i n x y with" i; @@ -1387,12 +1387,12 @@ let _ = pp " (fun n => comparen_%i (S n)) _ _ _" i; done; pp " comparenm _)."; - + for i = 0 to size - 1 do pp " exact spec_compare_%i." i; pp " intros n x y H;apply spec_opp_compare; apply spec_comparen_%i." i; pp " intros n x y H; exact (spec_comparen_%i (S n) x y)." i; - done; + done; pp " exact spec_compare_%i." size; pp " intros n x y;apply spec_opp_compare; apply spec_comparen_%i." size; pp " intros n; exact (spec_comparen_%i (S n))." size; @@ -1461,7 +1461,7 @@ let _ = pr " match n return word w%i (S n) -> t_ with" i; for j = 0 to size - i do if (i + j) == size then - begin + begin pr " | %i%s => fun x => %sn 0 x" j "%nat" c; pr " | %i%s => fun x => %sn 1 x" (j + 1) "%nat" c end @@ -1471,7 +1471,7 @@ let _ = pr " | _ => fun _ => N0 w_0"; pr " end."; pr ""; - done; + done; for i = 0 to size - 1 do @@ -1486,7 +1486,7 @@ let _ = pp " repeat rewrite inj_S; unfold Zsucc; auto with zarith."; pp " Qed."; pp ""; - done; + done; for i = 0 to size do @@ -1497,8 +1497,8 @@ let _ = pr " if w%i_eq0 w then %sn n r" i c; pr " else %sn (S n) (WW (extend%i n w) r)." c i; end - else - begin + else + begin pr " if w%i_eq0 w then to_Z%i n r" i i; pr " else to_Z%i (S n) (WW (extend%i n w) r)." i i; end; @@ -1556,7 +1556,7 @@ let _ = pp " Qed."; pp ""; done; - + pp " Lemma nmake_op_WW: forall ww ww1 n x y,"; pp " znz_to_Z (nmake_op ww ww1 (S n)) (WW x y) ="; pp " znz_to_Z (nmake_op ww ww1 n) x * base (znz_digits (nmake_op ww ww1 n)) +"; @@ -1564,7 +1564,7 @@ let _ = pp " auto."; pp " Qed."; pp ""; - + for i = 0 to size do pp " Lemma extend%in_spec: forall n x1," i; pp " znz_to_Z (nmake_op _ w%i_op (S n)) (extend%i n x1) = " i i; @@ -1573,12 +1573,12 @@ let _ = pp " intros n1 x2; rewrite nmake_double."; pp " unfold extend%i." i; pp " rewrite DoubleBase.spec_extend; auto."; - if i == 0 then + if i == 0 then pp " intros l; simpl; unfold w_0; rewrite (spec_0 w0_spec); ring."; pp " Qed."; pp ""; done; - + pp " Lemma spec_muln:"; pp " forall n (x: word _ (S n)) y,"; pp " [%sn (S n) (znz_mul_c (make_op n) x y)] = [%sn n x] * [%sn n y]." c c c; @@ -1614,7 +1614,7 @@ let _ = pp " generalize (spec_w%i_eq0 x1); case w%i_eq0; intros HH." i i; pp " unfold to_Z in HH; rewrite HH."; if i == size then - begin + begin pp " rewrite spec_eval%in; unfold eval%in, nmake_op%i; auto." i i i; pp " rewrite spec_eval%in; unfold eval%in, nmake_op%i." i i i end @@ -1708,7 +1708,7 @@ let _ = pr " (* Power *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; pr " Fixpoint power_pos (x:%s) (p:positive) {struct p} : %s :=" t t; pr " match p with"; @@ -1719,7 +1719,7 @@ let _ = pr ""; pr " Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n."; - pa " Admitted."; + pa " Admitted."; pp " Proof."; pp " intros x n; generalize x; elim n; clear n x; simpl power_pos."; pp " intros; rewrite spec_mul; rewrite spec_square; rewrite H."; @@ -1775,7 +1775,7 @@ let _ = pr " (* Division *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; for i = 0 to size do pr " Definition w%i_div_gt := w%i_op.(znz_div_gt)." i i @@ -1844,7 +1844,7 @@ let _ = pr " Definition div_gt := Eval lazy beta delta [iter] in"; pr " (iter _ "; - for i = 0 to size do + for i = 0 to size do pr " div_gt%i" i; pr " (fun n x y => div_gt%i x (DoubleBase.get_low %s (S n) y))" i (pz i); pr " w%i_divn1" i; @@ -1862,10 +1862,10 @@ let _ = pp " forall x y, [x] > [y] -> 0 < [y] ->"; pp " let (q,r) := div_gt x y in"; pp " [x] = [q] * [y] + [r] /\\ 0 <= [r] < [y])."; - pp " refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y ->"; + pp " refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y ->"; pp " let (q,r) := res in"; pp " x = [q] * y + [r] /\\ 0 <= [r] < y)"; - for i = 0 to size do + for i = 0 to size do pp " div_gt%i" i; pp " (fun n x y => div_gt%i x (DoubleBase.get_low %s (S n) y))" i (pz i); pp " w%i_divn1 _ _ _" i; @@ -1883,7 +1883,7 @@ let _ = pp " (DoubleBase.get_low %s (S n) y))." (pz i); pp0 " "; for j = 0 to i do - pp0 "unfold w%i; " (i-j); + pp0 "unfold w%i; " (i-j); done; pp "case znz_div_gt."; pp " intros xx yy H4; repeat rewrite spec_reduce_%i." i; @@ -1897,7 +1897,7 @@ let _ = pp " (spec_divn1 w%i w%i_op w%i_spec (S n) x y H3)." i i i; pp0 " unfold w%i_divn1; " i; for j = 0 to i do - pp0 "unfold w%i; " (i-j); + pp0 "unfold w%i; " (i-j); done; pp "case double_divn1."; pp " intros xx yy H4."; @@ -1990,7 +1990,7 @@ let _ = pr " (* Modulo *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; for i = 0 to size do pr " Definition w%i_mod_gt := w%i_op.(znz_mod_gt)." i i @@ -2063,7 +2063,7 @@ let _ = pp " rewrite <- (spec_get_end%i (S n) y x) in H3; auto with zarith." i; if i == size then pp " intros n x y H2 H3; rewrite spec_reduce_%i." i - else + else pp " intros n x y H1 H2 H3; rewrite spec_reduce_%i." i; pp " unfold w%i_modn1, to_Z; rewrite spec_double_eval%in." i i; pp " apply (spec_modn1 _ _ w%i_spec); auto." i; @@ -2110,7 +2110,7 @@ let _ = pr " (* Gcd *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; pr " Definition digits x :="; pr " match x with"; @@ -2423,7 +2423,7 @@ let _ = pr " (* Shift *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; (* Head0 *) pr " Definition head0 w := match w with"; @@ -2513,7 +2513,7 @@ let _ = pr " Definition %sdigits x :=" c; pr " match x with"; pr " | %s0 _ => %s0 w0_op.(znz_zdigits)" c c; - for i = 1 to size do + for i = 1 to size do pr " | %s%i _ => reduce_%i w%i_op.(znz_zdigits)" c i i i; done; pr " | %sn n _ => reduce_n n (make_op n).(znz_zdigits)" c; @@ -2644,7 +2644,7 @@ let _ = pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size; pp " try (apply sym_equal; exact (spec_extend%in m x))." size; end - else + else begin pp " intros m y; unfold shiftrn, Ndigits."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; @@ -2857,7 +2857,7 @@ let _ = pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size; pp " try (apply sym_equal; exact (spec_extend%in m x))." size; end - else + else begin pp " intros m y; unfold shiftln, head0."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; @@ -3030,7 +3030,7 @@ let _ = pr " (forall x, 2 ^ (Zpos p + 1) <= [head0 x]->"; pr " [cont n x] = [x] * 2 ^ [n]) ->"; pr " [safe_shiftl_aux_body cont n x] = [x] * 2 ^ [n]."; - pa " Admitted."; + pa " Admitted."; pp " Proof."; pp " intros n p x cont H1 H2; unfold safe_shiftl_aux_body."; pp " generalize (spec_compare n (head0 x)); case compare; intros H."; diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v index c3fdd1bf4..d42db97d5 100644 --- a/theories/Numbers/Natural/BigN/Nbasic.v +++ b/theories/Numbers/Natural/BigN/Nbasic.v @@ -21,7 +21,7 @@ Require Import DoubleCyclic. (* To compute the necessary height *) Fixpoint plength (p: positive) : positive := - match p with + match p with xH => xH | xO p1 => Psucc (plength p1) | xI p1 => Psucc (plength p1) @@ -34,10 +34,10 @@ rewrite Zpower_exp; auto with zarith. rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith. intros p; elim p; simpl plength; auto. intros p1 Hp1; rewrite F; repeat rewrite Zpos_xI. -assert (tmp: (forall p, 2 * p = p + p)%Z); +assert (tmp: (forall p, 2 * p = p + p)%Z); try repeat rewrite tmp; auto with zarith. intros p1 Hp1; rewrite F; rewrite (Zpos_xO p1). -assert (tmp: (forall p, 2 * p = p + p)%Z); +assert (tmp: (forall p, 2 * p = p + p)%Z); try repeat rewrite tmp; auto with zarith. rewrite Zpower_1_r; auto with zarith. Qed. @@ -73,7 +73,7 @@ case (Z_mod_lt (Zpos p) (Zpos q) H1); auto with zarith. intros q1 H2. replace (Zpos p - Zpos q * Zpos q1) with (Zpos p mod Zpos q). 2: pattern (Zpos p) at 2; rewrite H2; auto with zarith. -generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2; +generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2; case Zmod. intros HH _; rewrite HH; auto with zarith. intros r1 HH (_,HH1); rewrite HH; rewrite Zpos_succ_morphism. @@ -121,9 +121,9 @@ Definition zn2z_word_comm : forall w n, zn2z (word w n) = word (zn2z w) n. Defined. Fixpoint extend (n:nat) {struct n} : forall w:Type, zn2z w -> word w (S n) := - match n return forall w:Type, zn2z w -> word w (S n) with + match n return forall w:Type, zn2z w -> word w (S n) with | O => fun w x => x - | S m => + | S m => let aux := extend m in fun w x => WW W0 (aux w x) end. @@ -169,7 +169,7 @@ Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n := | S n1 => let v := fst (diff m1 n1) + n1 in let v1 := fst (diff m1 n1) + S n1 in - eq_ind v (fun n => v1 = S n) + eq_ind v (fun n => v1 = S n) (eq_ind v1 (fun n => v1 = n) (refl_equal v1) (S v) (plusnS _ _)) _ (diff_l _ _) end @@ -182,7 +182,7 @@ Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n := | 0 => refl_equal _ | S _ => plusn0 _ end - | S m => + | S m => match n return (snd (diff (S m) n) + S m = max (S m) n) with | 0 => refl_equal (snd (diff (S m) 0) + S m) | S n1 => @@ -253,9 +253,9 @@ Section ReduceRec. | WW xh xl => match xh with | W0 => @reduce_n m xl - | _ => @c (S m) x + | _ => @c (S m) x end - end + end end. End ReduceRec. @@ -276,14 +276,14 @@ Section CompareRec. Variable compare_m : wm -> w -> comparison. Fixpoint compare0_mn (n:nat) : word wm n -> comparison := - match n return word wm n -> comparison with - | O => compare0_m + match n return word wm n -> comparison with + | O => compare0_m | S m => fun x => match x with | W0 => Eq - | WW xh xl => + | WW xh xl => match compare0_mn m xh with - | Eq => compare0_mn m xl + | Eq => compare0_mn m xl | r => Lt end end @@ -296,7 +296,7 @@ Section CompareRec. Variable spec_compare0_m: forall x, match compare0_m x with Eq => w_to_Z w_0 = wm_to_Z x - | Lt => w_to_Z w_0 < wm_to_Z x + | Lt => w_to_Z w_0 < wm_to_Z x | Gt => w_to_Z w_0 > wm_to_Z x end. Variable wm_to_Z_pos: forall x, 0 <= wm_to_Z x < base wm_base. @@ -341,14 +341,14 @@ Section CompareRec. Qed. Fixpoint compare_mn_1 (n:nat) : word wm n -> w -> comparison := - match n return word wm n -> w -> comparison with - | O => compare_m - | S m => fun x y => + match n return word wm n -> w -> comparison with + | O => compare_m + | S m => fun x y => match x with | W0 => compare w_0 y - | WW xh xl => + | WW xh xl => match compare0_mn m xh with - | Eq => compare_mn_1 m xl y + | Eq => compare_mn_1 m xl y | r => Gt end end @@ -366,7 +366,7 @@ Section CompareRec. | Lt => wm_to_Z x < w_to_Z y | Gt => wm_to_Z x > w_to_Z y end. - Variable wm_base_lt: forall x, + Variable wm_base_lt: forall x, 0 <= w_to_Z x < base (wm_base). Let double_wB_lt: forall n x, @@ -385,7 +385,7 @@ Section CompareRec. unfold Zpower_pos; simpl; ring. Qed. - + Lemma spec_compare_mn_1: forall n x y, match compare_mn_1 n x y with Eq => double_to_Z n x = w_to_Z y @@ -434,7 +434,7 @@ Section AddS. | C1 z => match incr hy with C0 z1 => C0 (WW z1 z) | C1 z1 => C1 (WW z1 z) - end + end end end. @@ -458,12 +458,12 @@ End AddS. Fixpoint length_pos x := match x with xH => O | xO x1 => S (length_pos x1) | xI x1 => S (length_pos x1) end. - + Theorem length_pos_lt: forall x y, (length_pos x < length_pos y)%nat -> Zpos x < Zpos y. Proof. intros x; elim x; clear x; [intros x1 Hrec | intros x1 Hrec | idtac]; - intros y; case y; clear y; intros y1 H || intros H; simpl length_pos; + intros y; case y; clear y; intros y1 H || intros H; simpl length_pos; try (rewrite (Zpos_xI x1) || rewrite (Zpos_xO x1)); try (rewrite (Zpos_xI y1) || rewrite (Zpos_xO y1)); try (inversion H; fail); @@ -492,20 +492,20 @@ End AddS. Qed. Theorem make_zop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op x) = - fun z => match z with + znz_to_Z (mk_zn2z_op x) = + fun z => match z with W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) + | WW xh xl => znz_to_Z x xh * base (znz_digits x) + znz_to_Z x xl end. intros ww x; auto. Qed. Theorem make_kzop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op_karatsuba x) = - fun z => match z with + znz_to_Z (mk_zn2z_op_karatsuba x) = + fun z => match z with W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) + | WW xh xl => znz_to_Z x xh * base (znz_digits x) + znz_to_Z x xl end. intros ww x; auto. diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v index e53e627ec..5295aaec2 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSig.v +++ b/theories/Numbers/Natural/SpecViaZ/NSig.v @@ -58,7 +58,7 @@ Module Type NType. Parameter spec_eq_bool: forall x y, if eq_bool x y then [x] = [y] else [x] <> [y]. - + Parameter succ : t -> t. Parameter spec_succ: forall n, [succ n] = [n] + 1. @@ -98,7 +98,7 @@ Module Type NType. Parameter spec_div_eucl: forall x y, 0 < [y] -> let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. - + Parameter div : t -> t -> t. Parameter spec_div: forall x y, 0 < [y] -> [div x y] = [x] / [y]. diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v index 773807120..578cb6256 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v +++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v @@ -97,7 +97,7 @@ Section Induction. Variable A : N.t -> Prop. Hypothesis A_wd : predicate_wd N.eq A. Hypothesis A0 : A 0. -Hypothesis AS : forall n, A n <-> A (N.succ n). +Hypothesis AS : forall n, A n <-> A (N.succ n). Add Morphism A with signature N.eq ==> iff as A_morph. Proof. apply A_wd. Qed. @@ -221,7 +221,7 @@ Proof. Qed. Add Morphism N.compare with signature N.eq ==> N.eq ==> (@eq comparison) as compare_wd. -Proof. +Proof. intros x x' Hx y y' Hy. rewrite 2 spec_compare_alt. unfold N.eq in *. rewrite Hx, Hy; intuition. Qed. diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v index 67411eac8..0973b7d8d 100644 --- a/theories/Numbers/Rational/BigQ/QMake.v +++ b/theories/Numbers/Rational/BigQ/QMake.v @@ -28,27 +28,27 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. number y interpreted as x/y. The pairs (x,0) and (0,y) are all interpreted as 0. *) - Inductive t_ := + Inductive t_ := | Qz : Z.t -> t_ | Qq : Z.t -> N.t -> t_. Definition t := t_. - (** Specification with respect to [QArith] *) + (** Specification with respect to [QArith] *) Open Local Scope Q_scope. Definition of_Z x: t := Qz (Z.of_Z x). - Definition of_Q (q:Q) : t := - let (x,y) := q in - match y with + Definition of_Q (q:Q) : t := + let (x,y) := q in + match y with | 1%positive => Qz (Z.of_Z x) | _ => Qq (Z.of_Z x) (N.of_N (Npos y)) end. - Definition to_Q (q: t) := - match q with + Definition to_Q (q: t) := + match q with | Qz x => Z.to_Z x # 1 | Qq x y => if N.eq_bool y N.zero then 0 else Z.to_Z x # Z2P (N.to_Z y) @@ -59,11 +59,11 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q. Proof. intros(x,y); destruct y; simpl; rewrite Z.spec_of_Z; auto. - generalize (N.spec_eq_bool (N.of_N (Npos y~1)) N.zero); + generalize (N.spec_eq_bool (N.of_N (Npos y~1)) N.zero); case N.eq_bool; auto; rewrite N.spec_0. rewrite N.spec_of_N; discriminate. rewrite N.spec_of_N; auto. - generalize (N.spec_eq_bool (N.of_N (Npos y~0)) N.zero); + generalize (N.spec_eq_bool (N.of_N (Npos y~0)) N.zero); case N.eq_bool; auto; rewrite N.spec_0. rewrite N.spec_of_N; discriminate. rewrite N.spec_of_N; auto. @@ -98,77 +98,77 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition compare (x y: t) := match x, y with | Qz zx, Qz zy => Z.compare zx zy - | Qz zx, Qq ny dy => + | Qz zx, Qq ny dy => if N.eq_bool dy N.zero then Z.compare zx Z.zero else Z.compare (Z.mul zx (Z_of_N dy)) ny - | Qq nx dx, Qz zy => - if N.eq_bool dx N.zero then Z.compare Z.zero zy + | Qq nx dx, Qz zy => + if N.eq_bool dx N.zero then Z.compare Z.zero zy else Z.compare nx (Z.mul zy (Z_of_N dx)) | Qq nx dx, Qq ny dy => match N.eq_bool dx N.zero, N.eq_bool dy N.zero with | true, true => Eq | true, false => Z.compare Z.zero ny | false, true => Z.compare nx Z.zero - | false, false => Z.compare (Z.mul nx (Z_of_N dy)) + | false, false => Z.compare (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) end end. - Lemma Zcompare_spec_alt : + Lemma Zcompare_spec_alt : forall z z', Z.compare z z' = (Z.to_Z z ?= Z.to_Z z')%Z. Proof. intros; generalize (Z.spec_compare z z'); destruct Z.compare; auto. intro H; rewrite H; symmetry; apply Zcompare_refl. Qed. - - Lemma Ncompare_spec_alt : + + Lemma Ncompare_spec_alt : forall n n', N.compare n n' = (N.to_Z n ?= N.to_Z n')%Z. Proof. intros; generalize (N.spec_compare n n'); destruct N.compare; auto. intro H; rewrite H; symmetry; apply Zcompare_refl. Qed. - Lemma N_to_Z2P : forall n, N.to_Z n <> 0%Z -> + Lemma N_to_Z2P : forall n, N.to_Z n <> 0%Z -> Zpos (Z2P (N.to_Z n)) = N.to_Z n. Proof. intros; apply Z2P_correct. generalize (N.spec_pos n); romega. Qed. - Hint Rewrite - Zplus_0_r Zplus_0_l Zmult_0_r Zmult_0_l Zmult_1_r Zmult_1_l + Hint Rewrite + Zplus_0_r Zplus_0_l Zmult_0_r Zmult_0_l Zmult_1_r Zmult_1_l Z.spec_0 N.spec_0 Z.spec_1 N.spec_1 Z.spec_m1 Z.spec_opp Zcompare_spec_alt Ncompare_spec_alt - Z.spec_add N.spec_add Z.spec_mul N.spec_mul + Z.spec_add N.spec_add Z.spec_mul N.spec_mul Z.spec_gcd N.spec_gcd Zgcd_Zabs Zgcd_1 spec_Z_of_N spec_Zabs_N : nz. Ltac nzsimpl := autorewrite with nz in *. Ltac destr_neq_bool := repeat - (match goal with |- context [N.eq_bool ?x ?y] => + (match goal with |- context [N.eq_bool ?x ?y] => generalize (N.spec_eq_bool x y); case N.eq_bool end). - + Ltac destr_zeq_bool := repeat - (match goal with |- context [Z.eq_bool ?x ?y] => + (match goal with |- context [Z.eq_bool ?x ?y] => generalize (Z.spec_eq_bool x y); case Z.eq_bool end). Ltac simpl_ndiv := rewrite N.spec_div by (nzsimpl; romega). - Tactic Notation "simpl_ndiv" "in" "*" := + Tactic Notation "simpl_ndiv" "in" "*" := rewrite N.spec_div in * by (nzsimpl; romega). Ltac simpl_zdiv := rewrite Z.spec_div by (nzsimpl; romega). - Tactic Notation "simpl_zdiv" "in" "*" := + Tactic Notation "simpl_zdiv" "in" "*" := rewrite Z.spec_div in * by (nzsimpl; romega). - Ltac qsimpl := try red; unfold to_Q; simpl; intros; + Ltac qsimpl := try red; unfold to_Q; simpl; intros; destr_neq_bool; destr_zeq_bool; simpl; nzsimpl; auto; intros. Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]). Proof. - intros [z1 | x1 y1] [z2 | x2 y2]; + intros [z1 | x1 y1] [z2 | x2 y2]; unfold Qcompare, compare; qsimpl; rewrite ! N_to_Z2P; auto. Qed. @@ -177,7 +177,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition min n m := match compare n m with Gt => m | _ => n end. Definition max n m := match compare n m with Lt => m | _ => n end. - Definition eq_bool n m := + Definition eq_bool n m := match compare n m with Eq => true | _ => false end. Theorem spec_eq_bool: forall x y, @@ -196,9 +196,9 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (** Normalisation function *) Definition norm n d : t := - let gcd := N.gcd (Zabs_N n) d in + let gcd := N.gcd (Zabs_N n) d in match N.compare N.one gcd with - | Lt => + | Lt => let n := Z.div n (Z_of_N gcd) in let d := N.div d gcd in match N.compare d N.one with @@ -249,7 +249,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem strong_spec_norm : forall p q, [norm p q] = Qred [Qq p q]. Proof. intros. - replace (Qred [Qq p q]) with (Qred [norm p q]) by + replace (Qred [Qq p q]) with (Qred [norm p q]) by (apply Qred_complete; apply spec_norm). symmetry; apply Qred_identity. unfold norm. @@ -282,10 +282,10 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. simpl; auto with zarith. Qed. - (** Reduction function : producing irreducible fractions *) + (** Reduction function : producing irreducible fractions *) - Definition red (x : t) : t := - match x with + Definition red (x : t) : t := + match x with | Qz z => x | Qq n d => norm n d end. @@ -307,18 +307,18 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. symmetry; apply Qred_identity; simpl; auto with zarith. unfold red; apply strong_spec_norm. Qed. - + Definition add (x y: t): t := match x with | Qz zx => match y with | Qz zy => Qz (Z.add zx zy) - | Qq ny dy => - if N.eq_bool dy N.zero then x + | Qq ny dy => + if N.eq_bool dy N.zero then x else Qq (Z.add (Z.mul zx (Z_of_N dy)) ny) dy end | Qq nx dx => - if N.eq_bool dx N.zero then y + if N.eq_bool dx N.zero then y else match y with | Qz zy => Qq (Z.add nx (Z.mul zy (Z_of_N dx))) dx | Qq ny dy => @@ -352,12 +352,12 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. | Qz zx => match y with | Qz zy => Qz (Z.add zx zy) - | Qq ny dy => - if N.eq_bool dy N.zero then x + | Qq ny dy => + if N.eq_bool dy N.zero then x else norm (Z.add (Z.mul zx (Z_of_N dy)) ny) dy end | Qq nx dx => - if N.eq_bool dx N.zero then y + if N.eq_bool dx N.zero then y else match y with | Qz zy => norm (Z.add nx (Z.mul zy (Z_of_N dx))) dx | Qq ny dy => @@ -372,16 +372,16 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_add_norm : forall x y, [add_norm x y] == [x] + [y]. Proof. intros x y; rewrite <- spec_add. - destruct x; destruct y; unfold add_norm, add; + destruct x; destruct y; unfold add_norm, add; destr_neq_bool; auto using Qeq_refl, spec_norm. Qed. - Theorem strong_spec_add_norm : forall x y : t, + Theorem strong_spec_add_norm : forall x y : t, Reduced x -> Reduced y -> Reduced (add_norm x y). Proof. unfold Reduced; intros. rewrite strong_spec_red. - rewrite <- (Qred_complete [add x y]); + rewrite <- (Qred_complete [add x y]); [ | rewrite spec_add, spec_add_norm; apply Qeq_refl ]. rewrite <- strong_spec_red. destruct x as [zx|nx dx]; destruct y as [zy|ny dy]. @@ -404,7 +404,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Proof. intros [z | x y]; simpl. rewrite Z.spec_opp; auto. - match goal with |- context[N.eq_bool ?X ?Y] => + match goal with |- context[N.eq_bool ?X ?Y] => generalize (N.spec_eq_bool X Y); case N.eq_bool end; auto; rewrite N.spec_0. rewrite Z.spec_opp; auto. @@ -438,7 +438,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite spec_opp; ring. Qed. - Theorem strong_spec_sub_norm : forall x y, + Theorem strong_spec_sub_norm : forall x y, Reduced x -> Reduced y -> Reduced (sub_norm x y). Proof. intros. @@ -470,7 +470,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. generalize (N.spec_pos dy); omega. Qed. - Lemma norm_denum : forall n d, + Lemma norm_denum : forall n d, [if N.eq_bool d N.one then Qz n else Qq n d] == [Qq n d]. Proof. intros; simpl; qsimpl. @@ -478,15 +478,15 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite N_to_Z2P, H0; auto with zarith. Qed. - Definition irred n d := + Definition irred n d := let gcd := N.gcd (Zabs_N n) d in - match N.compare gcd N.one with + match N.compare gcd N.one with | Gt => (Z.div n (Z_of_N gcd), N.div d gcd) | _ => (n, d) end. - Lemma spec_irred : forall n d, exists g, - let (n',d') := irred n d in + Lemma spec_irred : forall n d, exists g, + let (n',d') := irred n d in (Z.to_Z n' * g = Z.to_Z n)%Z /\ (N.to_Z d' * g = N.to_Z d)%Z. Proof. intros. @@ -511,7 +511,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith. Qed. - Lemma spec_irred_zero : forall n d, + Lemma spec_irred_zero : forall n d, (N.to_Z d = 0)%Z <-> (N.to_Z (snd (irred n d)) = 0)%Z. Proof. intros. @@ -535,8 +535,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. compute in H1; elim H1; auto. Qed. - Lemma strong_spec_irred : forall n d, - (N.to_Z d <> 0%Z) -> + Lemma strong_spec_irred : forall n d, + (N.to_Z d <> 0%Z) -> let (n',d') := irred n d in Zgcd (Z.to_Z n') (N.to_Z d') = 1%Z. Proof. unfold irred; intros. @@ -554,31 +554,31 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Zgcd_is_gcd; auto. Qed. - Definition mul_norm_Qz_Qq z n d := - if Z.eq_bool z Z.zero then zero + Definition mul_norm_Qz_Qq z n d := + if Z.eq_bool z Z.zero then zero else let gcd := N.gcd (Zabs_N z) d in match N.compare gcd N.one with - | Gt => + | Gt => let z := Z.div z (Z_of_N gcd) in let d := N.div d gcd in if N.eq_bool d N.one then Qz (Z.mul z n) else Qq (Z.mul z n) d | _ => Qq (Z.mul z n) d end. - Definition mul_norm (x y: t): t := + Definition mul_norm (x y: t): t := match x, y with | Qz zx, Qz zy => Qz (Z.mul zx zy) | Qz zx, Qq ny dy => mul_norm_Qz_Qq zx ny dy | Qq nx dx, Qz zy => mul_norm_Qz_Qq zy nx dx - | Qq nx dx, Qq ny dy => - let (nx, dy) := irred nx dy in - let (ny, dx) := irred ny dx in + | Qq nx dx, Qq ny dy => + let (nx, dy) := irred nx dy in + let (ny, dx) := irred ny dx in let d := N.mul dx dy in if N.eq_bool d N.one then Qz (Z.mul ny nx) else Qq (Z.mul ny nx) d end. - Lemma spec_mul_norm_Qz_Qq : forall z n d, + Lemma spec_mul_norm_Qz_Qq : forall z n d, [mul_norm_Qz_Qq z n d] == [Qq (Z.mul z n) d]. Proof. intros z n d; unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. @@ -599,14 +599,14 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite <- Zgcd_div_swap0; auto with zarith; ring. Qed. - Lemma strong_spec_mul_norm_Qz_Qq : forall z n d, + Lemma strong_spec_mul_norm_Qz_Qq : forall z n d, Reduced (Qq n d) -> Reduced (mul_norm_Qz_Qq z n d). Proof. unfold Reduced; intros z n d. rewrite 2 strong_spec_red, 2 Qred_iff. simpl; nzsimpl. destr_neq_bool; intros Hd H; simpl in *; nzsimpl. - + unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. destr_zeq_bool; intros Hz; simpl; nzsimpl; simpl; auto. destruct Z_le_gt_dec. @@ -670,7 +670,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destruct (spec_irred ny dx) as (g' & Hg'). assert (Hz := spec_irred_zero nx dy). assert (Hz':= spec_irred_zero ny dx). - destruct irred as (n1,d1); destruct irred as (n2,d2). + destruct irred as (n1,d1); destruct irred as (n2,d2). simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2']. rewrite norm_denum. qsimpl. @@ -686,10 +686,10 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite 2 Z2P_correct. rewrite <- Hg1, <- Hg2, <- Hg1', <- Hg2'; ring. - assert (0 <= N.to_Z d2 * N.to_Z d1)%Z + assert (0 <= N.to_Z d2 * N.to_Z d1)%Z by (apply Zmult_le_0_compat; apply N.spec_pos). romega. - assert (0 <= N.to_Z dx * N.to_Z dy)%Z + assert (0 <= N.to_Z dx * N.to_Z dy)%Z by (apply Zmult_le_0_compat; apply N.spec_pos). romega. Qed. @@ -712,7 +712,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. assert (Hz':= spec_irred_zero ny dx). assert (Hgc := strong_spec_irred nx dy). assert (Hgc' := strong_spec_irred ny dx). - destruct irred as (n1,d1); destruct irred as (n2,d2). + destruct irred as (n1,d1); destruct irred as (n2,d2). simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2']. destr_neq_bool; simpl; nzsimpl; intros; auto. destr_neq_bool; simpl; nzsimpl; intros; auto. @@ -729,7 +729,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Zgcd_mult_rel_prime; rewrite Zgcd_comm; apply Zgcd_mult_rel_prime; rewrite Zgcd_comm; auto. - + rewrite Zgcd_1_rel_prime in *. apply bezout_rel_prime. destruct (rel_prime_bezout _ _ H4) as [u v Huv]. @@ -747,15 +747,15 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. romega. Qed. - Definition inv (x: t): t := + Definition inv (x: t): t := match x with - | Qz z => - match Z.compare Z.zero z with + | Qz z => + match Z.compare Z.zero z with | Eq => zero | Lt => Qq Z.one (Zabs_N z) | Gt => Qq Z.minus_one (Zabs_N z) end - | Qq n d => + | Qq n d => match Z.compare Z.zero n with | Eq => zero | Lt => Qq (Z_of_N d) (Zabs_N n) @@ -827,25 +827,25 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite T, Zpos_mult_morphism, N_to_Z2P; auto; ring. Qed. - Definition inv_norm (x: t): t := + Definition inv_norm (x: t): t := match x with - | Qz z => - match Z.compare Z.zero z with + | Qz z => + match Z.compare Z.zero z with | Eq => zero | Lt => Qq Z.one (Zabs_N z) | Gt => Qq Z.minus_one (Zabs_N z) end - | Qq n d => - if N.eq_bool d N.zero then zero else - match Z.compare Z.zero n with + | Qq n d => + if N.eq_bool d N.zero then zero else + match Z.compare Z.zero n with | Eq => zero - | Lt => - match Z.compare n Z.one with + | Lt => + match Z.compare n Z.one with | Gt => Qq (Z_of_N d) (Zabs_N n) | _ => Qz (Z_of_N d) end - | Gt => - match Z.compare n Z.minus_one with + | Gt => + match Z.compare n Z.minus_one with | Lt => Qq (Z.opp (Z_of_N d)) (Zabs_N n) | _ => Qz (Z.opp (Z_of_N d)) end @@ -882,7 +882,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem strong_spec_inv_norm : forall x, Reduced x -> Reduced (inv_norm x). Proof. - unfold Reduced. + unfold Reduced. intros. destruct x as [ z | n d ]. (* Qz *) @@ -952,8 +952,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Qeq_refl. apply spec_inv_norm; auto. Qed. - - Theorem strong_spec_div_norm : forall x y, + + Theorem strong_spec_div_norm : forall x y, Reduced x -> Reduced y -> Reduced (div_norm x y). Proof. intros; unfold div_norm. @@ -980,7 +980,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite H in H0; simpl in H0; elim H0; auto. assert (0 < N.to_Z d)%Z by (generalize (N.spec_pos d); romega). clear H H0. - rewrite Z.spec_square, N.spec_square. + rewrite Z.spec_square, N.spec_square. red; simpl. rewrite Zpos_mult_morphism; rewrite !Z2P_correct; auto. apply Zmult_lt_0_compat; auto. @@ -991,7 +991,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. | Qz zx => Qz (Z.power_pos zx p) | Qq nx dx => Qq (Z.power_pos nx p) (N.power_pos dx p) end. - + Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p. Proof. intros [ z | n d ] p; unfold power_pos. @@ -1019,7 +1019,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite N.spec_power_pos. auto. Qed. - Theorem strong_spec_power_pos : forall x p, + Theorem strong_spec_power_pos : forall x p, Reduced x -> Reduced (power_pos x p). Proof. destruct x as [z | n d]; simpl; intros. @@ -1040,8 +1040,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply rel_prime_Zpower; auto with zarith. Qed. - Definition power (x : t) (z : Z) : t := - match z with + Definition power (x : t) (z : Z) : t := + match z with | Z0 => one | Zpos p => power_pos x p | Zneg p => inv (power_pos x p) @@ -1056,8 +1056,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite spec_inv, spec_power_pos; apply Qeq_refl. Qed. - Definition power_norm (x : t) (z : Z) : t := - match z with + Definition power_norm (x : t) (z : Z) : t := + match z with | Z0 => one | Zpos p => power_pos x p | Zneg p => inv_norm (power_pos x p) @@ -1072,7 +1072,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite spec_inv_norm, spec_power_pos; apply Qeq_refl. Qed. - Theorem strong_spec_power_norm : forall x z, + Theorem strong_spec_power_norm : forall x z, Reduced x -> Reduced (power_norm x z). Proof. destruct z; simpl. @@ -1085,7 +1085,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (** Interaction with [Qcanon.Qc] *) - + Open Scope Qc_scope. Definition of_Qc q := of_Q (this q). @@ -1166,7 +1166,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Qplus_comp; apply Qeq_sym; apply Qred_correct. Qed. - Theorem spec_add_normc_bis : forall x y : Qc, + Theorem spec_add_normc_bis : forall x y : Qc, [add_norm (of_Qc x) (of_Qc y)] = x+y. Proof. intros. @@ -1189,7 +1189,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite spec_oppc; ring. Qed. - Theorem spec_sub_normc_bis : forall x y : Qc, + Theorem spec_sub_normc_bis : forall x y : Qc, [sub_norm (of_Qc x) (of_Qc y)] = x-y. Proof. intros. @@ -1228,7 +1228,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Qmult_comp; apply Qeq_sym; apply Qred_correct. Qed. - Theorem spec_mul_normc_bis : forall x y : Qc, + Theorem spec_mul_normc_bis : forall x y : Qc, [mul_norm (of_Qc x) (of_Qc y)] = x*y. Proof. intros. @@ -1266,7 +1266,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Qinv_comp; apply Qeq_sym; apply Qred_correct. Qed. - Theorem spec_inv_normc_bis : forall x : Qc, + Theorem spec_inv_normc_bis : forall x : Qc, [inv_norm (of_Qc x)] = /x. Proof. intros. @@ -1280,7 +1280,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Proof. intros x y; unfold div; rewrite spec_mulc; auto. unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. + apply spec_invc; auto. Qed. Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. @@ -1290,7 +1290,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply spec_inv_normc; auto. Qed. - Theorem spec_div_normc_bis : forall x y : Qc, + Theorem spec_div_normc_bis : forall x y : Qc, [div_norm (of_Qc x) (of_Qc y)] = x/y. Proof. intros. diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v index 7c88d25aa..8be66493e 100644 --- a/theories/Numbers/Rational/SpecViaQ/QSig.v +++ b/theories/Numbers/Rational/SpecViaQ/QSig.v @@ -48,12 +48,12 @@ Module Type QType. Definition max n m := match compare n m with Lt => m | _ => n end. Parameter eq_bool : t -> t -> bool. - - Parameter spec_eq_bool : forall x y, + + Parameter spec_eq_bool : forall x y, if eq_bool x y then [x]==[y] else ~([x]==[y]). Parameter red : t -> t. - + Parameter spec_red : forall x, [red x] == [x]. Parameter strong_spec_red : forall x, [red x] = Qred [x]. diff --git a/theories/Program/Basics.v b/theories/Program/Basics.v index 9335f4834..c54756881 100644 --- a/theories/Program/Basics.v +++ b/theories/Program/Basics.v @@ -8,7 +8,7 @@ (* $Id$ *) (** Standard functions and combinators. - + Proofs about them require functional extensionality and can be found in [Combinators]. Author: Matthieu Sozeau @@ -21,12 +21,12 @@ Implicit Arguments id [[A]]. (** Function composition. *) -Definition compose {A B C} (g : B -> C) (f : A -> B) := +Definition compose {A B C} (g : B -> C) (f : A -> B) := fun x : A => g (f x). Hint Unfold compose. -Notation " g ∘ f " := (compose g f) +Notation " g ∘ f " := (compose g f) (at level 40, left associativity) : program_scope. Open Local Scope program_scope. diff --git a/theories/Program/Combinators.v b/theories/Program/Combinators.v index 33ad3b556..e12f57668 100644 --- a/theories/Program/Combinators.v +++ b/theories/Program/Combinators.v @@ -34,7 +34,7 @@ Proof. symmetry ; apply eta_expansion. Qed. -Lemma compose_assoc : forall A B C D (f : A -> B) (g : B -> C) (h : C -> D), +Lemma compose_assoc : forall A B C D (f : A -> B) (g : B -> C) (h : C -> D), h ∘ g ∘ f = h ∘ (g ∘ f). Proof. intros. diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v index f35dc7adc..381a0bae4 100644 --- a/theories/Program/Equality.v +++ b/theories/Program/Equality.v @@ -26,7 +26,7 @@ Notation "'refl'" := (@refl_equal _ _). (** Do something on an heterogeneous equality appearing in the context. *) -Ltac on_JMeq tac := +Ltac on_JMeq tac := match goal with | [ H : @JMeq ?x ?X ?y ?Y |- _ ] => tac H end. @@ -44,17 +44,17 @@ Ltac simpl_JMeq := repeat simpl_one_JMeq. Ltac simpl_one_dep_JMeq := on_JMeq - ltac:(fun H => let H' := fresh "H" in + ltac:(fun H => let H' := fresh "H" in assert (H' := JMeq_eq H)). Require Import Eqdep. -(** Simplify dependent equality using sigmas to equality of the second projections if possible. +(** Simplify dependent equality using sigmas to equality of the second projections if possible. Uses UIP. *) Ltac simpl_existT := match goal with - [ H : existT _ ?x _ = existT _ ?x _ |- _ ] => + [ H : existT _ ?x _ = existT _ ?x _ |- _ ] => let Hi := fresh H in assert(Hi:=inj_pairT2 _ _ _ _ _ H) ; clear H end. @@ -64,15 +64,15 @@ Ltac simpl_existTs := repeat simpl_existT. Ltac elim_eq_rect := match goal with - | [ |- ?t ] => + | [ |- ?t ] => match t with - | context [ @eq_rect _ _ _ _ _ ?p ] => - let P := fresh "P" in - set (P := p); simpl in P ; + | context [ @eq_rect _ _ _ _ _ ?p ] => + let P := fresh "P" in + set (P := p); simpl in P ; ((case P ; clear P) || (clearbody P; rewrite (UIP_refl _ _ P); clear P)) - | context [ @eq_rect _ _ _ _ _ ?p _ ] => - let P := fresh "P" in - set (P := p); simpl in P ; + | context [ @eq_rect _ _ _ _ _ ?p _ ] => + let P := fresh "P" in + set (P := p); simpl in P ; ((case P ; clear P) || (clearbody P; rewrite (UIP_refl _ _ P); clear P)) end end. @@ -90,18 +90,18 @@ Ltac simpl_eq := simpl ; unfold eq_rec_r, eq_rec ; repeat (elim_eq_rect ; simpl) (** Try to abstract a proof of equality, if no proof of the same equality is present in the context. *) -Ltac abstract_eq_hyp H' p := +Ltac abstract_eq_hyp H' p := let ty := type of p in let tyred := eval simpl in ty in - match tyred with - ?X = ?Y => - match goal with + match tyred with + ?X = ?Y => + match goal with | [ H : X = Y |- _ ] => fail 1 | _ => set (H':=p) ; try (change p with H') ; clearbody H' ; simpl in H' end end. -(** Apply the tactic tac to proofs of equality appearing as coercion arguments. +(** Apply the tactic tac to proofs of equality appearing as coercion arguments. Just redefine this tactic (using [Ltac on_coerce_proof tac ::=]) to handle custom coercion operators. *) @@ -109,7 +109,7 @@ Ltac on_coerce_proof tac T := match T with | context [ eq_rect _ _ _ _ ?p ] => tac p end. - + Ltac on_coerce_proof_gl tac := match goal with [ |- ?T ] => on_coerce_proof tac T @@ -120,17 +120,17 @@ Ltac on_coerce_proof_gl tac := Ltac abstract_eq_proof := on_coerce_proof_gl ltac:(fun p => let H := fresh "eqH" in abstract_eq_hyp H p). Ltac abstract_eq_proofs := repeat abstract_eq_proof. - -(** Factorize proofs, by using proof irrelevance so that two proofs of the same equality + +(** Factorize proofs, by using proof irrelevance so that two proofs of the same equality in the goal become convertible. *) Ltac pi_eq_proof_hyp p := let ty := type of p in let tyred := eval simpl in ty in match tyred with - ?X = ?Y => - match goal with - | [ H : X = Y |- _ ] => + ?X = ?Y => + match goal with + | [ H : X = Y |- _ ] => match p with | H => fail 2 | _ => rewrite (proof_irrelevance (X = Y) p H) @@ -162,28 +162,28 @@ Ltac rewrite_refl_id := autorewrite with refl_id. Ltac clear_eq_ctx := rewrite_refl_id ; clear_eq_proofs. -(** Reapeated elimination of [eq_rect] applications. +(** Reapeated elimination of [eq_rect] applications. Abstracting equalities makes it run much faster than an naive implementation. *) -Ltac simpl_eqs := +Ltac simpl_eqs := repeat (elim_eq_rect ; simpl ; clear_eq_ctx). (** Clear unused reflexivity proofs. *) -Ltac clear_refl_eq := +Ltac clear_refl_eq := match goal with [ H : ?X = ?X |- _ ] => clear H end. Ltac clear_refl_eqs := repeat clear_refl_eq. (** Clear unused equality proofs. *) -Ltac clear_eq := +Ltac clear_eq := match goal with [ H : _ = _ |- _ ] => clear H end. Ltac clear_eqs := repeat clear_eq. (** Combine all the tactics to simplify goals containing coercions. *) -Ltac simplify_eqs := - simpl ; simpl_eqs ; clear_eq_ctx ; clear_refl_eqs ; +Ltac simplify_eqs := + simpl ; simpl_eqs ; clear_eq_ctx ; clear_refl_eqs ; try subst ; simpl ; repeat simpl_uip ; rewrite_refl_id. (** A tactic that tries to remove trivial equality guards in induction hypotheses coming @@ -219,7 +219,7 @@ Ltac simpl_IH_eq H := Ltac simpl_IH_eqs H := repeat simpl_IH_eq H. -Ltac do_simpl_IHs_eqs := +Ltac do_simpl_IHs_eqs := match goal with | [ H : context [ @JMeq _ _ _ _ -> _ ] |- _ ] => progress (simpl_IH_eqs H) | [ H : context [ _ = _ -> _ ] |- _ ] => progress (simpl_IH_eqs H) @@ -227,17 +227,17 @@ Ltac do_simpl_IHs_eqs := Ltac simpl_IHs_eqs := repeat do_simpl_IHs_eqs. -(** We split substitution tactics in the two directions depending on which +(** We split substitution tactics in the two directions depending on which names we want to keep corresponding to the generalization performed by the [generalize_eqs] tactic. *) Ltac subst_left_no_fail := - repeat (match goal with + repeat (match goal with [ H : ?X = ?Y |- _ ] => subst X end). Ltac subst_right_no_fail := - repeat (match goal with + repeat (match goal with [ H : ?X = ?Y |- _ ] => subst Y end). @@ -250,32 +250,32 @@ Ltac inject_right H := Ltac autoinjections_left := repeat autoinjection ltac:inject_left. Ltac autoinjections_right := repeat autoinjection ltac:inject_right. -Ltac simpl_depind := subst_no_fail ; autoinjections ; try discriminates ; +Ltac simpl_depind := subst_no_fail ; autoinjections ; try discriminates ; simpl_JMeq ; simpl_existTs ; simpl_IHs_eqs. -Ltac simpl_depind_l := subst_left_no_fail ; autoinjections_left ; try discriminates ; +Ltac simpl_depind_l := subst_left_no_fail ; autoinjections_left ; try discriminates ; simpl_JMeq ; simpl_existTs ; simpl_IHs_eqs. -Ltac simpl_depind_r := subst_right_no_fail ; autoinjections_right ; try discriminates ; +Ltac simpl_depind_r := subst_right_no_fail ; autoinjections_right ; try discriminates ; simpl_JMeq ; simpl_existTs ; simpl_IHs_eqs. (** Support for the [Equations] command. - These tactics implement the necessary machinery to solve goals produced by the - [Equations] command relative to dependent pattern-matching. + These tactics implement the necessary machinery to solve goals produced by the + [Equations] command relative to dependent pattern-matching. It is completely inspired from the "Eliminating Dependent Pattern-Matching" paper by Goguen, McBride and McKinna. *) (** The NoConfusionPackage class provides a method for making progress on proving a property [P] implied by an equality on an inductive type [I]. The type of [noConfusion] for a given - [P] should be of the form [ ΠΔ, (x y : I Δ) (x = y) -> NoConfusion P x y ], where + [P] should be of the form [ ΠΔ, (x y : I Δ) (x = y) -> NoConfusion P x y ], where [NoConfusion P x y] for constructor-headed [x] and [y] will give a formula ending in [P]. This gives a general method for simplifying by discrimination or injectivity of constructors. - + Some actual instances are defined later in the file using the more primitive [discriminate] and [injection] tactics on which we can always fall back. *) - + Class NoConfusionPackage (I : Type) := { NoConfusion : Î P : Prop, Type ; noConfusion : Î P, NoConfusion P }. (** The [DependentEliminationPackage] provides the default dependent elimination principle to @@ -287,13 +287,13 @@ Class DependentEliminationPackage (A : Type) := (** A higher-order tactic to apply a registered eliminator. *) -Ltac elim_tac tac p := +Ltac elim_tac tac p := let ty := type of p in let eliminator := eval simpl in (elim (A:=ty)) in tac p eliminator. -(** Specialization to do case analysis or induction. - Note: the [equations] tactic tries [case] before [elim_case]: there is no need to register +(** Specialization to do case analysis or induction. + Note: the [equations] tactic tries [case] before [elim_case]: there is no need to register generated induction principles. *) Ltac elim_case p := elim_tac ltac:(fun p el => destruct p using el) p. @@ -308,7 +308,7 @@ Class BelowPackage (A : Type) := { (** The [Recursor] class defines a recursor on a type, based on some definition of [Below]. *) -Class Recursor (A : Type) (BP : BelowPackage A) := +Class Recursor (A : Type) (BP : BelowPackage A) := { rec_type : A -> Type ; rec : Î (a : A), rec_type a }. (** Lemmas used by the simplifier, mainly rephrasings of [eq_rect], [eq_ind]. *) @@ -332,7 +332,7 @@ Proof. intros. apply X. apply inj_pair2. exact H. Defined. Lemma simplification_existT1 : Î A (P : A -> Type) B (p q : A) (x : P p) (y : P q), (p = q -> existT P p x = existT P q y -> B) -> (existT P p x = existT P q y -> B). Proof. intros. injection H. intros ; auto. Defined. - + Lemma simplification_K : Î A (x : A) (B : x = x -> Type), B (refl_equal x) -> (Î p : x = x, B p). Proof. intros. rewrite (UIP_refl A). assumption. Defined. @@ -342,26 +342,26 @@ Ltac unfold_equations := unfold solution_left, solution_right, deletion, simplification_heq, simplification_existT1, simplification_existT2, eq_rect_r, eq_rec, eq_ind. -(** The tactic [simplify_equations] is to be used when a program generated using [Equations] - is in the goal. It simplifies it as much as possible, possibly using [K] if needed. *) +(** The tactic [simplify_equations] is to be used when a program generated using [Equations] + is in the goal. It simplifies it as much as possible, possibly using [K] if needed. *) -Ltac simplify_equations := repeat (unfold_equations ; simplify_eqs). +Ltac simplify_equations := repeat (unfold_equations ; simplify_eqs). -(** We will use the [block_induction] definition to separate the goal from the +(** We will use the [block_induction] definition to separate the goal from the equalities generated by the tactic. *) Definition block_dep_elim {A : Type} (a : A) := a. -(** Using these we can make a simplifier that will perform the unification +(** Using these we can make a simplifier that will perform the unification steps needed to put the goal in normalised form (provided there are only constructor forms). Compare with the lemma 16 of the paper. - We don't have a [noCycle] procedure yet. *) + We don't have a [noCycle] procedure yet. *) Ltac simplify_one_dep_elim_term c := match c with | @JMeq _ _ _ _ -> _ => refine (simplification_heq _ _ _ _ _) | ?t = ?t -> _ => intros _ || refine (simplification_K _ t _ _) - | eq (existT _ _ _) (existT _ _ _) -> _ => + | eq (existT _ _ _) (existT _ _ _) -> _ => refine (simplification_existT2 _ _ _ _ _ _ _) || refine (simplification_existT1 _ _ _ _ _ _ _ _) | ?x = ?y -> _ => (* variables case *) @@ -413,12 +413,12 @@ Definition inaccessible_pattern {A : Type} (t : A) := t. Notation "?( t )" := (inaccessible_pattern t). (** To handle sections, we need to separate the context in two parts: - variables introduced by the section and the rest. We introduce a dummy variable + variables introduced by the section and the rest. We introduce a dummy variable between them to indicate that. *) CoInductive end_of_section := the_end_of_the_section. -Ltac set_eos := let eos := fresh "eos" in +Ltac set_eos := let eos := fresh "eos" in assert (eos:=the_end_of_the_section). (** We have a specialized [reverse_local] tactic to reverse the goal until the begining of the @@ -426,14 +426,14 @@ Ltac set_eos := let eos := fresh "eos" in Ltac reverse_local := match goal with - | [ H : ?T |- _ ] => + | [ H : ?T |- _ ] => match T with | end_of_section => idtac | _ => revert H ; reverse_local end | _ => idtac end. (** Do as much as possible to apply a method, trying to get the arguments right. - !!Unsafe!! We use [auto] for the [_nocomp] variant of [Equations], in which case some + !!Unsafe!! We use [auto] for the [_nocomp] variant of [Equations], in which case some non-dependent arguments of the method can remain after [apply]. *) Ltac simpl_intros m := ((apply m || refine m) ; auto) || (intro ; simpl_intros m). @@ -453,7 +453,7 @@ Ltac simplify_method tac := repeat (tac || simplify_one_dep_elim) ; reverse_loca (** Solving a method call: we can solve it by splitting on an empty family member or we must refine the goal until the body can be applied. *) - + Ltac solve_method rec := match goal with | [ H := ?body : nat |- _ ] => subst H ; clear ; abstract (simplify_method idtac ; solve_empty body) @@ -463,21 +463,21 @@ Ltac solve_method rec := (** Impossible cases, by splitting on a given target. *) Ltac solve_split := - match goal with + match goal with | [ |- let split := ?x : nat in _ ] => clear ; abstract (intros _ ; solve_empty x) end. (** If defining recursive functions, the prototypes come first. *) Ltac intro_prototypes := - match goal with + match goal with | [ |- Î x : _, _ ] => intro ; intro_prototypes | _ => idtac end. -Ltac introduce p := first [ - match p with _ => (* Already there, generalize dependent hyps *) - generalize dependent p ; intros p +Ltac introduce p := first [ + match p with _ => (* Already there, generalize dependent hyps *) + generalize dependent p ; intros p end | intros until p | intros ]. @@ -489,7 +489,7 @@ Ltac dep_elimify := match goal with [ |- ?T ] => change (block_dep_elim T) end. Ltac un_dep_elimify := unfold block_dep_elim in *. Ltac case_last := dep_elimify ; - on_last_hyp ltac:(fun p => + on_last_hyp ltac:(fun p => let ty := type of p in match ty with | ?x = ?x => revert p ; refine (simplification_K _ x _ _) @@ -497,28 +497,28 @@ Ltac case_last := dep_elimify ; | _ => simpl in p ; generalize_eqs p ; do_case p end). -Ltac nonrec_equations := +Ltac nonrec_equations := solve [solve_equations (case_last) (solve_method idtac)] || solve [ solve_split ] || fail "Unnexpected equations goal". Ltac recursive_equations := - solve [solve_equations (case_last) (solve_method ltac:intro)] || solve [ solve_split ] + solve [solve_equations (case_last) (solve_method ltac:intro)] || solve [ solve_split ] || fail "Unnexpected recursive equations goal". (** The [equations] tactic is the toplevel tactic for solving goals generated by [Equations]. *) Ltac equations := set_eos ; - match goal with + match goal with | [ |- Î x : _, _ ] => intro ; recursive_equations | _ => nonrec_equations end. (** The following tactics allow to do induction on an already instantiated inductive predicate - by first generalizing it and adding the proper equalities to the context, in a maner similar to + by first generalizing it and adding the proper equalities to the context, in a maner similar to the BasicElim tactic of "Elimination with a motive" by Conor McBride. *) -(** The [do_depind] higher-order tactic takes an induction tactic as argument and an hypothesis +(** The [do_depind] higher-order tactic takes an induction tactic as argument and an hypothesis and starts a dependent induction using this tactic. *) Ltac do_depind tac H := @@ -532,36 +532,36 @@ Ltac do_depind' tac H := (** Calls [destruct] on the generalized hypothesis, results should be similar to inversion. By default, we don't try to generalize the hyp by its variable indices. *) -Tactic Notation "dependent" "destruction" ident(H) := +Tactic Notation "dependent" "destruction" ident(H) := do_depind' ltac:(fun hyp => do_case hyp) H. -Tactic Notation "dependent" "destruction" ident(H) "using" constr(c) := +Tactic Notation "dependent" "destruction" ident(H) "using" constr(c) := do_depind' ltac:(fun hyp => destruct hyp using c) H. (** This tactic also generalizes the goal by the given variables before the induction. *) -Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) := +Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) := do_depind' ltac:(fun hyp => revert l ; do_case hyp) H. -Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := +Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := do_depind' ltac:(fun hyp => revert l ; destruct hyp using c) H. -(** Then we have wrappers for usual calls to induction. One can customize the induction tactic by +(** Then we have wrappers for usual calls to induction. One can customize the induction tactic by writting another wrapper calling do_depind. We suppose the hyp has to be generalized before calling [induction]. *) -Tactic Notation "dependent" "induction" ident(H) := +Tactic Notation "dependent" "induction" ident(H) := do_depind ltac:(fun hyp => do_ind hyp) H. -Tactic Notation "dependent" "induction" ident(H) "using" constr(c) := +Tactic Notation "dependent" "induction" ident(H) "using" constr(c) := do_depind ltac:(fun hyp => induction hyp using c) H. (** This tactic also generalizes the goal by the given variables before the induction. *) -Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) := +Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) := do_depind' ltac:(fun hyp => generalize l ; clear l ; do_ind hyp) H. -Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := +Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := do_depind' ltac:(fun hyp => generalize l ; clear l ; induction hyp using c) H. Ltac simplify_IH_hyps := repeat diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v index 14dc47358..a6aa4d524 100644 --- a/theories/Program/Subset.v +++ b/theories/Program/Subset.v @@ -14,7 +14,7 @@ Require Import Coq.Program.Equality. Open Local Scope program_scope. -(** The following tactics implement a poor-man's solution for proof-irrelevance: it tries to +(** The following tactics implement a poor-man's solution for proof-irrelevance: it tries to factorize every proof of the same proposition in a goal so that equality of such proofs becomes trivial. *) Ltac on_subset_proof_aux tac T := @@ -27,25 +27,25 @@ Ltac on_subset_proof tac := [ |- ?T ] => on_subset_proof_aux tac T end. -Ltac abstract_any_hyp H' p := +Ltac abstract_any_hyp H' p := match type of p with - ?X => - match goal with + ?X => + match goal with | [ H : X |- _ ] => fail 1 | _ => set (H':=p) ; try (change p with H') ; clearbody H' end end. -Ltac abstract_subset_proof := +Ltac abstract_subset_proof := on_subset_proof ltac:(fun p => let H := fresh "eqH" in abstract_any_hyp H p ; simpl in H). Ltac abstract_subset_proofs := repeat abstract_subset_proof. Ltac pi_subset_proof_hyp p := match type of p with - ?X => - match goal with - | [ H : X |- _ ] => + ?X => + match goal with + | [ H : X |- _ ] => match p with | H => fail 2 | _ => rewrite (proof_irrelevance X p H) @@ -78,16 +78,16 @@ Proof. pi. Qed. -(* Somewhat trivial definition, but not unfolded automatically hence we can match on [match_eq ?A ?B ?x ?f] +(* Somewhat trivial definition, but not unfolded automatically hence we can match on [match_eq ?A ?B ?x ?f] in tactics. *) Definition match_eq (A B : Type) (x : A) (fn : forall (y : A | y = x), B) : B := fn (exist _ x (refl_equal x)). -(* This is what we want to be able to do: replace the originaly matched object by a new, +(* This is what we want to be able to do: replace the originaly matched object by a new, propositionally equal one. If [fn] works on [x] it should work on any [y | y = x]. *) -Lemma match_eq_rewrite : forall (A B : Type) (x : A) (fn : forall (y : A | y = x), B) +Lemma match_eq_rewrite : forall (A B : Type) (x : A) (fn : forall (y : A | y = x), B) (y : A | y = x), match_eq A B x fn = fn y. Proof. @@ -103,9 +103,9 @@ Qed. (** Now we make a tactic to be able to rewrite a term [t] which is applied to a [match_eq] using an arbitrary equality [t = u], and [u] is now the subject of the [match]. *) -Ltac rewrite_match_eq H := +Ltac rewrite_match_eq H := match goal with - [ |- ?T ] => + [ |- ?T ] => match T with context [ match_eq ?A ?B ?t ?f ] => rewrite (match_eq_rewrite A B t f (exist _ _ (sym_eq H))) diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v index 7e8fedceb..881297955 100644 --- a/theories/Program/Tactics.v +++ b/theories/Program/Tactics.v @@ -15,13 +15,13 @@ Ltac show_goal := match goal with [ |- ?T ] => idtac T end. -Ltac show_hyp id := - match goal with - | [ H := ?b : ?T |- _ ] => +Ltac show_hyp id := + match goal with + | [ H := ?b : ?T |- _ ] => match H with | id => idtac id ":=" b ":" T end - | [ H : ?T |- _ ] => + | [ H : ?T |- _ ] => match H with | id => idtac id ":" T end @@ -77,7 +77,7 @@ Ltac destruct_exists := repeat (destruct_one_ex). Ltac destruct_conjs := repeat (destruct_one_pair || destruct_one_ex). -(** Destruct an existential hypothesis [t] keeping its name for the first component +(** Destruct an existential hypothesis [t] keeping its name for the first component and using [Ht] for the second *) Tactic Notation "destruct" "exist" ident(t) ident(Ht) := destruct t as [t Ht]. @@ -96,7 +96,7 @@ Ltac discriminates := (** Revert the last hypothesis. *) -Ltac revert_last := +Ltac revert_last := match goal with [ H : _ |- _ ] => revert H end. @@ -108,8 +108,8 @@ Ltac reverse := repeat revert_last. (** Clear duplicated hypotheses *) Ltac clear_dup := - match goal with - | [ H : ?X |- _ ] => + match goal with + | [ H : ?X |- _ ] => match goal with | [ H' : ?Y |- _ ] => match H with @@ -124,7 +124,7 @@ Ltac clear_dups := repeat clear_dup. (** A non-failing subst that substitutes as much as possible. *) Ltac subst_no_fail := - repeat (match goal with + repeat (match goal with [ H : ?X = ?Y |- _ ] => subst X || subst Y end). @@ -139,13 +139,13 @@ Ltac on_application f tac T := | context [f ?x ?y ?z ?w ?v] => tac (f x y z w v) | context [f ?x ?y ?z ?w] => tac (f x y z w) | context [f ?x ?y ?z] => tac (f x y z) - | context [f ?x ?y] => tac (f x y) + | context [f ?x ?y] => tac (f x y) | context [f ?x] => tac (f x) end. (** A variant of [apply] using [refine], doing as much conversion as necessary. *) -Ltac rapply p := +Ltac rapply p := refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) || refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _) || refine (p _ _ _ _ _ _ _ _ _ _ _ _ _) || @@ -162,7 +162,7 @@ Ltac rapply p := refine (p _ _) || refine (p _) || refine p. - + (** Tactical [on_call f tac] applies [tac] on any application of [f] in the hypothesis or goal. *) Ltac on_call f tac := @@ -195,15 +195,15 @@ Tactic Notation "destruct_call" constr(f) := destruct_call f. (** Permit to name the results of destructing the call to [f]. *) -Tactic Notation "destruct_call" constr(f) "as" simple_intropattern(l) := +Tactic Notation "destruct_call" constr(f) "as" simple_intropattern(l) := destruct_call_as f l. (** Specify the hypothesis in which the call occurs as well. *) -Tactic Notation "destruct_call" constr(f) "in" hyp(id) := +Tactic Notation "destruct_call" constr(f) "in" hyp(id) := destruct_call_in f id. -Tactic Notation "destruct_call" constr(f) "as" simple_intropattern(l) "in" hyp(id) := +Tactic Notation "destruct_call" constr(f) "as" simple_intropattern(l) "in" hyp(id) := destruct_call_as_in f l id. (** A marker for prototypes to destruct. *) @@ -215,7 +215,7 @@ Ltac destruct_rec_calls := | [ H : fix_proto _ |- _ ] => destruct_calls H ; clear H end. -Ltac destruct_all_rec_calls := +Ltac destruct_all_rec_calls := repeat destruct_rec_calls ; unfold fix_proto in *. (** Try to inject any potential constructor equality hypothesis. *) @@ -237,23 +237,23 @@ Ltac destruct_nondep H := let H0 := fresh "H" in assert(H0 := H); destruct H0. Ltac bang := match goal with - | |- ?x => + | |- ?x => match x with | context [False_rect _ ?p] => elim p end end. - + (** A tactic to show contradiction by first asserting an automatically provable hypothesis. *) -Tactic Notation "contradiction" "by" constr(t) := +Tactic Notation "contradiction" "by" constr(t) := let H := fresh in assert t as H by auto with * ; contradiction. (** A tactic that adds [H:=p:typeof(p)] to the context if no hypothesis of the same type appears in the goal. Useful to do saturation using tactics. *) -Ltac add_hypothesis H' p := +Ltac add_hypothesis H' p := match type of p with - ?X => - match goal with + ?X => + match goal with | [ H : X |- _ ] => fail 1 | _ => set (H':=p) ; try (change p with H') ; clearbody H' end @@ -281,11 +281,11 @@ Ltac refine_hyp c := end. (** The default simplification tactic used by Program is defined by [program_simpl], sometimes [auto] - is not enough, better rebind using [Obligation Tactic := tac] in this case, + is not enough, better rebind using [Obligation Tactic := tac] in this case, possibly using [program_simplify] to use standard goal-cleaning tactics. *) Ltac program_simplify := - simpl in |- *; intros ; destruct_all_rec_calls ; repeat (destruct_conjs; simpl proj1_sig in *); + simpl in |- *; intros ; destruct_all_rec_calls ; repeat (destruct_conjs; simpl proj1_sig in *); subst*; autoinjections ; try discriminates ; try (solve [ red ; intros ; destruct_conjs ; autoinjections ; discriminates ]). diff --git a/theories/Program/Wf.v b/theories/Program/Wf.v index 041b318e8..9b7ea0474 100644 --- a/theories/Program/Wf.v +++ b/theories/Program/Wf.v @@ -22,20 +22,20 @@ Section Well_founded. Variable A : Type. Variable R : A -> A -> Prop. Hypothesis Rwf : well_founded R. - + Variable P : A -> Type. - + Variable F_sub : forall x:A, (forall y: { y : A | R y x }, P (proj1_sig y)) -> P x. - + Fixpoint Fix_F_sub (x : A) (r : Acc R x) {struct r} : P x := - F_sub x (fun y: { y : A | R y x} => Fix_F_sub (proj1_sig y) + F_sub x (fun y: { y : A | R y x} => Fix_F_sub (proj1_sig y) (Acc_inv r (proj2_sig y))). - + Definition Fix_sub (x : A) := Fix_F_sub x (Rwf x). - - (* Notation Fix_F := (Fix_F_sub P F_sub) (only parsing). (* alias *) *) + + (* Notation Fix_F := (Fix_F_sub P F_sub) (only parsing). (* alias *) *) (* Definition Fix (x:A) := Fix_F_sub P F_sub x (Rwf x). *) - + Hypothesis F_ext : forall (x:A) (f g:forall y:{y:A | R y x}, P (`y)), @@ -44,10 +44,10 @@ Section Well_founded. Lemma Fix_F_eq : forall (x:A) (r:Acc R x), F_sub x (fun (y:A|R y x) => Fix_F_sub (`y) (Acc_inv r (proj2_sig y))) = Fix_F_sub x r. - Proof. + Proof. destruct r using Acc_inv_dep; auto. Qed. - + Lemma Fix_F_inv : forall (x:A) (r s:Acc R x), Fix_F_sub x r = Fix_F_sub x s. Proof. intro x; induction (Rwf x); intros. @@ -115,7 +115,7 @@ Section Fix_rects. Variable R : A -> A -> Prop. Variable Rwf : well_founded R. Variable f: forall (x : A), (forall y: { y: A | R y x }, P (proj1_sig y)) -> P x. - + Lemma F_unfold x r: Fix_F_sub A R P f x r = f (fun y => Fix_F_sub A R P f (proj1_sig y) (Acc_inv r (proj2_sig y))). @@ -200,8 +200,8 @@ Section Fix_rects. intros. assert (forall y: A, R y x0 -> Q y (Fix_F_sub A R P f y (Rwf y)))... set (inv x0 X0 a). clearbody q. - rewrite <- (equiv_lowers (fun y: {y: A | R y x0} => - Fix_F_sub A R P f (proj1_sig y) (Rwf (proj1_sig y))) + rewrite <- (equiv_lowers (fun y: {y: A | R y x0} => + Fix_F_sub A R P f (proj1_sig y) (Rwf (proj1_sig y))) (fun y: {y: A | R y x0} => Fix_F_sub A R P f (proj1_sig y) (Acc_inv a (proj2_sig y))))... intros. apply eq_Fix_F_sub. @@ -213,9 +213,9 @@ End Fix_rects. Ltac fold_sub f := match goal with - | [ |- ?T ] => + | [ |- ?T ] => match T with - appcontext C [ @Fix_sub _ _ _ _ ?arg ] => + appcontext C [ @Fix_sub _ _ _ _ ?arg ] => let app := context C [ f arg ] in change app end @@ -230,7 +230,7 @@ Module WfExtensionality. (** The two following lemmas allow to unfold a well-founded fixpoint definition without restriction using the functional extensionality axiom. *) - + (** For a function defined with Program using a well-founded order. *) Program Lemma fix_sub_eq_ext : @@ -247,11 +247,11 @@ Module WfExtensionality. extensionality y ; apply H. rewrite H0 ; auto. Qed. - + (** Tactic to unfold once a definition based on [Fix_sub]. *) - - Ltac unfold_sub f fargs := - set (call:=fargs) ; unfold f in call ; unfold call ; clear call ; + + Ltac unfold_sub f fargs := + set (call:=fargs) ; unfold f in call ; unfold call ; clear call ; rewrite fix_sub_eq_ext ; repeat fold_sub fargs ; simpl proj1_sig. End WfExtensionality. diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index 16733c3b8..dff556b98 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -120,12 +120,12 @@ Defined. Definition Qeq_bool x y := (Zeq_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z. -Definition Qle_bool x y := +Definition Qle_bool x y := (Zle_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z. Lemma Qeq_bool_iff : forall x y, Qeq_bool x y = true <-> x == y. Proof. - unfold Qeq_bool, Qeq; intros. + unfold Qeq_bool, Qeq; intros. symmetry; apply Zeq_is_eq_bool. Qed. diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v index c34423b4d..266d81e01 100644 --- a/theories/QArith/Qcanon.v +++ b/theories/QArith/Qcanon.v @@ -13,7 +13,7 @@ Require Import QArith. Require Import Znumtheory. Require Import Eqdep_dec. -(** [Qc] : A canonical representation of rational numbers. +(** [Qc] : A canonical representation of rational numbers. based on the setoid representation [Q]. *) Record Qc : Set := Qcmake { this :> Q ; canon : Qred this = this }. @@ -23,7 +23,7 @@ Bind Scope Qc_scope with Qc. Arguments Scope Qcmake [Q_scope]. Open Scope Qc_scope. -Lemma Qred_identity : +Lemma Qred_identity : forall q:Q, Zgcd (Qnum q) (QDen q) = 1%Z -> Qred q = q. Proof. unfold Qred; intros (a,b); simpl. @@ -36,7 +36,7 @@ Proof. subst; simpl; auto. Qed. -Lemma Qred_identity2 : +Lemma Qred_identity2 : forall q:Q, Qred q = q -> Zgcd (Qnum q) (QDen q) = 1%Z. Proof. unfold Qred; intros (a,b); simpl. @@ -50,7 +50,7 @@ Proof. destruct g as [|g|g]; destruct bb as [|bb|bb]; simpl in *; try discriminate. f_equal. apply Pmult_reg_r with bb. - injection H2; intros. + injection H2; intros. rewrite <- H0. rewrite H; simpl; auto. elim H1; auto. @@ -70,7 +70,7 @@ Proof. apply Qred_correct. Qed. -Definition Q2Qc (q:Q) : Qc := Qcmake (Qred q) (Qred_involutive q). +Definition Q2Qc (q:Q) : Qc := Qcmake (Qred q) (Qred_involutive q). Arguments Scope Q2Qc [Q_scope]. Notation " !! " := Q2Qc : Qc_scope. @@ -82,7 +82,7 @@ Proof. assert (H0:=Qred_complete _ _ H). assert (q = q') by congruence. subst q'. - assert (proof_q = proof_q'). + assert (proof_q = proof_q'). apply eq_proofs_unicity; auto; intros. repeat decide equality. congruence. @@ -98,8 +98,8 @@ Notation Qcgt := (fun x y : Qc => Qlt y x). Notation Qcge := (fun x y : Qc => Qle y x). Infix "<" := Qclt : Qc_scope. Infix "<=" := Qcle : Qc_scope. -Infix ">" := Qcgt : Qc_scope. -Infix ">=" := Qcge : Qc_scope. +Infix ">" := Qcgt : Qc_scope. +Infix ">=" := Qcge : Qc_scope. Notation "x <= y <= z" := (x<=y/\y<=z) : Qc_scope. Notation "x < y < z" := (x<y/\y<z) : Qc_scope. @@ -141,9 +141,9 @@ Proof. intros. destruct (Qeq_dec x y) as [H|H]; auto. right; contradict H; subst; auto with qarith. -Defined. +Defined. -(** The addition, multiplication and opposite are defined +(** The addition, multiplication and opposite are defined in the straightforward way: *) Definition Qcplus (x y : Qc) := !!(x+y). @@ -155,9 +155,9 @@ Notation "- x" := (Qcopp x) : Qc_scope. Definition Qcminus (x y : Qc) := x+-y. Infix "-" := Qcminus : Qc_scope. Definition Qcinv (x : Qc) := !!(/x). -Notation "/ x" := (Qcinv x) : Qc_scope. +Notation "/ x" := (Qcinv x) : Qc_scope. Definition Qcdiv (x y : Qc) := x*/y. -Infix "/" := Qcdiv : Qc_scope. +Infix "/" := Qcdiv : Qc_scope. (** [0] and [1] are apart *) @@ -167,8 +167,8 @@ Proof. intros H; discriminate H. Qed. -Ltac qc := match goal with - | q:Qc |- _ => destruct q; qc +Ltac qc := match goal with + | q:Qc |- _ => destruct q; qc | _ => apply Qc_is_canon; simpl; repeat rewrite Qred_correct end. @@ -191,7 +191,7 @@ Qed. Lemma Qcplus_0_r : forall x, x+0 = x. Proof. intros; qc; apply Qplus_0_r. -Qed. +Qed. (** Commutativity of addition: *) @@ -265,13 +265,13 @@ Qed. Theorem Qcmult_integral_l : forall x y, ~ x = 0 -> x*y = 0 -> y = 0. Proof. intros; destruct (Qcmult_integral _ _ H0); tauto. -Qed. +Qed. -(** Inverse and division. *) +(** Inverse and division. *) Theorem Qcmult_inv_r : forall x, x<>0 -> x*(/x) = 1. Proof. - intros; qc; apply Qmult_inv_r; auto. + intros; qc; apply Qmult_inv_r; auto. Qed. Theorem Qcmult_inv_l : forall x, x<>0 -> (/x)*x = 1. @@ -436,24 +436,24 @@ Qed. Lemma Qcmult_lt_0_le_reg_r : forall x y z, 0 < z -> x*z <= y*z -> x <= y. Proof. unfold Qcmult, Qcle, Qclt; intros; simpl in *. - repeat progress rewrite Qred_correct in * |-. + repeat progress rewrite Qred_correct in * |-. eapply Qmult_lt_0_le_reg_r; eauto. Qed. Lemma Qcmult_lt_compat_r : forall x y z, 0 < z -> x < y -> x*z < y*z. Proof. unfold Qcmult, Qclt; intros; simpl in *. - repeat progress rewrite Qred_correct in *. + repeat progress rewrite Qred_correct in *. eapply Qmult_lt_compat_r; eauto. Qed. (** Rational to the n-th power *) -Fixpoint Qcpower (q:Qc)(n:nat) { struct n } : Qc := - match n with +Fixpoint Qcpower (q:Qc)(n:nat) { struct n } : Qc := + match n with | O => 1 | S n => q * (Qcpower q n) - end. + end. Notation " q ^ n " := (Qcpower q n) : Qc_scope. @@ -467,7 +467,7 @@ Lemma Qcpower_0 : forall n, n<>O -> 0^n = 0. Proof. destruct n; simpl. destruct 1; auto. - intros. + intros. apply Qc_is_canon. simpl. compute; auto. @@ -537,7 +537,7 @@ Proof. intros (q, Hq) (q', Hq'); simpl; intros H. assert (H1 := H Hq Hq'). subst q'. - assert (Hq = Hq'). + assert (Hq = Hq'). apply Eqdep_dec.eq_proofs_unicity; auto; intros. repeat decide equality. congruence. diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v index 5373c1db3..fbfae55c3 100644 --- a/theories/QArith/Qfield.v +++ b/theories/QArith/Qfield.v @@ -73,15 +73,15 @@ Ltac Qpow_tac t := | _ => NotConstant end. -Add Field Qfield : Qsft - (decidable Qeq_bool_eq, +Add Field Qfield : Qsft + (decidable Qeq_bool_eq, completeness Qeq_eq_bool, - constants [Qcst], + constants [Qcst], power_tac Qpower_theory [Qpow_tac]). (** Exemple of use: *) -Section Examples. +Section Examples. Let ex1 : forall x y z : Q, (x+y)*z == (x*z)+(y*z). intros. @@ -89,7 +89,7 @@ Let ex1 : forall x y z : Q, (x+y)*z == (x*z)+(y*z). Qed. Let ex2 : forall x y : Q, x+y == y+x. - intros. + intros. ring. Qed. diff --git a/theories/QArith/Qpower.v b/theories/QArith/Qpower.v index efaefbb7c..fa341dd9c 100644 --- a/theories/QArith/Qpower.v +++ b/theories/QArith/Qpower.v @@ -59,7 +59,7 @@ Qed. Lemma Qmult_power : forall a b n, (a*b)^n == a^n*b^n. Proof. - intros a b [|n|n]; simpl; + intros a b [|n|n]; simpl; try rewrite Qmult_power_positive; try rewrite Qinv_mult_distr; reflexivity. @@ -73,7 +73,7 @@ Qed. Lemma Qinv_power : forall a n, (/a)^n == /a^n. Proof. - intros a [|n|n]; simpl; + intros a [|n|n]; simpl; try rewrite Qinv_power_positive; reflexivity. Qed. @@ -173,8 +173,8 @@ Qed. Lemma Qpower_mult : forall a n m, a^(n*m) == (a^n)^m. Proof. -intros a [|n|n] [|m|m]; simpl; - try rewrite Qpower_positive_1; +intros a [|n|n] [|m|m]; simpl; + try rewrite Qpower_positive_1; try rewrite Qpower_mult_positive; try rewrite Qinv_power_positive; try rewrite Qinv_involutive; diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v index d57a8c824..12e371ee9 100644 --- a/theories/QArith/Qreals.v +++ b/theories/QArith/Qreals.v @@ -173,7 +173,7 @@ unfold Qinv, Q2R, Qeq in |- *; intros (x1, x2); unfold Qden, Qnum in |- *. case x1. simpl in |- *; intros; elim H; trivial. intros; field; auto. -intros; +intros; change (IZR (Zneg x2)) with (- IZR (' x2))%R in |- *; change (IZR (Zneg p)) with (- IZR (' p))%R in |- *; field; (*auto 8 with real.*) @@ -193,8 +193,8 @@ Hint Rewrite Q2R_plus Q2R_mult Q2R_opp Q2R_minus Q2R_inv Q2R_div : q2r_simpl. Section LegacyQField. (** In the past, the field tactic was not able to deal with setoid datatypes, - so translating from Q to R and applying field on reals was a workaround. - See now Qfield for a direct field tactic on Q. *) + so translating from Q to R and applying field on reals was a workaround. + See now Qfield for a direct field tactic on Q. *) Ltac QField := apply eqR_Qeq; autorewrite with q2r_simpl; try field; auto. diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v index 6b16cfff4..27e3c4e02 100644 --- a/theories/QArith/Qreduction.v +++ b/theories/QArith/Qreduction.v @@ -35,15 +35,15 @@ Qed. (** Simplification of fractions using [Zgcd]. This version can compute within Coq. *) -Definition Qred (q:Q) := - let (q1,q2) := q in - let (r1,r2) := snd (Zggcd q1 ('q2)) +Definition Qred (q:Q) := + let (q1,q2) := q in + let (r1,r2) := snd (Zggcd q1 ('q2)) in r1#(Z2P r2). Lemma Qred_correct : forall q, (Qred q) == q. Proof. unfold Qred, Qeq; intros (n,d); simpl. - generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d)) + generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d)) (Zgcd_is_gcd n ('d)) (Zggcd_correct_divisors n ('d)). destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl. Open Scope Z_scope. @@ -52,7 +52,7 @@ Proof. rewrite H3; rewrite H4. assert (0 <> g). intro; subst g; discriminate. - + assert (0 < dd). apply Zmult_gt_0_lt_0_reg_r with g. omega. @@ -68,10 +68,10 @@ Proof. intros (a,b) (c,d). unfold Qred, Qeq in *; simpl in *. Open Scope Z_scope. - generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) + generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) (Zgcd_is_pos a ('b)) (Zggcd_correct_divisors a ('b)). destruct (Zggcd a (Zpos b)) as (g,(aa,bb)). - generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) + generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) (Zgcd_is_pos c ('d)) (Zggcd_correct_divisors c ('d)). destruct (Zggcd c (Zpos d)) as (g',(cc,dd)). simpl. @@ -136,7 +136,7 @@ Proof. Close Scope Z_scope. Qed. -Add Morphism Qred : Qred_comp. +Add Morphism Qred : Qred_comp. Proof. intros q q' H. rewrite (Qred_correct q); auto. @@ -144,7 +144,7 @@ Proof. Qed. Definition Qplus' (p q : Q) := Qred (Qplus p q). -Definition Qmult' (p q : Q) := Qred (Qmult p q). +Definition Qmult' (p q : Q) := Qred (Qmult p q). Definition Qminus' x y := Qred (Qminus x y). Lemma Qplus'_correct : forall p q : Q, (Qplus' p q)==(Qplus p q). diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v index 4511657a0..6e2488f5d 100644 --- a/theories/Reals/Alembert.v +++ b/theories/Reals/Alembert.v @@ -5,7 +5,7 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - + (*i $Id$ i*) Require Import Rbase. @@ -198,7 +198,7 @@ Proof. replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n)); [ idtac | ring ]; replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with - (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); [ idtac | ring ]; apply Rmult_le_compat_l. left; apply Rmult_lt_0_compat. prove_sup0. @@ -273,7 +273,7 @@ Proof. replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n)); [ idtac | ring ]; replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with - (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); [ idtac | ring ]; apply Rmult_le_compat_l. left; apply Rmult_lt_0_compat. prove_sup0. @@ -304,8 +304,8 @@ Proof. pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; rewrite Rplus_assoc; apply Rplus_le_compat_l. apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r; - rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; + rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; apply RRle_abs. unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. @@ -318,7 +318,7 @@ Proof. rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. apply Rinv_0_lt_compat; prove_sup0. apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *; - rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; + rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rle_lt_trans with (Rabs (An n)). apply RRle_abs. @@ -328,7 +328,7 @@ Proof. rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. apply Rinv_0_lt_compat; prove_sup0. apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *; - rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; + rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; apply Rle_lt_trans with (Rabs (An n)). rewrite <- Rabs_Ropp; apply RRle_abs. @@ -352,7 +352,7 @@ Proof. unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x). intro; elim (H1 (eps / Rabs x) H4); intros. exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Bn in |- *; replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x). @@ -363,13 +363,13 @@ Proof. replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0). apply H5; assumption. unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; reflexivity. apply Rabs_no_R0; assumption. replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with - (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); + (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); [ idtac | ring ]; rewrite <- Rinv_r_sym. simpl in |- *; ring. apply pow_nonzero; assumption. @@ -638,7 +638,7 @@ Lemma Alembert_C6 : rewrite Rmult_1_r. rewrite Rinv_mult_distr. replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with - (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); [ idtac | ring ]. rewrite <- Rinv_r_sym. rewrite Rmult_1_r; reflexivity. @@ -713,7 +713,7 @@ Lemma Alembert_C6 : rewrite Rmult_1_r. rewrite Rinv_mult_distr. replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with - (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); [ idtac | ring ]. rewrite <- Rinv_r_sym. rewrite Rmult_1_r; reflexivity. diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v index 952853a86..cccc8ceec 100644 --- a/theories/Reals/AltSeries.v +++ b/theories/Reals/AltSeries.v @@ -69,7 +69,7 @@ Lemma CV_ALT_step2 : forall (Un:nat -> R) (N:nat), Un_decreasing Un -> positivity_seq Un -> - sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. + sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. Proof. intros; induction N as [| N HrecN]. simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. @@ -101,7 +101,7 @@ Qed. Lemma CV_ALT_step3 : forall (Un:nat -> R) (N:nat), Un_decreasing Un -> - positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. + positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. Proof. intros; induction N as [| N HrecN]. simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. @@ -184,7 +184,7 @@ Proof. rewrite H12; apply H7; assumption. rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult; rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6; - rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); + rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); apply H6. unfold ge in |- *; apply le_trans with n. apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ]. @@ -246,7 +246,7 @@ Proof. apply CV_ALT_step1; assumption. assumption. unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; - unfold R_dist in H1; intros. + unfold R_dist in H1; intros. elim (H1 eps H2); intros. exists x; intros. apply H3. @@ -254,20 +254,20 @@ Proof. apply le_trans with n. assumption. assert (H5 := mult_O_le n 2). - elim H5; intro. + elim H5; intro. cut (0%nat <> 2%nat); [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. assumption. apply le_n_Sn. unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; - unfold R_dist in H1; intros. + unfold R_dist in H1; intros. elim (H1 eps H2); intros. exists x; intros. apply H3. unfold ge in |- *; apply le_trans with n. assumption. assert (H5 := mult_O_le n 2). - elim H5; intro. + elim H5; intro. cut (0%nat <> 2%nat); [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. assumption. diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v index a5c5ddaf8..f22ff5cb2 100644 --- a/theories/Reals/ArithProp.v +++ b/theories/Reals/ArithProp.v @@ -124,7 +124,7 @@ Proof. rewrite <- Ropp_inv_permute; [ idtac | assumption ]. replace (IZR (up (x * / - y)) - x * - / y + - (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; + (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; [ idtac | ring ]. elim H0; intros _ H1; unfold Rdiv in H1; exact H1. rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y). @@ -153,11 +153,11 @@ Proof. rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]; - apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); + apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); rewrite Rplus_0_r; unfold Rdiv in |- *; replace (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with - 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; + 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; exact H2. rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y). apply Rinv_0_lt_compat; assumption. @@ -165,10 +165,10 @@ Proof. rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]; apply Rplus_lt_reg_r with (IZR (up (x / y)) - 1); - replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y))); + replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y))); [ idtac | ring ]; replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with - (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *; + (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *; intros H2 _; exact H2. case (total_order_T 0 y); intro. elim s; intro. diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v index 3a8e816bc..0d34d22c5 100644 --- a/theories/Reals/Binomial.v +++ b/theories/Reals/Binomial.v @@ -194,7 +194,7 @@ Proof. apply minus_Sn_m; assumption. rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq. intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add; - replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; + replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; ring. intro; unfold C in |- *. replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v index c1c61586a..6ea0767d0 100644 --- a/theories/Reals/Cauchy_prod.v +++ b/theories/Reals/Cauchy_prod.v @@ -47,7 +47,7 @@ Theorem cauchy_finite : sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) - (pred (N - k))) (pred N). + (pred (N - k))) (pred N). Proof. intros; induction N as [| N HrecN]. elim (lt_irrefl _ H). @@ -124,7 +124,7 @@ Proof. (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (pred (N - k)))) (pred (pred N))); - set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); + set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); ring. rewrite (sum_N_predN diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v index a0675827b..6c08356a7 100644 --- a/theories/Reals/Cos_plus.v +++ b/theories/Reals/Cos_plus.v @@ -111,7 +111,7 @@ Proof. (Rsum_abs (fun l:nat => (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) * - ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * y ^ (2 * (N - l))) (pred (N - n))). apply Rle_trans with (sum_f_R0 @@ -745,42 +745,42 @@ Proof. exact H. Qed. -Theorem cos_plus : forall x y:R, cos (x + y) = cos x * cos y - sin x * sin y. +Theorem cos_plus : forall x y:R, cos (x + y) = cos x * cos y - sin x * sin y. Proof. - intros. - cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)). - cut (Un_cv (C1 x y) (cos (x + y))). - intros. - apply UL_sequence with (C1 x y); assumption. - apply C1_cvg. - unfold Un_cv in |- *; unfold R_dist in |- *. - intros. - assert (H0 := A1_cvg x). - assert (H1 := A1_cvg y). - assert (H2 := B1_cvg x). - assert (H3 := B1_cvg y). - assert (H4 := CV_mult _ _ _ _ H0 H1). - assert (H5 := CV_mult _ _ _ _ H2 H3). + intros. + cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)). + cut (Un_cv (C1 x y) (cos (x + y))). + intros. + apply UL_sequence with (C1 x y); assumption. + apply C1_cvg. + unfold Un_cv in |- *; unfold R_dist in |- *. + intros. + assert (H0 := A1_cvg x). + assert (H1 := A1_cvg y). + assert (H2 := B1_cvg x). + assert (H3 := B1_cvg y). + assert (H4 := CV_mult _ _ _ _ H0 H1). + assert (H5 := CV_mult _ _ _ _ H2 H3). assert (H6 := reste_cv_R0 x y). unfold Un_cv in H4; unfold Un_cv in H5; unfold Un_cv in H6. - unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6. + unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6. cut (0 < eps / 3); [ intro | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. - elim (H4 (eps / 3) H7); intros N1 H8. - elim (H5 (eps / 3) H7); intros N2 H9. + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H4 (eps / 3) H7); intros N1 H8. + elim (H5 (eps / 3) H7); intros N2 H9. elim (H6 (eps / 3) H7); intros N3 H10. - set (N := S (S (max (max N1 N2) N3))). - exists N. - intros. - cut (n = S (pred n)). - intro; rewrite H12. - rewrite <- cos_plus_form. - rewrite <- H12. + set (N := S (S (max (max N1 N2) N3))). + exists N. + intros. + cut (n = S (pred n)). + intro; rewrite H12. + rewrite <- cos_plus_form. + rewrite <- H12. apply Rle_lt_trans with (Rabs (A1 x n * A1 y n - cos x * cos y) + - Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))). + Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))). replace (A1 x n * A1 y n - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n) - (cos x * cos y - sin x * sin y)) with @@ -788,28 +788,28 @@ Proof. (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))); [ apply Rabs_triang | ring ]. replace eps with (eps / 3 + (eps / 3 + eps / 3)). - apply Rplus_lt_compat. - apply H8. - unfold ge in |- *; apply le_trans with N. - unfold N in |- *. - apply le_trans with (max N1 N2). - apply le_max_l. + apply Rplus_lt_compat. + apply H8. + unfold ge in |- *; apply le_trans with N. + unfold N in |- *. + apply le_trans with (max N1 N2). + apply le_max_l. apply le_trans with (max (max N1 N2) N3). apply le_max_l. apply le_trans with (S (max (max N1 N2) N3)); apply le_n_Sn. - assumption. + assumption. apply Rle_lt_trans with (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) + Rabs (Reste x y (pred n))). apply Rabs_triang. apply Rplus_lt_compat. - rewrite <- Rabs_Ropp. - rewrite Ropp_minus_distr. - apply H9. - unfold ge in |- *; apply le_trans with (max N1 N2). - apply le_max_r. - apply le_S_n. - rewrite <- H12. + rewrite <- Rabs_Ropp. + rewrite Ropp_minus_distr. + apply H9. + unfold ge in |- *; apply le_trans with (max N1 N2). + apply le_max_r. + apply le_S_n. + rewrite <- H12. apply le_trans with N. unfold N in |- *. apply le_n_S. @@ -843,11 +843,11 @@ Proof. replace (S (pred N)) with N. assumption. unfold N in |- *; simpl in |- *; reflexivity. - cut (0 < N)%nat. - intro. - cut (0 < n)%nat. - intro. + cut (0 < N)%nat. + intro. + cut (0 < n)%nat. + intro. apply S_pred with 0%nat; assumption. - apply lt_le_trans with N; assumption. + apply lt_le_trans with N; assumption. unfold N in |- *; apply lt_O_Sn. Qed. diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v index 56423f337..7a893c53c 100644 --- a/theories/Reals/Cos_rel.v +++ b/theories/Reals/Cos_rel.v @@ -5,7 +5,7 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - + (*i $Id$ i*) Require Import Rbase. @@ -15,15 +15,15 @@ Require Import Rtrigo_def. Open Local Scope R_scope. Definition A1 (x:R) (N:nat) : R := - sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N. - + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N. + Definition B1 (x:R) (N:nat) : R := sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) - N. - + N. + Definition C1 (x y:R) (N:nat) : R := - sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) N. - + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) N. + Definition Reste1 (x y:R) (N:nat) : R := sum_f_R0 (fun k:nat => @@ -50,7 +50,7 @@ Definition Reste (x y:R) (N:nat) : R := Reste2 x y N - Reste1 x y (S N). Theorem cos_plus_form : forall (x y:R) (n:nat), (0 < n)%nat -> - A1 x (S n) * A1 y (S n) - B1 x n * B1 y n + Reste x y n = C1 x y (S n). + A1 x (S n) * A1 y (S n) - B1 x n * B1 y n + Reste x y n = C1 x y (S n). intros. unfold A1, B1 in |- *. rewrite @@ -244,152 +244,152 @@ apply INR_fact_neq_0. apply INR_fact_neq_0. unfold Reste2 in |- *; apply sum_eq; intros. apply sum_eq; intros. -unfold Rdiv in |- *; ring. +unfold Rdiv in |- *; ring. unfold Reste1 in |- *; apply sum_eq; intros. apply sum_eq; intros. unfold Rdiv in |- *; ring. apply lt_O_Sn. Qed. -Lemma pow_sqr : forall (x:R) (i:nat), x ^ (2 * i) = (x * x) ^ i. -intros. +Lemma pow_sqr : forall (x:R) (i:nat), x ^ (2 * i) = (x * x) ^ i. +intros. assert (H := pow_Rsqr x i). unfold Rsqr in H; exact H. -Qed. - -Lemma A1_cvg : forall x:R, Un_cv (A1 x) (cos x). -intro. -assert (H := exist_cos (x * x)). -elim H; intros. -assert (p_i := p). -unfold cos_in in p. -unfold cos_n, infinite_sum in p. -unfold R_dist in p. -cut (cos x = x0). -intro. -rewrite H0. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (p eps H1); intros. -exists x1; intros. -unfold A1 in |- *. +Qed. + +Lemma A1_cvg : forall x:R, Un_cv (A1 x) (cos x). +intro. +assert (H := exist_cos (x * x)). +elim H; intros. +assert (p_i := p). +unfold cos_in in p. +unfold cos_n, infinite_sum in p. +unfold R_dist in p. +cut (cos x = x0). +intro. +rewrite H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (p eps H1); intros. +exists x1; intros. +unfold A1 in |- *. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) n) with - (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n). -apply H2; assumption. -apply sum_eq. -intros. -replace ((x * x) ^ i) with (x ^ (2 * i)). -reflexivity. -apply pow_sqr. -unfold cos in |- *. -case (exist_cos (Rsqr x)). -unfold Rsqr in |- *; intros. -unfold cos_in in p_i. -unfold cos_in in c. -apply uniqueness_sum with (fun i:nat => cos_n i * (x * x) ^ i); assumption. -Qed. - -Lemma C1_cvg : forall x y:R, Un_cv (C1 x y) (cos (x + y)). -intros. -assert (H := exist_cos ((x + y) * (x + y))). -elim H; intros. -assert (p_i := p). -unfold cos_in in p. -unfold cos_n, infinite_sum in p. -unfold R_dist in p. -cut (cos (x + y) = x0). -intro. -rewrite H0. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (p eps H1); intros. -exists x1; intros. -unfold C1 in |- *. + (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n). +apply H2; assumption. +apply sum_eq. +intros. +replace ((x * x) ^ i) with (x ^ (2 * i)). +reflexivity. +apply pow_sqr. +unfold cos in |- *. +case (exist_cos (Rsqr x)). +unfold Rsqr in |- *; intros. +unfold cos_in in p_i. +unfold cos_in in c. +apply uniqueness_sum with (fun i:nat => cos_n i * (x * x) ^ i); assumption. +Qed. + +Lemma C1_cvg : forall x y:R, Un_cv (C1 x y) (cos (x + y)). +intros. +assert (H := exist_cos ((x + y) * (x + y))). +elim H; intros. +assert (p_i := p). +unfold cos_in in p. +unfold cos_n, infinite_sum in p. +unfold R_dist in p. +cut (cos (x + y) = x0). +intro. +rewrite H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (p eps H1); intros. +exists x1; intros. +unfold C1 in |- *. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) n) with (sum_f_R0 - (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * ((x + y) * (x + y)) ^ i) n). -apply H2; assumption. -apply sum_eq. -intros. -replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)). -reflexivity. -apply pow_sqr. -unfold cos in |- *. -case (exist_cos (Rsqr (x + y))). -unfold Rsqr in |- *; intros. -unfold cos_in in p_i. -unfold cos_in in c. + (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * ((x + y) * (x + y)) ^ i) n). +apply H2; assumption. +apply sum_eq. +intros. +replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)). +reflexivity. +apply pow_sqr. +unfold cos in |- *. +case (exist_cos (Rsqr (x + y))). +unfold Rsqr in |- *; intros. +unfold cos_in in p_i. +unfold cos_in in c. apply uniqueness_sum with (fun i:nat => cos_n i * ((x + y) * (x + y)) ^ i); - assumption. -Qed. - -Lemma B1_cvg : forall x:R, Un_cv (B1 x) (sin x). -intro. -case (Req_dec x 0); intro. -rewrite H. -rewrite sin_0. -unfold B1 in |- *. -unfold Un_cv in |- *; unfold R_dist in |- *; intros; exists 0%nat; intros. + assumption. +Qed. + +Lemma B1_cvg : forall x:R, Un_cv (B1 x) (sin x). +intro. +case (Req_dec x 0); intro. +rewrite H. +rewrite sin_0. +unfold B1 in |- *. +unfold Un_cv in |- *; unfold R_dist in |- *; intros; exists 0%nat; intros. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k + 1)) - n) with 0. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -induction n as [| n Hrecn]. -simpl in |- *; ring. -rewrite tech5; rewrite <- Hrecn. -simpl in |- *; ring. -unfold ge in |- *; apply le_O_n. -assert (H0 := exist_sin (x * x)). -elim H0; intros. -assert (p_i := p). -unfold sin_in in p. -unfold sin_n, infinite_sum in p. -unfold R_dist in p. -cut (sin x = x * x0). -intro. -rewrite H1. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. + n) with 0. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +induction n as [| n Hrecn]. +simpl in |- *; ring. +rewrite tech5; rewrite <- Hrecn. +simpl in |- *; ring. +unfold ge in |- *; apply le_O_n. +assert (H0 := exist_sin (x * x)). +elim H0; intros. +assert (p_i := p). +unfold sin_in in p. +unfold sin_n, infinite_sum in p. +unfold R_dist in p. +cut (sin x = x * x0). +intro. +rewrite H1. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. cut (0 < eps / Rabs x); [ intro | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ]. -elim (p (eps / Rabs x) H3); intros. -exists x1; intros. -unfold B1 in |- *. + [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ]. +elim (p (eps / Rabs x) H3); intros. +exists x1; intros. +unfold B1 in |- *. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) n) with (x * - sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n). + sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n). replace (x * sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - x * x0) with (x * (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - - x0)); [ idtac | ring ]. -rewrite Rabs_mult. -apply Rmult_lt_reg_l with (/ Rabs x). -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. + x0)); [ idtac | ring ]. +rewrite Rabs_mult. +apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H4; apply H4; - assumption. -apply Rabs_no_R0; assumption. -rewrite scal_sum. -apply sum_eq. -intros. -rewrite pow_add. -rewrite pow_sqr. -simpl in |- *. -ring. -unfold sin in |- *. -case (exist_sin (Rsqr x)). -unfold Rsqr in |- *; intros. -unfold sin_in in p_i. -unfold sin_in in s. + assumption. +apply Rabs_no_R0; assumption. +rewrite scal_sum. +apply sum_eq. +intros. +rewrite pow_add. +rewrite pow_sqr. +simpl in |- *. +ring. +unfold sin in |- *. +case (exist_sin (Rsqr x)). +unfold Rsqr in |- *; intros. +unfold sin_in in p_i. +unfold sin_in in s. assert - (H1 := uniqueness_sum (fun i:nat => sin_n i * (x * x) ^ i) x0 x1 p_i s). -rewrite H1; reflexivity. -Qed. + (H1 := uniqueness_sum (fun i:nat => sin_n i * (x * x) ^ i) x0 x1 p_i s). +rewrite H1; reflexivity. +Qed. diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v index 603010c91..45e91577e 100644 --- a/theories/Reals/DiscrR.v +++ b/theories/Reals/DiscrR.v @@ -19,7 +19,7 @@ Qed. Lemma Rplus_lt_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x + y. intros. apply Rlt_trans with x. -assumption. +assumption. pattern x at 1 in |- *; rewrite <- Rplus_0_r. apply Rplus_lt_compat_l. assumption. @@ -63,9 +63,9 @@ Ltac omega_sup := change 0 with (IZR 0); repeat rewrite <- plus_IZR || - rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; apply IZR_lt; omega. - + Ltac prove_sup := match goal with | |- (?X1 > ?X2) => change (X2 < X1) in |- *; prove_sup @@ -83,5 +83,5 @@ Ltac Rcompute := change 0 with (IZR 0); repeat rewrite <- plus_IZR || - rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; apply IZR_eq; try reflexivity. diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v index 177035c4e..1c74f55a0 100644 --- a/theories/Reals/Exp_prop.v +++ b/theories/Reals/Exp_prop.v @@ -46,7 +46,7 @@ Proof. intros; unfold E1 in |- *. rewrite cauchy_finite. unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; + rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; intros. rewrite binomial. rewrite scal_sum; apply sum_eq; intros. @@ -125,7 +125,7 @@ Proof. sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N))))) - (pred (N - k))) (pred N)). + (pred (N - k))) (pred N)). unfold Reste_E in |- *. apply Rle_trans with (sum_f_R0 @@ -473,7 +473,7 @@ Proof. apply lt_n_S; apply H. cut (1 < S N)%nat. intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro; - assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; + assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; elim (lt_n_O _ H4). apply lt_n_S; apply H. assert (H1 := even_odd_cor N). diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v index 95237d116..774a0bd5c 100644 --- a/theories/Reals/Integration.v +++ b/theories/Reals/Integration.v @@ -5,7 +5,7 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - + (*i $Id$ i*) Require Export NewtonInt. diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v index ca4c38954..4037e3dec 100644 --- a/theories/Reals/MVT.v +++ b/theories/Reals/MVT.v @@ -115,7 +115,7 @@ Proof. (derivable_pt_mult _ _ _ (derivable_pt_const (f b - f a) c) (pr2 c P)))); [ idtac | apply pr_nu ]. rewrite derive_pt_minus; do 2 rewrite derive_pt_mult; - do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l; + do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l; do 2 rewrite Rplus_0_l; reflexivity. unfold h in |- *; ring. intros; unfold h in |- *; @@ -180,7 +180,7 @@ Proof. cut (derive_pt id x (X2 x x0) = 1). cut (derive_pt f x (X0 x x0) = f' x). intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3; - rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry in |- *; + rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry in |- *; assumption. apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption. apply derive_pt_eq_0; apply derivable_pt_lim_id. @@ -258,7 +258,7 @@ Lemma nonpos_derivative_0 : decreasing f -> forall x:R, derive_pt f x (pr x) <= 0. Proof. intros f pr H x; assert (H0 := H); unfold decreasing in H0; - generalize (derivable_derive f x (pr x)); intro; elim H1; + generalize (derivable_derive f x (pr x)); intro; elim H1; intros l H2. rewrite H2; case (Rtotal_order l 0); intro. left; assumption. @@ -282,7 +282,7 @@ Proof. intro. generalize (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2))) - (- (l / 2)) H15). + (- (l / 2)) H15). repeat rewrite Ropp_involutive. intro. generalize @@ -432,7 +432,7 @@ Lemma strictincreasing_strictdecreasing_opp : forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F. Proof. unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros; - generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; + generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; assumption. Qed. @@ -467,14 +467,14 @@ Qed. (**********) Lemma null_derivative_0 : forall (f:R -> R) (pr:derivable f), - constant f -> forall x:R, derive_pt f x (pr x) = 0. + constant f -> forall x:R, derive_pt f x (pr x) = 0. Proof. intros. unfold constant in H. apply derive_pt_eq_0. intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros. rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *; - rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; + rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. Qed. @@ -576,7 +576,7 @@ Lemma derive_increasing_interv_var : forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y. Proof. intros a b f pr H H0 x y H1 H2 H3; - generalize (derive_increasing_interv_ax a b f pr H); + generalize (derive_increasing_interv_ax a b f pr H); intro; elim H4; intros _ H5; apply (H5 H0 x y H1 H2 H3). Qed. @@ -618,7 +618,7 @@ Proof. cut (derivable (g - f)). intro X. cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0). - intro. + intro. assert (H2 := IAF (g - f)%F a b 0 X H H1). rewrite Rmult_0_l in H2; unfold minus_fct in H2. apply Rplus_le_reg_l with (- f b + f a). @@ -697,11 +697,11 @@ Proof. clear H0; intros H0 _; exists (g1 a - g2 a); intros; assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x). intros; unfold derivable_pt in |- *; exists (f x0); elim (H x0 H3); - intros; eapply derive_pt_eq_1; symmetry in |- *; + intros; eapply derive_pt_eq_1; symmetry in |- *; apply H4. assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x). intros; unfold derivable_pt in |- *; exists (f x0); - elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *; + elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *; apply H5. assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x). intros; elim H5; intros; apply derivable_pt_minus; @@ -717,6 +717,6 @@ Proof. apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros; eapply derive_pt_eq_1; symmetry in |- *; apply H10. assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7); - unfold constant_D_eq in H8; assert (H9 := H8 _ H2); + unfold constant_D_eq in H8; assert (H9 := H8 _ H2); unfold minus_fct in H9; rewrite <- H9; ring. Qed. diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v index 43ddfaf4a..74bcf7dcd 100644 --- a/theories/Reals/NewtonInt.v +++ b/theories/Reals/NewtonInt.v @@ -31,7 +31,7 @@ Lemma FTCN_step1 : Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b. Proof. intros f a b; unfold Newton_integrable in |- *; exists (d1 f); - unfold antiderivative in |- *; intros; case (Rle_dec a b); + unfold antiderivative in |- *; intros; case (Rle_dec a b); intro; [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ] | right; split; @@ -229,15 +229,15 @@ Lemma NewtonInt_P6 : l * NewtonInt f a b pr1 + NewtonInt g a b pr2. Proof. intros f g l a b pr1 pr2; unfold NewtonInt in |- *; - case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1; - intros; case pr2; intros; case (total_order_T a b); + case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1; + intros; case pr2; intros; case (total_order_T a b); intro. elim s; intro. elim o; intro. elim o0; intro. elim o1; intro. assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1); - assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); elim H3; intros; assert (H5 : a <= a <= b). split; [ right; reflexivity | left; assumption ]. assert (H6 : a <= b <= b). @@ -260,7 +260,7 @@ Proof. unfold antiderivative in H1; elim H1; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)). assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1); - assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); elim H3; intros; assert (H5 : b <= a <= a). split; [ left; assumption | right; reflexivity ]. assert (H6 : b <= b <= a). @@ -313,7 +313,7 @@ Proof. apply RRle_abs. apply H13. apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; + rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; apply Rmin_r. elim n; left; assumption. assert @@ -396,7 +396,7 @@ Proof. cut (b < x + h). intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)). apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h); - [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b); + [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b); [ idtac | ring ]; apply Rle_lt_trans with (Rabs h). rewrite <- Rabs_Ropp; apply RRle_abs. apply Rlt_le_trans with D. diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v index 623ae6311..97793386d 100644 --- a/theories/Reals/PSeries_reg.v +++ b/theories/Reals/PSeries_reg.v @@ -19,13 +19,13 @@ Open Local Scope R_scope. Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r. (** Uniform convergence *) -Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R) +Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal) : Prop := forall eps:R, 0 < eps -> exists N : nat, (forall (n:nat) (y:R), - (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). + (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). (** Normal convergence *) Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type := @@ -37,7 +37,7 @@ Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type := Definition CVN_R (fn:nat -> R -> R) : Type := forall r:posreal, CVN_r fn r. Definition SFL (fn:nat -> R -> R) - (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }) + (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }) (y:R) : R := let (a,_) := cv y in a. (** In a complete space, normal convergence implies uniform convergence *) @@ -94,7 +94,7 @@ Lemma CVU_continuity : forall y:R, Boule x r y -> continuity_pt f y. Proof. intros; unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; intros. unfold CVU in H. cut (0 < eps / 3); @@ -219,11 +219,11 @@ Proof. intros; apply (H n y). apply H1. unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r; - pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; + pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. Qed. -(** As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) +(** As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) Lemma CVN_R_CVS : forall fn:nat -> R -> R, CVN_R fn -> forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }. @@ -256,7 +256,7 @@ Proof. intro; apply Rle_trans with (Rabs (An n)). apply Rabs_pos. unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; - rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; + rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ]. Qed. diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v index 40972fbcf..6a33b8092 100644 --- a/theories/Reals/PartSum.v +++ b/theories/Reals/PartSum.v @@ -31,7 +31,7 @@ Lemma tech2 : forall (An:nat -> R) (m n:nat), (m < n)%nat -> sum_f_R0 An n = - sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). + sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). Proof. intros; induction n as [| n Hrecn]. elim (lt_n_O _ H). @@ -155,7 +155,7 @@ Lemma tech12 : Proof. intros; unfold Pser in |- *; unfold infinite_sum in |- *; unfold Un_cv in H; assumption. -Qed. +Qed. Lemma scal_sum : forall (An:nat -> R) (N:nat) (x:R), @@ -256,12 +256,12 @@ Qed. Lemma minus_sum : forall (An Bn:nat -> R) (N:nat), - sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. + sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. Proof. - intros; induction N as [| N HrecN]. - simpl in |- *; ring. - do 3 rewrite tech5; rewrite HrecN; ring. -Qed. + intros; induction N as [| N HrecN]. + simpl in |- *; ring. + do 3 rewrite tech5; rewrite HrecN; ring. +Qed. Lemma sum_decomposition : forall (An:nat -> R) (N:nat), @@ -346,7 +346,7 @@ Qed. (**********) Lemma Rabs_triang_gen : forall (An:nat -> R) (N:nat), - Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. + Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. Proof. intros. induction N as [| N HrecN]. diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index b2e561922..93b723af3 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -75,7 +75,7 @@ Hint Resolve Rlt_dichotomy_converse: real. Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2. Proof. intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse; - intuition eauto 3. + intuition eauto 3. Qed. Hint Resolve Req_dec: real. @@ -129,7 +129,7 @@ Hint Immediate Rge_le: rorders. (**********) Lemma Rlt_gt : forall r1 r2, r1 < r2 -> r2 > r1. -Proof. +Proof. trivial. Qed. Hint Resolve Rlt_gt: rorders. @@ -291,7 +291,7 @@ Proof. eauto using Rlt_trans with rorders. Qed. (**********) Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3. Proof. - generalize Rlt_trans Rlt_eq_compat. + generalize Rlt_trans Rlt_eq_compat. unfold Rle in |- *. intuition eauto 2. Qed. @@ -456,7 +456,7 @@ Proof. rewrite Rplus_comm; auto with real. Qed. -(*********************************************************) +(*********************************************************) (** ** Multiplication *) (*********************************************************) @@ -568,13 +568,13 @@ Proof. auto with real. Qed. -(**********) +(**********) Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0. Proof. intros r1 r2 H; split; red in |- *; intro; apply H; auto with real. Qed. -(**********) +(**********) Lemma Rmult_integral_contrapositive : forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0. Proof. @@ -583,11 +583,11 @@ Proof. Qed. Hint Resolve Rmult_integral_contrapositive: real. -Lemma Rmult_integral_contrapositive_currified : +Lemma Rmult_integral_contrapositive_currified : forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0. Proof. auto using Rmult_integral_contrapositive. Qed. -(**********) +(**********) Lemma Rmult_plus_distr_r : forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3. Proof. @@ -757,7 +757,7 @@ Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2. Proof. red in |- *; intros; elim H; rewrite H0; ring. Qed. -Hint Resolve Rminus_not_eq_right: real. +Hint Resolve Rminus_not_eq_right: real. (**********) Lemma Rmult_minus_distr_l : @@ -1284,7 +1284,7 @@ Proof. case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0. rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto. generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False; - generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); + generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); intro; apply (Rlt_irrefl (z * x)); auto. Qed. @@ -1333,7 +1333,7 @@ Qed. Hint Resolve Rlt_minus: real. Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0. -Proof. +Proof. intros; apply (Rplus_lt_reg_r r2). replace (r2 + (r1 - r2)) with r1. replace (r2 + 0) with r2; auto with real. @@ -1347,7 +1347,7 @@ Proof. Qed. Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0. -Proof. +Proof. destruct 1. auto using Rgt_minus, Rgt_ge. right; auto using Rminus_diag_eq with rorders. @@ -1500,7 +1500,7 @@ Proof. Qed. Hint Resolve Rinv_1_lt_contravar: real. -(*********************************************************) +(*********************************************************) (** ** Miscellaneous *) (*********************************************************) @@ -1528,7 +1528,7 @@ Proof. pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real. Qed. -(*********************************************************) +(*********************************************************) (** ** Injection from [N] to [R] *) (*********************************************************) @@ -1545,7 +1545,7 @@ Proof. Qed. (**********) -Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. +Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. Proof. intros n m; induction n as [| n Hrecn]. simpl in |- *; auto with real. @@ -1621,7 +1621,7 @@ Proof. simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto. auto with arith. generalize (pos_INR (S n0)); intro; cut (INR 0 = 0); - [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. + [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False; apply (Rlt_irrefl 0); auto. do 2 rewrite S_INR in H1; cut (INR n1 < INR n0). @@ -1696,7 +1696,7 @@ Proof. Qed. Hint Resolve not_1_INR: real. -(*********************************************************) +(*********************************************************) (** ** Injection from [Z] to [R] *) (*********************************************************) @@ -1797,7 +1797,7 @@ Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m). Proof. intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *. rewrite <- (Ropp_Ropp_IZR z2); symmetry in |- *; apply plus_IZR. -Qed. +Qed. (**********) Lemma lt_0_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z. @@ -1812,7 +1812,7 @@ Qed. (**********) Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z. Proof. - intros z1 z2 H; apply Zlt_0_minus_lt. + intros z1 z2 H; apply Zlt_0_minus_lt. apply lt_0_IZR. rewrite <- Z_R_minus. exact (Rgt_minus (IZR z2) (IZR z1) H). @@ -1831,7 +1831,7 @@ Qed. Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m. Proof. intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H); - rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); + rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); intro; omega. Qed. @@ -1981,7 +1981,7 @@ Proof. rewrite <- Rinv_l_sym. rewrite Rmult_1_r; replace (2 * x) with (x + x). rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption. - ring. + ring. replace 2 with (INR 2); [ apply not_0_INR; discriminate | reflexivity ]. pattern y at 2 in |- *; replace y with (y / 2 + y / 2). unfold Rminus, Rdiv in |- *. diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v index 35a92793c..a95985d3b 100644 --- a/theories/Reals/RList.v +++ b/theories/Reals/RList.v @@ -144,7 +144,7 @@ Proof. induction l as [| r0 l Hrecl0]. simpl in |- *; left; reflexivity. change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *; - unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); + unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. right; apply Hrecl; exists r0; left; reflexivity. left; reflexivity. @@ -395,8 +395,8 @@ Lemma RList_P7 : ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)). Proof. intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H); - clear H1 H2; assert (H1 := RList_P3 l x); elim H1; - clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4; + clear H1 H2; assert (H1 := RList_P3 l x); elim H1; + clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4; intros; elim H4; clear H4; intros; rewrite H4; assert (H6 : Rlength l = S (pred (Rlength l))). apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; @@ -468,7 +468,7 @@ Proof. simple induction l1; [ intro; reflexivity | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10; - apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring ]. Qed. @@ -495,7 +495,7 @@ Proof. reflexivity. change (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) = - (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2) + (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2) in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption. Qed. @@ -528,7 +528,7 @@ Proof. In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2)); [ elim (RList_P3 (cons_ORlist (cons r l1) l2) - (pos_Rl (cons_ORlist (cons r l1) l2) 0)); + (pos_Rl (cons_ORlist (cons r l1) l2) 0)); intros; apply H3; exists 0%nat; split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ] | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0)); @@ -547,7 +547,7 @@ Lemma RList_P16 : Proof. intros; apply Rle_antisym. induction l1 as [| r l1 Hrecl1]. - simpl in |- *; simpl in H1; right; symmetry in |- *; assumption. + simpl in |- *; simpl in H1; right; symmetry in |- *; assumption. assert (H2 : In @@ -557,13 +557,13 @@ Proof. [ elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) - (pred (Rlength (cons_ORlist (cons r l1) l2))))); + (pred (Rlength (cons_ORlist (cons r l1) l2))))); intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2))); split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ] | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) - (pred (Rlength (cons_ORlist (cons r l1) l2))))); + (pred (Rlength (cons_ORlist (cons r l1) l2))))); intros; assert (H5 := H3 H2); elim H5; intro; [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ]. induction l1 as [| r l1 Hrecl1]. @@ -576,19 +576,19 @@ Proof. In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/ In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *; - elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); + elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); intros; apply H5; exists (Rlength l1); split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] | assert (H5 := H3 H4); apply RList_P7; [ apply RList_P2; assumption | elim (RList_P9 (cons r l1) l2 - (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); intros; apply H7; left; elim (RList_P3 (cons r l1) - (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); - intros; apply H9; exists (pred (Rlength (cons r l1))); + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; apply H9; exists (pred (Rlength (cons r l1))); split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ]. Qed. @@ -643,7 +643,7 @@ Lemma RList_P20 : forall l:Rlist, (2 <= Rlength l)%nat -> exists r : R, - (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))). + (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))). Proof. intros; induction l as [| r l Hrecl]; [ simpl in H; elim (le_Sn_O _ H) @@ -720,7 +720,7 @@ Proof. simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn. change (pos_Rl (cons_Rlist (cons r1 r2) l2) i <= - pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; + pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; apply (H i); simpl in |- *; apply lt_S_n; assumption. Qed. diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v index dd589646d..57b2c7675 100644 --- a/theories/Reals/R_Ifp.v +++ b/theories/Reals/R_Ifp.v @@ -32,10 +32,10 @@ Lemma tech_up : forall (r:R) (z:Z), r < IZR z -> IZR z <= r + 1 -> z = up r. Proof. intros; generalize (archimed r); intro; elim H1; intros; clear H1; unfold Rgt in H2; unfold Rminus in H3; - generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); + generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1; rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1; - rewrite (Rplus_opp_r r) in H1; elim (Rplus_ne (IZR (up r))); + rewrite (Rplus_opp_r r) in H1; elim (Rplus_ne (IZR (up r))); intros a b; rewrite b in H1; clear a b; apply (single_z_r_R1 r z (up r)); auto with zarith real. Qed. @@ -56,15 +56,15 @@ Qed. Lemma fp_R0 : frac_part 0 = 0. Proof. unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros; - unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); - intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; + unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); + intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; cut (up 0 = 1%Z). intro; rewrite H1; - rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); - apply Ropp_0. + rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); + apply Ropp_0. elim (archimed 0); intros; clear H2; unfold Rgt in H1; rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1); - intro; clear H1; generalize (le_IZR_R1 (up 0) H0); + intro; clear H1; generalize (le_IZR_R1 (up 0) H0); intro; clear H H0; omega. Qed. @@ -92,12 +92,12 @@ Proof. apply Rge_minus; auto with zarith real. rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r); auto with zarith real. - (*inf a 1*) + (*inf a 1*) cut (r - IZR (up r) < 0). rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; - fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; - elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; + fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; + elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1); apply Rplus_lt_compat_l; auto with zarith real. elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr; @@ -110,7 +110,7 @@ Qed. (**********) Lemma base_Int_part : - forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. + forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. Proof. intro; unfold Int_part in |- *; elim (archimed r); intros. split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *. @@ -122,13 +122,13 @@ Proof. apply Rminus_le; auto with zarith real. generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro; rewrite (Rplus_comm (-1) (IZR (up r))) in H1; - generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); + generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2; fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2; rewrite (Rplus_comm (- r) (-1 + r)) in H2; rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2; - elim (Rplus_ne (-1)); intros a b; rewrite a in H2; - clear a b; auto with zarith real. + elim (Rplus_ne (-1)); intros a b; rewrite a in H2; + clear a b; auto with zarith real. Qed. (**********) @@ -168,19 +168,19 @@ Lemma Rminus_Int_part1 : Proof. intros; elim (base_fp r1); elim (base_fp r2); intros; generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; - generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); intro; clear H4; rewrite Ropp_0 in H0; - generalize (Rge_le 0 (- frac_part r2) H0); intro; - clear H0; generalize (Rge_le (frac_part r1) 0 H2); + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); intro; clear H1; unfold Rgt in H2; generalize (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); - intro; elim H1; intros; clear H1; elim (Rplus_ne 1); + intro; elim H1; intros; clear H1; elim (Rplus_ne 1); intros a b; rewrite a in H6; clear a b H5; - generalize (Rge_minus (frac_part r1) (frac_part r2) H); + generalize (Rge_minus (frac_part r1) (frac_part r2) H); intro; clear H; fold (frac_part r1 - frac_part r2) in H6; - generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); + generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H; unfold Rminus in H6, H; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H; @@ -195,7 +195,7 @@ Proof. fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H; generalize (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0 - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); intro; clear H; rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; rewrite <- @@ -209,9 +209,9 @@ Proof. (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) (- IZR (Int_part r1))) in H0; rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0; - elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; rewrite b in H0; clear a b; - elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); + elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); intros a b; rewrite a in H0; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; clear a b; @@ -229,7 +229,7 @@ Proof. fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6; generalize (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); intro; clear H6; rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; rewrite <- @@ -238,14 +238,14 @@ Proof. in H; rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H; - elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; clear a b; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; - rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; cut (1 = IZR 1); auto with zarith real. intro; rewrite H1 in H; clear H1; rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H; - generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H); - intros; clear H H0; unfold Int_part at 1 in |- *; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H); + intros; clear H H0; unfold Int_part at 1 in |- *; omega. Qed. @@ -257,18 +257,18 @@ Lemma Rminus_Int_part2 : Proof. intros; elim (base_fp r1); elim (base_fp r2); intros; generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; - generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); intro; clear H4; rewrite Ropp_0 in H0; - generalize (Rge_le 0 (- frac_part r2) H0); intro; - clear H0; generalize (Rge_le (frac_part r1) 0 H2); + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); intro; clear H1; unfold Rgt in H2; generalize (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); - intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); + intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); intros a b; rewrite b in H5; clear a b H6; - generalize (Rlt_minus (frac_part r1) (frac_part r2) H); - intro; clear H; fold (frac_part r1 - frac_part r2) in H5; + generalize (Rlt_minus (frac_part r1) (frac_part r2) H); + intro; clear H; fold (frac_part r1 - frac_part r2) in H5; clear H3 H4 H0 H2; unfold frac_part in H5, H1; unfold Rminus in H5, H1; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H5; rewrite (Ropp_involutive (IZR (Int_part r2))) in H5; @@ -283,7 +283,7 @@ Proof. fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5; generalize (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1) - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); intro; clear H5; rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; rewrite <- @@ -297,9 +297,9 @@ Proof. (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) (- IZR (Int_part r1))) in H; rewrite (Rplus_opp_l (IZR (Int_part r2))) in H; - elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H; - elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1; @@ -315,7 +315,7 @@ Proof. fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1; generalize (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); intro; clear H1; rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; rewrite <- @@ -324,21 +324,21 @@ Proof. in H0; rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0; - elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; clear a b; rewrite <- (Rplus_opp_l 1) in H0; rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1) in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H0; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; - rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; cut (1 = IZR 1); auto with zarith real. intro; rewrite H1 in H; rewrite H1 in H0; clear H1; rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H; rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H0; rewrite <- (plus_IZR (Int_part r1 - Int_part r2 - 1) 1) in H0; - generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H); + generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H); intro; clear H; - generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); - intros; clear H0 H1; unfold Int_part at 1 in |- *; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); + intros; clear H0 H1; unfold Int_part at 1 in |- *; omega. Qed. @@ -358,7 +358,7 @@ Proof. rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); - rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); auto with zarith real. Qed. @@ -370,7 +370,7 @@ Lemma Rminus_fp2 : Proof. intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H); intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1); - rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); + rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); unfold Rminus in |- *; rewrite (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1)) @@ -385,7 +385,7 @@ Proof. rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); - rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); auto with zarith real. Qed. @@ -397,11 +397,11 @@ Lemma plus_Int_part1 : Proof. intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H; elim (base_fp r1); elim (base_fp r2); intros; clear H H2; - generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); - intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); + generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); + intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2; generalize - (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); + (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1; unfold frac_part in H0, H1; unfold Rminus in H0, H1; rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) @@ -422,11 +422,11 @@ Proof. rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; generalize (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1 - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); intro; clear H0; generalize (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); intro; clear H1; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H; @@ -434,7 +434,7 @@ Proof. (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H; - elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; clear a b; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H0; @@ -442,7 +442,7 @@ Proof. (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; - elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; clear a b; rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0; cut (1 = IZR 1); auto with zarith real. @@ -452,7 +452,7 @@ Proof. rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H; rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0; rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0; - generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); intro; clear H H0; unfold Int_part at 1 in |- *; omega. Qed. @@ -465,8 +465,8 @@ Proof. intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3; generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; - generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1); - intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b; + generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1); + intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b; rewrite a in H2; clear a b; generalize (Rle_trans 0 (frac_part r1) (frac_part r1 + frac_part r2) H0 H2); intro; clear H0 H2; unfold frac_part in H, H1; unfold Rminus in H, H1; @@ -487,11 +487,11 @@ Proof. rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; generalize (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0 - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); intro; clear H1; generalize (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); intro; clear H; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H1; @@ -499,7 +499,7 @@ Proof. (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1; - elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; clear a b; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H0; @@ -507,7 +507,7 @@ Proof. (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; - elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); + elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; clear a b; cut (1 = IZR 1); auto with zarith real. @@ -515,8 +515,8 @@ Proof. rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1; rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1; - generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); - intro; clear H0 H1; unfold Int_part at 1 in |- *; + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); + intro; clear H0 H1; unfold Int_part at 1 in |- *; omega. Qed. diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v index 31a9b0b59..6460a9271 100644 --- a/theories/Reals/R_sqr.v +++ b/theories/Reals/R_sqr.v @@ -61,7 +61,7 @@ Proof. | elim H0; intro; [ elim H; symmetry in |- *; exact H1 | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1); - rewrite Ropp_0; intro; unfold Rsqr in |- *; + rewrite Ropp_0; intro; unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption ] ]. Qed. @@ -103,8 +103,8 @@ Proof. [ assumption | cut (y < x); [ intro; unfold Rsqr in H; - generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); - intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); + generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); intro; elim (Rlt_irrefl (x * x) H4) | auto with real ] ]. Qed. @@ -115,8 +115,8 @@ Proof. [ assumption | cut (y < x); [ intro; unfold Rsqr in H; - generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); - intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); + generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); intro; elim (Rlt_irrefl (x * x) H3) | auto with real ] ]. Qed. @@ -152,7 +152,7 @@ Proof. generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H; generalize (Rsqr_incr_0 (- x) y H H2 H0); intro; - rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; + rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; apply Rle_ge; assumption. apply Rle_trans with 0; [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption @@ -165,7 +165,7 @@ Proof. intros; case (Rcase_abs x); intro. generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; generalize (Rlt_le 0 (- x) H2); intro; - generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption. @@ -175,9 +175,9 @@ Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y. Proof. intros; case (Rcase_abs x); intro. generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; - generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; intro; generalize (Rge_le y (- x) H2); intro; generalize (Rlt_le 0 (- x) H1); - intro; generalize (Rle_trans 0 (- x) y H4 H3); intro; + intro; generalize (Rle_trans 0 (- x) y H4 H3); intro; rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. generalize (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro; apply Rsqr_incr_1; assumption. @@ -225,16 +225,16 @@ Proof. intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros. rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H; generalize (Ropp_lt_gt_contravar y 0 r); - generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1); intros; apply Rsqr_inj; assumption. rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 r); intro; - generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; - intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; assumption. rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro; - generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; - intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; + generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; assumption. generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj; assumption. diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v index 627f04102..ef9caa402 100644 --- a/theories/Reals/R_sqrt.v +++ b/theories/Reals/R_sqrt.v @@ -40,7 +40,7 @@ Qed. Lemma sqrt_0 : sqrt 0 = 0. Proof. - apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. + apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. Qed. Lemma sqrt_1 : sqrt 1 = 1. @@ -48,7 +48,7 @@ Proof. apply (Rsqr_inj (sqrt 1) 1); [ apply sqrt_positivity; left | left - | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; + | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; apply Rlt_0_1. Qed. @@ -108,7 +108,7 @@ Proof. (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y) (sqrt_positivity (x * y) (Rmult_le_pos x y H1 H2)) (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) - (sqrt_positivity y H2))); rewrite Rsqr_mult; + (sqrt_positivity y H2))); rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ]. Qed. @@ -132,7 +132,7 @@ Proof. | apply (Rmult_le_pos (sqrt x) (/ sqrt y)); [ apply (sqrt_positivity x H1) | generalize (sqrt_lt_R0 y H2); clear H2; intro H2; - generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; + generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; intro H2; left; assumption ] | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt; [ reflexivity @@ -193,7 +193,7 @@ Qed. Lemma sqrt_less : forall x:R, 0 <= x -> 1 < x -> sqrt x < x. Proof. intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2); - intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *; rewrite <- (sqrt_def x H1); apply @@ -204,8 +204,8 @@ Qed. Lemma sqrt_more : forall x:R, 0 < x -> x < 1 -> x < sqrt x. Proof. intros x H1 H2; - generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); - intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *; rewrite <- (sqrt_def x (Rlt_le 0 x H1)); apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3). @@ -338,7 +338,7 @@ Proof. (b * (- b * (/ 2 * / a)) + c). repeat rewrite <- Rplus_assoc; replace (b * b + b * b) with (2 * (b * b)). rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc; - rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc. rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v index 371c1af74..500dd5295 100644 --- a/theories/Reals/Ranalysis.v +++ b/theories/Reals/Ranalysis.v @@ -85,7 +85,7 @@ Ltac intro_hyp_glob trm := match goal with | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => intro_hyp_glob X1 - | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => + | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => intro_hyp_glob X1 | |- (derivable _) => cut (forall x0:R, aux x0 <> 0); @@ -277,7 +277,7 @@ Ltac intro_hyp_pt trm pt := Ltac is_diff_pt := match goal with | |- (derivable_pt Rsqr _) => - + (* fonctions de base *) apply derivable_pt_Rsqr | |- (derivable_pt id ?X1) => apply (derivable_pt_id X1) @@ -326,7 +326,7 @@ Ltac is_diff_pt := unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, pow_fct, id, fct_cte in |- * ] | |- (derivable_pt (/ ?X1) ?X2) => - + (* INVERSION *) apply (derivable_pt_inv X1 X2); [ assumption || @@ -334,7 +334,7 @@ Ltac is_diff_pt := comp, pow_fct, id, fct_cte in |- * | is_diff_pt ] | |- (derivable_pt (comp ?X1 ?X2) ?X3) => - + (* COMPOSITION *) apply (derivable_pt_comp X2 X1 X3); is_diff_pt | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) => @@ -352,7 +352,7 @@ Ltac is_diff_pt := (**********) Ltac is_diff_glob := match goal with - | |- (derivable Rsqr) => + | |- (derivable Rsqr) => (* fonctions de base *) apply derivable_Rsqr | |- (derivable id) => apply derivable_id @@ -392,7 +392,7 @@ Ltac is_diff_glob := unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, comp, pow_fct in |- * ] | |- (derivable (/ ?X1)) => - + (* INVERSION *) apply (derivable_inv X1); [ try @@ -401,7 +401,7 @@ Ltac is_diff_glob := id, fct_cte, comp, pow_fct in |- * | is_diff_glob ] | |- (derivable (comp sqrt _)) => - + (* COMPOSITION *) unfold derivable in |- *; intro; try is_diff_pt | |- (derivable (comp Rabs _)) => @@ -421,7 +421,7 @@ Ltac is_diff_glob := Ltac is_cont_pt := match goal with | |- (continuity_pt Rsqr _) => - + (* fonctions de base *) apply derivable_continuous_pt; apply derivable_pt_Rsqr | |- (continuity_pt id ?X1) => @@ -475,7 +475,7 @@ Ltac is_cont_pt := unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, id, fct_cte, pow_fct in |- * ] | |- (continuity_pt (/ ?X1) ?X2) => - + (* INVERSION *) apply (continuity_pt_inv X1 X2); [ is_cont_pt @@ -483,7 +483,7 @@ Ltac is_cont_pt := unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, id, fct_cte, pow_fct in |- * ] | |- (continuity_pt (comp ?X1 ?X2) ?X3) => - + (* COMPOSITION *) apply (continuity_pt_comp X2 X1 X3); is_cont_pt | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => @@ -508,7 +508,7 @@ Ltac is_cont_pt := Ltac is_cont_glob := match goal with | |- (continuity Rsqr) => - + (* fonctions de base *) apply derivable_continuous; apply derivable_Rsqr | |- (continuity id) => apply derivable_continuous; apply derivable_id @@ -559,7 +559,7 @@ Ltac is_cont_glob := unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, pow_fct in |- * ] | |- (continuity (comp sqrt _)) => - + (* COMPOSITION *) unfold continuity_pt in |- *; intro; try is_cont_pt | |- (continuity (comp ?X1 ?X2)) => diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v index de43711c3..1516b3384 100644 --- a/theories/Reals/Ranalysis1.v +++ b/theories/Reals/Ranalysis1.v @@ -61,7 +61,7 @@ Definition strict_increasing f : Prop := forall x y:R, x < y -> f x < f y. Definition strict_decreasing f : Prop := forall x y:R, x < y -> f y < f x. Definition constant f : Prop := forall x y:R, f x = f y. -(**********) +(**********) Definition no_cond (x:R) : Prop := True. (**********) @@ -114,7 +114,7 @@ Qed. Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0. Proof. unfold constant, continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split; [ apply Rlt_0_1 | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *; @@ -196,7 +196,7 @@ Proof. elim H5; intros; assumption. Qed. -(**********) +(**********) Lemma continuity_plus : forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2). Proof. @@ -322,18 +322,18 @@ Proof. prove_sup0. rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double; - pattern alp at 1 in |- *; replace alp with (alp + 0); + pattern alp at 1 in |- *; replace alp with (alp + 0); [ idtac | ring ]; apply Rplus_lt_compat_l; assumption. symmetry in |- *; apply Rabs_right; left; assumption. symmetry in |- *; apply Rabs_right; left; change (0 < / 2) in |- *; - apply Rinv_0_lt_compat; prove_sup0. + apply Rinv_0_lt_compat; prove_sup0. Qed. Lemma uniqueness_step2 : forall f (x l:R), derivable_pt_lim f x l -> limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0. -Proof. +Proof. unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *; unfold limit_in in |- *; intros. assert (H1 := H eps H0). @@ -418,10 +418,10 @@ Proof. intros; split. unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; intros. - apply derive_pt_eq_0. + apply derive_pt_eq_0. unfold derivable_pt_lim in |- *. intros; elim (H eps H0); intros alpha H1; elim H1; intros; - exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); intro; cut (x + h - x = h); [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); [ intro; generalize (H6 H8); rewrite H7; intro; assumption @@ -434,7 +434,7 @@ Proof. intro. assert (H0 := derive_pt_eq_1 f x (df x) pr H). unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; intros. elim (H0 eps H1); intros alpha H2; exists (pos alpha); split. apply (cond_pos alpha). @@ -454,7 +454,7 @@ Proof. simpl in |- *; unfold R_dist in |- *; intros. unfold derivable_pt_lim in |- *. intros; elim (H eps H0); intros alpha H1; elim H1; intros; - exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); intro; cut (x + h - x = h); [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); [ intro; generalize (H6 H8); rewrite H7; intro; assumption @@ -467,7 +467,7 @@ Proof. intro. unfold derivable_pt_lim in H. unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; intros. elim (H eps H0); intros alpha H2; exists (pos alpha); split. apply (cond_pos alpha). @@ -548,7 +548,7 @@ Qed. Lemma derivable_pt_lim_opp : forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l). -Proof. +Proof. intros. apply uniqueness_step3. assert (H1 := uniqueness_step2 _ _ _ H). @@ -1066,7 +1066,7 @@ Qed. Lemma pr_nu : forall f (x:R) (pr1 pr2:derivable_pt f x), - derive_pt f x pr1 = derive_pt f x pr2. + derive_pt f x pr1 = derive_pt f x pr2. Proof. intros. unfold derivable_pt in pr1. @@ -1141,7 +1141,7 @@ Proof. - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2))) (l / 2) H19); - repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)). intro; generalize @@ -1168,7 +1168,7 @@ Proof. Rge_le ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r). - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). assumption. rewrite <- Ropp_0; replace @@ -1260,7 +1260,7 @@ Proof. prove_sup0. rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. rewrite Rmult_1_l. - replace (2 * delta) with (delta + delta). + replace (2 * delta) with (delta + delta). pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); apply Rplus_lt_compat_l. rewrite Rplus_0_r; apply (cond_pos delta). @@ -1270,7 +1270,7 @@ Proof. intro; generalize (Rmin_stable_in_posreal (mkposreal (delta / 2) H9) - (mkposreal ((b - c) / 2) H8)); simpl in |- *; + (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. @@ -1307,7 +1307,7 @@ Proof. cut (Rabs ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < - (l / 2)). unfold Rabs in |- *; case @@ -1332,7 +1332,7 @@ Proof. generalize (Rlt_trans ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); + Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); intro; elim (Rlt_irrefl 0 @@ -1369,7 +1369,7 @@ Proof. reflexivity. unfold Rdiv in H11; assumption. generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10); - rewrite Rplus_0_r; intro; apply Rlt_trans with c; + rewrite Rplus_0_r; intro; apply Rlt_trans with c; assumption. generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro; generalize @@ -1390,21 +1390,21 @@ Proof. generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13); intro; apply Rle_lt_trans with (delta / 2). assumption. - apply Rmult_lt_reg_l with 2. + apply Rmult_lt_reg_l with 2. prove_sup0. unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. rewrite Rmult_1_l; rewrite double. pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta). - discrR. + discrR. cut (- (delta / 2) < 0). cut ((a - c) / 2 < 0). intros; generalize (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13) - (mknegreal ((a - c) / 2) H12)); simpl in |- *; - intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); + (mknegreal ((a - c) / 2) H12)); simpl in |- *; + intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); intro; elim (Rlt_irrefl 0 @@ -1413,7 +1413,7 @@ Proof. apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). assumption. unfold Rdiv in |- *. - rewrite <- Ropp_mult_distr_l_reverse. + rewrite <- Ropp_mult_distr_l_reverse. rewrite (Ropp_minus_distr a c). reflexivity. rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; @@ -1435,7 +1435,7 @@ Proof. apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). assumption. unfold Rdiv in |- *. - rewrite <- Ropp_mult_distr_l_reverse. + rewrite <- Ropp_mult_distr_l_reverse. rewrite (Ropp_minus_distr a c). reflexivity. unfold Rdiv in |- *; apply Rmult_lt_0_compat; @@ -1532,7 +1532,7 @@ Proof. generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12); rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - left; assumption. + left; assumption. left; apply Rinv_0_lt_compat; assumption. split. unfold Rdiv in |- *; apply prod_neq_R0. diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v index d9937e225..66bac9de7 100644 --- a/theories/Reals/Ranalysis2.v +++ b/theories/Reals/Ranalysis2.v @@ -36,16 +36,16 @@ Proof. replace (l1 * (/ f2 x * / f2 (x + h)) * - f2 (x + h)) with (- (l1 * / f2 x * (f2 (x + h) * / f2 (x + h)))); [ idtac | ring ]. replace (f1 x * (/ f2 x * / f2 (x + h)) * (f2 (x + h) * / h)) with - (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h))); + (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h))); [ idtac | ring ]. replace (f1 x * (/ f2 x * / f2 (x + h)) * (- f2 x * / h)) with - (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x))); + (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x))); [ idtac | ring ]. replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * f2 (x + h)) with (l2 * f1 x * / f2 x * / f2 x * (f2 (x + h) * / f2 (x + h))); [ idtac | ring ]. replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * - f2 x) with - (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x))); + (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x))); [ idtac | ring ]. repeat rewrite <- Rinv_r_sym; try assumption || ring. apply prod_neq_R0; assumption. @@ -58,7 +58,7 @@ Proof. Qed. Lemma maj_term1 : - forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal) + forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal) (f1 f2:R -> R), 0 < eps -> f2 x <> 0 -> @@ -105,7 +105,7 @@ Proof. Qed. Lemma maj_term2 : - forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) + forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) (f2:R -> R), 0 < eps -> f2 x <> 0 -> @@ -143,7 +143,7 @@ Proof. replace (Rabs 2) with 2. rewrite (Rmult_comm 2). replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with - (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); [ idtac | ring ]. repeat apply Rmult_lt_compat_l. apply Rabs_pos_lt; assumption. @@ -176,7 +176,7 @@ Proof. Qed. Lemma maj_term3 : - forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal) + forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal) (f1 f2:R -> R), 0 < eps -> f2 x <> 0 -> @@ -218,7 +218,7 @@ Proof. replace (Rabs 2) with 2. rewrite (Rmult_comm 2). replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with - (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); [ idtac | ring ]. repeat apply Rmult_lt_compat_l. apply Rabs_pos_lt; assumption. @@ -251,7 +251,7 @@ Proof. Qed. Lemma maj_term4 : - forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal) + forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal) (f1 f2:R -> R), 0 < eps -> f2 x <> 0 -> @@ -431,7 +431,7 @@ Proof. assert (Hyp : 0 < 2). prove_sup0. intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10); - rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; + rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; [ idtac | discrR ]. cut (IZR 1 < IZR 2). unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro; diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v index cb48a26b8..3de97ba90 100644 --- a/theories/Reals/Ranalysis3.v +++ b/theories/Reals/Ranalysis3.v @@ -213,7 +213,7 @@ Proof. apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; repeat apply prod_neq_R0. red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6). - assumption. + assumption. assumption. apply Rinv_neq_0_compat; repeat apply prod_neq_R0; [ discrR | discrR | discrR | assumption ]. @@ -380,7 +380,7 @@ Proof. unfold Rdiv, Rsqr in |- *. repeat rewrite Rinv_mult_distr; try assumption. repeat apply prod_neq_R0; try assumption. - red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). + red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). apply Rinv_neq_0_compat; discrR. apply Rinv_neq_0_compat; discrR. apply Rinv_neq_0_compat; discrR. @@ -408,14 +408,14 @@ Proof. unfold Rsqr, Rdiv in |- *. repeat rewrite Rinv_mult_distr; try assumption || discrR. repeat apply prod_neq_R0; try assumption. - red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). + red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). apply Rinv_neq_0_compat; discrR. apply Rinv_neq_0_compat; discrR. apply Rinv_neq_0_compat; discrR. apply Rinv_neq_0_compat; assumption. apply Rinv_neq_0_compat; assumption. apply prod_neq_R0; [ discrR | assumption ]. - red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). + red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). apply Rinv_neq_0_compat; discrR. apply Rinv_neq_0_compat; discrR. apply Rinv_neq_0_compat; discrR. @@ -519,7 +519,7 @@ Proof. repeat apply Rmin_pos. apply (cond_pos eps_f2). elim H3; intros; assumption. - apply (cond_pos alp_f1d). + apply (cond_pos alp_f1d). apply (cond_pos alp_f2d). elim H11; intros; assumption. apply Rabs_pos_lt. @@ -776,7 +776,7 @@ Proof. Qed. Lemma derive_pt_div : - forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) + forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x) (na:f2 x <> 0), derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) = (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x). diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v index adda4e5a5..1ed3fb713 100644 --- a/theories/Reals/Ranalysis4.v +++ b/theories/Reals/Ranalysis4.v @@ -31,8 +31,8 @@ Proof. unfold div_fct, inv_fct, fct_cte in |- *; intro X0; elim X0; intros; unfold derivable_pt in |- *; exists x0; unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *; - unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; - intros; elim (p eps H0); intros; exists x1; intros; + unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; + intros; elim (p eps H0); intros; exists x1; intros; unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x)); rewrite <- (Rmult_1_l (/ f (x + h))). apply H1; assumption. @@ -60,14 +60,14 @@ Proof. elim pr1; intros. elim pr2; intros. simpl in |- *. - assert (H0 := uniqueness_step2 _ _ _ p). - assert (H1 := uniqueness_step2 _ _ _ p0). + assert (H0 := uniqueness_step2 _ _ _ p). + assert (H1 := uniqueness_step2 _ _ _ p0). cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0). - intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). + intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). assumption. unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1; - unfold limit_in in H1; unfold dist in H1; simpl in H1; + unfold limit_in in H1; unfold dist in H1; simpl in H1; unfold R_dist in H1. intros; elim (H1 eps H2); intros. elim H3; intros. @@ -122,7 +122,7 @@ Proof. case (Rcase_abs h); intro. rewrite (Rabs_left h r) in H2. left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r; - rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H2. apply Rplus_le_le_0_compat. left; apply H. @@ -178,12 +178,12 @@ Proof. unfold continuity in |- *; intro. case (Req_dec x 0); intro. unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; exists eps; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists eps; split. apply H0. intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3; rewrite Rplus_0_r in H3; apply H3. apply derivable_continuous_pt; apply (Rderivable_pt_abs x H). @@ -297,7 +297,7 @@ Proof. induction N as [| N HrecN]. exists 0; apply H. exists - (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); apply H. Qed. @@ -317,7 +317,7 @@ Proof. ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. replace ((exp x - exp (- x)) * / 2) with ((exp x + exp (- x) * -1) * fct_cte (/ 2) x + - (exp + comp exp (- id))%F x * 0). + (exp + comp exp (- id))%F x * 0). apply derivable_pt_lim_mult. apply derivable_pt_lim_plus. apply derivable_pt_lim_exp. @@ -337,7 +337,7 @@ Proof. ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. replace ((exp x + exp (- x)) * / 2) with ((exp x - exp (- x) * -1) * fct_cte (/ 2) x + - (exp - comp exp (- id))%F x * 0). + (exp - comp exp (- id))%F x * 0). apply derivable_pt_lim_mult. apply derivable_pt_lim_minus. apply derivable_pt_lim_exp. diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v index eddcb561a..9715414f5 100644 --- a/theories/Reals/Raxioms.v +++ b/theories/Reals/Raxioms.v @@ -40,13 +40,13 @@ Hint Resolve Rplus_opp_r: real v62. Axiom Rplus_0_l : forall r:R, 0 + r = r. Hint Resolve Rplus_0_l: real. -(***********************************************************) +(***********************************************************) (** ** Multiplication *) (***********************************************************) (**********) Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1. -Hint Resolve Rmult_comm: real v62. +Hint Resolve Rmult_comm: real v62. (**********) Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3). @@ -102,7 +102,7 @@ Axiom Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real. -(**********************************************************) +(**********************************************************) (** * Injection from N to R *) (**********************************************************) @@ -112,11 +112,11 @@ Boxed Fixpoint INR (n:nat) : R := | O => 0 | S O => 1 | S n => INR n + 1 - end. + end. Arguments Scope INR [nat_scope]. -(**********************************************************) +(**********************************************************) (** * Injection from [Z] to [R] *) (**********************************************************) @@ -126,7 +126,7 @@ Definition IZR (z:Z) : R := | Z0 => 0 | Zpos n => INR (nat_of_P n) | Zneg n => - INR (nat_of_P n) - end. + end. Arguments Scope IZR [Z_scope]. (**********************************************************) diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v index 1fcf6f61e..5c3a929af 100644 --- a/theories/Reals/Rbasic_fun.v +++ b/theories/Reals/Rbasic_fun.v @@ -151,7 +151,7 @@ Qed. (*******************************) (*********) -Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. +Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. Proof. intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X. right; apply (Rle_ge 0 r a). @@ -248,7 +248,7 @@ Proof. elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *; case (Rcase_abs x); intros; auto. clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0); - rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); + rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); trivial. Qed. @@ -258,13 +258,13 @@ Proof. intros; unfold Rabs in |- *; case (Rcase_abs (x - y)); case (Rcase_abs (y - x)); intros. generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros; - generalize (Rlt_asym x y H); intro; elimtype False; + generalize (Rlt_asym x y H); intro; elimtype False; auto. rewrite (Ropp_minus_distr x y); trivial. rewrite (Ropp_minus_distr y x); trivial. unfold Rge in r, r0; elim r; elim r0; intros; clear r r0. generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y); - intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); + intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); intro; elimtype False; auto. rewrite (Rminus_diag_uniq x y H); trivial. rewrite (Rminus_diag_uniq y x H0); trivial. @@ -277,15 +277,15 @@ Proof. intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x); case (Rcase_abs y); intros; auto. generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro; - rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); - intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; + rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); + intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; auto. - rewrite (Ropp_mult_distr_l_reverse x y); trivial. + rewrite (Ropp_mult_distr_l_reverse x y); trivial. rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x); rewrite (Rmult_comm x y); trivial. unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0. generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1; - generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; + generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; auto. rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0); intro; elimtype False; auto. @@ -297,27 +297,27 @@ Proof. unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H. generalize (Rmult_lt_compat_l y x 0 H0 r0); intro; rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1; - generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; auto. generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0)); - generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); - intros; generalize (Rmult_integral x y H); intro; - elim H3; intro; elimtype False; auto. + generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H; - generalize (Rlt_irrefl 0); intro; elimtype False; + generalize (Rlt_irrefl 0); intro; elimtype False; auto. rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial. unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros; unfold Rgt in H0, H. generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1; - generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; auto. generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r)); - generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); - intros; generalize (Rmult_integral x y H); intro; - elim H3; intro; elimtype False; auto. + generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H; - generalize (Rlt_irrefl 0); intro; elimtype False; + generalize (Rlt_irrefl 0); intro; elimtype False; auto. rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial. Qed. @@ -337,7 +337,7 @@ Proof. unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0)); intro; elimtype False; auto. elimtype False; auto. -Qed. +Qed. Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x. Proof. @@ -353,7 +353,7 @@ Proof. generalize (Ropp_le_ge_contravar 0 (-1) H1). rewrite Ropp_involutive; rewrite Ropp_0. intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2); - intro; elimtype False; auto. + intro; elimtype False; auto. ring. Qed. @@ -368,7 +368,7 @@ Proof. rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b); unfold Rle in |- *; unfold Rge in r; elim r; intro. left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro; - elim (Rplus_ne (- b)); intros v w; rewrite v in H0; + elim (Rplus_ne (- b)); intros v w; rewrite v in H0; clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H). right; rewrite H; apply Ropp_0. (**) @@ -376,13 +376,13 @@ Proof. rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a); unfold Rle in |- *; unfold Rge in r0; elim r0; intro. left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro; - elim (Rplus_ne (- a)); intros v w; rewrite v in H0; + elim (Rplus_ne (- a)); intros v w; rewrite v in H0; clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H). right; rewrite H; apply Ropp_0. (**) elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro; elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; - generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; + generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; unfold Rge in H0; elim H0; intro; clear H0. unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto. absurd (a + b = 0); auto. @@ -390,7 +390,7 @@ Proof. (**) elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro; elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; - generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; + generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; unfold Rge in r1; elim r1; clear r1; intro. unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro; apply (Rlt_irrefl (a + b)); assumption. @@ -399,16 +399,16 @@ Proof. rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b); apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a)); unfold Rminus in |- *; rewrite (Ropp_involutive a); - generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; - intro; elim (Rplus_ne a); intros v w; rewrite v in H; - clear v w; generalize (Rlt_trans (a + a) a 0 H r0); + generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; + intro; elim (Rplus_ne a); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (a + a) a 0 H r0); intro; apply (Rlt_le (a + a) 0 H0). (**) apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b)); unfold Rminus in |- *; rewrite (Ropp_involutive b); - generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; - intro; elim (Rplus_ne b); intros v w; rewrite v in H; - clear v w; generalize (Rlt_trans (b + b) b 0 H r); + generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; + intro; elim (Rplus_ne b); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (b + b) b 0 H r); intro; apply (Rlt_le (b + b) 0 H0). (**) unfold Rle in |- *; right; reflexivity. @@ -430,25 +430,25 @@ Proof. Qed. (* ||a|-|b||<=|a-b| *) -Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b). +Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b). Proof. cut - (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). + (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]]. rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b)); - do 2 rewrite Ropp_minus_distr. - apply H; left; assumption. + do 2 rewrite Ropp_minus_distr. + apply H; left; assumption. rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply Rabs_pos. - apply H; left; assumption. - intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). - apply Rabs_triang_inv. + apply Rabs_pos. + apply H; left; assumption. + intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). + apply Rabs_triang_inv. rewrite (Rabs_right (Rabs a - Rabs b)); [ reflexivity | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r; - replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); - [ assumption | ring ] ]. -Qed. + replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); + [ assumption | ring ] ]. +Qed. (*********) Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a. @@ -464,13 +464,13 @@ Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x. Proof. unfold Rabs in |- *; intro x; case (Rcase_abs x); intros. generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro; - generalize (Rlt_trans 0 (- x) a H0 H); intro; split. + generalize (Rlt_trans 0 (- x) a H0 H); intro; split. apply (Rlt_trans x 0 a r H1). generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x); unfold Rgt in |- *; trivial. fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro; generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *; - generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; + generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; intro; split; assumption. Qed. @@ -508,7 +508,7 @@ Proof. intros p0; rewrite Rabs_Ropp. apply Rabs_right; auto with real zarith. Qed. - + Lemma abs_IZR : forall z, IZR (Zabs z) = Rabs (IZR z). Proof. intros. diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v index 897d5c710..023cfc93c 100644 --- a/theories/Reals/Rdefinitions.v +++ b/theories/Reals/Rdefinitions.v @@ -30,8 +30,8 @@ Parameter R1 : R. Parameter Rplus : R -> R -> R. Parameter Rmult : R -> R -> R. Parameter Ropp : R -> R. -Parameter Rinv : R -> R. -Parameter Rlt : R -> R -> Prop. +Parameter Rinv : R -> R. +Parameter Rlt : R -> R -> Prop. Parameter up : R -> Z. Infix "+" := Rplus : R_scope. diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v index 398d840d9..3309f7d50 100644 --- a/theories/Reals/Rderiv.v +++ b/theories/Reals/Rderiv.v @@ -39,15 +39,15 @@ Lemma cont_deriv : D_in f d D x0 -> continue_in f D x0. Proof. unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; - intros; elim (H eps H0); clear H; intros; elim H; + unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; + intros; elim (H eps H0); clear H; intros; elim H; clear H; intros; elim (Req_dec (d x0) 0); intro. split with (Rmin 1 x); split. elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)). intros; elim H3; clear H3; intros; generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1); - unfold Rgt in |- *; intro; elim (H5 H4); clear H5; - intros; generalize (H1 x1 (conj H3 H6)); clear H1; + unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + intros; generalize (H1 x1 (conj H3 H6)); clear H1; intro; unfold D_x in H3; elim H3; intros. rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1; cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)). @@ -84,10 +84,10 @@ Proof. generalize (let (H1, H2) := Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in - H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1); - unfold Rgt in |- *; intro; elim (H7 H5); clear H7; - intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); + unfold Rgt in |- *; intro; elim (H7 H5); clear H7; + intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); clear H1; intro; unfold D_x in H3; elim H3; intros; generalize (sym_not_eq H5); clear H5; intro H5; generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1; @@ -114,11 +114,11 @@ Proof. rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9)); rewrite (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2) - ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); + ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); intro; rewrite (Rmult_comm (x1 - x0) (- d x0)); rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0)); fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *; - rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; + rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; intro; generalize (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) @@ -132,15 +132,15 @@ Proof. rewrite <- (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0))) (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0)))); - rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); + rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps). intro; apply (Rlt_trans (Rabs (f x1 - f x0)) - (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). + (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro; unfold Rgt in H0; - generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); + generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); clear H7; intro; generalize (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) ( @@ -164,7 +164,7 @@ Proof. intro; rewrite H7 in H5; generalize (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2) - (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; + (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; rewrite eps2 in H10; assumption. unfold Rabs in |- *; case (Rcase_abs 2); auto. intro; cut (0 < 2). @@ -180,7 +180,7 @@ Lemma Dconst : forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0. Proof. unfold D_in in |- *; intros; unfold limit1_in in |- *; - unfold limit_in in |- *; unfold Rdiv in |- *; intros; + unfold limit_in in |- *; unfold Rdiv in |- *; intros; simpl in |- *; split with eps; split; auto. intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l; unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0)); @@ -195,7 +195,7 @@ Lemma Dx : forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0. Proof. unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *; - unfold limit_in in |- *; intros; simpl in |- *; split with eps; + unfold limit_in in |- *; intros; simpl in |- *; split with eps; split; auto. intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros; rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3))); @@ -204,7 +204,7 @@ Proof. absurd (0 < 0); auto. red in |- *; intro; apply (Rlt_irrefl 0 r). unfold Rgt in H; assumption. -Qed. +Qed. (*********) Lemma Dadd : @@ -218,9 +218,9 @@ Proof. (limit_plus (fun x:R => (f x - f x0) * / (x - x0)) (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) ( df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); - clear H; intros; elim H; clear H; intros; split with x; - split; auto; intros; generalize (H1 x1 H2); clear H1; + unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); + clear H; intros; elim H; clear H; intros; split with x; + split; auto; intros; generalize (H1 x1 H2); clear H1; intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0)) @@ -239,11 +239,11 @@ Lemma Dmult : D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0. Proof. intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0; - generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; + generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; intro; generalize (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) ( - fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); + fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0). intro; generalize @@ -253,11 +253,11 @@ Proof. generalize (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0) (fun x:R => (g x - g x0) * / (x - x0) * f x) ( - D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); - clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; - simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; intros; elim (H eps H0); clear H; intros; - elim H; clear H; intros; split with x; split; auto; + D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); + clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; + simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; intros; elim (H eps H0); clear H; intros; + elim H; clear H; intros; split with x; split; auto; intros; generalize (H1 x1 H2); clear H1; intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; @@ -275,7 +275,7 @@ Proof. ring. unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0)); - intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; + intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; assumption. Qed. @@ -287,7 +287,7 @@ Proof. intros; generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H); unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0; - rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; + rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; assumption. Qed. @@ -297,9 +297,9 @@ Lemma Dopp : D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0. Proof. intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - intros; generalize (H0 eps H1); clear H0; intro; elim H0; - clear H0; intros; elim H0; clear H0; simpl in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros; generalize (H0 eps H1); clear H0; intro; elim H0; + clear H0; intros; elim H0; clear H0; simpl in |- *; intros; split with x; split; auto. intros; generalize (H2 x1 H3); clear H2; intro; rewrite Ropp_mult_distr_l_reverse in H2; @@ -307,7 +307,7 @@ Proof. rewrite Ropp_mult_distr_l_reverse in H2; rewrite (let (H1, H2) := Rmult_ne (f x1) in H2) in H2; rewrite (let (H1, H2) := Rmult_ne (f x0) in H2) in H2; - rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2; + rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2; assumption. Qed. @@ -319,8 +319,8 @@ Lemma Dminus : D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0. Proof. unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro; - apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); - assumption. + apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); + assumption. Qed. (*********) @@ -336,8 +336,8 @@ Proof. (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) ( fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) ( H D x0)); unfold D_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); - clear H0; intros; elim H0; clear H0; intros; split with x; + unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); + clear H0; intros; elim H0; clear H0; intros; split with x; split; auto. intros; generalize (H2 x1 H3); clear H2 H3; intro; rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2; @@ -365,9 +365,9 @@ Proof. unfold Rdiv in |- *; intros; generalize (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) ( - D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); - intro; generalize (cont_deriv f df Df x0 H); intro; - unfold continue_in in H4; generalize (H3 H4 H2); clear H3; + D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); + intro; generalize (cont_deriv f df Df x0 H); intro; + unfold continue_in in H4; generalize (H3 H4 H2); clear H3; intro; generalize (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0)) @@ -381,16 +381,16 @@ Proof. generalize (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1 - (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); - intro; unfold limit1_in in |- *; unfold limit_in in |- *; + (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); + intro; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7; - simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8); - clear H5 H7; intros; elim H5; elim H7; clear H5 H7; + simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8); + clear H5 H7; intros; elim H5; elim H7; clear H5 H7; intros; split with (Rmin x x1); split. elim (Rmin_Rgt x x1 0); intros a b; apply (b (conj H9 H5)); clear a b. intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0)); - intros a b; clear b; unfold Rgt in a; elim (a H12); - clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10; + intros a b; clear b; unfold Rgt in a; elim (a H12); + clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10; clear H12; elim (classic (f x2 = f x0)); intro. elim H11; clear H11; intros; elim H11; clear H11; intros; generalize (H10 x2 (conj (conj H11 H14) H5)); intro; @@ -412,12 +412,12 @@ Proof. rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15; rewrite (Rmult_comm (df x0) (dg (f x0))); assumption. clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; - simpl in H1; intros; elim (H1 eps H2); clear H1; intros; - elim H1; clear H1; intros; split with x; split; auto; - intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4; + simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; + simpl in H1; intros; elim (H1 eps H2); clear H1; intros; + elim H1; clear H1; intros; split with x; split; auto; + intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4; intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)). -Qed. +Qed. (*********) Lemma D_pow_n : @@ -430,11 +430,11 @@ Proof. intros n D x0 expr dexpr H; generalize (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr ( - fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); + fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); intro; unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0; - unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; - elim (H0 eps H1); clear H0; intros; elim H0; clear H0; + unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; + elim (H0 eps H1); clear H0; intros; elim H0; clear H0; intros; split with x; split; intros; auto. cut (dexpr x0 * (INR n * expr x0 ^ (n - 1)) = diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v index 8c3d3feac..d18213db4 100644 --- a/theories/Reals/Reals.v +++ b/theories/Reals/Reals.v @@ -23,7 +23,7 @@ - Sup: for goals like ``?1<?2`` - RCompute: for equalities with constants like ``10*10==100`` - Reg: for goals like (continuity_pt ?1 ?2) or (derivable_pt ?1 ?2) *) - + Require Export Rbase. Require Export Rfunctions. Require Export SeqSeries. diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v index 68862f492..a57bb1638 100644 --- a/theories/Reals/Rfunctions.v +++ b/theories/Reals/Rfunctions.v @@ -38,13 +38,13 @@ Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0. Proof. intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n)); assumption. -Qed. +Qed. (*********) Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat. Proof. intro; reflexivity. -Qed. +Qed. (*********) Lemma simpl_fact : @@ -160,7 +160,7 @@ Proof. rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1); rewrite (Rmult_comm (INR n) (x ^ a)); rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n)); - rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); + rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); apply Rmult_comm. Qed. @@ -185,7 +185,7 @@ Proof. fold (x > 0) in H; apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))). rewrite (S_INR n0); ring. - unfold Rle in H0; elim H0; intro. + unfold Rle in H0; elim H0; intro. unfold Rle in |- *; left; apply Rmult_lt_compat_l. rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)). assumption. @@ -288,7 +288,7 @@ Lemma pow_lt_1_zero : 0 < y -> exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y). Proof. - intros; elim (Req_dec x 0); intro. + intros; elim (Req_dec x 0); intro. exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero. rewrite Rabs_R0; assumption. inversion GE; auto. @@ -758,7 +758,7 @@ Proof. rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0); intro; unfold Rgt in H; elimtype False; auto. generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro; - generalize (Rge_antisym x y H0 H); intro; rewrite H1; + generalize (Rge_antisym x y H0 H); intro; rewrite H1; ring. Qed. @@ -771,7 +771,7 @@ Proof. rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro; apply (Rminus_diag_eq y x H0). apply (Rminus_diag_uniq x y H). - apply (Rminus_diag_eq x y H). + apply (Rminus_diag_eq x y H). Qed. Lemma R_dist_eq : forall x:R, R_dist x x = 0. diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v index 9e83150fc..8890cbb50 100644 --- a/theories/Reals/Rgeom.v +++ b/theories/Reals/Rgeom.v @@ -32,7 +32,7 @@ Proof. Qed. Lemma distance_symm : - forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. + forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. Proof. intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj; [ apply sqrt_positivity; apply Rplus_le_le_0_compat @@ -187,7 +187,7 @@ Lemma isometric_rot_trans : forall x1 y1 x2 y2 tx ty theta:R, Rsqr (x1 - x2) + Rsqr (y1 - y2) = Rsqr (xr (xt x1 tx) (yt y1 ty) theta - xr (xt x2 tx) (yt y2 ty) theta) + - Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta). + Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta). Proof. intros; rewrite <- isometric_rotation_0; apply isometric_translation. Qed. @@ -196,7 +196,7 @@ Lemma isometric_trans_rot : forall x1 y1 x2 y2 tx ty theta:R, Rsqr (x1 - x2) + Rsqr (y1 - y2) = Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) + - Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). + Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). Proof. intros; rewrite <- isometric_translation; apply isometric_rotation_0. Qed. diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v index 79e4fd2a1..88cead7a5 100644 --- a/theories/Reals/RiemannInt.v +++ b/theories/Reals/RiemannInt.v @@ -32,8 +32,8 @@ Definition Riemann_integrable (f:R -> R) (a b:R) : Type := Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\ Rabs (RiemannInt_SF psi) < eps } }. -Definition phi_sequence (un:nat -> posreal) (f:R -> R) - (a b:R) (pr:Riemann_integrable f a b) (n:nat) := +Definition phi_sequence (un:nat -> posreal) (f:R -> R) + (a b:R) (pr:Riemann_integrable f a b) (n:nat) := projT1 (pr (un n)). Lemma phi_sequence_prop : @@ -54,7 +54,7 @@ Lemma RiemannInt_P1 : Proof. unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros; elim p; clear p; intros; exists (mkStepFun (StepFun_P6 (pre x))); - exists (mkStepFun (StepFun_P6 (pre x0))); + exists (mkStepFun (StepFun_P6 (pre x0))); elim p; clear p; intros; split. intros; apply (H t); elim H1; clear H1; intros; split; [ apply Rle_trans with (Rmin b a); try assumption; right; @@ -97,7 +97,7 @@ Proof. elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *; unfold R_dist in H4; elim (H1 n); elim (H1 m); intros; replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with - (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m)); + (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m)); [ idtac | ring ]; rewrite <- StepFun_P30; apply Rle_lt_trans with (RiemannInt_SF @@ -131,7 +131,7 @@ Proof. apply Rplus_le_compat; apply RRle_abs. replace (pos (un n)) with (un n - 0); [ idtac | ring ]; replace (pos (un m)) with (un m - 0); [ idtac | ring ]; - rewrite (double_var eps); apply Rplus_lt_compat; apply H4; + rewrite (double_var eps); apply Rplus_lt_compat; apply H4; assumption. Qed. @@ -179,8 +179,8 @@ Proof. rewrite Rabs_Ropp in H4; apply H4. apply H4. assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros; - exists (- x); unfold Un_cv in |- *; unfold Un_cv in p; - intros; elim (p _ H4); intros; exists x0; intros; + exists (- x); unfold Un_cv in |- *; unfold Un_cv in p; + intros; elim (p _ H4); intros; exists x0; intros; generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *; case (Rle_dec b a); case (Rle_dec a b); intros. elim n; assumption. @@ -189,7 +189,7 @@ Proof. (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (vn n0)))))); [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp; - rewrite Ropp_plus_distr; rewrite Ropp_involutive; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; apply H7 | symmetry in |- *; apply StepFun_P17 with (fe (vn n0)) a b; [ apply StepFun_P1 @@ -200,7 +200,7 @@ Proof. Qed. Lemma RiemannInt_exists : - forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) + forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) (un:nat -> posreal), Un_cv un 0 -> { l:R | Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l }. @@ -281,7 +281,7 @@ Proof. assumption. replace (pos (un n)) with (Rabs (un n - 0)); [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; - unfold N in |- *; apply le_trans with (max N0 N1); + unfold N in |- *; apply le_trans with (max N0 N1); apply le_max_l | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)) ]. @@ -346,7 +346,7 @@ Proof. unfold N in |- *; apply le_trans with (max N0 N1); [ apply le_max_r | apply le_max_l ] | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (vn n)) ]. apply Rlt_trans with (pos (un n)). elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). @@ -354,7 +354,7 @@ Proof. assumption. replace (pos (un n)) with (Rabs (un n - 0)); [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; - unfold N in |- *; apply le_trans with (max N0 N1); + unfold N in |- *; apply le_trans with (max N0 N1); apply le_max_l | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)) ]. @@ -382,7 +382,7 @@ Proof. apply le_IZR; left; apply Rlt_trans with (/ eps); [ apply Rinv_0_lt_compat; assumption | assumption ]. elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *; - simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; + simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1). apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. rewrite Rabs_right; @@ -406,7 +406,7 @@ Proof. red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H). Qed. -(**********) +(**********) Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R := let (a,_) := RiemannInt_exists pr RinvN RinvN_cv in a. @@ -416,7 +416,7 @@ Lemma RiemannInt_P5 : Proof. intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; eapply UL_sequence; [ apply u0 | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ]. @@ -452,8 +452,8 @@ Proof. apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del); assumption. assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5; - unfold Nbound in |- *; exists N; intros; unfold I in H6; - apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; + unfold Nbound in |- *; exists N; intros; unfold I in H6; + apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; left; apply Rle_lt_trans with ((b - a) / del); try assumption; apply Rmult_le_reg_l with (pos del); [ apply (cond_pos del) @@ -498,11 +498,11 @@ Proof. a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps)); assert (H1 : bound E). unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros; - unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; + unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; intros; assumption. assert (H2 : exists x : R, E x). assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps); - elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; + elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; split; [ split; [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro; @@ -530,7 +530,7 @@ Proof. unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros; split. elim H2; intros; assert (H7 := H4 _ H6); unfold E in H6; elim H6; clear H6; - intros H6 _; elim H6; intros; apply Rlt_le_trans with x0; + intros H6 _; elim H6; intros; apply Rlt_le_trans with x0; assumption. apply H5; intros; unfold E in H6; elim H6; clear H6; intros H6 _; elim H6; intros; assumption. @@ -579,7 +579,7 @@ Proof. | intros; change (pos_Rl (SubEquiN (S n) (a0 + del0) b del0) - (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b) + (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b) in |- *; apply H ] ]. Qed. @@ -633,7 +633,7 @@ Proof. 2: apply le_lt_n_Sm; assumption. apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r; pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l; rewrite Rmult_1_l; left; + apply Rplus_le_compat_l; rewrite Rmult_1_l; left; apply (cond_pos del). Qed. @@ -686,7 +686,7 @@ Proof. [ reflexivity | elim n; left; assumption ]. elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4; elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi; - split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); + split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); split. 2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr. 2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym. @@ -731,7 +731,7 @@ Proof. apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) (max_N del H)). replace (pos_Rl (SubEqui del H) (max_N del H) + - (t - pos_Rl (SubEqui del H) (max_N del H))) with t; + (t - pos_Rl (SubEqui del H) (max_N del H))) with t; [ idtac | ring ]; apply Rlt_le_trans with b. rewrite H14 in H12; assert (H13 : S (max_N del H) = pred (Rlength (SubEqui del H))). @@ -760,20 +760,20 @@ Proof. intros; assumption. assert (H4 : Nbound I). unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *; - case (maxN del H); intros; elim a0; clear a0; intros _ H5; + case (maxN del H); intros; elim a0; clear a0; intros _ H5; apply INR_le; apply Rmult_le_reg_l with (pos del). apply (cond_pos del). apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del); apply Rle_trans with t0; unfold I in H4; try assumption; - apply Rle_trans with b; try assumption; elim H8; intros; + apply Rle_trans with b; try assumption; elim H8; intros; assumption. elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat). unfold max_N in |- *; case (maxN del H); intros; apply INR_lt; apply Rmult_lt_reg_l with (pos del). apply (cond_pos del). apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del); - apply Rle_lt_trans with t0; unfold I in H5; try assumption; - elim a0; intros; apply Rlt_le_trans with b; try assumption; + apply Rle_lt_trans with t0; unfold I in H5; try assumption; + elim a0; intros; apply Rlt_le_trans with b; try assumption; elim H8; intros. elim H11; intro. assumption. @@ -1027,7 +1027,7 @@ Proof. unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0); intro. elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0; - intros; split; try assumption; rewrite e; intros; + intros; split; try assumption; rewrite e; intros; rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption. assert (H : 0 < eps / 2). unfold Rdiv in |- *; apply Rmult_lt_0_compat; @@ -1038,8 +1038,8 @@ Proof. | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. elim (X (mkposreal _ H)); intros; elim (X0 (mkposreal _ H0)); intros; - split with (mkStepFun (StepFun_P28 l x x0)); elim p0; - elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2)); + split with (mkStepFun (StepFun_P28 l x x0)); elim p0; + elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2)); elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split. intros; simpl in |- *; apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))). @@ -1098,7 +1098,7 @@ Proof. replace eps with (2 * (eps / 3) + eps / 3). apply Rplus_lt_compat. replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with - (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); [ idtac | ring ]. rewrite <- StepFun_P30. apply Rle_lt_trans with @@ -1146,7 +1146,7 @@ Proof. apply H; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_max_l. unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)). unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_max_r. @@ -1172,7 +1172,7 @@ Proof. replace eps with (2 * (eps / 3) + eps / 3). apply Rplus_lt_compat. replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with - (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); [ idtac | ring ]. rewrite <- StepFun_P30. rewrite StepFun_P39. @@ -1238,7 +1238,7 @@ Proof. apply H; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_max_l. unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)). unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_max_r. @@ -1258,7 +1258,7 @@ Proof. intro f; intros; case (Req_dec l 0); intro. pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r; unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); - case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; + case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; eapply UL_sequence; [ apply u0 | set (psi1 := fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); @@ -1283,13 +1283,13 @@ Proof. intros; apply u. unfold Un_cv in |- *; intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; + case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; intros; assert (H2 : 0 < eps / 5). unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv); unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4; - assert (H5 : 0 < eps / (5 * Rabs l)). + assert (H5 : 0 < eps / (5 * Rabs l)). unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; @@ -1380,7 +1380,7 @@ Proof. (RiemannInt_SF (phi_sequence RinvN pr3 n) + -1 * (RiemannInt_SF (phi_sequence RinvN pr1 n) + - l * RiemannInt_SF (phi_sequence RinvN pr2 n))); + l * RiemannInt_SF (phi_sequence RinvN pr2 n))); [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a). unfold Rmin in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n0; assumption ]. @@ -1421,7 +1421,7 @@ Proof. rewrite Rplus_assoc; apply Rplus_le_compat. elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H13. - elim H12; intros; split; left; assumption. + elim H12; intros; split; left; assumption. apply Rle_trans with (Rabs (f x1 - phi_sequence RinvN pr1 n x1) + Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)). @@ -1487,7 +1487,7 @@ Proof. [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l; do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. + | discrR ]. Qed. Lemma RiemannInt_P13 : @@ -1517,7 +1517,7 @@ Proof. split with (mkStepFun (StepFun_P4 a b c)); split with (mkStepFun (StepFun_P4 a b 0)); split; [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; unfold fct_cte in |- *; right; + rewrite Rabs_R0; unfold fct_cte in |- *; right; reflexivity | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps) ]. @@ -1546,12 +1546,12 @@ Proof. elim H1; clear H1; intros psi1 H1; set (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c)); set (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0)); - apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; + apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; try assumption. apply RinvN_cv. intro; split. intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *; - rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; right; reflexivity. unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos (RinvN n)). @@ -1594,7 +1594,7 @@ Proof. apply Rmult_eq_reg_l with 2; [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2); - repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] | discrR ]. apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1; @@ -1637,7 +1637,7 @@ Proof. Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; - apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). + apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). assert (H1 : exists psi2 : nat -> StepFun a b, @@ -1674,7 +1674,7 @@ Lemma RiemannInt_P18 : Proof. intro f; intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; eapply UL_sequence. apply u0. set (phi1 := fun N:nat => phi_sequence RinvN pr1 N); @@ -1688,7 +1688,7 @@ Proof. Rabs (f t - phi1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); intro; - apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). + apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). elim H1; clear H1; intros psi1 H1; set (phi2 := fun N:nat => phi_sequence RinvN pr2 N). set @@ -1712,10 +1712,10 @@ Proof. Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; - apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). + apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). elim H2; clear H2; intros psi2 H2; - apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; - try assumption. + apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; + try assumption. apply RinvN_cv. intro; elim (H2 n); intros; split; try assumption. intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; @@ -1764,11 +1764,11 @@ Proof. right; reflexivity. intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2; unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2]; - split with l; split with lf; unfold adapted_couple in H2; - decompose [and] H2; clear H2; unfold adapted_couple in |- *; + split with l; split with lf; unfold adapted_couple in H2; + decompose [and] H2; clear H2; unfold adapted_couple in |- *; repeat split; try assumption. intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9; - unfold constant_D_eq, open_interval in |- *; intros; + unfold constant_D_eq, open_interval in |- *; intros; rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i). replace a with (Rmin a b). rewrite <- H5; elim (RList_P6 l); intros; apply H10. @@ -1808,7 +1808,7 @@ Proof. (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))). apply (RiemannInt_P17 (RiemannInt_P10 (-1) pr2 pr1) - (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))); + (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))); assumption. replace (RiemannInt pr2 + - RiemannInt pr1) with (RiemannInt (RiemannInt_P10 (-1) pr2 pr1)). @@ -1833,7 +1833,7 @@ Proof. Qed. Definition primitive (f:R -> R) (a b:R) (h:a <= b) - (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) + (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) (x:R) : R := match Rle_dec a x with | left r => @@ -1977,20 +1977,20 @@ Proof. | elim n0; left; assumption ]. apply StepFun_P46 with b; assumption. assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; + unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). apply Rle_lt_trans with (pos_Rl l1 i). replace b with (Rmin b c). rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. apply le_O_n. apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. unfold Rmin in |- *; case (Rle_dec b c); intro; [ reflexivity | elim n; assumption ]. elim H7; intros; assumption. @@ -2000,19 +2000,19 @@ Proof. | elim n; apply Rle_trans with b; [ assumption | left; assumption ] | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; + unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). apply Rle_trans with (pos_Rl l1 (S i)). elim H7; intros; left; assumption. replace b with (Rmax a b). rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. + discriminate. unfold Rmax in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. assert (H11 : a <= x). @@ -2021,8 +2021,8 @@ Proof. rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. apply le_O_n. apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; - discriminate. + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. unfold Rmin in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. left; elim H7; intros; assumption. @@ -2030,19 +2030,19 @@ Proof. assumption. apply StepFun_P46 with b. assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; + unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). apply Rle_trans with (pos_Rl l1 (S i)). elim H7; intros; left; assumption. replace b with (Rmax a b). rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. + discriminate. unfold Rmax in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. assert (H11 : a <= x). @@ -2051,28 +2051,28 @@ Proof. rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. apply le_O_n. apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; - discriminate. + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. unfold Rmin in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. left; elim H7; intros; assumption. unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n; assumption. assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; + unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). apply Rle_lt_trans with (pos_Rl l1 i). replace b with (Rmin b c). rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. apply le_O_n. apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. unfold Rmin in |- *; case (Rle_dec b c); intro; [ reflexivity | elim n; assumption ]. elim H7; intros; assumption. @@ -2088,7 +2088,7 @@ Lemma RiemannInt_P22 : Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c. Proof. unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; - intros phi [psi H0]; elim H; elim H0; clear H H0; + intros phi [psi H0]; elim H; elim H0; clear H H0; intros; assert (H3 : IsStepFun phi a c). apply StepFun_P44 with b. apply (pre phi). @@ -2178,7 +2178,7 @@ Lemma RiemannInt_P23 : Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b. Proof. unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; - intros phi [psi H0]; elim H; elim H0; clear H H0; + intros phi [psi H0]; elim H; elim H0; clear H H0; intros; assert (H3 : IsStepFun phi c b). apply StepFun_P45 with a. apply (pre phi). @@ -2294,7 +2294,7 @@ Proof. intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); case (RiemannInt_exists pr2 RinvN RinvN_cv); - case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; + case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; symmetry in |- *; eapply UL_sequence. apply u. unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3). @@ -2309,7 +2309,7 @@ Proof. (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n))) 0). intro; elim (H3 _ H0); clear H3; intros N3 H3; - set (N0 := max (max N1 N2) N3); exists N0; intros; + set (N0 := max (max N1 N2) N3); exists N0; intros; unfold R_dist in |- *; apply Rle_lt_trans with (Rabs @@ -2368,7 +2368,7 @@ Proof. Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); intro; - apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). + apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). assert (H2 : exists psi2 : nat -> StepFun b c, @@ -2378,7 +2378,7 @@ Proof. Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; - apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). + apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). assert (H3 : exists psi3 : nat -> StepFun a c, @@ -2388,9 +2388,9 @@ Proof. Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr3 n)); intro; - apply (proj2_sig (phi_sequence_prop RinvN pr3 n)). + apply (proj2_sig (phi_sequence_prop RinvN pr3 n)). elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3; - clear H3; intros psi3 H3; assert (H := RinvN_cv); + clear H3; intros psi3 H3; assert (H := RinvN_cv); unfold Un_cv in |- *; intros; assert (H4 : 0 < eps / 3). unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. @@ -2401,14 +2401,14 @@ Proof. (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0). apply H; assumption. unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (RinvN n)). exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3; - intros; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; + intros; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; set (phi1 := phi_sequence RinvN pr1 n) in H8 |- *; - set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *; - set (phi3 := phi_sequence RinvN pr3 n) in H1 |- *; + set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *; + set (phi3 := phi_sequence RinvN pr3 n) in H1 |- *; assert (H10 : IsStepFun phi3 a b). apply StepFun_P44 with c. apply (pre phi3). @@ -2832,7 +2832,7 @@ Proof. (derivable_pt_lim ((fct_cte (f b) * (id - fct_cte b))%F + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( - f b + 0)) in |- *. + f b + 0)) in |- *. apply derivable_pt_lim_plus. pattern (f b) at 2 in |- *; replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). @@ -2899,7 +2899,7 @@ Proof. apply (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))) (RiemannInt_P16 - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))); + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))); left; assumption. apply Rle_lt_trans with (RiemannInt (RiemannInt_P14 (b + h0) b (eps / 2)) * Rabs (/ h0)). @@ -2953,13 +2953,13 @@ Proof. rewrite RiemannInt_P15. rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0; [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *; - repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | assumption ] | assumption ]. cut (a <= b + h0). cut (b + h0 <= b). intros; unfold primitive in |- *; case (Rle_dec a (b + h0)); - case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); + case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); intros; try (elim n; right; reflexivity) || (elim n; left; assumption). rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring. elim n; assumption. @@ -3083,7 +3083,7 @@ Proof. apply (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))) (RiemannInt_P16 - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))); + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))); left; assumption. apply Rle_lt_trans with (RiemannInt (RiemannInt_P14 a (a + h0) (eps / 2)) * Rabs (/ h0)). @@ -3138,7 +3138,7 @@ Proof. cut (a <= a + h0). cut (a + h0 <= b). intros; unfold primitive in |- *; case (Rle_dec a (a + h0)); - case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); intros; try (elim n; right; reflexivity) || (elim n; left; assumption). rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply RiemannInt_P5. @@ -3174,7 +3174,7 @@ Proof. (derivable_pt_lim ((fct_cte (f b) * (id - fct_cte b))%F + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( - f b + 0)) in |- *. + f b + 0)) in |- *. apply derivable_pt_lim_plus. pattern (f b) at 2 in |- *; replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). @@ -3198,7 +3198,7 @@ Proof. pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0)); - case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); intros; try (elim n; right; assumption || reflexivity). elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)). elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). @@ -3216,7 +3216,7 @@ Proof. assumption. elim H8; symmetry in |- *; assumption. rewrite H0 in H1; rewrite H1; unfold primitive in |- *; - case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); + case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); intros; try (elim n; right; assumption || reflexivity). rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). @@ -3286,7 +3286,7 @@ Proof. intros; apply (cont1 f). rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); assert (H1 := RiemannInt_P29 H H0); assert (H2 := RiemannInt_P31 f H); - elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2); + elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2); intros C H3; repeat rewrite H3; [ ring | split; [ right; reflexivity | assumption ] diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v index 14f1ea6af..e7f0375f0 100644 --- a/theories/Reals/RiemannInt_SF.v +++ b/theories/Reals/RiemannInt_SF.v @@ -36,8 +36,8 @@ Proof. intros I H H0; set (E := fun x:R => exists i : nat, I i /\ INR i = x); assert (H1 : bound E). unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *; - exists (INR N); unfold is_upper_bound in |- *; intros; - unfold E in H2; elim H2; intros; elim H3; intros; + exists (INR N); unfold is_upper_bound in |- *; intros; + unfold E in H2; elim H2; intros; elim H3; intros; rewrite <- H5; apply le_INR; apply H1; assumption. assert (H2 : exists x : R, E x). elim H; intros; exists (INR x); unfold E in |- *; exists x; split; @@ -54,13 +54,13 @@ Proof. assert (H9 : x <= IZR (up x) - 1). apply H5; intros; assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros; elim H11; intros; rewrite <- H13; apply Rplus_le_reg_l with 1; - replace (1 + (IZR (up x) - 1)) with (IZR (up x)); + replace (1 + (IZR (up x) - 1)) with (IZR (up x)); [ idtac | ring ]; replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ]. assert (H14 : (0 <= up x)%Z). apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. assert (H15 := IZN _ H14); elim H15; clear H15; intros; rewrite H15; - rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S; + rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H13; apply Rle_lt_trans with x; [ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ]. assert (H10 : x = IZR (up x) - 1). @@ -68,7 +68,7 @@ Proof. [ assumption | apply Rplus_le_reg_l with (- x + 1); replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x); - [ idtac | ring ]; replace (- x + 1 + x) with 1; + [ idtac | ring ]; replace (- x + 1 + x) with 1; [ assumption | ring ] ]. assert (H11 : (0 <= up x)%Z). apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. @@ -104,7 +104,7 @@ Proof. simpl in |- *; split. assumption. intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros; - rewrite H20; apply H4; unfold E in |- *; exists i; + rewrite H20; apply H4; unfold E in |- *; exists i; split; [ assumption | reflexivity ]. Qed. @@ -113,7 +113,7 @@ Qed. (*******************************************) Definition open_interval (a b x:R) : Prop := a < x < b. -Definition co_interval (a b x:R) : Prop := a <= x < b. +Definition co_interval (a b x:R) : Prop := a <= x < b. Definition adapted_couple (f:R -> R) (a b:R) (l lf:Rlist) : Prop := ordered_Rlist l /\ @@ -174,7 +174,7 @@ Definition RiemannInt_SF (a b:R) (f:StepFun a b) : R := Lemma StepFun_P1 : forall (a b:R) (f:StepFun a b), adapted_couple f a b (subdivision f) (subdivision_val f). -Proof. +Proof. intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros; apply a0. Qed. @@ -182,7 +182,7 @@ Qed. Lemma StepFun_P2 : forall (a b:R) (f:R -> R) (l lf:Rlist), adapted_couple f a b l lf -> adapted_couple f b a l lf. -Proof. +Proof. unfold adapted_couple in |- *; intros; decompose [and] H; clear H; repeat split; try assumption. rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro; @@ -199,7 +199,7 @@ Lemma StepFun_P3 : forall a b c:R, a <= b -> adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil). -Proof. +Proof. intros; unfold adapted_couple in |- *; repeat split. unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0; [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ]. @@ -212,19 +212,19 @@ Proof. Qed. Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b. -Proof. +Proof. intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro. apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *; apply existT with (cons c nil); apply (StepFun_P3 c r). apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *; - apply existT with (cons c nil); apply StepFun_P2; + apply existT with (cons c nil); apply StepFun_P2; apply StepFun_P3; auto with real. Qed. Lemma StepFun_P5 : forall (a b:R) (f:R -> R) (l:Rlist), is_subdivision f a b l -> is_subdivision f b a l. -Proof. +Proof. destruct 1 as (x,(H0,(H1,(H2,(H3,H4))))); exists x; repeat split; try assumption. rewrite H1; apply Rmin_comm. @@ -233,7 +233,7 @@ Qed. Lemma StepFun_P6 : forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a. -Proof. +Proof. unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x; apply StepFun_P5; assumption. Qed. @@ -243,7 +243,7 @@ Lemma StepFun_P7 : a <= b -> adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) -> adapted_couple f r2 b (cons r2 l) lf. -Proof. +Proof. unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0; assert (H5 : Rmax a b = b). unfold Rmax in |- *; case (Rle_dec a b); intro; @@ -258,7 +258,7 @@ Proof. unfold Rmax in |- *; case (Rle_dec r2 b); intro; [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ]. simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1; - do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; + do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; rewrite H4; reflexivity. intros; unfold constant_D_eq, open_interval in |- *; intros; unfold constant_D_eq, open_interval in H6; @@ -270,7 +270,7 @@ Qed. Lemma StepFun_P8 : forall (f:R -> R) (l1 lf1:Rlist) (a b:R), adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0. -Proof. +Proof. simple induction l1. intros; induction lf1 as [| r lf1 Hreclf1]; reflexivity. simple induction r0. @@ -285,7 +285,7 @@ Proof. ring. rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ]. clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1; - intros; simpl in H4; rewrite H4; unfold Rmin in |- *; + intros; simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro; [ assumption | reflexivity ]. unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym. apply (H3 0%nat); simpl in |- *; apply lt_O_Sn. @@ -299,14 +299,14 @@ Qed. Lemma StepFun_P9 : forall (a b:R) (f:R -> R) (l lf:Rlist), adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat. -Proof. +Proof. intros; unfold adapted_couple in H; decompose [and] H; clear H; induction l as [| r l Hrecl]; [ simpl in H4; discriminate | induction l as [| r0 l Hrecl0]; [ simpl in H3; simpl in H2; generalize H3; generalize H2; - unfold Rmin, Rmax in |- *; case (Rle_dec a b); - intros; elim H0; rewrite <- H5; rewrite <- H7; + unfold Rmin, Rmax in |- *; case (Rle_dec a b); + intros; elim H0; rewrite <- H5; rewrite <- H7; reflexivity | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ]. Qed. @@ -317,13 +317,13 @@ Lemma StepFun_P10 : adapted_couple f a b l lf -> exists l' : Rlist, (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). -Proof. +Proof. simple induction l. intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4; discriminate. intros; case (Req_dec a b); intro. exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *; - unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; + unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)). simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro; reflexivity. @@ -341,7 +341,7 @@ Proof. replace a with t2. apply H6. rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1; - decompose [and] H1; clear H1; simpl in H9; rewrite H9; + decompose [and] H1; clear H1; simpl in H9; rewrite H9; unfold Rmin in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro. @@ -360,7 +360,7 @@ Proof. decompose [and] H1; apply (H16 0%nat). simpl in |- *; apply lt_O_Sn. unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13; - rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); + rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); intro; [ assumption | elim n; assumption ]. elim (le_Sn_O _ H10). intros; simpl in H8; elim (lt_n_O _ H8). @@ -377,7 +377,7 @@ Proof. clear Hreclf'; case (Req_dec r1 r2); intro. case (Req_dec (f t2) r1); intro. exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1; - rewrite H9 in H6; unfold adapted_couple in H6, H1; + rewrite H9 in H6; unfold adapted_couple in H6, H1; decompose [and] H1; decompose [and] H6; clear H1 H6; unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; repeat split. @@ -417,7 +417,7 @@ Proof. change (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/ f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i) - in |- *; rewrite <- H9; elim H8; intros; apply H6; + in |- *; rewrite <- H9; elim H8; intros; apply H6; simpl in |- *; apply H1. intros; induction i as [| i Hreci]. simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. @@ -427,7 +427,7 @@ Proof. elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *; simpl in H1; apply H1. exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; - rewrite H3 in H1; unfold adapted_couple in H1, H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; decompose [and] H6; decompose [and] H1; clear H6 H1; unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; repeat split. @@ -438,7 +438,7 @@ Proof. simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. change (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) - in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; + in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; assumption. simpl in |- *; simpl in H19; apply H19. rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *; @@ -470,7 +470,7 @@ Proof. elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1; simpl in |- *; simpl in H1; apply lt_S_n; apply H1. exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; - rewrite H3 in H1; unfold adapted_couple in H1, H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; decompose [and] H6; decompose [and] H1; clear H6 H1; unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; repeat split. @@ -481,7 +481,7 @@ Proof. simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. change (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) - in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; + in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; assumption. simpl in |- *; simpl in H18; apply H18. rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *; @@ -518,14 +518,14 @@ Proof. Qed. Lemma StepFun_P11 : - forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) (f:R -> R), a < b -> adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. -Proof. +Proof. intros; unfold adapted_couple_opt in H1; elim H1; clear H1; intros; - unfold adapted_couple in H0, H1; decompose [and] H0; + unfold adapted_couple in H0, H1; decompose [and] H0; decompose [and] H1; clear H0 H1; assert (H12 : r = s1). simpl in H10; simpl in H5; rewrite H10; rewrite H5; reflexivity. assert (H14 := H3 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro. @@ -542,7 +542,7 @@ Proof. clear Hreclf2; assert (H17 : r3 = r4). set (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _)); assert (H18 := H13 0%nat (lt_O_Sn _)); - unfold constant_D_eq, open_interval in H17, H18; simpl in H17; + unfold constant_D_eq, open_interval in H17, H18; simpl in H17; simpl in H18; rewrite <- (H17 x). rewrite <- (H18 x). reflexivity. @@ -582,7 +582,7 @@ Proof. | unfold open_interval in |- *; simpl in |- *; split; assumption ]. assert (H19 : r3 = r5). assert (H19 := H7 1%nat); simpl in H19; - assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; + assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; intro. set (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat); assert (H23 := H13 1%nat); simpl in H22; simpl in H23; @@ -595,7 +595,7 @@ Proof. | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; - unfold Rmin in |- *; case (Rle_dec r1 r0); intro; + unfold Rmin in |- *; case (Rle_dec r1 r0); intro; assumption | discrR ] ]. apply Rmult_lt_reg_l with 2; @@ -616,7 +616,7 @@ Proof. | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; - unfold Rmin in |- *; case (Rle_dec r1 r0); + unfold Rmin in |- *; case (Rle_dec r1 r0); intro; assumption | discrR ] ] ]. apply Rmult_lt_reg_l with 2; @@ -630,7 +630,7 @@ Proof. | apply Rplus_le_compat_l; apply Rmin_l ] | discrR ] ]. elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23; - assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; + assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; assumption. elim H2; intros; assert (H22 := H20 0%nat); simpl in H22; assert (H23 := H22 (lt_O_Sn _)); elim H23; intro; @@ -644,7 +644,7 @@ Qed. Lemma StepFun_P12 : forall (a b:R) (f:R -> R) (l lf:Rlist), adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf. -Proof. +Proof. unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros; decompose [and] H; clear H; repeat split; try assumption. rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro; @@ -658,12 +658,12 @@ Proof. Qed. Lemma StepFun_P13 : - forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) (f:R -> R), a <> b -> adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. -Proof. +Proof. intros; case (total_order_T a b); intro. elim s; intro. eapply StepFun_P11; [ apply a0 | apply H0 | apply H1 ]. @@ -677,7 +677,7 @@ Lemma StepFun_P14 : a <= b -> adapted_couple f a b l1 lf1 -> adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. -Proof. +Proof. simple induction l1. intros l2 lf1 lf2 a b Hyp H H0; unfold adapted_couple in H; decompose [and] H; clear H H0 H2 H3 H1 H6; simpl in H4; discriminate. @@ -705,7 +705,7 @@ Proof. clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. clear Hreclf2; assert (H6 : r = s1). unfold adapted_couple in H, H2; decompose [and] H; decompose [and] H2; - clear H H2; simpl in H13; simpl in H8; rewrite H13; + clear H H2; simpl in H13; simpl in H8; rewrite H13; rewrite H8; reflexivity. assert (H7 : r3 = r4 \/ r = r1). case (Req_dec r r1); intro. @@ -718,7 +718,7 @@ Proof. rewrite <- (H20 (lt_O_Sn _) x). reflexivity. assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro; - [ idtac | elim H7; assumption ]; unfold x in |- *; + [ idtac | elim H7; assumption ]; unfold x in |- *; split. apply Rmult_lt_reg_l with 2; [ prove_sup0 @@ -734,7 +734,7 @@ Proof. apply Rplus_lt_compat_l; apply H | discrR ] ]. rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; - intro; [ idtac | elim H7; assumption ]; unfold x in |- *; + intro; [ idtac | elim H7; assumption ]; unfold x in |- *; split. apply Rmult_lt_reg_l with 2; [ prove_sup0 @@ -884,7 +884,7 @@ Lemma StepFun_P15 : forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), adapted_couple f a b l1 lf1 -> adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. -Proof. +Proof. intros; case (Rle_dec a b); intro; [ apply (StepFun_P14 r H H0) | assert (H1 : b <= a); @@ -897,8 +897,8 @@ Lemma StepFun_P16 : forall (f:R -> R) (l lf:Rlist) (a b:R), adapted_couple f a b l lf -> exists l' : Rlist, - (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). -Proof. + (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). +Proof. intros; case (Rle_dec a b); intro; [ apply (StepFun_P10 r H) | assert (H1 : b <= a); @@ -912,14 +912,14 @@ Lemma StepFun_P17 : forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), adapted_couple f a b l1 lf1 -> adapted_couple f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. -Proof. +Proof. intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1); rewrite (StepFun_P15 H0 H1); reflexivity. Qed. Lemma StepFun_P18 : forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a). -Proof. +Proof. intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) @@ -943,7 +943,7 @@ Lemma StepFun_P19 : forall (l1:Rlist) (f g:R -> R) (l:R), Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 = Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1. -Proof. +Proof. intros; induction l1 as [| r l1 Hrecl1]; [ simpl in |- *; ring | induction l1 as [| r0 l1 Hrecl0]; simpl in |- *; @@ -953,7 +953,7 @@ Qed. Lemma StepFun_P20 : forall (l:Rlist) (f:R -> R), (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)). -Proof. +Proof. intros l f H; induction l; [ elim (lt_irrefl _ H) | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ]. @@ -962,9 +962,9 @@ Qed. Lemma StepFun_P21 : forall (a b:R) (f:R -> R) (l:Rlist), is_subdivision f a b l -> adapted_couple f a b l (FF l f). -Proof. +Proof. intros; unfold adapted_couple in |- *; unfold is_subdivision in X; - unfold adapted_couple in X; elim X; clear X; intros; + unfold adapted_couple in X; elim X; clear X; intros; decompose [and] p; clear p; repeat split; try assumption. apply StepFun_P20; rewrite H2; apply lt_O_Sn. intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5; @@ -974,7 +974,7 @@ Proof. unfold FF in |- *; rewrite RList_P12. simpl in |- *; change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *; - rewrite RList_P13; try assumption; rewrite (H5 x0 H6); + rewrite RList_P13; try assumption; rewrite (H5 x0 H6); rewrite H5. reflexivity. split. @@ -990,7 +990,7 @@ Proof. | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ rewrite Rmult_1_l; rewrite double; - rewrite (Rplus_comm (pos_Rl (cons r l) i)); + rewrite (Rplus_comm (pos_Rl (cons r l) i)); apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0; assumption | discrR ] ]. @@ -1002,7 +1002,7 @@ Lemma StepFun_P22 : a <= b -> is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). -Proof. +Proof. unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). unfold Rmin in |- *; case (Rle_dec a b); intro; @@ -1011,9 +1011,9 @@ Proof. unfold Rmax in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0; - decompose [and] p; decompose [and] p0; clear p p0; + decompose [and] p; decompose [and] p0; clear p p0; rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0; - rewrite Hyp_max in H5; unfold adapted_couple in |- *; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; repeat split. apply RList_P2; assumption. rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. @@ -1024,25 +1024,25 @@ Proof. In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). elim (RList_P3 (cons_ORlist (cons r lf) lg) - (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; apply H10; exists 0%nat; split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H12 _; assert (H13 := H12 H10); elim H13; intro. elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); - intros H11 _; assert (H14 := H11 H8); elim H14; intros; + intros H11 _; assert (H14 := H11 H8); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H6; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption | apply le_O_n | assumption ]. elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; - assert (H14 := H11 H8); elim H14; intros; elim H15; - clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); intros; apply H17; [ assumption | apply le_O_n | assumption ]. induction lf as [| r lf Hreclf]. simpl in |- *; right; assumption. assert (H8 : In a (cons_ORlist (cons r lf) lg)). elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; - elim (RList_P3 (cons r lf) a); intros; apply H12; + elim (RList_P3 (cons r lf) a); intros; apply H12; exists 0%nat; split; [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. apply RList_P5; [ apply RList_P2; assumption | assumption ]. @@ -1058,21 +1058,21 @@ Proof. elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); + (pred (Rlength (cons_ORlist (cons r lf) lg))))); intros _ H10; apply H10; - exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); + (pred (Rlength (cons_ORlist (cons r lf) lg))))); intros H10 _. assert (H11 := H10 H8); elim H11; intro. elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H5; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption @@ -1081,8 +1081,8 @@ Proof. elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros. rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))). apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; @@ -1187,7 +1187,7 @@ Proof. apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5; rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11). assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; - exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; + exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat). elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf). @@ -1232,7 +1232,7 @@ Proof. clear b0; apply RList_P17; try assumption. apply RList_P2; assumption. elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left; - elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27; + elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27; exists (S x0); split; [ reflexivity | apply H22 ]. Qed. @@ -1240,7 +1240,7 @@ Lemma StepFun_P23 : forall (a b:R) (f g:R -> R) (lf lg:Rlist), is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). -Proof. +Proof. intros; case (Rle_dec a b); intro; [ apply StepFun_P22 with g; assumption | apply StepFun_P5; apply StepFun_P22 with g; @@ -1254,7 +1254,7 @@ Lemma StepFun_P24 : a <= b -> is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). -Proof. +Proof. unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). unfold Rmin in |- *; case (Rle_dec a b); intro; @@ -1263,9 +1263,9 @@ Proof. unfold Rmax in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0; - decompose [and] p; decompose [and] p0; clear p p0; + decompose [and] p; decompose [and] p0; clear p p0; rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0; - rewrite Hyp_max in H5; unfold adapted_couple in |- *; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; repeat split. apply RList_P2; assumption. rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. @@ -1276,25 +1276,25 @@ Proof. In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). elim (RList_P3 (cons_ORlist (cons r lf) lg) - (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; apply H10; exists 0%nat; split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H12 _; assert (H13 := H12 H10); elim H13; intro. elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); - intros H11 _; assert (H14 := H11 H8); elim H14; intros; + intros H11 _; assert (H14 := H11 H8); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H6; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption | apply le_O_n | assumption ]. elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; - assert (H14 := H11 H8); elim H14; intros; elim H15; - clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); intros; apply H17; [ assumption | apply le_O_n | assumption ]. induction lf as [| r lf Hreclf]. simpl in |- *; right; assumption. assert (H8 : In a (cons_ORlist (cons r lf) lg)). elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; - elim (RList_P3 (cons r lf) a); intros; apply H12; + elim (RList_P3 (cons r lf) a); intros; apply H12; exists 0%nat; split; [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. apply RList_P5; [ apply RList_P2; assumption | assumption ]. @@ -1310,20 +1310,20 @@ Proof. elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); + (pred (Rlength (cons_ORlist (cons r lf) lg))))); intros _ H10; apply H10; - exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); + (pred (Rlength (cons_ORlist (cons r lf) lg))))); intros H10 _; assert (H11 := H10 H8); elim H11; intro. elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H5; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption @@ -1332,8 +1332,8 @@ Proof. elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros; rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))). apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; @@ -1436,7 +1436,7 @@ Proof. apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0; rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11). assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; - exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; + exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat). elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg). @@ -1481,7 +1481,7 @@ Proof. clear b0; apply RList_P17; try assumption; [ apply RList_P2; assumption | elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right; - elim (RList_P3 lg (pos_Rl lg (S x0))); intros; + elim (RList_P3 lg (pos_Rl lg (S x0))); intros; apply H27; exists (S x0); split; [ reflexivity | apply H22 ] ]. Qed. @@ -1489,7 +1489,7 @@ Lemma StepFun_P25 : forall (a b:R) (f g:R -> R) (lf lg:Rlist), is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). -Proof. +Proof. intros a b f g lf lg H H0; case (Rle_dec a b); intro; [ apply StepFun_P24 with f; assumption | apply StepFun_P5; apply StepFun_P24 with f; @@ -1504,12 +1504,12 @@ Lemma StepFun_P26 : is_subdivision g a b l1 -> is_subdivision (fun x:R => f x + l * g x) a b l1. Proof. - intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) + intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) (x,(_,(_,(_,(_,H9))))). exists (FF l1 (fun x:R => f x + l * g x)); repeat split; try assumption. apply StepFun_P20; rewrite H3; auto with arith. - intros i H8 x1 H10; unfold open_interval in H10, H9, H4; - rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); + intros i H8 x1 H10; unfold open_interval in H10, H9, H4; + rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); assert (H11 : l1 <> nil). red in |- *; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8). destruct (RList_P19 _ H11) as (r,(r0,H12)); @@ -1548,7 +1548,7 @@ Lemma StepFun_P27 : is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision (fun x:R => f x + l * g x) a b (cons_ORlist lf lg). -Proof. +Proof. intros a b l f g lf lg H H0; apply StepFun_P26; [ apply StepFun_P23 with g; assumption | apply StepFun_P25 with f; assumption ]. @@ -1557,16 +1557,16 @@ Qed. (** The set of step functions on [a,b] is a vectorial space *) Lemma StepFun_P28 : forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b. -Proof. +Proof. intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f); - assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; - elim H0; intros; apply existT with (cons_ORlist x0 x); + assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; + elim H0; intros; apply existT with (cons_ORlist x0 x); apply StepFun_P27; assumption. Qed. Lemma StepFun_P29 : forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f). -Proof. +Proof. intros a b f; unfold is_subdivision in |- *; apply existT with (subdivision_val f); apply StepFun_P1. Qed. @@ -1575,7 +1575,7 @@ Lemma StepFun_P30 : forall (a b l:R) (f g:StepFun a b), RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) = RiemannInt_SF f + l * RiemannInt_SF g. -Proof. +Proof. intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b); (intro; replace @@ -1612,29 +1612,29 @@ Lemma StepFun_P31 : forall (a b:R) (f:R -> R) (l lf:Rlist), adapted_couple f a b l lf -> adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs). -Proof. +Proof. unfold adapted_couple in |- *; intros; decompose [and] H; clear H; repeat split; try assumption. symmetry in |- *; rewrite H3; rewrite RList_P18; reflexivity. intros; unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H5; intros; + unfold constant_D_eq, open_interval in H5; intros; rewrite (H5 _ H _ H4); rewrite RList_P12; [ reflexivity | rewrite H3 in H; simpl in H; apply H ]. Qed. Lemma StepFun_P32 : forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b. -Proof. +Proof. intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f); unfold is_subdivision in |- *; - apply existT with (app_Rlist (subdivision_val f) Rabs); + apply existT with (app_Rlist (subdivision_val f) Rabs); apply StepFun_P31; apply StepFun_P1. Qed. Lemma StepFun_P33 : forall l2 l1:Rlist, ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1. -Proof. +Proof. simple induction l2; intros. simpl in |- *; rewrite Rabs_R0; right; reflexivity. simpl in |- *; induction l1 as [| r1 l1 Hrecl1]. @@ -1653,14 +1653,14 @@ Lemma StepFun_P34 : forall (a b:R) (f:StepFun a b), a <= b -> Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)). -Proof. +Proof. intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. replace (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with (Int_SF (app_Rlist (subdivision_val f) Rabs) (subdivision f)). apply StepFun_P33; assert (H0 := StepFun_P29 f); unfold is_subdivision in H0; - elim H0; intros; unfold adapted_couple in p; decompose [and] p; + elim H0; intros; unfold adapted_couple in p; decompose [and] p; assumption. apply StepFun_P17 with (fun x:R => Rabs (f x)) a b; [ apply StepFun_P31; apply StepFun_P1 @@ -1675,7 +1675,7 @@ Lemma StepFun_P35 : pos_Rl l (pred (Rlength l)) = b -> (forall x:R, a < x < b -> f x <= g x) -> Int_SF (FF l f) l <= Int_SF (FF l g) l. -Proof. +Proof. simple induction l; intros. right; reflexivity. simpl in |- *; induction r0 as [| r0 r1 Hrecr0]. @@ -1742,7 +1742,7 @@ Lemma StepFun_P36 : is_subdivision g a b l -> (forall x:R, a < x < b -> f x <= g x) -> RiemannInt_SF f <= RiemannInt_SF g. -Proof. +Proof. intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l). replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l). @@ -1768,7 +1768,7 @@ Lemma StepFun_P37 : a <= b -> (forall x:R, a < x < b -> f x <= g x) -> RiemannInt_SF f <= RiemannInt_SF g. -Proof. +Proof. intros; eapply StepFun_P36; try assumption. eapply StepFun_P25; apply StepFun_P29. eapply StepFun_P23; apply StepFun_P29. @@ -1785,8 +1785,8 @@ Lemma StepFun_P38 : (i < pred (Rlength l))%nat -> constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) (f (pos_Rl l i))) }. -Proof. - intros l a b f; generalize a; clear a; induction l. +Proof. + intros l a b f; generalize a; clear a; induction l. intros a H H0 H1; simpl in H0; simpl in H1; exists (mkStepFun (StepFun_P4 a b (f b))); split. reflexivity. @@ -1812,7 +1812,7 @@ Proof. rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ]. assert (H8 : IsStepFun g' a b). unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8; - elim H8; intros lg H9; unfold is_subdivision in H9; + elim H8; intros lg H9; unfold is_subdivision in H9; elim H9; clear H9; intros lg2 H9; split with (cons a lg); unfold is_subdivision in |- *; split with (cons (f a) lg2); unfold adapted_couple in H9; decompose [and] H9; clear H9; @@ -1896,7 +1896,7 @@ Proof. assert (H11 : (i < pred (Rlength (cons r1 l)))%nat). simpl in |- *; apply lt_S_n; assumption. assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12; - unfold constant_D_eq, co_interval in |- *; intros; + unfold constant_D_eq, co_interval in |- *; intros; rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *; case (Rle_dec r1 x); intro. reflexivity. @@ -1913,7 +1913,7 @@ Qed. Lemma StepFun_P39 : forall (a b:R) (f:StepFun a b), RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))). -Proof. +Proof. intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a); intros. assert (H : adapted_couple f a b (subdivision f) (subdivision_val f)); @@ -1931,12 +1931,12 @@ Proof. rewrite Ropp_involutive; eapply StepFun_P17; [ apply StepFun_P1 | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; - elim H; intros; unfold is_subdivision in |- *; + elim H; intros; unfold is_subdivision in |- *; elim p; intros; apply p0 ]. apply Ropp_eq_compat; eapply StepFun_P17; [ apply StepFun_P1 | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; - elim H; intros; unfold is_subdivision in |- *; + elim H; intros; unfold is_subdivision in |- *; elim p; intros; apply p0 ]. assert (H : a < b); [ auto with real @@ -1951,9 +1951,9 @@ Lemma StepFun_P40 : adapted_couple f a b l1 lf1 -> adapted_couple f b c l2 lf2 -> adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f). -Proof. +Proof. intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2; - unfold adapted_couple in |- *; decompose [and] H1; + unfold adapted_couple in |- *; decompose [and] H1; decompose [and] H2; clear H1 H2; repeat split. apply RList_P25; try assumption. rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b); @@ -2030,7 +2030,7 @@ Proof. pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; rewrite H14; change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = - pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; + pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; rewrite H15; assert (H18 := H8 (S i)); unfold constant_D_eq, open_interval in H18; assert (H19 : (S i < pred (Rlength l1))%nat). @@ -2112,11 +2112,11 @@ Proof. rewrite H19 in H16; rewrite H19 in H17; change (pos_Rl (cons_Rlist (cons r2 r3) l2) i = - pos_Rl l2 (S i - Rlength (cons r1 (cons r2 r3)))) + pos_Rl l2 (S i - Rlength (cons r1 (cons r2 r3)))) in H16; rewrite H16; change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = - pos_Rl l2 (S (S i - Rlength (cons r1 (cons r2 r3))))) + pos_Rl l2 (S (S i - Rlength (cons r1 (cons r2 r3))))) in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat); unfold constant_D_eq, open_interval in H20; assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat). @@ -2154,7 +2154,7 @@ Proof. rewrite double; apply Rplus_lt_compat_l; assumption | discrR ] ]. rewrite <- H19 in H16; rewrite <- H19 in H17; elim H2; intros; - rewrite H19 in H25; rewrite H19 in H26; simpl in H25; + rewrite H19 in H25; rewrite H19 in H26; simpl in H25; simpl in H16; rewrite H16 in H25; simpl in H26; simpl in H17; rewrite H17 in H26; simpl in H24; rewrite H24 in H25; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)). @@ -2189,7 +2189,7 @@ Lemma StepFun_P42 : pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 -> Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2) = Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2. -Proof. +Proof. intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H; [ simpl in |- *; ring | destruct l1 as [| r0 r1]; @@ -2200,11 +2200,11 @@ Proof. Qed. Lemma StepFun_P43 : - forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b) + forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b) (pr2:IsStepFun f b c) (pr3:IsStepFun f a c), RiemannInt_SF (mkStepFun pr1) + RiemannInt_SF (mkStepFun pr2) = RiemannInt_SF (mkStepFun pr3). -Proof. +Proof. intros f; intros. pose proof pr1 as (l1,(lf1,H1)). pose proof pr2 as (l2,(lf2,H2)). @@ -2441,7 +2441,7 @@ Qed. Lemma StepFun_P44 : forall (f:R -> R) (a b c:R), IsStepFun f a b -> a <= c <= b -> IsStepFun f a c. -Proof. +Proof. intros f; intros; assert (H0 : a <= b). elim H; intros; apply Rle_trans with c; assumption. elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; @@ -2479,7 +2479,7 @@ Proof. case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. elim H1; intro. split with (cons r (cons c nil)); split with (cons r3 nil); - unfold adapted_couple in H; decompose [and] H; clear H; + unfold adapted_couple in H; decompose [and] H; clear H; assert (H6 : r = a). simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro; [ reflexivity @@ -2497,7 +2497,7 @@ Proof. assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). simpl in |- *; apply lt_O_Sn. apply (H10 H12); unfold open_interval in |- *; simpl in |- *; - rewrite H11 in H9; simpl in H9; elim H9; clear H9; + rewrite H11 in H9; simpl in H9; elim H9; clear H9; intros; split; try assumption. apply Rlt_le_trans with c; assumption. elim (le_Sn_O _ H11). @@ -2505,8 +2505,8 @@ Proof. cut (r1 <= c <= b). intros. elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with (cons r l1'); - split with (cons r3 lf1'); unfold adapted_couple in H, H4; - decompose [and] H; decompose [and] H4; clear H H4 X0; + split with (cons r3 lf1'); unfold adapted_couple in H, H4; + decompose [and] H; decompose [and] H4; clear H H4 X0; assert (H14 : a <= b). elim H0; intros; apply Rle_trans with c; assumption. assert (H16 : r = a). @@ -2538,7 +2538,7 @@ Proof. assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). simpl in |- *; apply lt_O_Sn. apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4; - elim H4; clear H4; intros; split; try assumption; + elim H4; clear H4; intros; split; try assumption; replace r1 with r4. assumption. simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; @@ -2557,7 +2557,7 @@ Qed. Lemma StepFun_P45 : forall (f:R -> R) (a b c:R), IsStepFun f a b -> a <= c <= b -> IsStepFun f c b. -Proof. +Proof. intros f; intros; assert (H0 : a <= b). elim H; intros; apply Rle_trans with c; assumption. elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; @@ -2614,7 +2614,7 @@ Proof. apply (H7 0%nat). simpl in |- *; apply lt_O_Sn. unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6; - intros; split; try assumption; apply Rle_lt_trans with c; + intros; split; try assumption; apply Rle_lt_trans with c; try assumption; replace r with a. elim H0; intros; assumption. simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros; @@ -2634,7 +2634,7 @@ Qed. Lemma StepFun_P46 : forall (f:R -> R) (a b c:R), IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. -Proof. +Proof. intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros. apply StepFun_P41 with b; assumption. case (Rle_dec a c); intro. diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v index 287fda493..810a7de03 100644 --- a/theories/Reals/Rlimit.v +++ b/theories/Reals/Rlimit.v @@ -85,7 +85,7 @@ Proof. fourier. discrR. ring. -Qed. +Qed. (*********) Lemma prop_eps : forall r:R, (forall eps:R, eps > 0 -> r < eps) -> r <= 0. @@ -148,7 +148,7 @@ Qed. (*******************************) (*********) -Record Metric_Space : Type := +Record Metric_Space : Type := {Base : Type; dist : Base -> Base -> R; dist_pos : forall x y:Base, dist x y >= 0; @@ -167,7 +167,7 @@ Definition limit_in (X X':Metric_Space) (f:Base X -> Base X') eps > 0 -> exists alp : R, alp > 0 /\ - (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps). + (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps). (*******************************) (** ** R is a metric space *) @@ -214,7 +214,7 @@ Qed. Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0. Proof. unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; - split with eps; split; auto; intros; elim H0; intros; + split with eps; split; auto; intros; elim H0; intros; auto. Qed. @@ -226,7 +226,7 @@ Lemma limit_plus : Proof. intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1)); - elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; + elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; clear H H0; intros; elim H; elim H0; clear H H0; intros; split with (Rmin x1 x); split. exact (Rmin_Rgt_r x1 x 0 (conj H H2)). @@ -248,11 +248,11 @@ Lemma limit_Ropp : limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0. Proof. unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; - elim (H eps H0); clear H; intros; elim H; clear H; - intros; split with x; split; auto; intros; generalize (H1 x1 H2); + elim (H eps H0); clear H; intros; elim H; clear H; + intros; split with x; split; auto; intros; generalize (H1 x1 H2); clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *; rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l); - fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; + fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; rewrite R_dist_sym; assumption. Qed. @@ -273,7 +273,7 @@ Lemma limit_free : Proof. unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x)); - intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; + intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; assumption. Qed. @@ -286,13 +286,13 @@ Proof. intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1)); - elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); - clear H H0; simpl in |- *; intros; elim H; elim H0; + elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); + clear H H0; simpl in |- *; intros; elim H; elim H0; clear H H0; intros; split with (Rmin x1 x); split. exact (Rmin_Rgt_r x1 x 0 (conj H H2)). intros; elim H4; clear H4; intros; unfold R_dist in |- *; replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)). - cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). + cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). cut (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <= Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))). @@ -353,19 +353,19 @@ Proof. unfold Rabs in |- *; case (Rcase_abs (l - l')); intros. cut (forall eps:R, eps > 0 -> - (l - l') < eps). intro; generalize (prop_eps (- (l - l')) H1); intro; - generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; - unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); + generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; + unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); intro; elimtype False; auto. intros; cut (eps * / 2 > 0). intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; - unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); - intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; clear a b; apply (Rlt_trans 0 1 2 H3 H4). unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); - rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); auto. apply (Rinv_0_lt_compat 2); cut (1 < 2). intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). @@ -374,7 +374,7 @@ Proof. (**) cut (forall eps:R, eps > 0 -> l - l' < eps). intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0); - intros a b; clear b; apply (Rminus_diag_uniq l l'); + intros a b; clear b; apply (Rminus_diag_uniq l l'); apply a; split. assumption. apply (Rge_le (l - l') 0 r). @@ -383,11 +383,11 @@ Proof. rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; - unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); - intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; clear a b; apply (Rlt_trans 0 1 2 H3 H4). unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); - rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); auto. apply (Rinv_0_lt_compat 2); cut (1 < 2). intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). @@ -395,21 +395,21 @@ Proof. rewrite a; clear a b; trivial. (**) intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros; - clear H0 H1; elim H3; elim H4; clear H3 H4; intros; - simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); + clear H0 H1; elim H3; elim H4; clear H3 H4; intros; + simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0))); intros; elim H5; intros; clear H5 H H6 H7; - generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; - elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); + generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; + elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); intros; clear H5 H9; generalize (H1 x2 (conj H8 H6)); - generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; + generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; intros; generalize (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0); unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1; rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1); elim (Rmult_ne eps); intros a b; rewrite a; clear a b; - generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; + generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; intros; apply (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l')) @@ -449,7 +449,7 @@ Proof. intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1). cut (D x /\ Rabs (x - x0) < delta2). intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12); - clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); + clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); intro; rewrite Rabs_minus_sym in H7; generalize (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7); diff --git a/theories/Reals/Rlogic.v b/theories/Reals/Rlogic.v index e535a5568..d940a1d11 100644 --- a/theories/Reals/Rlogic.v +++ b/theories/Reals/Rlogic.v @@ -34,7 +34,7 @@ Require Import PartSum. Require Import SeqSeries. Require Import RiemannInt. Require Import Fourier. - + Section Arithmetical_dec. Variable P : nat -> Prop. @@ -108,7 +108,7 @@ rewrite Rabs_pos_eq. intro i. unfold f, g. elim (HP i); intro; ring_simplify; auto with *. - cut (sum_f_R0 g m <= sum_f_R0 g n). + cut (sum_f_R0 g m <= sum_f_R0 g n). intro; fourier. apply (ge_fun_sums_ge m n g Hnm). intro. unfold g. diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v index 6dfb2d604..57bc050a9 100644 --- a/theories/Reals/Rpower.v +++ b/theories/Reals/Rpower.v @@ -7,7 +7,7 @@ (************************************************************************) (*i $Id$ i*) -(*i Due to L.Thery i*) +(*i Due to L.Thery i*) (************************************************************) (* Definitions of log and Rpower : R->R->R; main properties *) @@ -86,7 +86,7 @@ Proof. apply INR_fact_neq_0. apply INR_fact_neq_0. assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0; - intros; elim (H0 _ H1); intros; exists x0; intros; + intros; elim (H0 _ H1); intros; exists x0; intros; unfold R_dist in H2; unfold R_dist in |- *; replace (/ INR (fact n)) with (1 ^ n / INR (fact n)). apply (H2 _ H3). @@ -139,8 +139,8 @@ Qed. Lemma exp_ineq1 : forall x:R, 0 < x -> 1 + x < exp x. Proof. intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x)); - assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; - intros; elim H1; intros; unfold Rminus in H2; rewrite H2; + assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; + intros; elim H1; intros; unfold Rminus in H2; rewrite H2; rewrite Ropp_0; rewrite Rplus_0_r; replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0). rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; @@ -162,7 +162,7 @@ Proof. pose proof (IVT_cor f 0 y H2 (Rlt_le _ _ H0) H4) as (t,(_,H7)); exists t; unfold f in H7; apply Rminus_diag_uniq_sym; exact H7. pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)); - rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; + rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; assumption. unfold f in |- *; apply Rplus_le_reg_l with y; left; apply Rlt_trans with (1 + y). @@ -191,7 +191,7 @@ Proof. apply Rmult_eq_reg_l with (exp x / y). unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc; - rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; + rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; rewrite Rmult_1_r; symmetry in |- *; apply p. red in |- *; intro H3; rewrite H3 in H; elim (Rlt_irrefl _ H). unfold Rdiv in |- *; apply prod_neq_R0. @@ -216,7 +216,7 @@ Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x. Proof. intros; unfold ln in |- *; case (Rlt_dec 0 x); intro. unfold Rln in |- *; - case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); + case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); intros. simpl in e; symmetry in |- *; apply e. elim n; apply H. @@ -248,7 +248,7 @@ Qed. Theorem ln_increasing : forall x y:R, 0 < x -> x < y -> ln x < ln y. Proof. intros x y H H0; apply exp_lt_inv. - repeat rewrite exp_ln. + repeat rewrite exp_ln. apply H0. apply Rlt_trans with x; assumption. apply H. @@ -270,7 +270,7 @@ Theorem ln_lt_inv : forall x y:R, 0 < x -> 0 < y -> ln x < ln y -> x < y. Proof. intros x y H H0 H1; rewrite <- (exp_ln x); try rewrite <- (exp_ln y). apply exp_increasing; apply H1. - assumption. + assumption. assumption. Qed. @@ -299,7 +299,7 @@ Theorem ln_Rinv : forall x:R, 0 < x -> ln (/ x) = - ln x. Proof. intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp. reflexivity. - assumption. + assumption. apply Rinv_0_lt_compat; assumption. Qed. @@ -325,7 +325,7 @@ Proof. unfold dist, R_met, R_dist in |- *; simpl in |- *. intros x [[H3 H4] H5]. cut (y * (x * / y) = x). - intro Hxyy. + intro Hxyy. replace (ln x - ln y) with (ln (x * / y)). case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ]. rewrite Rabs_left. @@ -580,8 +580,8 @@ Proof. (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln). apply ln_continue; auto. assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); intros; exists (pos x); split. apply (cond_pos x). intros; pattern y at 3 in |- *; rewrite <- exp_ln. @@ -589,7 +589,7 @@ Proof. [ idtac | ring ]. apply H1. elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3; - apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); + apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); apply H3. elim H2; clear H2; intros _ H2; apply H2. assumption. @@ -600,7 +600,7 @@ Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x). Proof. intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; unfold R_dist in H0; - unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); + unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2)); assert (H4 : 0 < alp). unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro. diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v index e6801e6d6..f02b77564 100644 --- a/theories/Reals/Rprod.v +++ b/theories/Reals/Rprod.v @@ -43,7 +43,7 @@ Proof. rewrite Hrecn; [ ring | assumption ]. omega. omega. -Qed. +Qed. (**********) Lemma prod_SO_pos : @@ -80,9 +80,9 @@ Qed. (** Application to factorial *) Lemma fact_prodSO : - forall n:nat, INR (fact n) = prod_f_R0 (fun k:nat => - (match (eq_nat_dec k 0) with - | left _ => 1%R + forall n:nat, INR (fact n) = prod_f_R0 (fun k:nat => + (match (eq_nat_dec k 0) with + | left _ => 1%R | right _ => INR k end)) n. Proof. @@ -102,7 +102,7 @@ Proof. replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ]. replace (S n0) with (n0 + 1)%nat; [ idtac | ring ]. ring. -Qed. +Qed. (** We prove that (N!)^2<=(2N-k)!*k! forall k in [|O;2N|] *) Lemma RfactN_fact2N_factk : @@ -112,7 +112,7 @@ Lemma RfactN_fact2N_factk : Proof. assert (forall (n:nat), 0 <= (if eq_nat_dec n 0 then 1 else INR n)). intros; case (eq_nat_dec n 0); auto with real. - assert (forall (n:nat), (0 < n)%nat -> + assert (forall (n:nat), (0 < n)%nat -> (if eq_nat_dec n 0 then 1 else INR n) = INR n). intros n; case (eq_nat_dec n 0); auto with real. intros; absurd (0 < n)%nat; omega. @@ -125,7 +125,7 @@ Proof. rewrite Rmult_assoc; apply Rmult_le_compat_l. apply prod_SO_pos; intros; auto. replace (2 * N - k - N-1)%nat with (N - k-1)%nat. - rewrite Rmult_comm; rewrite (prod_SO_split + rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) N k). apply Rmult_le_compat_l. apply prod_SO_pos; intros; auto. @@ -138,14 +138,14 @@ Proof. assumption. omega. omega. - rewrite <- (Rmult_comm (prod_f_R0 (fun l:nat => + rewrite <- (Rmult_comm (prod_f_R0 (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) k)); - rewrite (prod_SO_split (fun l:nat => + rewrite (prod_SO_split (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) k N). rewrite Rmult_assoc; apply Rmult_le_compat_l. apply prod_SO_pos; intros; auto. rewrite Rmult_comm; - rewrite (prod_SO_split (fun l:nat => + rewrite (prod_SO_split (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) N (2 * N - k)). apply Rmult_le_compat_l. apply prod_SO_pos; intros; auto. @@ -160,7 +160,7 @@ Proof. omega. assumption. omega. -Qed. +Qed. (**********) diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v index 5436b4daa..62f1940bf 100644 --- a/theories/Reals/Rseries.v +++ b/theories/Reals/Rseries.v @@ -71,7 +71,7 @@ Section sequence. forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x. Proof. intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0; - clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; + clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; trivial. Qed. @@ -106,11 +106,11 @@ Section sequence. Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R, Un_cv l. Proof. unfold Un_growing, Un_cv in |- *; intros; - generalize (completeness_weak EUn H0 EUn_noempty); - intro; elim H1; clear H1; intros; split with x; intros; + generalize (completeness_weak EUn H0 EUn_noempty); + intro; elim H1; clear H1; intros; split with x; intros; unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1; - elim H0; clear H0; intros; elim H1; clear H1; intros; - generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); + elim H0; clear H0; intros; elim H1; clear H1; intros; + generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); intro. cut (exists N : nat, x - eps < Un N). intro; elim H6; clear H6; intros; split with x1. @@ -131,10 +131,10 @@ Section sequence. apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)). red in |- *; intro; cut (forall N:nat, Un N <= x - eps). intro; generalize (Un_bound_imp (x - eps) H7); intro; - unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); + unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; - rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); + rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); rewrite Ropp_involutive; intro; unfold Rgt in H2; generalize (Rgt_not_le eps 0 H2); intro; auto. intro; elim (H6 N); intro; unfold Rle in |- *. @@ -151,7 +151,7 @@ Section sequence. split with (Un 0); intros; rewrite (le_n_O_eq n H); apply (Req_le (Un n) (Un n) (refl_equal (Un n))). elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros; - elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; + elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; inversion H0. rewrite <- H1; rewrite <- H1 in H2; apply @@ -163,21 +163,21 @@ Section sequence. Lemma cauchy_bound : Cauchy_crit -> bound EUn. Proof. unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *; - unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; + unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; generalize (H x); intro; generalize (le_dec x); intro; - elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); - clear H; intros; unfold EUn in H; elim H; clear H; + elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); + clear H; intros; unfold EUn in H; elim H; clear H; intros; elim (H1 x2); clear H1; intro y. unfold ge in H0; generalize (H0 x2 (le_n x) y); clear H0; intro; rewrite <- H in H0; unfold R_dist in H0; elim (Rabs_def2 (Un x - x1) 1 H0); - clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); + clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); intros; apply H4; clear H3 H4; right; clear H H0 y; apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1); clear H1; intro; apply (Rminus_lt x1 (Un x + 1)); cut (-1 - (Un x - x1) = x1 - (Un x + 1)); [ intro; rewrite H0 in H; assumption | ring ]. generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0; - elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; + elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; apply H2; left; assumption. Qed. @@ -248,7 +248,7 @@ Proof. cut (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) = Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))). - clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r. + clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r. rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps). intros; rewrite H9; unfold Rle in |- *; right; reflexivity. ring. diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v index b228f8985..33c20355c 100644 --- a/theories/Reals/Rsqrt_def.v +++ b/theories/Reals/Rsqrt_def.v @@ -23,7 +23,7 @@ Boxed Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R := let up := Dichotomy_ub x y P n in let z := (down + up) / 2 in if P z then down else z end - + with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R := match N with | O => y @@ -471,8 +471,8 @@ Proof. intros. cut (x <= y). intro. - generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). - generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). + generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). + generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). intros X X0. elim X; intros. elim X0; intros. @@ -667,7 +667,7 @@ Proof. apply Ropp_0_gt_lt_contravar; assumption. Qed. -(** We can now define the square root function as the reciprocal +(** We can now define the square root function as the reciprocal transformation of the square root function *) Lemma Rsqrt_exists : forall y:R, 0 <= y -> { z:R | 0 <= z /\ y = Rsqr z }. @@ -698,7 +698,7 @@ Proof. rewrite Rsqr_1. apply Rplus_le_reg_l with y. rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; left; assumption. exists 1. split. diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v index c36542d2b..c115969e3 100644 --- a/theories/Reals/Rtopology.v +++ b/theories/Reals/Rtopology.v @@ -33,8 +33,8 @@ Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x. Lemma interior_P1 : forall D:R -> Prop, included (interior D) D. Proof. intros; unfold included in |- *; unfold interior in |- *; intros; - unfold neighbourhood in H; elim H; intros; unfold included in H0; - apply H0; unfold disc in |- *; unfold Rminus in |- *; + unfold neighbourhood in H; elim H; intros; unfold included in H0; + apply H0; unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). Qed. @@ -98,7 +98,7 @@ Lemma complementary_P1 : ~ (exists y : R, intersection_domain D (complementary D) y). Proof. intro; red in |- *; intro; elim H; intros; - unfold intersection_domain, complementary in H0; elim H0; + unfold intersection_domain, complementary in H0; elim H0; intros; elim H2; assumption. Qed. @@ -110,23 +110,23 @@ Proof. elim H1; intro. assumption. assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros; - unfold intersection_domain in H5; elim H5; intros; + unfold intersection_domain in H5; elim H5; intros; elim H6; assumption. Qed. Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D). Proof. intro; unfold closed_set, adherence in |- *; - unfold open_set, complementary, point_adherent in |- *; + unfold open_set, complementary, point_adherent in |- *; intros; set (P := fun V:R -> Prop => neighbourhood V x -> exists y : R, intersection_domain V D y); - assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; + assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; unfold P in H1; assert (H2 := imply_to_and _ _ H1); unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3; - elim H3; intros; exists x0; unfold included in |- *; + elim H3; intros; exists x0; unfold included in |- *; intros; red in |- *; intro. assert (H8 := H7 V0); cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)). @@ -170,7 +170,7 @@ Proof. apply adherence_P2; assumption. unfold eq_Dom in |- *; unfold included in |- *; intros; assert (H0 := adherence_P3 D); unfold closed_set in H0; - unfold closed_set in |- *; unfold open_set in |- *; + unfold closed_set in |- *; unfold open_set in |- *; unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x). unfold complementary in |- *; unfold complementary in H1; red in |- *; intro; elim H; clear H; intros _ H; elim H1; apply (H _ H2). @@ -178,7 +178,7 @@ Proof. unfold neighbourhood in H3; elim H3; intros; exists x0; unfold included in |- *; unfold included in H4; intros; assert (H6 := H4 _ H5); unfold complementary in H6; - unfold complementary in |- *; red in |- *; intro; + unfold complementary in |- *; red in |- *; intro; elim H; clear H; intros H _; elim H6; apply (H _ H7). Qed. @@ -187,7 +187,7 @@ Lemma neighbourhood_P1 : included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x. Proof. unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0; - intros; unfold included in |- *; unfold included in H1; + intros; unfold included in |- *; unfold included in H1; intros; apply (H _ (H1 _ H2)). Qed. @@ -211,8 +211,8 @@ Proof. unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1; intros. assert (H4 := H _ H2); assert (H5 := H0 _ H3); - unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; - elim H4; clear H; intros del1 H; elim H5; clear H0; + unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; + elim H4; clear H; intros del1 H; elim H5; clear H0; intros del2 H0; cut (0 < Rmin del1 del2). intro; set (del := mkposreal _ H6). exists del; unfold included in |- *; intros; unfold included in H, H0; @@ -292,7 +292,7 @@ Proof. apply (sym_not_eq (A:=R)); apply H7. unfold disc in H6; apply H6. intros; unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; intros. assert (H1 := H (disc (f x) (mkposreal eps H0))). cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)). @@ -317,8 +317,8 @@ Proof. intros; unfold open_set in H0; unfold open_set in |- *; intros; assert (H2 := continuity_P1 f x); elim H2; intros H3 _; assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *; - unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); - elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; + unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); + elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; elim H7; intros del H9; exists del; unfold included in H9; unfold included in |- *; intros; apply (H8 _ (H9 _ H10)). Qed. @@ -333,7 +333,7 @@ Proof. intros; apply continuity_P2; assumption. intros; unfold continuity in |- *; unfold continuity_pt in |- *; unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; intros; cut (open_set (disc (f x) (mkposreal _ H0))). intro; assert (H2 := H _ H1). unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)). @@ -466,7 +466,7 @@ Proof. cut (covering_open_set X f0). intro; assert (H3 := H1 H2); elim H3; intros D' H4; unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6; - unfold domain_finite in H6; elim H6; intros l H7; + unfold domain_finite in H6; elim H6; intros l H7; unfold bounded in |- *; set (r := MaxRlist l). exists (- r); exists r; intros. unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros; @@ -538,9 +538,9 @@ Proof. intro; assert (H10 := H0 (disc x (mkposreal _ H9))); cut (neighbourhood (disc x (mkposreal alp H9)) x). intro; assert (H12 := H10 H11); elim H12; clear H12; intros y H12; - unfold intersection_domain in H12; elim H12; clear H12; - intros; assert (H14 := H7 _ H13); elim H14; clear H14; - intros y0 H14; elim H14; clear H14; intros; unfold g in H14; + unfold intersection_domain in H12; elim H12; clear H12; + intros; assert (H14 := H7 _ H13); elim H14; clear H14; + intros y0 H14; elim H14; clear H14; intros; unfold g in H14; elim H14; clear H14; intros; unfold disc in H12; simpl in H12; cut (alp <= Rabs (y0 - x) / 2). intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17); @@ -557,10 +557,10 @@ Proof. unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; apply H9. unfold alp in |- *; apply MinRlist_P2; intros; - assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; - intros z H10; elim H10; clear H10; intros; rewrite H11; + assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; + intros z H10; elim H10; clear H10; intros; rewrite H11; apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10); - unfold intersection_domain, D in H13; elim H13; clear H13; + unfold intersection_domain, D in H13; elim H13; clear H13; intros; assumption. unfold covering_open_set in |- *; split. unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *; @@ -577,7 +577,7 @@ Proof. rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6. apply H5. unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros; - rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; + rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; apply H7. apply open_set_P6 with (fun z:R => False). apply open_set_P4. @@ -639,8 +639,8 @@ Proof. intro; assert (H3 := completeness A H1 H2); elim H3; clear H3; intros m H3; unfold is_lub in H3; cut (a <= m <= b). intro; unfold covering_open_set in H; elim H; clear H; intros; - unfold covering in H; assert (H6 := H m H4); elim H6; - clear H6; intros y0 H6; unfold family_open_set in H5; + unfold covering in H; assert (H6 := H m H4); elim H6; + clear H6; intros y0 H6; unfold family_open_set in H5; assert (H7 := H5 y0); unfold open_set in H7; assert (H8 := H7 m H6); unfold neighbourhood in H8; elim H8; clear H8; intros eps H8; cut (exists x : R, A x /\ m - eps < x <= m). @@ -651,11 +651,11 @@ Proof. set (Db := fun x:R => Dx x \/ x = y0); exists Db; unfold covering_finite in |- *; split. unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; - intros; unfold covering in H12; case (Rle_dec x0 x); + intros; unfold covering in H12; case (Rle_dec x0 x); intro. cut (a <= x0 <= x). intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; - simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; + simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ]. split. elim H14; intros; assumption. @@ -672,9 +672,9 @@ Proof. apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15. unfold Db in |- *; right; reflexivity. unfold family_finite in |- *; unfold domain_finite in |- *; - unfold covering_finite in H12; elim H12; clear H12; - intros; unfold family_finite in H13; unfold domain_finite in H13; - elim H13; clear H13; intros l H13; exists (cons y0 l); + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); intro; split. intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); clear H13; intros; case (Req_dec x0 y0); intro. @@ -723,7 +723,7 @@ Proof. set (Db := fun x:R => Dx x \/ x = y0); exists Db; unfold covering_finite in |- *; split. unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; - intros; unfold covering in H12; case (Rle_dec x0 x); + intros; unfold covering in H12; case (Rle_dec x0 x); intro. cut (a <= x0 <= x). intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; @@ -758,15 +758,15 @@ Proof. ring. unfold Db in |- *; right; reflexivity. unfold family_finite in |- *; unfold domain_finite in |- *; - unfold covering_finite in H12; elim H12; clear H12; - intros; unfold family_finite in H13; unfold domain_finite in H13; - elim H13; clear H13; intros l H13; exists (cons y0 l); + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); intro; split. intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); clear H13; intros; case (Req_dec x0 y0); intro. simpl in |- *; left; apply H16. simpl in |- *; right; apply H13; simpl in |- *; - unfold intersection_domain in |- *; unfold Db in H14; + unfold intersection_domain in |- *; unfold Db in H14; decompose [and or] H14. split; assumption. elim H16; assumption. @@ -793,7 +793,7 @@ Proof. set (P := fun n:R => A n /\ m - eps < n <= m); assert (H12 := not_ex_all_not _ P H9); unfold P in H12; unfold is_upper_bound in |- *; intros; - assert (H14 := not_and_or _ _ (H12 x)); elim H14; + assert (H14 := not_and_or _ _ (H12 x)); elim H14; intro. elim H15; apply H13. elim (not_and_or _ _ H15); intro. @@ -806,11 +806,11 @@ Proof. split. apply (H3 _ H0). apply (H4 b); unfold is_upper_bound in |- *; intros; unfold A in H5; elim H5; - clear H5; intros H5 _; elim H5; clear H5; intros _ H5; + clear H5; intros H5 _; elim H5; clear H5; intros _ H5; apply H5. exists a; apply H0. unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros; - unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; + unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; clear H1; intros _ H1; apply H1. unfold A in |- *; split. split; [ right; reflexivity | apply r ]. @@ -862,15 +862,15 @@ Proof. elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7. apply H9. unfold family_finite in |- *; unfold domain_finite in |- *; - unfold family_finite in H6; unfold domain_finite in H6; + unfold family_finite in H6; unfold domain_finite in H6; elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x); elim H7; clear H7; intros. split. intro; apply H7; simpl in |- *; unfold intersection_domain in |- *; - simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; + simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; apply H9. intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10; - simpl in |- *; unfold intersection_domain in |- *; + simpl in |- *; unfold intersection_domain in |- *; unfold D' in H10; apply H10. unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2; clear H2; intros. @@ -964,14 +964,14 @@ Proof. simpl in H11; elim H11; intros z H12; exists z; unfold g in H12; unfold image_rec in H12; rewrite H9; apply H12. unfold family_finite in H6; unfold domain_finite in H6; - unfold family_finite in |- *; unfold domain_finite in |- *; - elim H6; intros l H7; exists l; intro; elim (H7 x); + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H6; intros l H7; exists l; intro; elim (H7 x); intros; split; intro. apply H8; simpl in H10; simpl in |- *; apply H10. apply (H9 H10). unfold covering_open_set in |- *; split. unfold covering in |- *; intros; simpl in |- *; unfold covering in H1; - unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; + unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; apply H1. exists x; split; [ reflexivity | apply H4 ]. unfold family_open_set in |- *; unfold family_open_set in H2; intro; @@ -1014,8 +1014,8 @@ Proof. exists h; split. unfold continuity in |- *; intro; case (Rtotal_order x a); intro. unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); split. change (0 < a - x) in |- *; apply Rlt_Rminus; assumption. intros; elim H5; clear H5; intros _ H5; unfold h in |- *. @@ -1034,8 +1034,8 @@ Proof. unfold limit1_in in H6; unfold limit_in in H6; simpl in H6; unfold R_dist in H6; unfold continuity_pt in |- *; unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); split. unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. elim H8; intros; assumption. @@ -1067,8 +1067,8 @@ Proof. unfold limit1_in in H7; unfold limit_in in H7; simpl in H7; unfold R_dist in H7; unfold continuity_pt in |- *; unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros; elim (H7 _ H8); intros; elim H9; clear H9; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H7 _ H8); intros; elim H9; clear H9; intros. assert (H11 : 0 < x - a). apply Rlt_Rminus; assumption. @@ -1119,8 +1119,8 @@ Proof. unfold limit1_in in H8; unfold limit_in in H8; simpl in H8; unfold R_dist in H8; unfold continuity_pt in |- *; unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); split. unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. elim H10; intros; assumption. @@ -1152,8 +1152,8 @@ Proof. assumption. apply Rmin_r. unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); split. change (0 < x - b) in |- *; apply Rlt_Rminus; assumption. intros; elim H8; clear H8; intros. @@ -1210,8 +1210,8 @@ Proof. intro; unfold image_dir in H8; elim H8; clear H8; intros Mxx H8; elim H8; clear H8; intros; exists Mxx; split. intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros; - rewrite <- H8; unfold is_lub in H7; elim H7; clear H7; - intros H7 _; unfold is_upper_bound in H7; apply H7; + rewrite <- H8; unfold is_lub in H7; elim H7; clear H7; + intros H7 _; unfold is_upper_bound in H7; apply H7; unfold image_dir in |- *; exists c; split; [ reflexivity | apply H10 ]. apply H9. elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro. @@ -1298,7 +1298,7 @@ Proof. intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2; intros x0 H3; exists x0; intros; split. intros; rewrite <- (Ropp_involutive (f0 x0)); - rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; + rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; elim H3; intros; unfold opp_fct in H5; apply H5; apply H4. elim H3; intros; assumption. intros. @@ -1348,10 +1348,10 @@ Lemma ValAdh_un_prop : Proof. intros; split; intro. unfold ValAdh in H; unfold ValAdh_un in |- *; - unfold intersection_family in |- *; simpl in |- *; + unfold intersection_family in |- *; simpl in |- *; intros; elim H0; intros N H1; unfold adherence in |- *; - unfold point_adherent in |- *; intros; elim (H V N H2); - intros; exists (un x0); unfold intersection_domain in |- *; + unfold point_adherent in |- *; intros; elim (H V N H2); + intros; exists (un x0); unfold intersection_domain in |- *; elim H3; clear H3; intros; split. assumption. split. @@ -1367,9 +1367,9 @@ Proof. (exists n : nat, INR N = INR n)) x). apply H; exists N; reflexivity. unfold adherence in H1; unfold point_adherent in H1; assert (H2 := H1 _ H0); - elim H2; intros; unfold intersection_domain in H3; - elim H3; clear H3; intros; elim H4; clear H4; intros; - elim H4; clear H4; intros; elim H4; clear H4; intros; + elim H2; intros; unfold intersection_domain in H3; + elim H3; clear H3; intros; elim H4; clear H4; intros; + elim H4; clear H4; intros; elim H4; clear H4; intros; exists x1; split. apply (INR_le _ _ H6). rewrite H4 in H3; apply H3. @@ -1379,7 +1379,7 @@ Lemma adherence_P4 : forall F G:R -> Prop, included F G -> included (adherence F) (adherence G). Proof. unfold adherence, included in |- *; unfold point_adherent in |- *; intros; - elim (H0 _ H1); unfold intersection_domain in |- *; + elim (H0 _ H1); unfold intersection_domain in |- *; intros; elim H2; clear H2; intros; exists x0; split; [ assumption | apply (H _ H3) ]. Qed. @@ -1392,7 +1392,7 @@ Definition intersection_vide_in (D:R -> Prop) (f:family) : Prop := (ind f x -> included (f x) D) /\ ~ (exists y : R, intersection_family f y). -Definition intersection_vide_finite_in (D:R -> Prop) +Definition intersection_vide_finite_in (D:R -> Prop) (f:family) : Prop := intersection_vide_in D f /\ family_finite f. (**********) @@ -1417,9 +1417,9 @@ Proof. elim (H1 x); intros; unfold intersection_family in H5; assert (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x); - assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); - elim H7; intros; exists x0; elim (imply_to_and _ _ H8); - intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; + assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); + elim H7; intros; exists x0; elim (imply_to_and _ _ H8); + intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; split; [ apply H10 | apply H9 ]. unfold family_open_set in |- *; intro; elim (classic (D' x)); intro. apply open_set_P6 with (complementary (g x)). @@ -1448,7 +1448,7 @@ Proof. unfold covering in H4; elim (H4 x0 H7); intros; simpl in H8; unfold intersection_domain in H6; cut (ind g x1 /\ SF x1). intro; assert (H10 := H6 x1 H9); elim H10; clear H10; intros H10 _; elim H8; - clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8; + clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8; elim H8; clear H8; intros H8 _; elim H8; assumption. split. apply (cond_fam f0). @@ -1463,15 +1463,15 @@ Proof. unfold covering_finite in H4; elim H4; clear H4; intros H4 _; cut (exists z : R, X z). intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5); - intros; simpl in H6; elim Hyp'; exists x1; elim H6; + intros; simpl in H6; elim Hyp'; exists x1; elim H6; intros; unfold intersection_domain in |- *; split. apply (cond_fam f0); exists x0; apply H7. apply H8. apply Hyp. unfold covering_finite in H4; elim H4; clear H4; intros; unfold family_finite in H5; unfold domain_finite in H5; - unfold family_finite in |- *; unfold domain_finite in |- *; - elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); intros; split; intro; [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ]. Qed. @@ -1506,7 +1506,7 @@ Proof. intro; cut (intersection_vide_in X f0). intro; assert (H7 := H3 H5 H6). elim H7; intros SF H8; unfold intersection_vide_finite_in in H8; elim H8; - clear H8; intros; unfold intersection_vide_in in H8; + clear H8; intros; unfold intersection_vide_in in H8; elim (H8 0); intros _ H10; elim H10; unfold family_finite in H9; unfold domain_finite in H9; elim H9; clear H9; intros l H9; set (r := MaxRlist l); cut (D r). @@ -1536,7 +1536,7 @@ Proof. assert (H17 := not_ex_all_not _ (fun z:R => intersection_domain (ind f0) SF z) H13); - assert (H18 := H16 x); unfold intersection_family in H18; + assert (H18 := H16 x); unfold intersection_family in H18; simpl in H18; assert (H19 := @@ -1604,8 +1604,8 @@ Proof. elim Hyp; clear Hyp; intro Hyp. (* X possède un seul élément *) unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); - intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; - intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); + intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; + intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos eps). (* X possède au moins deux éléments distincts *) @@ -1616,8 +1616,8 @@ Proof. elim H2; intros; exists x; exists x0; split. apply H3. elim Hyp; intros; elim H4; intros; decompose [and] H5; - assert (H10 := H3 _ H6); assert (H11 := H3 _ H8); - elim H10; intros; elim H11; intros; case (total_order_T x x0); + assert (H10 := H3 _ H6); assert (H11 := H3 _ H8); + elim H10; intros; elim H11; intros; case (total_order_T x x0); intro. elim s; intro. assumption. @@ -1652,7 +1652,7 @@ Proof. assumption. assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4; unfold limit1_in in H4; unfold limit_in in H4; simpl in H4; - unfold R_dist in H4; elim (H4 (eps / 2) (H1 eps)); + unfold R_dist in H4; elim (H4 (eps / 2) (H1 eps)); intros; set (E := @@ -1661,7 +1661,7 @@ Proof. (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); assert (H6 : bound E). unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; - unfold E in |- *; intros; elim H6; clear H6; intros H6 _; + unfold E in |- *; intros; elim H6; clear H6; intros H6 _; elim H6; clear H6; intros _ H6; apply H6. assert (H7 : exists x : R, E x). elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros; @@ -1693,14 +1693,14 @@ Proof. intro; assert (H16 := H14 _ H15); elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)). unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13; - assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); + assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); intro. assumption. elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ]. split. apply p. unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; + rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ]. elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _; unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12; @@ -1711,8 +1711,8 @@ Proof. unfold family_open_set in |- *; intro; simpl in |- *; elim (classic (X x)); intro. unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4; - intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; - intros; unfold neighbourhood in |- *; case (Req_dec x x0); + intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; + intros; unfold neighbourhood in |- *; case (Req_dec x x0); intro. exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros; split. @@ -1745,7 +1745,7 @@ Proof. intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4. elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4; intros; unfold family_finite in H5; unfold domain_finite in H5; - unfold covering in H4; simpl in H4; simpl in H5; elim H5; + unfold covering in H4; simpl in H4; simpl in H5; elim H5; clear H5; intros l H5; unfold intersection_domain in H5; cut (forall x:R, @@ -1761,8 +1761,8 @@ Proof. (fun x del:R => 0 < del /\ (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ - included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); - elim H7; clear H7; intros l' H7; elim H7; clear H7; + included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); + elim H7; clear H7; intros l' H7; elim H7; clear H7; intros; set (D := MinRlist l'); cut (0 < D / 2). intro; exists (mkposreal _ H9); intros; assert (H13 := H4 _ H10); elim H13; clear H13; intros xi H13; assert (H14 : In xi l). @@ -1785,8 +1785,8 @@ Proof. rewrite double; apply Rplus_lt_compat_l; apply H19. discrR. assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; - elim H20; clear H20; intros; rewrite <- Rabs_Ropp; - rewrite Ropp_minus_distr; apply H20; unfold included in H21; + elim H20; clear H20; intros; rewrite <- Rabs_Ropp; + rewrite Ropp_minus_distr; apply H20; unfold included in H21; elim H13; intros; assert (H24 := H21 x H22); apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)). replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ]. @@ -1803,7 +1803,7 @@ Proof. unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros; elim (H10 H9); intros; elim H12; intros; rewrite H14; - rewrite <- H7 in H13; elim (H8 x H13); intros; + rewrite <- H7 in H13; elim (H8 x H13); intros; apply H15 | apply Rinv_0_lt_compat; prove_sup0 ]. intros; elim (H5 x); intros; elim (H8 H6); intros; @@ -1814,14 +1814,14 @@ Proof. (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); assert (H11 : bound E). unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; - unfold E in |- *; intros; elim H11; clear H11; intros H11 _; + unfold E in |- *; intros; elim H11; clear H11; intros H11 _; elim H11; clear H11; intros _ H11; apply H11. assert (H12 : exists x : R, E x). assert (H13 := H _ H9); unfold continuity_pt in H13; - unfold continue_in in H13; unfold limit1_in in H13; + unfold continue_in in H13; unfold limit1_in in H13; unfold limit_in in H13; simpl in H13; unfold R_dist in H13; - elim (H13 _ (H1 eps)); intros; elim H12; clear H12; - intros; exists (Rmin x0 (M - m)); unfold E in |- *; + elim (H13 _ (H1 eps)); intros; elim H12; clear H12; + intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros; split. split; [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro; @@ -1850,7 +1850,7 @@ Proof. intro; assert (H21 := H19 _ H20); elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)). unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18; - assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); + assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); intro. assumption. elim (H17 x1); split. @@ -1864,7 +1864,7 @@ Proof. apply H21. elim H12; intros; unfold E in H13; elim H13; intros H14 _; elim H14; intros H15 _; unfold is_lub in p; elim p; intros; - unfold is_upper_bound in H16; unfold is_upper_bound in H17; + unfold is_upper_bound in H16; unfold is_upper_bound in H17; split. apply Rlt_le_trans with x1; [ assumption | apply (H16 _ H13) ]. apply H17; intros; unfold E in H18; elim H18; intros; elim H19; intros; diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v index c9f83d639..c637b7ab9 100644 --- a/theories/Reals/Rtrigo.v +++ b/theories/Reals/Rtrigo.v @@ -32,7 +32,7 @@ Proof. elim (Rlt_irrefl _ H0). Qed. -(**********) +(**********) Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y. Proof. intros; unfold Rminus in |- *; rewrite cos_plus. @@ -50,7 +50,7 @@ Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x). Proof. intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1; unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x))); - rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry in |- *; apply Rplus_0_r. Qed. @@ -151,7 +151,7 @@ Proof. rewrite <- Rinv_r_sym. rewrite Rmult_1_l; rewrite (Rmult_comm (sin x)); rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc; - apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); + apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym. apply Rmult_1_r. assumption. @@ -185,7 +185,7 @@ Qed. Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1. Proof. intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc; - rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; + rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; intro H1; rewrite <- H1; ring_Rsqr. Qed. @@ -219,7 +219,7 @@ Qed. Lemma tan_0 : tan 0 = 0. Proof. unfold tan in |- *; rewrite sin_0; rewrite cos_0. - unfold Rdiv in |- *; apply Rmult_0_l. + unfold Rdiv in |- *; apply Rmult_0_l. Qed. Lemma tan_neg : forall x:R, tan (- x) = - tan x. @@ -320,7 +320,7 @@ Lemma PI2_RGT_0 : 0 < PI / 2. Proof. unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ]. -Qed. +Qed. Lemma SIN_bound : forall x:R, -1 <= sin x <= 1. Proof. @@ -331,13 +331,13 @@ Proof. intro; generalize (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1) - (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); + (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0; generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); - repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); - repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). auto with real. cut (sin x < -1). @@ -346,13 +346,13 @@ Proof. generalize (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1) (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H))); - rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; + rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; rewrite sin2 in H0; unfold Rminus in H0; generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); - repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); - repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). auto with real. Qed. @@ -366,7 +366,7 @@ Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0). Proof. intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro; rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2; - rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; + rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3). Qed. @@ -399,18 +399,18 @@ Proof. repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r; replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ]; replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]; - replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); + replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); [ idtac | ring ]; replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ]. apply Rplus_lt_0_compat. unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat); - rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply H1. unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat); - rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply H1. intro; unfold Un in |- *. cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat). @@ -533,7 +533,7 @@ Proof. (SIN (PI - x) (Rlt_le 0 (PI - x) H7) (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI))); intros H8 _; - generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); + generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8). reflexivity. pattern PI at 2 in |- *; rewrite double_var; ring. @@ -545,7 +545,7 @@ Proof. intros; rewrite cos_sin; generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H). rewrite Rplus_opp_r; intro H1; - generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); + generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2). Qed. @@ -599,7 +599,7 @@ Proof. replace (PI / 2) with (- PI + 3 * (PI / 2)). apply Rplus_le_compat_l; assumption. pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; - ring. + ring. unfold INR in |- *; ring. Qed. @@ -625,7 +625,7 @@ Proof. intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H); replace (2 * PI + - PI) with PI; [ intro H1; rewrite Rplus_comm in H1; - generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); + generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); intro H2; rewrite (Rplus_comm (2 * PI)) in H2; rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2; rewrite <- (sin_period x 1); unfold INR in |- *; @@ -644,12 +644,12 @@ Proof. unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l; assumption. pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; - ring. + ring. unfold Rminus in |- *; rewrite Rplus_comm; replace (PI / 2) with (- PI + 3 * (PI / 2)). apply Rplus_lt_compat_l; assumption. pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; - ring. + ring. unfold INR in |- *; ring. Qed. @@ -658,7 +658,7 @@ Proof. intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0; generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros; generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5; - generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); + generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat. apply sin_gt_0; assumption. apply Rinv_0_lt_compat; apply cos_gt_0; assumption. @@ -667,7 +667,7 @@ Qed. Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0. Proof. intros x H1 H2; unfold tan in |- *; - generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); + generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); intro H3; rewrite <- Ropp_0; replace (sin x / cos x) with (- (- sin x / cos x)). rewrite <- sin_neg; apply Ropp_gt_lt_contravar; @@ -688,11 +688,11 @@ Proof. intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1); unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x). generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1; - generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; + generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1). - rewrite Rplus_opp_r. + rewrite Rplus_opp_r. intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3; - generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; + generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; intro H3; generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3). replace (2 * PI + - (3 * (PI / 2))) with (PI / 2). @@ -780,11 +780,11 @@ Proof. generalize (Rmult_le_compat_l (/ 2) (x - y) PI (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8). - repeat rewrite (Rmult_comm (/ 2)). + repeat rewrite (Rmult_comm (/ 2)). intro H9; generalize (sin_gt_0 ((x - y) / 2) H6 - (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); + (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); intro H10; elim (Rlt_irrefl (sin ((x - y) / 2)) @@ -799,7 +799,7 @@ Proof. generalize (Rmult_le_compat_l (/ 2) (x + y) PI (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4). - repeat rewrite (Rmult_comm (/ 2)). + repeat rewrite (Rmult_comm (/ 2)). clear H4; intro H4; generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1); replace (- (PI / 2) + - (PI / 2)) with (- PI). @@ -813,7 +813,7 @@ Proof. elim H5; intro H50. generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6; generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6). - rewrite Rmult_0_r. + rewrite Rmult_0_r. clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7. assumption. generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7; @@ -824,7 +824,7 @@ Proof. (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3); intro H9; elim (Rlt_irrefl 0 H9). rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3; - rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; + rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; elim (Rlt_irrefl 0 H3). unfold Rdiv in H3. rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50; @@ -865,8 +865,8 @@ Proof. clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1); rewrite Ropp_involutive; clear H1; intro H1; generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1; - generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; - intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); + generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; + intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3); replace (- y + x) with (x - y). rewrite Rplus_opp_l. @@ -885,12 +885,12 @@ Proof. replace (/ 2 * (x - y)) with ((x - y) / 2). clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4; generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8; - generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); + generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); clear H8; intro H8; cut (- PI < - (PI / 2)). intro H9; generalize (sin_lt_0_var ((x - y) / 2) - (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); + (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); intro H10; generalize (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 ( @@ -1012,21 +1012,21 @@ Proof. replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5). unfold Rminus in |- *. - rewrite Ropp_mult_distr_l_reverse. - apply Rplus_comm. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. unfold Rminus in |- *. - rewrite Ropp_mult_distr_l_reverse. - apply Rplus_comm. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. pattern PI at 3 in |- *; rewrite double_var. ring. rewrite double; pattern PI at 3 4 in |- *; rewrite double_var. ring. unfold Rminus in |- *. - rewrite Ropp_mult_distr_l_reverse. - apply Rplus_comm. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. unfold Rminus in |- *. - rewrite Ropp_mult_distr_l_reverse. - apply Rplus_comm. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. rewrite Rmult_1_r. rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. ring. @@ -1110,7 +1110,7 @@ Lemma tan_diff : cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y). Proof. intros; unfold tan in |- *; rewrite sin_minus. - unfold Rdiv in |- *. + unfold Rdiv in |- *. unfold Rminus in |- *. rewrite Rmult_plus_distr_r. rewrite Rinv_mult_distr. @@ -1143,7 +1143,7 @@ Lemma tan_increasing_0 : x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y. Proof. intros; generalize PI4_RLT_PI2; intro H4; - generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); intro H5; change (- (PI / 2) < - (PI / 4)) in H5; generalize (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) @@ -1155,20 +1155,20 @@ Proof. (sym_not_eq (Rlt_not_eq 0 (cos x) (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) - (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); intro H6; generalize (sym_not_eq (Rlt_not_eq 0 (cos y) (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) - (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); intro H7; generalize (tan_diff x y H6 H7); intro H8; - generalize (Rlt_minus (tan x) (tan y) H3); clear H3; + generalize (Rlt_minus (tan x) (tan y) H3); clear H3; intro H3; rewrite H8 in H3; cut (sin (x - y) < 0). intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1); rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10); clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2); - intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); clear H11; intro H11; generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10); @@ -1180,7 +1180,7 @@ Proof. (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI)); intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)). elim H14; intro H15. - rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). + rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). apply Rminus_lt; assumption. pattern PI at 1 in |- *; rewrite double_var. unfold Rdiv in |- *. @@ -1218,7 +1218,7 @@ Proof. elim (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)). rewrite Rinv_mult_distr. - reflexivity. + reflexivity. assumption. assumption. Qed. @@ -1229,7 +1229,7 @@ Lemma tan_increasing_1 : x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y. Proof. intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4; - generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); intro H5; change (- (PI / 2) < - (PI / 4)) in H5; generalize (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) @@ -1241,27 +1241,27 @@ Proof. (sym_not_eq (Rlt_not_eq 0 (cos x) (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) - (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); intro H6; generalize (sym_not_eq (Rlt_not_eq 0 (cos y) (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) - (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); intro H7; rewrite (tan_diff x y H6 H7); generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); replace (/ cos x * / cos y) with (/ (cos x * cos y)). clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2); - intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); clear H11; intro H11; generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); replace (x + - y) with (x - y). replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3; - clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; - intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); + clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; + intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); clear H1; intro H1; generalize (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3); @@ -1576,13 +1576,13 @@ Proof. Qed. Lemma cos_eq_0_0 : - forall x:R, cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. + forall x:R, cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. Proof. intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H); intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z; rewrite <- Z_R_minus; simpl. unfold INR in H3. field_simplify [(sym_eq H3)]. field. -(** +(** ring_simplify. (* rewrite (Rmult_comm PI);*) (* old ring compat *) rewrite <- H3; simpl; @@ -1618,7 +1618,7 @@ Proof. (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0); repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. repeat rewrite Rmult_1_r; intro; - generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); + generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); rewrite <- plus_IZR. replace (IZR (-2) + 1) with (-1). intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6); @@ -1710,7 +1710,7 @@ Proof. apply Rplus_le_le_0_compat. left; unfold Rdiv in |- *; apply Rmult_lt_0_compat. apply PI_RGT_0. - apply Rinv_0_lt_compat; prove_sup0. + apply Rinv_0_lt_compat; prove_sup0. assumption. elim H2; intro. right; assumption. diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v index 36ed0c1a0..fe2da8391 100644 --- a/theories/Reals/Rtrigo_alt.v +++ b/theories/Reals/Rtrigo_alt.v @@ -48,9 +48,9 @@ Theorem sin_bound : Proof. intros; case (Req_dec a 0); intro Hyp_a. rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *; - apply sum_eq_R0 || (symmetry in |- *; apply sum_eq_R0); - intros; unfold sin_term in |- *; rewrite pow_add; - simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; + apply sum_eq_R0 || (symmetry in |- *; apply sum_eq_R0); + intros; unfold sin_term in |- *; rewrite pow_add; + simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; ring. unfold sin_approx in |- *; cut (0 < a). intro Hyp_a_pos. @@ -123,7 +123,7 @@ Proof. simpl in |- *; ring. ring. assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3; - unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; + unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H3 eps H4); intros N H5. exists N; intros; apply H5. replace (2 * S n0 + 1)%nat with (S (2 * S n0)). @@ -138,7 +138,7 @@ Proof. assert (X := exist_sin (Rsqr a)); elim X; intros. cut (x = sin a / a). intro; rewrite H3 in p; unfold sin_in in p; unfold infinite_sum in p; - unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; intros. cut (0 < eps / Rabs a). intro; elim (p _ H5); intros N H6. @@ -146,9 +146,9 @@ Proof. replace (sum_f_R0 (tg_alt Un) n0) with (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))). unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; - rewrite Ropp_plus_distr; rewrite Ropp_involutive; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; repeat rewrite Rplus_assoc; rewrite (Rplus_comm a); - rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; + rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a). apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a). @@ -163,7 +163,7 @@ Proof. simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse; - rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; + rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; apply sum_eq. intros; unfold sin_n, Un, tg_alt in |- *; replace ((-1) ^ S i) with (- (-1) ^ i). @@ -230,7 +230,7 @@ Lemma cos_bound : forall (a:R) (n:nat), - PI / 2 <= a -> a <= PI / 2 -> - cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). Proof. cut ((forall (a:R) (n:nat), @@ -318,7 +318,7 @@ Proof. simpl in |- *; ring. ring. assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4; - unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; + unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H4 eps H5); intros N H6; exists N; intros. apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat. apply le_trans with (2 * N)%nat. @@ -328,7 +328,7 @@ Proof. assert (X := exist_cos (Rsqr a0)); elim X; intros. cut (x = cos a0). intro; rewrite H4 in p; unfold cos_in in p; unfold infinite_sum in p; - unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; intros. elim (p _ H5); intros N H6. exists N; intros. @@ -336,9 +336,9 @@ Proof. (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive; repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1); - rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; + rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp; - rewrite Ropp_plus_distr; rewrite Ropp_involutive; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; unfold Rminus in H6; apply H6. unfold ge in |- *; apply le_trans with n1. exact H7. @@ -351,7 +351,7 @@ Proof. replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1) with (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1); - [ idtac | ring ]; rewrite scal_sum; apply sum_eq; + [ idtac | ring ]; rewrite scal_sum; apply sum_eq; intros; unfold cos_n, Un, tg_alt in |- *. replace ((-1) ^ S i) with (- (-1) ^ i). replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i). diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v index d6a0f262a..a7fddb473 100644 --- a/theories/Reals/Rtrigo_calc.v +++ b/theories/Reals/Rtrigo_calc.v @@ -18,7 +18,7 @@ Open Local Scope R_scope. Lemma tan_PI : tan PI = 0. Proof. unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *; - apply Rmult_0_l. + apply Rmult_0_l. Qed. Lemma sin_3PI2 : sin (3 * (PI / 2)) = -1. @@ -129,7 +129,7 @@ Qed. Lemma R1_sqrt2_neq_0 : 1 / sqrt 2 <> 0. Proof. generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H; - generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); + generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); intro H0; assumption. Qed. @@ -163,9 +163,9 @@ Proof. | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3); [ prove_sup0 | generalize (Rlt_le 0 3 Hyp2); intro H2; - generalize (lt_INR_0 1 (neq_O_lt 1 H0)); + generalize (lt_INR_0 1 (neq_O_lt 1 H0)); unfold INR in |- *; intro H3; - generalize (Rplus_lt_compat_l 2 0 1 H3); + generalize (Rplus_lt_compat_l 2 0 1 H3); rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3; [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3; apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3) @@ -303,7 +303,7 @@ Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2. Proof. rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); - repeat rewrite <- Rmult_assoc; rewrite double_var; + repeat rewrite <- Rmult_assoc; rewrite double_var; reflexivity. Qed. @@ -385,7 +385,7 @@ Proof. replace (PI + PI / 2) with (3 * (PI / 2)). rewrite Rplus_0_r; intro H2; assumption. pattern PI at 2 in |- *; rewrite double_var; ring. -Qed. +Qed. Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI. Proof. @@ -450,7 +450,7 @@ Proof. left; apply sin_lb_gt_0; assumption. elim H1; intro. rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *; - unfold sum_f_R0 in |- *; unfold sin_term in |- *; + unfold sum_f_R0 in |- *; unfold sin_term in |- *; repeat rewrite pow_ne_zero. unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; repeat rewrite Rplus_0_r; right; reflexivity. diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v index 7f62f538b..9588e4438 100644 --- a/theories/Reals/Rtrigo_def.v +++ b/theories/Reals/Rtrigo_def.v @@ -63,7 +63,7 @@ Proof. Defined. (* Value of [exp 0] *) -Lemma exp_0 : exp 0 = 1. +Lemma exp_0 : exp 0 = 1. Proof. cut (exp_in 0 (exp 0)). cut (exp_in 0 1). @@ -96,7 +96,7 @@ Qed. Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)). Lemma simpl_cos_n : - forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). + forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). Proof. intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. @@ -176,7 +176,7 @@ Proof. assert (H0 := archimed_cor1 eps H). elim H0; intros; exists x. intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; rewrite Rabs_Ropp; rewrite Rabs_right. rewrite mult_INR; rewrite Rinv_mult_distr. cut (/ INR (2 * S n) < 1). @@ -250,7 +250,7 @@ Definition cos (x:R) : R := let (a,_) := exist_cos (Rsqr x) in a. Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)). Lemma simpl_sin_n : - forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). + forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). Proof. intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. @@ -300,7 +300,7 @@ Proof. unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H). elim H0; intros; exists x. intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; rewrite Rabs_Ropp; rewrite Rabs_right. rewrite mult_INR; rewrite Rinv_mult_distr. cut (/ INR (2 * S n) < 1). @@ -382,7 +382,7 @@ Qed. Lemma sin_antisym : forall x:R, sin (- x) = - sin x. Proof. intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x); - [ idtac | apply Rsqr_neg ]. + [ idtac | apply Rsqr_neg ]. case (exist_sin (Rsqr x)); intros; ring. Qed. diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v index 173fe4960..cb53b5346 100644 --- a/theories/Reals/Rtrigo_fun.v +++ b/theories/Reals/Rtrigo_fun.v @@ -33,7 +33,7 @@ Proof. generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2); replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ]. rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2; - generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); intro; unfold Rgt in H3; generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2); intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4; @@ -42,11 +42,11 @@ Proof. rewrite (Rmult_comm (/ INR (S n))) in H4; rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4; rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4; - rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; assumption. apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1; apply (Rinv_lt_contravar 1 eps); auto; - rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H; + rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H; assumption. unfold Rgt in H1; apply Rlt_le; assumption. unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. @@ -61,12 +61,12 @@ Proof. intro ; generalize (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4 - (le_INR x n H2)); + (le_INR x n H2)); clear H4; intro; unfold Rminus in H4; generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4); replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ]. rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4; - generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); intro; unfold Rgt in H5; generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4); intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6; @@ -75,7 +75,7 @@ Proof. rewrite (Rmult_comm (/ INR (S n))) in H6; rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6; rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6; - rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; assumption. cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x)); [ intro | rewrite H1; trivial ]. @@ -92,8 +92,8 @@ Proof. rewrite (Rinv_l eps (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H)))) - ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); - intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; + ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); + intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; unfold Rgt in |- *; assumption. right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto. elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le; diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v index dc65dd2e9..5b731488b 100644 --- a/theories/Reals/Rtrigo_reg.v +++ b/theories/Reals/Rtrigo_reg.v @@ -131,7 +131,7 @@ Proof. apply SFL_continuity; assumption. unfold continuity in |- *; unfold continuity_pt in |- *; unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; intros. elim (H1 x _ H2); intros. exists x0; intros. @@ -172,7 +172,7 @@ Proof. unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; unfold R_dist in H0; unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; intros. elim (H0 _ H); intros. exists x0; intros. @@ -186,7 +186,7 @@ Proof. trivial. red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1); - apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); + apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); apply H7. replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ]; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6. @@ -420,7 +420,7 @@ Proof. elim H9; intros; assumption. cut (Rabs (h / 2) < del). intro; cut (h / 2 <> 0). - intro; assert (H11 := H2 _ H10 H9). + intro; assert (H11 := H2 _ H10 H9). rewrite Rplus_0_l in H11; rewrite sin_0 in H11. rewrite Rminus_0_r in H11; apply H11. unfold Rdiv in |- *; apply prod_neq_R0. @@ -436,7 +436,7 @@ Proof. unfold delta in |- *; simpl in |- *; apply Rmin_l. apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *; - rewrite (double_var del); apply Rplus_lt_compat_l; + rewrite (double_var del); apply Rplus_lt_compat_l; unfold Rdiv in |- *; apply Rmult_lt_0_compat. apply (cond_pos del). apply Rinv_0_lt_compat; prove_sup0. diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v index e41addadb..dbfc85bb9 100644 --- a/theories/Reals/SeqSeries.v +++ b/theories/Reals/SeqSeries.v @@ -25,7 +25,7 @@ Open Local Scope R_scope. (**********) Lemma sum_maj1 : - forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) + forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) (N:nat), Un_cv (fun n:nat => SP fn n x) l1 -> Un_cv (fun n:nat => sum_f_R0 An n) l2 -> @@ -92,7 +92,7 @@ Proof. (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with (sum_f_R0 (fun k:nat => fn k x) N + - sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); [ idtac | ring ]. replace (sum_f_R0 (fun k:nat => fn k x) N + @@ -170,7 +170,7 @@ Proof. (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with (sum_f_R0 (fun k:nat => fn k x) N + - sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); [ idtac | ring ]. replace (sum_f_R0 (fun k:nat => fn k x) N + @@ -241,13 +241,13 @@ Proof. apply Rle_ge; apply cond_pos_sum; intro. elim (H (S n + n0)%nat); intros; assumption. rewrite b; unfold R_dist in |- *; unfold Rminus in |- *; - do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; + do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; reflexivity. rewrite (tech2 An m n); [ idtac | assumption ]. rewrite (tech2 Bn m n); [ idtac | assumption ]. unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc; rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m)); - do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; + do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right. apply sum_Rle; intros. elim (H (S m + n0)%nat); intros; apply H8. diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v index 42860180f..4f336648b 100644 --- a/theories/Reals/Sqrt_reg.v +++ b/theories/Reals/Sqrt_reg.v @@ -11,7 +11,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Ranalysis1. -Require Import R_sqrt. +Require Import R_sqrt. Open Local Scope R_scope. (**********) @@ -104,8 +104,8 @@ Qed. Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1. Proof. unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; intros. set (alpha := Rmin eps 1). exists alpha; intros. @@ -129,8 +129,8 @@ Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x. Proof. intros; generalize sqrt_continuity_pt_R1. unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; intros. cut (0 < eps / sqrt x). intro; elim (H0 _ H2); intros alp_1 H3. @@ -153,7 +153,7 @@ Proof. unfold Rdiv in H5. case (Req_dec x x0); intro. rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; - rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; + rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; rewrite Rabs_R0. apply Rmult_lt_0_compat. assumption. @@ -238,7 +238,7 @@ Proof. intro; cut (g 0 <> 0). intro; assert (H2 := continuity_pt_inv g 0 H0 H1). unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2; - unfold continue_in in H2; unfold limit1_in in H2; + unfold continue_in in H2; unfold limit1_in in H2; unfold limit_in in H2; simpl in H2; unfold R_dist in H2. elim (H2 eps H3); intros alpha H4. elim H4; intros. @@ -333,7 +333,7 @@ Proof. apply (sqrt_continuity_pt x H0). elim H0; intro. unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; intros. exists (Rsqr eps); intros. split. diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v index 2ced22298..d35841e00 100644 --- a/theories/Relations/Operators_Properties.v +++ b/theories/Relations/Operators_Properties.v @@ -24,7 +24,7 @@ Section Properties. Variable R : relation A. Let incl (R1 R2:relation A) : Prop := forall x y:A, R1 x y -> R2 x y. - + Section Clos_Refl_Trans. (** Correctness of the reflexive-transitive closure operator *) @@ -33,7 +33,7 @@ Section Properties. Proof. apply Build_preorder. exact (rt_refl A R). - + exact (rt_trans A R). Qed. @@ -114,7 +114,7 @@ Section Properties. apply t1n_trans; auto. Qed. - Lemma t1n_trans_equiv : forall x y, + Lemma t1n_trans_equiv : forall x y, clos_trans A R x y <-> clos_trans_1n A R x y. Proof. split. @@ -144,7 +144,7 @@ Section Properties. right with y0; auto. Qed. - Lemma tn1_trans_equiv : forall x y, + Lemma tn1_trans_equiv : forall x y, clos_trans A R x y <-> clos_trans_n1 A R x y. Proof. split. @@ -152,7 +152,7 @@ Section Properties. apply tn1_trans. Qed. - (** Direct reflexive-transitive closure is equivalent to + (** Direct reflexive-transitive closure is equivalent to transitivity by left-step extension *) Lemma R_rt1n : forall x y, R x y -> clos_refl_trans_1n A R x y. @@ -167,7 +167,7 @@ Section Properties. right with x;[assumption|left]. Qed. - Lemma rt1n_trans : forall x y, + Lemma rt1n_trans : forall x y, clos_refl_trans_1n A R x y -> clos_refl_trans A R x y. Proof. induction 1. @@ -176,7 +176,7 @@ Section Properties. constructor 1; auto. Qed. - Lemma trans_rt1n : forall x y, + Lemma trans_rt1n : forall x y, clos_refl_trans A R x y -> clos_refl_trans_1n A R x y. Proof. induction 1. @@ -190,7 +190,7 @@ Section Properties. apply rt1n_trans; auto. Qed. - Lemma rt1n_trans_equiv : forall x y, + Lemma rt1n_trans_equiv : forall x y, clos_refl_trans A R x y <-> clos_refl_trans_1n A R x y. Proof. split. @@ -198,7 +198,7 @@ Section Properties. apply rt1n_trans. Qed. - (** Direct reflexive-transitive closure is equivalent to + (** Direct reflexive-transitive closure is equivalent to transitivity by right-step extension *) Lemma rtn1_trans : forall x y, @@ -210,7 +210,7 @@ Section Properties. constructor 1; assumption. Qed. - Lemma trans_rtn1 : forall x y, + Lemma trans_rtn1 : forall x y, clos_refl_trans A R x y -> clos_refl_trans_n1 A R x y. Proof. induction 1. @@ -221,7 +221,7 @@ Section Properties. right with y0; auto. Qed. - Lemma rtn1_trans_equiv : forall x y, + Lemma rtn1_trans_equiv : forall x y, clos_refl_trans A R x y <-> clos_refl_trans_n1 A R x y. Proof. split. @@ -240,7 +240,7 @@ Section Properties. revert H H0. induction H1; intros; auto with sets. apply H1 with x; auto with sets. - + apply IHclos_refl_trans2. apply IHclos_refl_trans1; auto with sets. @@ -270,10 +270,10 @@ Section Properties. eauto. Qed. - (** Direct reflexive-symmetric-transitive closure is equivalent to + (** Direct reflexive-symmetric-transitive closure is equivalent to transitivity by symmetric left-step extension *) - Lemma rts1n_rts : forall x y, + Lemma rts1n_rts : forall x y, clos_refl_sym_trans_1n A R x y -> clos_refl_sym_trans A R x y. Proof. induction 1. @@ -283,7 +283,7 @@ Section Properties. Qed. Lemma rts_1n_trans : forall x y, clos_refl_sym_trans_1n A R x y -> - forall z, clos_refl_sym_trans_1n A R y z -> + forall z, clos_refl_sym_trans_1n A R y z -> clos_refl_sym_trans_1n A R x z. induction 1. auto. @@ -301,7 +301,7 @@ Section Properties. left. Qed. - Lemma rts_rts1n : forall x y, + Lemma rts_rts1n : forall x y, clos_refl_sym_trans A R x y -> clos_refl_sym_trans_1n A R x y. induction 1. constructor 2 with y; auto. @@ -311,7 +311,7 @@ Section Properties. eapply rts_1n_trans; eauto. Qed. - Lemma rts_rts1n_equiv : forall x y, + Lemma rts_rts1n_equiv : forall x y, clos_refl_sym_trans A R x y <-> clos_refl_sym_trans_1n A R x y. Proof. split. @@ -319,10 +319,10 @@ Section Properties. apply rts1n_rts. Qed. - (** Direct reflexive-symmetric-transitive closure is equivalent to + (** Direct reflexive-symmetric-transitive closure is equivalent to transitivity by symmetric right-step extension *) - Lemma rtsn1_rts : forall x y, + Lemma rtsn1_rts : forall x y, clos_refl_sym_trans_n1 A R x y -> clos_refl_sym_trans A R x y. Proof. induction 1. @@ -332,7 +332,7 @@ Section Properties. Qed. Lemma rtsn1_trans : forall y z, clos_refl_sym_trans_n1 A R y z-> - forall x, clos_refl_sym_trans_n1 A R x y -> + forall x, clos_refl_sym_trans_n1 A R x y -> clos_refl_sym_trans_n1 A R x z. Proof. induction 1. @@ -352,7 +352,7 @@ Section Properties. left. Qed. - Lemma rts_rtsn1 : forall x y, + Lemma rts_rtsn1 : forall x y, clos_refl_sym_trans A R x y -> clos_refl_sym_trans_n1 A R x y. Proof. induction 1. @@ -363,7 +363,7 @@ Section Properties. eapply rtsn1_trans; eauto. Qed. - Lemma rts_rtsn1_equiv : forall x y, + Lemma rts_rtsn1_equiv : forall x y, clos_refl_sym_trans A R x y <-> clos_refl_sym_trans_n1 A R x y. Proof. split. diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v index 977135fab..c03c4b95f 100644 --- a/theories/Relations/Relation_Definitions.v +++ b/theories/Relations/Relation_Definitions.v @@ -11,14 +11,14 @@ Section Relation_Definition. Variable A : Type. - + Definition relation := A -> A -> Prop. Variable R : relation. - + Section General_Properties_of_Relations. - + Definition reflexive : Prop := forall x:A, R x x. Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z. Definition symmetric : Prop := forall x y:A, R x y -> R y x. @@ -32,33 +32,33 @@ Section Relation_Definition. Section Sets_of_Relations. - - Record preorder : Prop := + + Record preorder : Prop := { preord_refl : reflexive; preord_trans : transitive}. - - Record order : Prop := + + Record order : Prop := { ord_refl : reflexive; ord_trans : transitive; ord_antisym : antisymmetric}. - - Record equivalence : Prop := + + Record equivalence : Prop := { equiv_refl : reflexive; equiv_trans : transitive; equiv_sym : symmetric}. - + Record PER : Prop := {per_sym : symmetric; per_trans : transitive}. End Sets_of_Relations. Section Relations_of_Relations. - + Definition inclusion (R1 R2:relation) : Prop := forall x y:A, R1 x y -> R2 x y. - + Definition same_relation (R1 R2:relation) : Prop := inclusion R1 R2 /\ inclusion R2 R1. - + Definition commut (R1 R2:relation) : Prop := forall x y:A, R1 y x -> forall z:A, R2 z y -> exists2 y' : A, R2 y' x & R1 z y'. diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v index eec3f8ebd..2d1503f23 100644 --- a/theories/Relations/Relation_Operators.v +++ b/theories/Relations/Relation_Operators.v @@ -65,7 +65,7 @@ Section Reflexive_Transitive_Closure. Inductive clos_refl_trans_1n (x: A) : A -> Prop := | rt1n_refl : clos_refl_trans_1n x x - | rt1n_trans (y z:A) : + | rt1n_trans (y z:A) : R x y -> clos_refl_trans_1n y z -> clos_refl_trans_1n x z. (** Alternative definition by transitive extension on the right *) @@ -82,7 +82,7 @@ End Reflexive_Transitive_Closure. Section Reflexive_Symetric_Transitive_Closure. Variable A : Type. Variable R : relation A. - + (** Definition by direct reflexive-symmetric-transitive closure *) Inductive clos_refl_sym_trans : relation A := @@ -104,7 +104,7 @@ Section Reflexive_Symetric_Transitive_Closure. Inductive clos_refl_sym_trans_n1 (x: A) : A -> Prop := | rtsn1_refl : clos_refl_sym_trans_n1 x x - | rtsn1_trans (y z:A) : R y z \/ R z y -> + | rtsn1_trans (y z:A) : R y z \/ R z y -> clos_refl_sym_trans_n1 x y -> clos_refl_sym_trans_n1 x z. End Reflexive_Symetric_Transitive_Closure. @@ -139,7 +139,7 @@ Inductive le_AsB : A + B -> A + B -> Prop := | le_ab (x:A) (y:B) : le_AsB (inl _ x) (inr _ y) | le_bb (x y:B) : leB x y -> le_AsB (inr _ x) (inr _ y). -End Disjoint_Union. +End Disjoint_Union. (** ** Lexicographic order on dependent pairs *) @@ -189,12 +189,12 @@ End Swap. Section Lexicographic_Exponentiation. - + Variable A : Set. Variable leA : A -> A -> Prop. Let Nil := nil (A:=A). Let List := list A. - + Inductive Ltl : List -> List -> Prop := | Lt_nil (a:A) (x:List) : Ltl Nil (a :: x) | Lt_hd (a b:A) : leA a b -> forall x y:list A, Ltl (a :: x) (b :: y) @@ -207,7 +207,7 @@ Section Lexicographic_Exponentiation. leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil). Definition Pow : Set := sig Desc. - + Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b). End Lexicographic_Exponentiation. diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v index 9eef2bc1d..c5530e7ca 100644 --- a/theories/Setoids/Setoid.v +++ b/theories/Setoids/Setoid.v @@ -29,35 +29,35 @@ Definition Seq_trans A Aeq (s : Setoid_Theory A Aeq) : forall x y z:A, Aeq x y - unfold Setoid_Theory. intros ; transitivity y ; assumption. Defined. -(** Some tactics for manipulating Setoid Theory not officially +(** Some tactics for manipulating Setoid Theory not officially declared as Setoid. *) Ltac trans_st x := idtac "trans_st on Setoid_Theory is OBSOLETE"; idtac "use transitivity on Equivalence instead"; match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => apply (Seq_trans _ _ H) with x; auto end. Ltac sym_st := idtac "sym_st on Setoid_Theory is OBSOLETE"; idtac "use symmetry on Equivalence instead"; - match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + match goal with + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => apply (Seq_sym _ _ H); auto end. Ltac refl_st := idtac "refl_st on Setoid_Theory is OBSOLETE"; idtac "use reflexivity on Equivalence instead"; - match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + match goal with + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => apply (Seq_refl _ _ H); auto end. Definition gen_st : forall A : Set, Setoid_Theory _ (@eq A). -Proof. - constructor; congruence. +Proof. + constructor; congruence. Qed. - + diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v index 62fd4df1a..5f6860997 100644 --- a/theories/Sets/Classical_sets.v +++ b/theories/Sets/Classical_sets.v @@ -56,7 +56,7 @@ Section Ensembles_classical. forall X Y:Ensemble U, Included U X Y -> ~ Included U Y X -> Inhabited U (Setminus U Y X). Proof. - intros X Y I NI. + intros X Y I NI. elim (not_all_ex_not U (fun x:U => In U Y x -> In U X x) NI). intros x YX. apply Inhabited_intro with x. @@ -78,7 +78,7 @@ Section Ensembles_classical. unfold Subtract at 1 in |- *; auto with sets. Qed. Hint Resolve Subtract_intro : sets. - + Lemma Subtract_inv : forall (A:Ensemble U) (x y:U), In U (Subtract U A x) y -> In U A y /\ x <> y. Proof. diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v index 65ce03e28..0719365f1 100644 --- a/theories/Sets/Constructive_sets.v +++ b/theories/Sets/Constructive_sets.v @@ -30,7 +30,7 @@ Require Export Ensembles. Section Ensembles_facts. Variable U : Type. - + Lemma Extension : forall B C:Ensemble U, B = C -> Same_set U B C. Proof. intros B C H'; rewrite H'; auto with sets. @@ -52,7 +52,7 @@ Section Ensembles_facts. Proof. unfold Add at 1 in |- *; auto with sets. Qed. - + Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x. Proof. unfold Add at 1 in |- *; auto with sets. @@ -98,15 +98,15 @@ Section Ensembles_facts. Proof. intros B C x H'; elim H'; auto with sets. Qed. - + Lemma Add_inv : forall (A:Ensemble U) (x y:U), In U (Add U A x) y -> In U A y \/ x = y. Proof. - intros A x y H'; induction H'. + intros A x y H'; induction H'. left; assumption. right; apply Singleton_inv; assumption. Qed. - + Lemma Intersection_inv : forall (B C:Ensemble U) (x:U), In U (Intersection U B C) x -> In U B x /\ In U C x. @@ -125,7 +125,7 @@ Section Ensembles_facts. Proof. unfold Setminus at 1 in |- *; red in |- *; auto with sets. Qed. - + Lemma Strict_Included_intro : forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y. Proof. diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v index c1e64babc..8c69e6877 100644 --- a/theories/Sets/Cpo.v +++ b/theories/Sets/Cpo.v @@ -35,7 +35,7 @@ Section Bounds. Variable D : PO U. Let C := Carrier_of U D. - + Let R := Rel_of U D. Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop := @@ -45,7 +45,7 @@ Section Bounds. Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop := Lower_Bound_definition : In U C x -> (forall y:U, In U B y -> R x y) -> Lower_Bound B x. - + Inductive Lub (B:Ensemble U) (x:U) : Prop := Lub_definition : Upper_Bound B x -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x. @@ -57,7 +57,7 @@ Section Bounds. Inductive Bottom (bot:U) : Prop := Bottom_definition : In U C bot -> (forall y:U, In U C y -> R bot y) -> Bottom bot. - + Inductive Totally_ordered (B:Ensemble U) : Prop := Totally_ordered_definition : (Included U B C -> @@ -77,7 +77,7 @@ Section Bounds. Included U (Couple U x1 x2) X -> exists x3 : _, In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) -> Directed X. - + Inductive Complete : Prop := Definition_of_Complete : (exists bot : _, Bottom bot) -> @@ -102,7 +102,7 @@ Section Specific_orders. Record Cpo : Type := Definition_of_cpo {PO_of_cpo : PO U; Cpo_cond : Complete U PO_of_cpo}. - + Record Chain : Type := Definition_of_chain {PO_of_chain : PO U; Chain_cond : Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)}. diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v index 339298572..0fa9c74a8 100644 --- a/theories/Sets/Ensembles.v +++ b/theories/Sets/Ensembles.v @@ -28,23 +28,23 @@ Section Ensembles. Variable U : Type. - - Definition Ensemble := U -> Prop. + + Definition Ensemble := U -> Prop. Definition In (A:Ensemble) (x:U) : Prop := A x. - + Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x. - + Inductive Empty_set : Ensemble :=. - + Inductive Full_set : Ensemble := Full_intro : forall x:U, In Full_set x. -(** NB: The following definition builds-in equality of elements in [U] as - Leibniz equality. +(** NB: The following definition builds-in equality of elements in [U] as + Leibniz equality. - This may have to be changed if we replace [U] by a Setoid on [U] - with its own equality [eqs], with + This may have to be changed if we replace [U] by a Setoid on [U] + with its own equality [eqs], with [In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *) Inductive Singleton (x:U) : Ensemble := @@ -55,7 +55,7 @@ Section Ensembles. | Union_intror : forall x:U, In C x -> In (Union B C) x. Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x). - + Inductive Intersection (B C:Ensemble) : Ensemble := Intersection_intro : forall x:U, In B x -> In C x -> In (Intersection B C) x. @@ -63,29 +63,29 @@ Section Ensembles. Inductive Couple (x y:U) : Ensemble := | Couple_l : In (Couple x y) x | Couple_r : In (Couple x y) y. - + Inductive Triple (x y z:U) : Ensemble := | Triple_l : In (Triple x y z) x | Triple_m : In (Triple x y z) y | Triple_r : In (Triple x y z) z. - + Definition Complement (A:Ensemble) : Ensemble := fun x:U => ~ In A x. - + Definition Setminus (B C:Ensemble) : Ensemble := fun x:U => In B x /\ ~ In C x. - + Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x). - + Inductive Disjoint (B C:Ensemble) : Prop := Disjoint_intro : (forall x:U, ~ In (Intersection B C) x) -> Disjoint B C. Inductive Inhabited (B:Ensemble) : Prop := Inhabited_intro : forall x:U, In B x -> Inhabited B. - + Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C. - + Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B. - + (** Extensionality Axiom *) Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B. diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v index a75c3b767..019c25a55 100644 --- a/theories/Sets/Finite_sets.v +++ b/theories/Sets/Finite_sets.v @@ -52,7 +52,7 @@ Require Import Constructive_sets. Section Ensembles_finis_facts. Variable U : Type. - + Lemma cardinal_invert : forall (X:Ensemble U) (p:nat), cardinal U X p -> diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v index 0615c9c9d..fdcc4150f 100644 --- a/theories/Sets/Finite_sets_facts.v +++ b/theories/Sets/Finite_sets_facts.v @@ -72,7 +72,7 @@ Section Finite_sets_facts. Proof. intros X Y H; induction H as [|A Fin_A Hind x]. rewrite (Empty_set_zero U Y). trivial. - intros. + intros. rewrite (Union_commutative U (Add U A x) Y). rewrite <- (Union_add U Y A x). rewrite (Union_commutative U Y A). @@ -98,7 +98,7 @@ Section Finite_sets_facts. Proof. intros A H' X; apply Finite_downward_closed with A; auto with sets. Qed. - + Lemma cardinalO_empty : forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U. Proof. @@ -212,7 +212,7 @@ Section Finite_sets_facts. Proof. intros; apply cardinal_is_functional with X X; auto with sets. Qed. - + Lemma card_Add_gen : forall (A:Ensemble U) (x:U) (n n':nat), cardinal U A n -> cardinal U (Add U A x) n' -> n' <= S n. @@ -279,7 +279,7 @@ Section Finite_sets_facts. intro E; rewrite E; auto with sets arith. apply cardinal_unicity with X; auto with sets arith. Qed. - + Lemma G_aux : forall P:Ensemble U -> Prop, (forall X:Ensemble U, diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v index da3aec320..64c341bd3 100644 --- a/theories/Sets/Image.v +++ b/theories/Sets/Image.v @@ -40,10 +40,10 @@ Require Export Finite_sets_facts. Section Image. Variables U V : Type. - + Inductive Im (X:Ensemble U) (f:U -> V) : Ensemble V := Im_intro : forall x:U, In _ X x -> forall y:V, y = f x -> In _ (Im X f) y. - + Lemma Im_def : forall (X:Ensemble U) (f:U -> V) (x:U), In _ X x -> In _ (Im X f) (f x). Proof. @@ -62,13 +62,13 @@ Section Image. rewrite H0. elim Add_inv with U X x x1; auto using Im_def with sets. destruct 1; auto using Im_def with sets. - elim Add_inv with V (Im X f) (f x) x0. + elim Add_inv with V (Im X f) (f x) x0. destruct 1 as [x0 H y H0]. rewrite H0; auto using Im_def with sets. destruct 1; auto using Im_def with sets. trivial. Qed. - + Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V. Proof. intro f; try assumption. @@ -88,7 +88,7 @@ Section Image. rewrite (Im_add A x f); auto with sets. apply Add_preserves_Finite; auto with sets. Qed. - + Lemma Im_inv : forall (X:Ensemble U) (f:U -> V) (y:V), In _ (Im X f) y -> exists x : U, In _ X x /\ f x = y. @@ -97,9 +97,9 @@ Section Image. intros x H'0 y0 H'1; rewrite H'1. exists x; auto with sets. Qed. - + Definition injective (f:U -> V) := forall x y:U, f x = f y -> x = y. - + Lemma not_injective_elim : forall f:U -> V, ~ injective f -> exists x : _, (exists y : _, f x = f y /\ x <> y). @@ -115,7 +115,7 @@ Section Image. destruct 1 as [y D]; exists y. apply imply_to_and; trivial with sets. Qed. - + Lemma cardinal_Im_intro : forall (A:Ensemble U) (f:U -> V) (n:nat), cardinal _ A n -> exists p : nat, cardinal _ (Im A f) p. @@ -124,7 +124,7 @@ Section Image. apply finite_cardinal; apply finite_image. apply cardinal_finite with n; trivial with sets. Qed. - + Lemma In_Image_elim : forall (A:Ensemble U) (f:U -> V), injective f -> forall x:U, In _ (Im A f) (f x) -> In _ A x. @@ -134,7 +134,7 @@ Section Image. intros z C; elim C; intros InAz E. elim (H z x E); trivial with sets. Qed. - + Lemma injective_preserves_cardinal : forall (A:Ensemble U) (f:U -> V) (n:nat), injective f -> @@ -158,7 +158,7 @@ Section Image. red in |- *; intro; apply H'2. apply In_Image_elim with f; trivial with sets. Qed. - + Lemma cardinal_decreases : forall (A:Ensemble U) (f:U -> V) (n:nat), cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n. @@ -188,7 +188,7 @@ Section Image. apply injective_preserves_cardinal with (A := A) (f := f) (n := n); trivial with sets. Qed. - + Lemma Pigeonhole_principle : forall (A:Ensemble U) (f:U -> V) (n:nat), cardinal _ A n -> diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v index 6b02e8383..b63ec1d47 100644 --- a/theories/Sets/Infinite_sets.v +++ b/theories/Sets/Infinite_sets.v @@ -50,7 +50,7 @@ Hint Resolve Defn_of_Approximant. Section Infinite_sets. Variable U : Type. - + Lemma make_new_approximant : forall A X:Ensemble U, ~ Finite U A -> Approximant U A X -> Inhabited U (Setminus U A X). @@ -61,7 +61,7 @@ Section Infinite_sets. red in |- *; intro H'3; apply H'. rewrite <- H'3; auto with sets. Qed. - + Lemma approximants_grow : forall A X:Ensemble U, ~ Finite U A -> @@ -101,7 +101,7 @@ Section Infinite_sets. apply Defn_of_Approximant; auto with sets. apply cardinal_finite with (n := S n0); auto with sets. Qed. - + Lemma approximants_grow' : forall A X:Ensemble U, ~ Finite U A -> @@ -121,7 +121,7 @@ Section Infinite_sets. apply cardinal_finite with (n := S n); auto with sets. apply approximants_grow with (X := X); auto with sets. Qed. - + Lemma approximant_can_be_any_size : forall A X:Ensemble U, ~ Finite U A -> @@ -135,7 +135,7 @@ Section Infinite_sets. Qed. Variable V : Type. - + Theorem Image_set_continuous : forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), Finite V X -> @@ -230,7 +230,7 @@ Section Infinite_sets. rewrite H'4; auto with sets. elim H'3; auto with sets. Qed. - + Theorem Pigeonhole_ter : forall (A:Ensemble U) (f:U -> V) (n:nat), injective U V f -> Finite V (Im U V A f) -> Finite U A. diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v index ec44a6e58..443713211 100644 --- a/theories/Sets/Integers.v +++ b/theories/Sets/Integers.v @@ -45,7 +45,7 @@ Require Export Partial_Order. Require Export Cpo. Section Integers_sect. - + Inductive Integers : Ensemble nat := Integers_defn : forall x:nat, In nat Integers x. @@ -53,7 +53,7 @@ Section Integers_sect. Proof. red in |- *; auto with arith. Qed. - + Lemma le_antisym : Antisymmetric nat le. Proof. red in |- *; intros x y H H'; rewrite (le_antisym x y); auto. @@ -63,12 +63,12 @@ Section Integers_sect. Proof. red in |- *; intros; apply le_trans with y; auto. Qed. - + Lemma le_Order : Order nat le. Proof. - split; [exact le_reflexive | exact le_trans | exact le_antisym]. + split; [exact le_reflexive | exact le_trans | exact le_antisym]. Qed. - + Lemma triv_nat : forall n:nat, In nat Integers n. Proof. exact Integers_defn. @@ -77,11 +77,11 @@ Section Integers_sect. Definition nat_po : PO nat. apply Definition_of_PO with (Carrier_of := Integers) (Rel_of := le); auto with sets arith. - apply Inhabited_intro with (x := 0). + apply Inhabited_intro with (x := 0). apply Integers_defn. exact le_Order. Defined. - + Lemma le_total_order : Totally_ordered nat nat_po Integers. Proof. apply Totally_ordered_definition. @@ -92,7 +92,7 @@ Section Integers_sect. intro H'1; right. cut (y <= x); auto with sets arith. Qed. - + Lemma Finite_subset_has_lub : forall X:Ensemble nat, Finite nat X -> exists m : nat, Upper_Bound nat nat_po X m. @@ -124,7 +124,7 @@ Section Integers_sect. apply H'4 with (y := x0). elim H'3; simpl in |- *; auto with sets arith. trivial. intros x1 H'4; elim H'4. unfold nat_po; simpl; trivial. exists x0. - apply Upper_Bound_definition. + apply Upper_Bound_definition. unfold nat_po. simpl. apply triv_nat. intros y H'1; elim H'1. intros x1 H'4; try assumption. @@ -148,7 +148,7 @@ Section Integers_sect. absurd (S x <= x); auto with arith. apply triv_nat. Qed. - + Lemma Integers_infinite : ~ Finite nat Integers. Proof. generalize Integers_has_no_ub. diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v index 42130bbb5..75b9f2efa 100644 --- a/theories/Sets/Multiset.v +++ b/theories/Sets/Multiset.v @@ -22,7 +22,7 @@ Section multiset_defs. Inductive multiset : Type := Bag : (A -> nat) -> multiset. - + Definition EmptyBag := Bag (fun a:A => 0). Definition SingletonBag (a:A) := Bag (fun a':A => match Aeq_dec a a' with @@ -31,23 +31,23 @@ Section multiset_defs. end). Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a. - + (** multiset equality *) Definition meq (m1 m2:multiset) := forall a:A, multiplicity m1 a = multiplicity m2 a. - + Lemma meq_refl : forall x:multiset, meq x x. Proof. destruct x; unfold meq; reflexivity. Qed. - + Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z. Proof. unfold meq in |- *. destruct x; destruct y; destruct z. intros; rewrite H; auto. Qed. - + Lemma meq_sym : forall x y:multiset, meq x y -> meq y x. Proof. unfold meq in |- *. @@ -62,7 +62,7 @@ Section multiset_defs. Proof. unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. Qed. - + Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag). Proof. unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. @@ -70,7 +70,7 @@ Section multiset_defs. Require Plus. (* comm. and ass. of plus *) - + Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x). Proof. unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *. @@ -106,28 +106,28 @@ Section multiset_defs. Lemma munion_rotate : forall x y z:multiset, meq (munion x (munion y z)) (munion z (munion x y)). Proof. - intros; apply (op_rotate multiset munion meq). + intros; apply (op_rotate multiset munion meq). apply munion_comm. apply munion_ass. exact meq_trans. exact meq_sym. trivial. Qed. - + Lemma meq_congr : forall x y z t:multiset, meq x y -> meq z t -> meq (munion x z) (munion y t). Proof. intros; apply (cong_congr multiset munion meq); auto using meq_left, meq_right. exact meq_trans. Qed. - + Lemma munion_perm_left : forall x y z:multiset, meq (munion x (munion y z)) (munion y (munion x z)). Proof. intros; apply (perm_left multiset munion meq); auto using munion_comm, munion_ass, meq_left, meq_right, meq_sym. exact meq_trans. Qed. - + Lemma multiset_twist1 : forall x y z t:multiset, meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z). @@ -156,7 +156,7 @@ Section multiset_defs. apply meq_right; apply meq_left; trivial. apply multiset_twist1. Qed. - + Lemma treesort_twist2 : forall x y z t u:multiset, meq u (munion y z) -> @@ -168,7 +168,7 @@ Section multiset_defs. Qed. -(*i theory of minter to do similarly +(*i theory of minter to do similarly Require Min. (* multiset intersection *) Definition minter := [m1,m2:multiset] diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v index 8589f387e..4fe8f4f6a 100644 --- a/theories/Sets/Partial_Order.v +++ b/theories/Sets/Partial_Order.v @@ -31,20 +31,20 @@ Require Export Relations_1. Section Partial_orders. Variable U : Type. - + Definition Carrier := Ensemble U. - + Definition Rel := Relation U. - + Record PO : Type := Definition_of_PO { Carrier_of : Ensemble U; Rel_of : Relation U; PO_cond1 : Inhabited U Carrier_of; PO_cond2 : Order U Rel_of }. Variable p : PO. - + Definition Strict_Rel_of : Rel := fun x y:U => Rel_of p x y /\ x <> y. - + Inductive covers (y x:U) : Prop := Definition_of_covers : Strict_Rel_of x y -> @@ -60,7 +60,7 @@ Hint Resolve Definition_of_covers: sets v62. Section Partial_order_facts. Variable U : Type. Variable D : PO U. - + Lemma Strict_Rel_Transitive_with_Rel : forall x y z:U, Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z. diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v index 6c9a064c1..f593031a0 100644 --- a/theories/Sets/Permut.v +++ b/theories/Sets/Permut.v @@ -36,23 +36,23 @@ Section Axiomatisation. apply cong_left; trivial. apply cong_right; trivial. Qed. - + Lemma comm_right : forall x y z:U, cong (op x (op y z)) (op x (op z y)). Proof. intros; apply cong_right; apply op_comm. Qed. - + Lemma comm_left : forall x y z:U, cong (op (op x y) z) (op (op y x) z). Proof. intros; apply cong_left; apply op_comm. Qed. - + Lemma perm_right : forall x y z:U, cong (op (op x y) z) (op (op x z) y). Proof. intros. apply cong_trans with (op x (op y z)). apply op_ass. - apply cong_trans with (op x (op z y)). + apply cong_trans with (op x (op z y)). apply cong_right; apply op_comm. apply cong_sym; apply op_ass. Qed. @@ -66,7 +66,7 @@ Section Axiomatisation. apply cong_left; apply op_comm. apply op_ass. Qed. - + Lemma op_rotate : forall x y z t:U, cong (op x (op y z)) (op z (op x y)). Proof. intros; apply cong_trans with (op (op x y) z). diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v index 8116045b6..36d2150c3 100644 --- a/theories/Sets/Powerset_Classical_facts.v +++ b/theories/Sets/Powerset_Classical_facts.v @@ -40,7 +40,7 @@ Require Export Classical_sets. Section Sets_as_an_algebra. Variable U : Type. - + Lemma sincl_add_x : forall (A B:Ensemble U) (x:U), ~ In U A x -> @@ -63,7 +63,7 @@ Section Sets_as_an_algebra. intros X x H'; red in |- *. intros x0 H'0; elim H'0; auto with sets. Qed. - + Lemma incl_soustr : forall (X Y:Ensemble U) (x:U), Included U X Y -> Included U (Subtract U X x) (Subtract U Y x). @@ -73,7 +73,7 @@ Section Sets_as_an_algebra. intros H'1 H'2. apply Subtract_intro; auto with sets. Qed. - + Lemma incl_soustr_add_l : forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X. Proof. @@ -93,7 +93,7 @@ Section Sets_as_an_algebra. red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets. Qed. Hint Resolve incl_soustr_add_r: sets v62. - + Lemma add_soustr_2 : forall (X:Ensemble U) (x:U), In U X x -> Included U X (Add U (Subtract U X x) x). @@ -103,7 +103,7 @@ Section Sets_as_an_algebra. elim (classic (x = x0)); intro K; auto with sets. elim K; auto with sets. Qed. - + Lemma add_soustr_1 : forall (X:Ensemble U) (x:U), In U X x -> Included U (Add U (Subtract U X x) x) X. @@ -114,7 +114,7 @@ Section Sets_as_an_algebra. intros t H'1; try assumption. rewrite <- (Singleton_inv U x t); auto with sets. Qed. - + Lemma add_soustr_xy : forall (X:Ensemble U) (x y:U), x <> y -> Subtract U (Add U X x) y = Add U (Subtract U X y) x. @@ -133,7 +133,7 @@ Section Sets_as_an_algebra. intro H'0; elim H'0; auto with sets. intro H'0; rewrite <- H'0; auto with sets. Qed. - + Lemma incl_st_add_soustr : forall (X Y:Ensemble U) (x:U), ~ In U X x -> @@ -151,13 +151,13 @@ Section Sets_as_an_algebra. red in |- *; intro H'0; apply H'2. rewrite H'0; auto 8 using add_soustr_xy, add_soustr_1, add_soustr_2 with sets. Qed. - + Lemma Sub_Add_new : forall (X:Ensemble U) (x:U), ~ In U X x -> X = Subtract U (Add U X x) x. Proof. auto using incl_soustr_add_l with sets. Qed. - + Lemma Simplify_add : forall (X X0:Ensemble U) (x:U), ~ In U X x -> ~ In U X0 x -> Add U X x = Add U X0 x -> X = X0. @@ -167,7 +167,7 @@ Section Sets_as_an_algebra. rewrite (Sub_Add_new X0 x); auto with sets. rewrite H'1; auto with sets. Qed. - + Lemma Included_Add : forall (X A:Ensemble U) (x:U), Included U X (Add U A x) -> @@ -201,7 +201,7 @@ Section Sets_as_an_algebra. absurd (In U X x0); auto with sets. rewrite <- H'5; auto with sets. Qed. - + Lemma setcover_inv : forall A x y:Ensemble U, covers (Ensemble U) (Power_set_PO U A) y x -> @@ -219,7 +219,7 @@ Section Sets_as_an_algebra. elim H'1. exists z; auto with sets. Qed. - + Theorem Add_covers : forall A a:Ensemble U, Included U a A -> @@ -255,7 +255,7 @@ Section Sets_as_an_algebra. intros x1 H'10; elim H'10; auto with sets. intros x2 H'11; elim H'11; auto with sets. Qed. - + Theorem covers_Add : forall A a a':Ensemble U, Included U a A -> @@ -301,7 +301,7 @@ Section Sets_as_an_algebra. intros x H'1; elim H'1; intros H'2 H'3; rewrite H'2; clear H'1. apply Add_covers; intuition. Qed. - + Theorem Singleton_atomic : forall (x:U) (A:Ensemble U), In U A x -> @@ -311,7 +311,7 @@ Section Sets_as_an_algebra. rewrite <- (Empty_set_zero' U x). apply Add_covers; auto with sets. Qed. - + Lemma less_than_singleton : forall (X:Ensemble U) (x:U), Strict_Included U X (Singleton U x) -> X = Empty_set U. diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v index dee4af65a..76f7f1ec8 100644 --- a/theories/Sets/Powerset_facts.v +++ b/theories/Sets/Powerset_facts.v @@ -41,34 +41,34 @@ Section Sets_as_an_algebra. Proof. auto 6 with sets. Qed. - + Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x. Proof. unfold Add at 1 in |- *; auto using Empty_set_zero with sets. Qed. - + Lemma less_than_empty : forall X:Ensemble U, Included U X (Empty_set U) -> X = Empty_set U. Proof. auto with sets. Qed. - + Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A. Proof. auto with sets. Qed. - + Theorem Union_associative : forall A B C:Ensemble U, Union U (Union U A B) C = Union U A (Union U B C). Proof. auto 9 with sets. Qed. - + Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A. Proof. auto 7 with sets. Qed. - + Lemma Union_absorbs : forall A B:Ensemble U, Included U B A -> Union U A B = A. Proof. @@ -82,7 +82,7 @@ Section Sets_as_an_algebra. intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets). intros x0 H'; elim H'; auto with sets. Qed. - + Theorem Triple_as_union : forall x y z:U, Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z) = @@ -94,7 +94,7 @@ Section Sets_as_an_algebra. intros x1 H'0; elim H'0; auto with sets. intros x0 H'; elim H'; auto with sets. Qed. - + Theorem Triple_as_Couple : forall x y:U, Couple U x y = Triple U x x y. Proof. intros x y. @@ -102,7 +102,7 @@ Section Sets_as_an_algebra. rewrite <- (Union_idempotent (Singleton U x)). apply Triple_as_union. Qed. - + Theorem Triple_as_Couple_Singleton : forall x y z:U, Triple U x y z = Union U (Couple U x y) (Singleton U z). Proof. @@ -110,7 +110,7 @@ Section Sets_as_an_algebra. rewrite <- (Triple_as_union x y z). rewrite <- (Couple_as_union x y); auto with sets. Qed. - + Theorem Intersection_commutative : forall A B:Ensemble U, Intersection U A B = Intersection U B A. Proof. @@ -118,7 +118,7 @@ Section Sets_as_an_algebra. apply Extensionality_Ensembles. split; red in |- *; intros x H'; elim H'; auto with sets. Qed. - + Theorem Distributivity : forall A B C:Ensemble U, Intersection U A (Union U B C) = @@ -132,7 +132,7 @@ Section Sets_as_an_algebra. elim H'1; auto with sets. elim H'; intros x0 H'0; elim H'0; auto with sets. Qed. - + Theorem Distributivity' : forall A B C:Ensemble U, Union U A (Intersection U B C) = @@ -149,13 +149,13 @@ Section Sets_as_an_algebra. generalize H'1. elim H'2; auto with sets. Qed. - + Theorem Union_add : forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x). Proof. unfold Add in |- *; auto using Union_associative with sets. Qed. - + Theorem Non_disjoint_union : forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X. Proof. @@ -165,7 +165,7 @@ Section Sets_as_an_algebra. intros x0 H'0; elim H'0; auto with sets. intros t H'1; elim H'1; auto with sets. Qed. - + Theorem Non_disjoint_union' : forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X. Proof. @@ -178,12 +178,12 @@ Section Sets_as_an_algebra. lapply (Singleton_inv U x x0); auto with sets. intro H'4; apply H'; rewrite H'4; auto with sets. Qed. - + Lemma singlx : forall x y:U, In U (Add U (Empty_set U) x) y -> x = y. Proof. intro x; rewrite (Empty_set_zero' x); auto with sets. Qed. - + Lemma incl_add : forall (A B:Ensemble U) (x:U), Included U A B -> Included U (Add U A x) (Add U B x). @@ -209,7 +209,7 @@ Section Sets_as_an_algebra. absurd (In U A x0); auto with sets. rewrite <- H'4; auto with sets. Qed. - + Lemma Add_commutative : forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x. Proof. @@ -220,7 +220,7 @@ Section Sets_as_an_algebra. rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); auto with sets. Qed. - + Lemma Add_commutative' : forall (A:Ensemble U) (x y z:U), Add U (Add U (Add U A x) y) z = Add U (Add U (Add U A z) x) y. @@ -229,7 +229,7 @@ Section Sets_as_an_algebra. rewrite (Add_commutative (Add U A x) y z). rewrite (Add_commutative A x z); auto with sets. Qed. - + Lemma Add_distributes : forall (A B:Ensemble U) (x y:U), Included U B A -> Add U (Add U A x) y = Union U (Add U A x) (Add U B y). diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v index f15bf19e6..85d0cffcc 100644 --- a/theories/Sets/Relations_1.v +++ b/theories/Sets/Relations_1.v @@ -28,38 +28,38 @@ Section Relations_1. Variable U : Type. - + Definition Relation := U -> U -> Prop. Variable R : Relation. - + Definition Reflexive : Prop := forall x:U, R x x. - + Definition Transitive : Prop := forall x y z:U, R x y -> R y z -> R x z. - + Definition Symmetric : Prop := forall x y:U, R x y -> R y x. - + Definition Antisymmetric : Prop := forall x y:U, R x y -> R y x -> x = y. - + Definition contains (R R':Relation) : Prop := forall x y:U, R' x y -> R x y. - + Definition same_relation (R R':Relation) : Prop := contains R R' /\ contains R' R. - + Inductive Preorder : Prop := Definition_of_preorder : Reflexive -> Transitive -> Preorder. - + Inductive Order : Prop := Definition_of_order : Reflexive -> Transitive -> Antisymmetric -> Order. - + Inductive Equivalence : Prop := Definition_of_equivalence : Reflexive -> Transitive -> Symmetric -> Equivalence. - + Inductive PER : Prop := Definition_of_PER : Symmetric -> Transitive -> PER. - + End Relations_1. Hint Unfold Reflexive Transitive Antisymmetric Symmetric contains same_relation: sets v62. diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v index d5257c12c..3554901b9 100644 --- a/theories/Sets/Relations_2_facts.v +++ b/theories/Sets/Relations_2_facts.v @@ -140,7 +140,7 @@ intros U R H' x b H'0; elim H'0. intros x0 a H'1; exists a; auto with sets. intros x0 y z H'1 H'2 H'3 a H'4. red in H'. -specialize H' with (x := x0) (a := a) (b := y); lapply H'; +specialize H' with (x := x0) (a := a) (b := y); lapply H'; [ intro H'8; lapply H'8; [ intro H'9; try exact H'9; clear H'8 H' | clear H'8 H' ] | clear H' ]; auto with sets. diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v index ec8fb7e6d..970db1827 100644 --- a/theories/Sets/Relations_3.v +++ b/theories/Sets/Relations_3.v @@ -32,26 +32,26 @@ Require Export Relations_2. Section Relations_3. Variable U : Type. Variable R : Relation U. - + Definition coherent (x y:U) : Prop := exists z : _, Rstar U R x z /\ Rstar U R y z. - + Definition locally_confluent (x:U) : Prop := forall y z:U, R x y -> R x z -> coherent y z. - + Definition Locally_confluent : Prop := forall x:U, locally_confluent x. - + Definition confluent (x:U) : Prop := forall y z:U, Rstar U R x y -> Rstar U R x z -> coherent y z. - + Definition Confluent : Prop := forall x:U, confluent x. - + Inductive noetherian (x: U) : Prop := definition_of_noetherian : (forall y:U, R x y -> noetherian y) -> noetherian x. - + Definition Noetherian : Prop := forall x:U, noetherian x. - + End Relations_3. Hint Unfold coherent: sets v62. Hint Unfold locally_confluent: sets v62. diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v index 03dc55ef9..909c79838 100644 --- a/theories/Sets/Uniset.v +++ b/theories/Sets/Uniset.v @@ -90,10 +90,10 @@ Qed. Definition union (m1 m2:uniset) := Charac (fun a:A => orb (charac m1 a) (charac m2 a)). -Lemma union_empty_left : forall x:uniset, seq x (union Emptyset x). -Proof. -unfold seq in |- *; unfold union in |- *; simpl in |- *; auto. -Qed. +Lemma union_empty_left : forall x:uniset, seq x (union Emptyset x). +Proof. +unfold seq in |- *; unfold union in |- *; simpl in |- *; auto. +Qed. Hint Resolve union_empty_left. Lemma union_empty_right : forall x:uniset, seq x (union x Emptyset). @@ -203,7 +203,7 @@ apply uniset_twist2. Qed. -(*i theory of minter to do similarly +(*i theory of minter to do similarly Require Min. (* uniset intersection *) Definition minter := [m1,m2:uniset] diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v index 2d639d096..6d5564ed7 100644 --- a/theories/Sorting/Heap.v +++ b/theories/Sorting/Heap.v @@ -25,7 +25,7 @@ Section defs. Variable eqA : relation A. Let gtA (x y:A) := ~ leA x y. - + Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. @@ -37,7 +37,7 @@ Section defs. Let emptyBag := EmptyBag A. Let singletonBag := SingletonBag _ eqA_dec. - + Inductive Tree := | Tree_Leaf : Tree | Tree_Node : A -> Tree -> Tree -> Tree. @@ -92,7 +92,7 @@ Section defs. forall T:Tree, is_heap T -> P T. Proof. simple induction T; auto with datatypes. - intros a G PG D PD PN. + intros a G PG D PD PN. elim (invert_heap a G D); auto with datatypes. intros H1 H2; elim H2; intros H3 H4; elim H4; intros. apply X0; auto with datatypes. @@ -109,7 +109,7 @@ Section defs. forall T:Tree, is_heap T -> P T. Proof. simple induction T; auto with datatypes. - intros a G PG D PD PN. + intros a G PG D PD PN. elim (invert_heap a G D); auto with datatypes. intros H1 H2; elim H2; intros H3 H4; elim H4; intros. apply X; auto with datatypes. @@ -167,15 +167,15 @@ Section defs. elim (X a0); intros. apply insert_exist with (Tree_Node a T2 T0); auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. - simpl in |- *; apply treesort_twist1; trivial with datatypes. + simpl in |- *; apply treesort_twist1; trivial with datatypes. elim (X a); intros T3 HeapT3 ConT3 LeA. - apply insert_exist with (Tree_Node a0 T2 T3); + apply insert_exist with (Tree_Node a0 T2 T3); auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. apply node_is_heap; auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. - apply low_trans with a; auto with datatypes. + apply low_trans with a; auto with datatypes. apply LeA; auto with datatypes. apply low_trans with a; auto with datatypes. - simpl in |- *; apply treesort_twist2; trivial with datatypes. + simpl in |- *; apply treesort_twist2; trivial with datatypes. Qed. @@ -186,7 +186,7 @@ Section defs. forall T:Tree, is_heap T -> meq (list_contents _ eqA_dec l) (contents T) -> build_heap l. - + Lemma list_to_heap : forall l:list A, build_heap l. Proof. simple induction l. @@ -204,7 +204,7 @@ Section defs. (** ** Building the sorted list *) - + Inductive flat_spec (T:Tree) : Type := flat_exist : forall l:list A, diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v index f7bd37ee2..9bfe31ed1 100644 --- a/theories/Sorting/PermutEq.v +++ b/theories/Sorting/PermutEq.v @@ -13,22 +13,22 @@ Require Import Omega Relations Setoid List Multiset Permutation. Set Implicit Arguments. (** This file is similar to [PermutSetoid], except that the equality used here - is Coq usual one instead of a setoid equality. In particular, we can then - prove the equivalence between [List.Permutation] and + is Coq usual one instead of a setoid equality. In particular, we can then + prove the equivalence between [List.Permutation] and [Permutation.permutation]. *) Section Perm. - + Variable A : Type. Hypothesis eq_dec : forall x y:A, {x=y} + {~ x=y}. - + Notation permutation := (permutation _ eq_dec). Notation list_contents := (list_contents _ eq_dec). (** we can use [multiplicity] to define [In] and [NoDup]. *) - Lemma multiplicity_In : + Lemma multiplicity_In : forall l a, In a l <-> 0 < multiplicity (list_contents l) a. Proof. induction l. @@ -49,18 +49,18 @@ Section Perm. Lemma multiplicity_In_O : forall l a, ~ In a l -> multiplicity (list_contents l) a = 0. Proof. - intros l a; rewrite multiplicity_In; + intros l a; rewrite multiplicity_In; destruct (multiplicity (list_contents l) a); auto. destruct 1; auto with arith. Qed. - + Lemma multiplicity_In_S : forall l a, In a l -> multiplicity (list_contents l) a >= 1. Proof. intros l a; rewrite multiplicity_In; auto. Qed. - Lemma multiplicity_NoDup : + Lemma multiplicity_NoDup : forall l, NoDup l <-> (forall a, multiplicity (list_contents l) a <= 1). Proof. induction l. @@ -78,7 +78,7 @@ Section Perm. generalize (H a). destruct (eq_dec a a) as [H0|H0]. destruct (multiplicity (list_contents l) a); auto with arith. - simpl; inversion 1. + simpl; inversion 1. inversion H3. destruct H0; auto. rewrite IHl; intros. @@ -86,13 +86,13 @@ Section Perm. destruct (eq_dec a a0); simpl; auto with arith. Qed. - Lemma NoDup_permut : - forall l l', NoDup l -> NoDup l' -> + Lemma NoDup_permut : + forall l l', NoDup l -> NoDup l' -> (forall x, In x l <-> In x l') -> permutation l l'. Proof. intros. red; unfold meq; intros. - rewrite multiplicity_NoDup in H, H0. + rewrite multiplicity_NoDup in H, H0. generalize (H a) (H0 a) (H1 a); clear H H0 H1. do 2 rewrite multiplicity_In. destruct 3; omega. @@ -128,11 +128,11 @@ Section Perm. intro Abs; generalize (permut_In_In _ Abs H). inversion 1. Qed. - - (** When used with [eq], this permutation notion is equivalent to + + (** When used with [eq], this permutation notion is equivalent to the one defined in [List.v]. *) - Lemma permutation_Permutation : + Lemma permutation_Permutation : forall l l', Permutation l l' <-> permutation l l'. Proof. split. @@ -165,7 +165,7 @@ Section Perm. destruct (eq_dec b b) as [H|H]; [ | destruct H; auto]. destruct (eq_dec a b); simpl; auto; intros; discriminate. Qed. - + Lemma permut_length_2 : forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> (a1=a2) /\ (b1=b2) \/ (a1=b2) /\ (a2=b1). @@ -177,7 +177,7 @@ Section Perm. apply permut_length_1. red; red; intros. generalize (P a); clear P; simpl. - destruct (eq_dec a1 a) as [H2|H2]; + destruct (eq_dec a1 a) as [H2|H2]; destruct (eq_dec a2 a) as [H3|H3]; auto. destruct H3; transitivity a1; auto. destruct H2; transitivity a2; auto. @@ -187,7 +187,7 @@ Section Perm. apply permut_length_1. red; red; intros. generalize (P a); clear P; simpl. - destruct (eq_dec a1 a) as [H2|H2]; + destruct (eq_dec a1 a) as [H2|H2]; destruct (eq_dec b2 a) as [H3|H3]; auto. simpl; rewrite <- plus_n_Sm; inversion 1; auto. destruct H3; transitivity a1; auto. @@ -210,12 +210,12 @@ Section Perm. Qed. Variable B : Type. - Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. + Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. (** Permutation is compatible with map. *) Lemma permutation_map : - forall f l1 l2, permutation l1 l2 -> + forall f l1 l2, permutation l1 l2 -> Permutation.permutation _ eqB_dec (map f l1) (map f l2). Proof. intros f; induction l1. diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v index 1ea71972b..803a6143f 100644 --- a/theories/Sorting/PermutSetoid.v +++ b/theories/Sorting/PermutSetoid.v @@ -12,8 +12,8 @@ Require Import Omega Relations Multiset Permutation SetoidList. Set Implicit Arguments. -(** This file contains additional results about permutations - with respect to a setoid equality (i.e. an equivalence relation). +(** This file contains additional results about permutations + with respect to a setoid equality (i.e. an equivalence relation). *) Section Perm. @@ -33,7 +33,7 @@ Variable eqA_trans : forall x y z, eqA x y -> eqA y z -> eqA x z. (** we can use [multiplicity] to define [InA] and [NoDupA]. *) -Lemma multiplicity_InA : +Lemma multiplicity_InA : forall l a, InA eqA a l <-> 0 < multiplicity (list_contents l) a. Proof. induction l. @@ -54,7 +54,7 @@ Qed. Lemma multiplicity_InA_O : forall l a, ~ InA eqA a l -> multiplicity (list_contents l) a = 0. Proof. - intros l a; rewrite multiplicity_InA; + intros l a; rewrite multiplicity_InA; destruct (multiplicity (list_contents l) a); auto with arith. destruct 1; auto with arith. Qed. @@ -65,7 +65,7 @@ Proof. intros l a; rewrite multiplicity_InA; auto with arith. Qed. -Lemma multiplicity_NoDupA : forall l, +Lemma multiplicity_NoDupA : forall l, NoDupA eqA l <-> (forall a, multiplicity (list_contents l) a <= 1). Proof. induction l. @@ -83,7 +83,7 @@ Proof. generalize (H a). destruct (eqA_dec a a) as [H0|H0]. destruct (multiplicity (list_contents l) a); auto with arith. - simpl; inversion 1. + simpl; inversion 1. inversion H3. destruct H0; auto. rewrite IHl; intros. @@ -140,7 +140,7 @@ Proof. apply permut_length_1. red; red; intros. generalize (P a); clear P; simpl. - destruct (eqA_dec a1 a) as [H2|H2]; + destruct (eqA_dec a1 a) as [H2|H2]; destruct (eqA_dec a2 a) as [H3|H3]; auto. destruct H3; apply eqA_trans with a1; auto. destruct H2; apply eqA_trans with a2; auto. @@ -150,7 +150,7 @@ Proof. apply permut_length_1. red; red; intros. generalize (P a); clear P; simpl. - destruct (eqA_dec a1 a) as [H2|H2]; + destruct (eqA_dec a1 a) as [H2|H2]; destruct (eqA_dec b2 a) as [H3|H3]; auto. simpl; rewrite <- plus_n_Sm; inversion 1; auto. destruct H3; apply eqA_trans with a1; auto. @@ -174,19 +174,19 @@ Proof. apply permut_tran with (a::l1); auto. revert H1; unfold Permutation.permutation, meq; simpl. intros; f_equal; auto. - destruct (eqA_dec b a0) as [H2|H2]; + destruct (eqA_dec b a0) as [H2|H2]; destruct (eqA_dec a a0) as [H3|H3]; auto. destruct H3; apply eqA_trans with b; auto. destruct H2; apply eqA_trans with a; auto. Qed. -Lemma NoDupA_equivlistA_permut : - forall l l', NoDupA eqA l -> NoDupA eqA l' -> +Lemma NoDupA_equivlistA_permut : + forall l l', NoDupA eqA l -> NoDupA eqA l' -> equivlistA eqA l l' -> permutation l l'. Proof. intros. red; unfold meq; intros. - rewrite multiplicity_NoDupA in H, H0. + rewrite multiplicity_NoDupA in H, H0. generalize (H a) (H0 a) (H1 a); clear H H0 H1. do 2 rewrite multiplicity_InA. destruct 3; omega. @@ -195,15 +195,15 @@ Qed. Variable B : Type. Variable eqB : B->B->Prop. -Variable eqB_dec : forall x y:B, { eqB x y }+{ ~eqB x y }. +Variable eqB_dec : forall x y:B, { eqB x y }+{ ~eqB x y }. Variable eqB_trans : forall x y z, eqB x y -> eqB y z -> eqB x z. (** Permutation is compatible with map. *) Lemma permut_map : - forall f, + forall f, (forall x y, eqA x y -> eqB (f x) (f y)) -> - forall l1 l2, permutation l1 l2 -> + forall l1 l2, permutation l1 l2 -> Permutation.permutation _ eqB_dec (map f l1) (map f l2). Proof. intros f; induction l1. @@ -218,7 +218,7 @@ Proof. apply permut_tran with (f b :: map f l1). revert H1; unfold Permutation.permutation, meq; simpl. intros; f_equal; auto. - destruct (eqB_dec (f b) a0) as [H2|H2]; + destruct (eqB_dec (f b) a0) as [H2|H2]; destruct (eqB_dec (f a) a0) as [H3|H3]; auto. destruct H3; apply eqB_trans with (f b); auto. destruct H2; apply eqB_trans with (f a); auto. @@ -229,7 +229,7 @@ Proof. apply permut_tran with (a::l1); auto. revert H1; unfold Permutation.permutation, meq; simpl. intros; f_equal; auto. - destruct (eqA_dec b a0) as [H2|H2]; + destruct (eqA_dec b a0) as [H2|H2]; destruct (eqA_dec a a0) as [H3|H3]; auto. destruct H3; apply eqA_trans with b; auto. destruct H2; apply eqA_trans with a; auto. diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v index a92212054..9daf71b2b 100644 --- a/theories/Sorting/Permutation.v +++ b/theories/Sorting/Permutation.v @@ -10,9 +10,9 @@ Require Import Relations List Multiset Arith. -(** This file define a notion of permutation for lists, based on multisets: - there exists a permutation between two lists iff every elements have - the same multiplicity in the two lists. +(** This file define a notion of permutation for lists, based on multisets: + there exists a permutation between two lists iff every elements have + the same multiplicity in the two lists. Unlike [List.Permutation], the present notion of permutation requires the domain to be equipped with a decidable equality. This @@ -22,10 +22,10 @@ Require Import Relations List Multiset Arith. The present file contains basic results, obtained without any particular assumption on the decidable equality used. - File [PermutSetoid] contains additional results about permutations - with respect to an setoid equality (i.e. an equivalence relation). + File [PermutSetoid] contains additional results about permutations + with respect to an setoid equality (i.e. an equivalence relation). - Finally, file [PermutEq] concerns Coq equality : this file is similar + Finally, file [PermutEq] concerns Coq equality : this file is similar to the previous one, but proves in addition that [List.Permutation] and [permutation] are equivalent in this context. *) @@ -62,9 +62,9 @@ Section defs. auto with datatypes. Qed. - + (** * [permutation]: definition and basic properties *) - + Definition permutation (l m:list A) := meq (list_contents l) (list_contents m). @@ -72,42 +72,42 @@ Section defs. Proof. unfold permutation in |- *; auto with datatypes. Qed. - + Lemma permut_sym : forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1. Proof. unfold permutation, meq; intros; apply sym_eq; trivial. Qed. - + Lemma permut_tran : forall l m n:list A, permutation l m -> permutation m n -> permutation l n. Proof. unfold permutation in |- *; intros. apply meq_trans with (list_contents m); auto with datatypes. Qed. - + Lemma permut_cons : forall l m:list A, permutation l m -> forall a:A, permutation (a :: l) (a :: m). Proof. unfold permutation in |- *; simpl in |- *; auto with datatypes. Qed. - + Lemma permut_app : forall l l' m m':list A, permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m'). Proof. unfold permutation in |- *; intros. - apply meq_trans with (munion (list_contents l) (list_contents m)); + apply meq_trans with (munion (list_contents l) (list_contents m)); auto using permut_cons, list_contents_app with datatypes. - apply meq_trans with (munion (list_contents l') (list_contents m')); + apply meq_trans with (munion (list_contents l') (list_contents m')); auto using permut_cons, list_contents_app with datatypes. apply meq_trans with (munion (list_contents l') (list_contents m)); auto using permut_cons, list_contents_app with datatypes. Qed. Lemma permut_add_inside : - forall a l1 l2 l3 l4, + forall a l1 l2 l3 l4, permutation (l1 ++ l2) (l3 ++ l4) -> permutation (l1 ++ a :: l2) (l3 ++ a :: l4). Proof. @@ -118,9 +118,9 @@ Section defs. destruct (eqA_dec a a0); simpl; auto with arith. do 2 rewrite <- plus_n_Sm; f_equal; auto. Qed. - + Lemma permut_add_cons_inside : - forall a l l1 l2, + forall a l l1 l2, permutation l (l1 ++ l2) -> permutation (a :: l) (l1 ++ a :: l2). Proof. @@ -134,17 +134,17 @@ Section defs. Proof. intros; apply permut_add_cons_inside; auto using permut_sym, permut_refl. Qed. - + Lemma permut_sym_app : forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1). Proof. intros l1 l2; - unfold permutation, meq; - intro a; do 2 rewrite list_contents_app; simpl; + unfold permutation, meq; + intro a; do 2 rewrite list_contents_app; simpl; auto with arith. Qed. - Lemma permut_rev : + Lemma permut_rev : forall l, permutation l (rev l). Proof. induction l. @@ -162,7 +162,7 @@ Section defs. generalize (H a); apply plus_reg_l. Qed. - Lemma permut_app_inv1 : + Lemma permut_app_inv1 : forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2. Proof. intros l l1 l2; unfold permutation, meq; simpl; @@ -174,7 +174,7 @@ Section defs. trivial. Qed. - Lemma permut_app_inv2 : + Lemma permut_app_inv2 : forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2. Proof. intros l l1 l2; unfold permutation, meq; simpl; @@ -186,7 +186,7 @@ Section defs. Qed. Lemma permut_remove_hd : - forall l l1 l2 a, + forall l l1 l2 a, permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2). Proof. intros l l1 l2 a; unfold permutation, meq; simpl; intros H a0; generalize (H a0); clear H. @@ -200,6 +200,6 @@ Section defs. End defs. -(** For compatibilty *) +(** For compatibilty *) Notation permut_right := permut_cons. Unset Implicit Arguments. diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v index 4c8173172..2d76b25a2 100644 --- a/theories/Sorting/Sorting.v +++ b/theories/Sorting/Sorting.v @@ -19,7 +19,7 @@ Section defs. Variable eqA : relation A. Let gtA (x y:A) := ~ leA x y. - + Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. @@ -112,7 +112,7 @@ Section defs. (* 2 (leA a0 a) *) elim X0; simpl in |- *; intros. - apply merge_exist with (a0 :: l3); simpl in |- *; + apply merge_exist with (a0 :: l3); simpl in |- *; auto using cons_sort, cons_leA with datatypes. apply meq_trans with (munion (singletonBag a0) diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v index 5a2cc9695..6d3dc02a9 100644 --- a/theories/Strings/Ascii.v +++ b/theories/Strings/Ascii.v @@ -18,26 +18,26 @@ Declare ML Module "ascii_syntax_plugin". (** * Definition of ascii characters *) (** Definition of ascii character as a 8 bits constructor *) - + Inductive ascii : Set := Ascii (_ _ _ _ _ _ _ _ : bool). Delimit Scope char_scope with char. Bind Scope char_scope with ascii. - + Definition zero := Ascii false false false false false false false false. - + Definition one := Ascii true false false false false false false false. - + Definition app1 (f : bool -> bool) (a : ascii) := match a with | Ascii a1 a2 a3 a4 a5 a6 a7 a8 => Ascii (f a1) (f a2) (f a3) (f a4) (f a5) (f a6) (f a7) (f a8) end. - + Definition app2 (f : bool -> bool -> bool) (a b : ascii) := match a, b with | Ascii a1 a2 a3 a4 a5 a6 a7 a8, Ascii b1 b2 b3 b4 b5 b6 b7 b8 => - Ascii (f a1 b1) (f a2 b2) (f a3 b3) (f a4 b4) + Ascii (f a1 b1) (f a2 b2) (f a3 b3) (f a4 b4) (f a5 b5) (f a6 b6) (f a7 b7) (f a8 b8) end. @@ -47,7 +47,7 @@ Definition shift (c : bool) (a : ascii) := end. (** Definition of a decidable function that is effective *) - + Definition ascii_dec : forall a b : ascii, {a = b} + {a <> b}. decide equality; apply bool_dec. Defined. @@ -57,7 +57,7 @@ Defined. (** Auxillary function that turns a positive into an ascii by looking at the last n bits, ie z mod 2^n *) -Fixpoint ascii_of_pos_aux (res acc : ascii) (z : positive) +Fixpoint ascii_of_pos_aux (res acc : ascii) (z : positive) (n : nat) {struct n} : ascii := match n with | O => res @@ -72,7 +72,7 @@ Fixpoint ascii_of_pos_aux (res acc : ascii) (z : positive) (** Function that turns a positive into an ascii by looking at the last 8 bits, ie a mod 8 *) - + Definition ascii_of_pos (a : positive) := ascii_of_pos_aux zero one a 8. (** Function that turns a Peano number into an ascii by converting it @@ -83,7 +83,7 @@ Definition ascii_of_nat (a : nat) := | O => zero | S a' => ascii_of_pos (P_of_succ_nat a') end. - + (** The opposite function *) Definition nat_of_ascii (a : ascii) : nat := @@ -103,7 +103,7 @@ Definition nat_of_ascii (a : ascii) : nat := + (if a2 then 1 else 0)) + (if a1 then 1 else 0). -Theorem ascii_nat_embedding : +Theorem ascii_nat_embedding : forall a : ascii, ascii_of_nat (nat_of_ascii a) = a. Proof. destruct a as [[|][|][|][|][|][|][|][|]]; compute; reflexivity. @@ -124,7 +124,7 @@ Qed. Notice that the ascii characters of code >= 128 do not denote stand-alone utf8 characters so that only the notation "nnn" is available for them (unless your terminal is able to represent them, - which is typically not the case in coqide). + which is typically not the case in coqide). *) Open Local Scope char_scope. diff --git a/theories/Strings/String.v b/theories/Strings/String.v index 7d6696b78..82a60c189 100644 --- a/theories/Strings/String.v +++ b/theories/Strings/String.v @@ -18,7 +18,7 @@ Declare ML Module "string_syntax_plugin". (** *** Definition of strings *) (** Implementation of string as list of ascii characters *) - + Inductive string : Set := | EmptyString : string | String : ascii -> string -> string. @@ -48,7 +48,7 @@ where "s1 ++ s2" := (append s1 s2) : string_scope. (******************************) (** Length *) (******************************) - + Fixpoint length (s : string) : nat := match s with | EmptyString => 0 @@ -58,7 +58,7 @@ Fixpoint length (s : string) : nat := (******************************) (** Nth character of a string *) (******************************) - + Fixpoint get (n : nat) (s : string) {struct s} : option ascii := match s with | EmptyString => None @@ -69,7 +69,7 @@ Fixpoint get (n : nat) (s : string) {struct s} : option ascii := end. (** Two lists that are identical through get are syntactically equal *) - + Theorem get_correct : forall s1 s2 : string, (forall n : nat, get n s1 = get n s2) <-> s1 = s2. Proof. @@ -90,7 +90,7 @@ rewrite H1; auto. Qed. (** The first elements of [s1 ++ s2] are the ones of [s1] *) - + Theorem append_correct1 : forall (s1 s2 : string) (n : nat), n < length s1 -> get n s1 = get n (s1 ++ s2). @@ -103,7 +103,7 @@ apply lt_S_n; auto. Qed. (** The last elements of [s1 ++ s2] are the ones of [s2] *) - + Theorem append_correct2 : forall (s1 s2 : string) (n : nat), get n s2 = get (n + length s1) (s1 ++ s2). @@ -120,7 +120,7 @@ Qed. (** [substring n m s] returns the substring of [s] that starts at position [n] and of length [m]; if this does not make sense it returns [""] *) - + Fixpoint substring (n m : nat) (s : string) {struct s} : string := match n, m, s with | 0, 0, _ => EmptyString @@ -131,7 +131,7 @@ Fixpoint substring (n m : nat) (s : string) {struct s} : string := end. (** The substring is included in the initial string *) - + Theorem substring_correct1 : forall (s : string) (n m p : nat), p < m -> get p (substring n m s) = get (p + n) s. @@ -149,7 +149,7 @@ intros n' m p H; rewrite <- Plus.plus_Snm_nSm; simpl in |- *; auto. Qed. (** The substring has at most [m] elements *) - + Theorem substring_correct2 : forall (s : string) (n m p : nat), m <= p -> get p (substring n m s) = None. Proof. @@ -167,7 +167,7 @@ Qed. (** *** Test functions *) (** Test if [s1] is a prefix of [s2] *) - + Fixpoint prefix (s1 s2 : string) {struct s2} : bool := match s1 with | EmptyString => true @@ -184,7 +184,7 @@ Fixpoint prefix (s1 s2 : string) {struct s2} : bool := (** If [s1] is a prefix of [s2], it is the [substring] of length [length s1] starting at position [O] of [s2] *) - + Theorem prefix_correct : forall s1 s2 : string, prefix s1 s2 = true <-> substring 0 (length s1) s2 = s1. @@ -203,7 +203,7 @@ Qed. (** Test if, starting at position [n], [s1] occurs in [s2]; if so it returns the position *) - + Fixpoint index (n : nat) (s1 s2 : string) {struct s2} : option nat := match s2, n with | EmptyString, 0 => @@ -212,7 +212,7 @@ Fixpoint index (n : nat) (s1 s2 : string) {struct s2} : option nat := | String a s1' => None end | EmptyString, S n' => None - | String b s2', 0 => + | String b s2', 0 => if prefix s1 s2 then Some 0 else match index 0 s1 s2' with @@ -230,7 +230,7 @@ Fixpoint index (n : nat) (s1 s2 : string) {struct s2} : option nat := Opaque prefix. (** If the result of [index] is [Some m], [s1] in [s2] at position [m] *) - + Theorem index_correct1 : forall (n m : nat) (s1 s2 : string), index n s1 s2 = Some m -> substring m (length s1) s2 = s1. @@ -260,9 +260,9 @@ intros x H H1; apply H; injection H1; intros H2; injection H2; auto. intros; discriminate. Qed. -(** If the result of [index] is [Some m], +(** If the result of [index] is [Some m], [s1] does not occur in [s2] before [m] *) - + Theorem index_correct2 : forall (n m : nat) (s1 s2 : string), index n s1 s2 = Some m -> @@ -305,9 +305,9 @@ apply Lt.lt_S_n; auto. intros; discriminate. Qed. -(** If the result of [index] is [None], [s1] does not occur in [s2] +(** If the result of [index] is [None], [s1] does not occur in [s2] after [n] *) - + Theorem index_correct3 : forall (n m : nat) (s1 s2 : string), index n s1 s2 = None -> @@ -349,7 +349,7 @@ Transparent prefix. (** If we are searching for the [Empty] string and the answer is no this means that [n] is greater than the size of [s] *) - + Theorem index_correct4 : forall (n : nat) (s : string), index n EmptyString s = None -> length s < n. @@ -368,7 +368,7 @@ Qed. (** Same as [index] but with no optional type, we return [0] when it does not occur *) - + Definition findex n s1 s2 := match index n s1 s2 with | Some n => n diff --git a/theories/Unicode/Utf8.v b/theories/Unicode/Utf8.v index 6b6a55d99..940cec9bd 100644 --- a/theories/Unicode/Utf8.v +++ b/theories/Unicode/Utf8.v @@ -19,11 +19,11 @@ Notation "∀ x y z u , P" := (forall x y z u , P) : type_scope. Notation "∀ x : t , P" := (forall x : t , P) (at level 200, x ident, right associativity) : type_scope. -Notation "∀ x y : t , P" := (forall x y : t , P) +Notation "∀ x y : t , P" := (forall x y : t , P) (at level 200, x ident, y ident, right associativity) : type_scope. Notation "∀ x y z : t , P" := (forall x y z : t , P) (at level 200, x ident, y ident, z ident, right associativity) : type_scope. -Notation "∀ x y z u : t , P" := (forall x y z u : t , P) +Notation "∀ x y z u : t , P" := (forall x y z u : t , P) (at level 200, x ident, y ident, z ident, u ident, right associativity) : type_scope. diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v index f6ce84f98..785d623b4 100644 --- a/theories/Wellfounded/Disjoint_Union.v +++ b/theories/Wellfounded/Disjoint_Union.v @@ -9,8 +9,8 @@ (*i $Id$ i*) (** Author: Cristina Cornes - From : Constructing Recursion Operators in Type Theory - L. Paulson JSC (1986) 2, 325-355 *) + From : Constructing Recursion Operators in Type Theory + L. Paulson JSC (1986) 2, 325-355 *) Require Import Relation_Operators. @@ -20,7 +20,7 @@ Section Wf_Disjoint_Union. Variable leB : B -> B -> Prop. Notation Le_AsB := (le_AsB A B leA leB). - + Lemma acc_A_sum : forall x:A, Acc leA x -> Acc Le_AsB (inl B x). Proof. induction 1. @@ -47,7 +47,7 @@ Section Wf_Disjoint_Union. destruct a as [a| b]. apply (acc_A_sum a). apply (H a). - + apply (acc_B_sum H b). apply (H0 b). Qed. diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v index e72b1e11d..01049989e 100644 --- a/theories/Wellfounded/Inclusion.v +++ b/theories/Wellfounded/Inclusion.v @@ -21,7 +21,7 @@ Section WfInclusion. induction 2. apply Acc_intro; auto with sets. Qed. - + Hint Resolve Acc_incl. Theorem wf_incl : inclusion A R1 R2 -> well_founded R2 -> well_founded R1. diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v index df6a61198..c57e70725 100644 --- a/theories/Wellfounded/Inverse_Image.v +++ b/theories/Wellfounded/Inverse_Image.v @@ -47,8 +47,8 @@ Section Inverse_Image. destruct H3. apply (IHAcc x1); auto. Qed. - - + + Theorem wf_inverse_rel : well_founded R -> well_founded RoF. Proof. red in |- *; constructor; intros. diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v index 69421255d..ff1889000 100644 --- a/theories/Wellfounded/Lexicographic_Exponentiation.v +++ b/theories/Wellfounded/Lexicographic_Exponentiation.v @@ -10,7 +10,7 @@ (** Author: Cristina Cornes - From : Constructing Recursion Operators in Type Theory + From : Constructing Recursion Operators in Type Theory L. Paulson JSC (1986) 2, 325-355 *) Require Import List. @@ -20,12 +20,12 @@ Require Import Transitive_Closure. Section Wf_Lexicographic_Exponentiation. Variable A : Set. Variable leA : A -> A -> Prop. - + Notation Power := (Pow A leA). Notation Lex_Exp := (lex_exp A leA). Notation ltl := (Ltl A leA). Notation Descl := (Desc A leA). - + Notation List := (list A). Notation Nil := (nil (A:=A)). (* useless but symmetric *) @@ -33,13 +33,13 @@ Section Wf_Lexicographic_Exponentiation. Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100). (* Hint Resolve d_one d_nil t_step. *) - + Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z. Proof. simple induction x. simple induction z. simpl in |- *; intros H. - inversion_clear H. + inversion_clear H. simpl in |- *; intros; apply (Lt_nil A leA). intros a l HInd. simpl in |- *. @@ -71,12 +71,12 @@ Section Wf_Lexicographic_Exponentiation. rewrite H8. right; exists x2; auto with sets. Qed. - + Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x. Proof. intros. inversion H. - generalize (app_cons_not_nil _ _ _ H1); simple induction 1. + generalize (app_cons_not_nil _ _ _ H1); simple induction 1. cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets. intro. generalize (app_eq_unit _ _ H0). @@ -87,7 +87,7 @@ Section Wf_Lexicographic_Exponentiation. simple induction 1; intros. rewrite <- H4; auto with sets. Qed. - + Lemma desc_tail : forall (x:List) (a b:A), Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b. @@ -99,7 +99,7 @@ Section Wf_Lexicographic_Exponentiation. forall a b:A, Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b). intros. - + inversion H. cut (Cons b (Cons a Nil) = (Nil ++ Cons b Nil) ++ Cons a Nil); auto with sets; intro. @@ -108,17 +108,17 @@ Section Wf_Lexicographic_Exponentiation. generalize (app_inj_tail (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4); simple induction 1. intros. - + generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros. generalize H1. rewrite <- H10; rewrite <- H7; intro. apply (t_step A leA); auto with sets. - + intros. inversion H0. generalize (app_cons_not_nil _ _ _ H3); intro. elim H1. - + generalize H0. generalize (app_comm_cons (l ++ Cons x0 Nil) (Cons a Nil) b); simple induction 1. @@ -127,11 +127,11 @@ Section Wf_Lexicographic_Exponentiation. generalize (H x0 b H6). intro. apply t_trans with (A := A) (y := x0); auto with sets. - + apply t_step. generalize H1. rewrite H4; intro. - + generalize (app_inj_tail _ _ _ _ H8); simple induction 1. intros. generalize H2; generalize (app_comm_cons l (Cons x0 Nil) b). @@ -154,7 +154,7 @@ Section Wf_Lexicographic_Exponentiation. generalize (app_eq_nil _ _ H0); simple induction 1. intros. rewrite H2; rewrite H3; split; apply d_nil. - + intros. cut (x0 ++ y = Cons x Nil); auto with sets. intros E. @@ -162,15 +162,15 @@ Section Wf_Lexicographic_Exponentiation. simple induction 1; intros. rewrite H2; rewrite H3; split. apply d_nil. - + apply d_one. - + simple induction 1; intros. rewrite H2; rewrite H3; split. apply d_one. - + apply d_nil. - + do 5 intro. intros Hind. do 2 intro. @@ -181,13 +181,13 @@ Section Wf_Lexicographic_Exponentiation. forall x0:List, (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 -> Descl x0 /\ Descl y0). - + intro. generalize (app_nil_end x1); simple induction 1; simple induction 1. split. apply d_conc; auto with sets. - + apply d_nil. - + do 3 intro. generalize x1. apply rev_ind with @@ -202,7 +202,7 @@ Section Wf_Lexicographic_Exponentiation. split. generalize (app_inj_tail _ _ _ _ H2); simple induction 1. simple induction 1; auto with sets. - + apply d_one. do 5 intro. generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)). @@ -219,7 +219,7 @@ Section Wf_Lexicographic_Exponentiation. generalize (Hind x4 (l1 ++ Cons x2 Nil) H11). simple induction 1; split. auto with sets. - + generalize H14. rewrite <- H10; intro. apply d_conc; auto with sets. @@ -233,11 +233,11 @@ Section Wf_Lexicographic_Exponentiation. intros. apply (dist_aux (x ++ y) H x y); auto with sets. Qed. - + Lemma desc_end : forall (a b:A) (x:List), Descl (x ++ Cons a Nil) /\ ltl (x ++ Cons a Nil) (Cons b Nil) -> - clos_trans A leA a b. + clos_trans A leA a b. Proof. intros a b x. case x. @@ -246,14 +246,14 @@ Section Wf_Lexicographic_Exponentiation. intros. inversion H1; auto with sets. inversion H3. - + simple induction 1. generalize (app_comm_cons l (Cons a Nil) a0). intros E; rewrite <- E; intros. generalize (desc_tail l a a0 H0); intro. inversion H1. apply t_trans with (y := a0); auto with sets. - + inversion H4. Qed. @@ -268,15 +268,15 @@ Section Wf_Lexicographic_Exponentiation. intro. case x. intros; apply (Lt_nil A leA). - + simpl in |- *; intros. inversion_clear H0. apply (Lt_hd A leA a b); auto with sets. - + inversion_clear H1. Qed. - - + + Lemma acc_app : forall (x1 x2:List) (y1:Descl (x1 ++ x2)), Acc Lex_Exp << x1 ++ x2, y1 >> -> @@ -285,11 +285,11 @@ Section Wf_Lexicographic_Exponentiation. intros. apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)). auto with sets. - + unfold lex_exp in |- *; simpl in |- *; auto with sets. Qed. - - + + Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp. Proof. unfold well_founded at 2 in |- *. @@ -303,7 +303,7 @@ Section Wf_Lexicographic_Exponentiation. forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>). intros. inversion_clear H0. - + intro. generalize (well_founded_ind (wf_clos_trans A leA H)). intros GR. @@ -318,7 +318,7 @@ Section Wf_Lexicographic_Exponentiation. generalize (right_prefix x2 l (Cons x1 Nil) H1). simple induction 1. intro; apply (H0 x2 y1 H3). - + simple induction 1. intro; simple induction 1. clear H4 H2. @@ -340,8 +340,8 @@ Section Wf_Lexicographic_Exponentiation. unfold lex_exp at 1 in |- *. simpl in |- *; intros x4 y3. intros. apply (H0 x4 y3); auto with sets. - - intros. + + intros. generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1). simple induction 1. intros. diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v index f41b6e93d..5144c0bee 100644 --- a/theories/Wellfounded/Lexicographic_Product.v +++ b/theories/Wellfounded/Lexicographic_Product.v @@ -14,7 +14,7 @@ Require Import Eqdep. Require Import Relation_Operators. Require Import Transitive_Closure. -(** From : Constructing Recursion Operators in Type Theory +(** From : Constructing Recursion Operators in Type Theory L. Paulson JSC (1986) 2, 325-355 *) Section WfLexicographic_Product. @@ -24,7 +24,7 @@ Section WfLexicographic_Product. Variable leB : forall x:A, B x -> B x -> Prop. Notation LexProd := (lexprod A B leA leB). - + Lemma acc_A_B_lexprod : forall x:A, Acc leA x -> @@ -41,16 +41,16 @@ Section WfLexicographic_Product. intros. apply H2. apply t_trans with x2; auto with sets. - + red in H2. apply H2. auto with sets. - + injection H1. destruct 2. injection H3. destruct 2; auto with sets. - + rewrite <- H1. injection H3; intros _ Hx1. subst x1. @@ -105,7 +105,7 @@ End Wf_Symmetric_Product. Section Swap. - + Variable A : Type. Variable R : A -> A -> Prop. @@ -121,13 +121,13 @@ Section Swap. inversion_clear H; inversion_clear H1; apply H0. apply sp_swap. apply right_sym; auto with sets. - + apply sp_swap. apply left_sym; auto with sets. - + apply sp_noswap. apply right_sym; auto with sets. - + apply sp_noswap. apply left_sym; auto with sets. Qed. @@ -147,20 +147,20 @@ Section Swap. destruct y; intro H5. inversion_clear H5. inversion_clear H0; auto with sets. - + apply swap_Acc. inversion_clear H0; auto with sets. - + intros. apply IHAcc1; auto with sets; intros. apply Acc_inv with (y0, x1); auto with sets. apply sp_noswap. apply right_sym; auto with sets. - + auto with sets. Qed. - + Lemma wf_swapprod : well_founded R -> well_founded SwapProd. Proof. red in |- *. diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v index 5e33da5ff..bce32af48 100644 --- a/theories/Wellfounded/Transitive_Closure.v +++ b/theories/Wellfounded/Transitive_Closure.v @@ -18,7 +18,7 @@ Section Wf_Transitive_Closure. Variable R : relation A. Notation trans_clos := (clos_trans A R). - + Lemma incl_clos_trans : inclusion A R trans_clos. red in |- *; auto with sets. Qed. diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v index ebf4ba98e..fbb3d9e3c 100644 --- a/theories/Wellfounded/Union.v +++ b/theories/Wellfounded/Union.v @@ -17,9 +17,9 @@ Require Import Transitive_Closure. Section WfUnion. Variable A : Type. Variables R1 R2 : relation A. - + Notation Union := (union A R1 R2). - + Remark strip_commut : commut A R1 R2 -> forall x y:A, @@ -29,7 +29,7 @@ Section WfUnion. induction 2 as [x y| x y z H0 IH1 H1 IH2]; intros. elim H with y x z; auto with sets; intros x0 H2 H3. exists x0; auto with sets. - + elim IH1 with z0; auto with sets; intros. elim IH2 with x0; auto with sets; intros. exists x1; auto with sets. @@ -50,7 +50,7 @@ Section WfUnion. elim H8; intros. apply H6; auto with sets. apply t_trans with x0; auto with sets. - + elim strip_commut with x x0 y0; auto with sets; intros. apply Acc_inv_trans with x1; auto with sets. unfold union in |- *. @@ -63,7 +63,7 @@ Section WfUnion. apply Acc_intro; auto with sets. Qed. - + Theorem wf_union : commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union. Proof. diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v index 7296897ef..e11b89248 100644 --- a/theories/Wellfounded/Well_Ordering.v +++ b/theories/Wellfounded/Well_Ordering.v @@ -16,15 +16,15 @@ Require Import Eqdep. Section WellOrdering. Variable A : Type. - Variable B : A -> Type. - + Variable B : A -> Type. + Inductive WO : Type := sup : forall (a:A) (f:B a -> WO), WO. Inductive le_WO : WO -> WO -> Prop := le_sup : forall (a:A) (f:B a -> WO) (v:B a), le_WO (f v) (sup a f). - + Theorem wf_WO : well_founded le_WO. Proof. unfold well_founded in |- *; intro. diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index a0bf8e3f8..b8301d0f4 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -336,8 +336,8 @@ Proof. rewrite nat_of_P_gt_Gt_compare_complement_morphism; [ discriminate | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); - elim (ZL4 x); intros k E2; rewrite E2; - simpl in |- *; unfold gt, lt in |- *; + elim (ZL4 x); intros k E2; rewrite E2; + simpl in |- *; unfold gt, lt in |- *; apply le_n_S; apply le_plus_r ] | assumption ] | absurd ((x + y ?= z)%positive Eq = Lt); @@ -345,8 +345,8 @@ Proof. rewrite nat_of_P_gt_Gt_compare_complement_morphism; [ discriminate | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); - elim (ZL4 x); intros k E2; rewrite E2; - simpl in |- *; unfold gt, lt in |- *; + elim (ZL4 x); intros k E2; rewrite E2; + simpl in |- *; unfold gt, lt in |- *; apply le_n_S; apply le_plus_r ] | assumption ] | rewrite (Pcompare_Eq_eq y z E0); @@ -377,7 +377,7 @@ Proof. [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9; elim (Pminus_mask_Gt z (x + y)); [ intros j H10; elim H10; intros H11 H12; elim H12; - intros H13 H14; unfold Pminus in |- *; + intros H13 H14; unfold Pminus in |- *; rewrite H6; rewrite H11; cut (i = j); [ intros E; rewrite E; auto with arith | apply (Pplus_reg_l (x + y)); rewrite H13; @@ -388,7 +388,7 @@ Proof. | apply nat_of_P_lt_Lt_compare_complement_morphism; apply plus_lt_reg_l with (p := nat_of_P y); do 2 rewrite <- nat_of_P_plus_morphism; - apply nat_of_P_lt_Lt_compare_morphism; + apply nat_of_P_lt_Lt_compare_morphism; rewrite H3; rewrite Pplus_comm; assumption ] | apply ZC2; assumption ] | elim (Pminus_mask_Gt z y); @@ -399,22 +399,22 @@ Proof. unfold Pminus in |- *; rewrite H1; rewrite H6; cut ((x ?= k)%positive Eq = Gt); [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11; - elim H11; intros H12 H13; elim H13; - intros H14 H15; rewrite H10; rewrite H12; + elim H11; intros H12 H13; elim H13; + intros H14 H15; rewrite H10; rewrite H12; cut (i = j); [ intros H16; rewrite H16; auto with arith | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j); rewrite H14; rewrite (Pplus_comm z k); rewrite <- Pplus_assoc; rewrite H8; rewrite (Pplus_comm x y); rewrite Pplus_assoc; - rewrite (Pplus_comm k y); rewrite H3; + rewrite (Pplus_comm k y); rewrite H3; trivial with arith ] | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold lt, gt in |- *; apply plus_lt_reg_l with (p := nat_of_P y); do 2 rewrite <- nat_of_P_plus_morphism; - apply nat_of_P_lt_Lt_compare_morphism; - rewrite H3; rewrite Pplus_comm; apply ZC1; + apply nat_of_P_lt_Lt_compare_morphism; + rewrite H3; rewrite Pplus_comm; apply ZC1; assumption ] | assumption ] | apply ZC2; assumption ] @@ -437,14 +437,14 @@ Proof. | assumption ] | elim Pminus_mask_Gt with (1 := E0); intros k H1; (* Case 9 *) - elim Pminus_mask_Gt with (1 := E1); intros i H2; - elim H1; intros H3 H4; elim H4; intros H5 H6; - elim H2; intros H7 H8; elim H8; intros H9 H10; + elim Pminus_mask_Gt with (1 := E1); intros i H2; + elim H1; intros H3 H4; elim H4; intros H5 H6; + elim H2; intros H7 H8; elim H8; intros H9 H10; unfold Pminus in |- *; rewrite H3; rewrite H7; cut ((x + k)%positive = i); [ intros E; rewrite E; auto with arith | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc; - rewrite H5; rewrite H9; rewrite Pplus_comm; + rewrite H5; rewrite H9; rewrite Pplus_comm; trivial with arith ] ] ]. Qed. @@ -460,7 +460,7 @@ Proof. rewrite Zplus_comm; rewrite <- weak_assoc; rewrite (Zplus_comm (- Zpos p1)); rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p); - rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0)); + rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0)); trivial with arith | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p)); rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0)); @@ -503,7 +503,7 @@ Qed. Lemma Zplus_succ_l : forall n m:Z, Zsucc n + m = Zsucc (n + m). Proof. intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y)); - rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1)); + rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1)); trivial with arith. Qed. @@ -706,7 +706,7 @@ Lemma Zplus_minus_eq : forall n m p:Z, n = m + p -> p = n - m. Proof. intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m); rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc; - rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H; + rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H; trivial with arith. Qed. @@ -747,7 +747,7 @@ Proof. reflexivity. Qed. -Lemma Zpos_minus_morphism : forall a b:positive, Pcompare a b Eq = Lt -> +Lemma Zpos_minus_morphism : forall a b:positive, Pcompare a b Eq = Lt -> Zpos (b-a) = Zpos b - Zpos a. Proof. intros. @@ -773,7 +773,7 @@ Qed. (**********************************************************************) (** * Properties of multiplication on binary integer numbers *) -Theorem Zpos_mult_morphism : +Theorem Zpos_mult_morphism : forall p q:positive, Zpos (p*q) = Zpos p * Zpos q. Proof. auto. @@ -862,7 +862,7 @@ Lemma Zmult_1_inversion_l : Proof. intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ]; (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H; - intro H; rewrite Pmult_1_inversion_l with (1 := H); + intro H; rewrite Pmult_1_inversion_l with (1 := H); reflexivity). Qed. @@ -873,7 +873,7 @@ Proof. reflexivity. Qed. -Lemma Zdouble_plus_one_mult : forall z, +Lemma Zdouble_plus_one_mult : forall z, Zdouble_plus_one z = (Zpos 2) * z + (Zpos 1). Proof. destruct z; simpl; auto with zarith. @@ -927,13 +927,13 @@ Proof. [ intros E; rewrite E; rewrite Pmult_minus_distr_l; [ trivial with arith | apply ZC2; assumption ] | apply nat_of_P_lt_Lt_compare_complement_morphism; - do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); + do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); intros h H1; rewrite H1; apply mult_S_lt_compat_l; exact (nat_of_P_lt_Lt_compare_morphism z y E0) ] | cut ((x * z ?= x * y)%positive Eq = Gt); [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; - do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); + do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); intros h H1; rewrite H1; apply mult_S_lt_compat_l; exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]). Qed. @@ -963,7 +963,7 @@ Proof. apply Zmult_plus_distr_l. Qed. - + Lemma Zmult_minus_distr_l : forall n m p:Z, p * (n - m) = p * n - p * m. Proof. intros x y z; rewrite (Zmult_comm z (x - y)). @@ -1007,7 +1007,7 @@ Qed. Lemma Zmult_succ_r : forall n m:Z, n * Zsucc m = n * m + n. Proof. intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r; - rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l; + rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l; trivial with arith. Qed. @@ -1146,7 +1146,7 @@ Definition Zabs_N (z:Z) := | Zneg p => Npos p end. -Definition Z_of_N (x:N) := +Definition Z_of_N (x:N) := match x with | N0 => Z0 | Npos p => Zpos p diff --git a/theories/ZArith/Int.v b/theories/ZArith/Int.v index 24d2696c5..de05c296d 100644 --- a/theories/ZArith/Int.v +++ b/theories/ZArith/Int.v @@ -6,22 +6,22 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre +(* Finite sets library. + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) (* $Id$ *) -(** An axiomatization of integers. *) +(** An axiomatization of integers. *) -(** We define a signature for an integer datatype based on [Z]. - The goal is to allow a switch after extraction to ocaml's - [big_int] or even [int] when finiteness isn't a problem - (typically : when mesuring the height of an AVL tree). +(** We define a signature for an integer datatype based on [Z]. + The goal is to allow a switch after extraction to ocaml's + [big_int] or even [int] when finiteness isn't a problem + (typically : when mesuring the height of an AVL tree). *) -Require Import ZArith. +Require Import ZArith. Delimit Scope Int_scope with I. @@ -30,33 +30,33 @@ Delimit Scope Int_scope with I. Module Type Int. Open Scope Int_scope. - - Parameter int : Set. - + + Parameter int : Set. + Parameter i2z : int -> Z. Arguments Scope i2z [ Int_scope ]. - - Parameter _0 : int. - Parameter _1 : int. - Parameter _2 : int. + + Parameter _0 : int. + Parameter _1 : int. + Parameter _2 : int. Parameter _3 : int. - Parameter plus : int -> int -> int. + Parameter plus : int -> int -> int. Parameter opp : int -> int. - Parameter minus : int -> int -> int. + Parameter minus : int -> int -> int. Parameter mult : int -> int -> int. - Parameter max : int -> int -> int. - + Parameter max : int -> int -> int. + Notation "0" := _0 : Int_scope. - Notation "1" := _1 : Int_scope. - Notation "2" := _2 : Int_scope. + Notation "1" := _1 : Int_scope. + Notation "2" := _2 : Int_scope. Notation "3" := _3 : Int_scope. Infix "+" := plus : Int_scope. Infix "-" := minus : Int_scope. Infix "*" := mult : Int_scope. Notation "- x" := (opp x) : Int_scope. - (** For logical relations, we can rely on their counterparts in Z, - since they don't appear after extraction. Moreover, using tactics + (** For logical relations, we can rely on their counterparts in Z, + since they don't appear after extraction. Moreover, using tactics like omega is easier this way. *) Notation "x == y" := (i2z x = i2z y) @@ -69,22 +69,22 @@ Module Type Int. Notation "x <= y < z" := (x <= y /\ y < z) : Int_scope. Notation "x < y < z" := (x < y /\ y < z) : Int_scope. Notation "x < y <= z" := (x < y /\ y <= z) : Int_scope. - + (** Some decidability fonctions (informative). *) - + Axiom gt_le_dec : forall x y: int, {x > y} + {x <= y}. Axiom ge_lt_dec : forall x y : int, {x >= y} + {x < y}. Axiom eq_dec : forall x y : int, { x == y } + {~ x==y }. (** Specifications *) - (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality - [==] and the generic [=] are in fact equivalent. We define [==] + (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality + [==] and the generic [=] are in fact equivalent. We define [==] nonetheless since the translation to [Z] for using automatic tactic is easier. *) - Axiom i2z_eq : forall n p : int, n == p -> n = p. - - (** Then, we express the specifications of the above parameters using their + Axiom i2z_eq : forall n p : int, n == p -> n = p. + + (** Then, we express the specifications of the above parameters using their Z counterparts. *) Open Scope Z_scope. @@ -98,25 +98,25 @@ Module Type Int. Axiom i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p. Axiom i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). -End Int. +End Int. (** * Facts and tactics using [Int] *) Module MoreInt (I:Int). Import I. - + Open Scope Int_scope. - (** A magic (but costly) tactic that goes from [int] back to the [Z] + (** A magic (but costly) tactic that goes from [int] back to the [Z] friendly world ... *) - Hint Rewrite -> + Hint Rewrite -> i2z_0 i2z_1 i2z_2 i2z_3 i2z_plus i2z_opp i2z_minus i2z_mult i2z_max : i2z. - Ltac i2z := match goal with - | H : (eq (A:=int) ?a ?b) |- _ => - generalize (f_equal i2z H); + Ltac i2z := match goal with + | H : (eq (A:=int) ?a ?b) |- _ => + generalize (f_equal i2z H); try autorewrite with i2z; clear H; intro H; i2z | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); try autorewrite with i2z; i2z | H : _ |- _ => progress autorewrite with i2z in H; i2z @@ -125,25 +125,25 @@ Module MoreInt (I:Int). (** A reflexive version of the [i2z] tactic *) - (** this [i2z_refl] is actually weaker than [i2z]. For instance, if a - [i2z] is buried deep inside a subterm, [i2z_refl] may miss it. - See also the limitation about [Set] or [Type] part below. + (** this [i2z_refl] is actually weaker than [i2z]. For instance, if a + [i2z] is buried deep inside a subterm, [i2z_refl] may miss it. + See also the limitation about [Set] or [Type] part below. Anyhow, [i2z_refl] is enough for applying [romega]. *) - - Ltac i2z_gen := match goal with + + Ltac i2z_gen := match goal with | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); i2z_gen - | H : (eq (A:=int) ?a ?b) |- _ => + | H : (eq (A:=int) ?a ?b) |- _ => generalize (f_equal i2z H); clear H; i2z_gen | H : (eq (A:=Z) ?a ?b) |- _ => revert H; i2z_gen | H : (Zlt ?a ?b) |- _ => revert H; i2z_gen | H : (Zle ?a ?b) |- _ => revert H; i2z_gen | H : (Zgt ?a ?b) |- _ => revert H; i2z_gen | H : (Zge ?a ?b) |- _ => revert H; i2z_gen - | H : _ -> ?X |- _ => + | H : _ -> ?X |- _ => (* A [Set] or [Type] part cannot be dealt with easily - using the [ExprP] datatype. So we forget it, leaving + using the [ExprP] datatype. So we forget it, leaving a goal that can be weaker than the original. *) - match type of X with + match type of X with | Type => clear H; i2z_gen | Prop => revert H; i2z_gen end @@ -154,10 +154,10 @@ Module MoreInt (I:Int). | _ => idtac end. - Inductive ExprI : Set := + Inductive ExprI : Set := | EI0 : ExprI | EI1 : ExprI - | EI2 : ExprI + | EI2 : ExprI | EI3 : ExprI | EIplus : ExprI -> ExprI -> ExprI | EIopp : ExprI -> ExprI @@ -166,7 +166,7 @@ Module MoreInt (I:Int). | EImax : ExprI -> ExprI -> ExprI | EIraw : int -> ExprI. - Inductive ExprZ : Set := + Inductive ExprZ : Set := | EZplus : ExprZ -> ExprZ -> ExprZ | EZopp : ExprZ -> ExprZ | EZminus : ExprZ -> ExprZ -> ExprZ @@ -175,12 +175,12 @@ Module MoreInt (I:Int). | EZofI : ExprI -> ExprZ | EZraw : Z -> ExprZ. - Inductive ExprP : Type := - | EPeq : ExprZ -> ExprZ -> ExprP - | EPlt : ExprZ -> ExprZ -> ExprP - | EPle : ExprZ -> ExprZ -> ExprP - | EPgt : ExprZ -> ExprZ -> ExprP - | EPge : ExprZ -> ExprZ -> ExprP + Inductive ExprP : Type := + | EPeq : ExprZ -> ExprZ -> ExprP + | EPlt : ExprZ -> ExprZ -> ExprP + | EPle : ExprZ -> ExprZ -> ExprP + | EPgt : ExprZ -> ExprZ -> ExprP + | EPge : ExprZ -> ExprZ -> ExprP | EPimpl : ExprP -> ExprP -> ExprP | EPequiv : ExprP -> ExprP -> ExprP | EPand : ExprP -> ExprP -> ExprP @@ -190,8 +190,8 @@ Module MoreInt (I:Int). (** [int] to [ExprI] *) - Ltac i2ei trm := - match constr:trm with + Ltac i2ei trm := + match constr:trm with | 0 => constr:EI0 | 1 => constr:EI1 | 2 => constr:EI2 @@ -206,8 +206,8 @@ Module MoreInt (I:Int). (** [Z] to [ExprZ] *) - with z2ez trm := - match constr:trm with + with z2ez trm := + match constr:trm with | (?x+?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey) | (?x-?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey) | (?x*?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey) @@ -218,7 +218,7 @@ Module MoreInt (I:Int). end. (** [Prop] to [ExprP] *) - + Ltac p2ep trm := match constr:trm with | (?x <-> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPequiv ex ey) @@ -228,11 +228,11 @@ Module MoreInt (I:Int). | (~ ?x) => let ex := p2ep x in constr:(EPneg ex) | (eq (A:=Z) ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EPeq ex ey) | (?x<?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey) - | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey) - | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey) + | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey) + | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey) | (?x>=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey) | ?x => constr:(EPraw x) - end. + end. (** [ExprI] to [int] *) @@ -241,19 +241,19 @@ Module MoreInt (I:Int). | EI0 => 0 | EI1 => 1 | EI2 => 2 - | EI3 => 3 + | EI3 => 3 | EIplus e1 e2 => (ei2i e1)+(ei2i e2) | EIminus e1 e2 => (ei2i e1)-(ei2i e2) | EImult e1 e2 => (ei2i e1)*(ei2i e2) | EImax e1 e2 => max (ei2i e1) (ei2i e2) | EIopp e => -(ei2i e) - | EIraw i => i - end. + | EIraw i => i + end. (** [ExprZ] to [Z] *) - Fixpoint ez2z (e:ExprZ) : Z := - match e with + Fixpoint ez2z (e:ExprZ) : Z := + match e with | EZplus e1 e2 => ((ez2z e1)+(ez2z e2))%Z | EZminus e1 e2 => ((ez2z e1)-(ez2z e2))%Z | EZmult e1 e2 => ((ez2z e1)*(ez2z e2))%Z @@ -265,8 +265,8 @@ Module MoreInt (I:Int). (** [ExprP] to [Prop] *) - Fixpoint ep2p (e:ExprP) : Prop := - match e with + Fixpoint ep2p (e:ExprP) : Prop := + match e with | EPeq e1 e2 => (ez2z e1) = (ez2z e2) | EPlt e1 e2 => ((ez2z e1)<(ez2z e2))%Z | EPle e1 e2 => ((ez2z e1)<=(ez2z e2))%Z @@ -281,25 +281,25 @@ Module MoreInt (I:Int). end. (** [ExprI] (supposed under a [i2z]) to a simplified [ExprZ] *) - - Fixpoint norm_ei (e:ExprI) : ExprZ := - match e with + + Fixpoint norm_ei (e:ExprI) : ExprZ := + match e with | EI0 => EZraw (0%Z) | EI1 => EZraw (1%Z) | EI2 => EZraw (2%Z) - | EI3 => EZraw (3%Z) + | EI3 => EZraw (3%Z) | EIplus e1 e2 => EZplus (norm_ei e1) (norm_ei e2) | EIminus e1 e2 => EZminus (norm_ei e1) (norm_ei e2) | EImult e1 e2 => EZmult (norm_ei e1) (norm_ei e2) | EImax e1 e2 => EZmax (norm_ei e1) (norm_ei e2) | EIopp e => EZopp (norm_ei e) - | EIraw i => EZofI (EIraw i) + | EIraw i => EZofI (EIraw i) end. (** [ExprZ] to a simplified [ExprZ] *) - Fixpoint norm_ez (e:ExprZ) : ExprZ := - match e with + Fixpoint norm_ez (e:ExprZ) : ExprZ := + match e with | EZplus e1 e2 => EZplus (norm_ez e1) (norm_ez e2) | EZminus e1 e2 => EZminus (norm_ez e1) (norm_ez e2) | EZmult e1 e2 => EZmult (norm_ez e1) (norm_ez e2) @@ -310,9 +310,9 @@ Module MoreInt (I:Int). end. (** [ExprP] to a simplified [ExprP] *) - - Fixpoint norm_ep (e:ExprP) : ExprP := - match e with + + Fixpoint norm_ep (e:ExprP) : ExprP := + match e with | EPeq e1 e2 => EPeq (norm_ez e1) (norm_ez e2) | EPlt e1 e2 => EPlt (norm_ez e1) (norm_ez e2) | EPle e1 e2 => EPle (norm_ez e1) (norm_ez e2) @@ -327,35 +327,35 @@ Module MoreInt (I:Int). end. Lemma norm_ei_correct : forall e:ExprI, ez2z (norm_ei e) = i2z (ei2i e). - Proof. + Proof. induction e; simpl; intros; i2z; auto; try congruence. Qed. Lemma norm_ez_correct : forall e:ExprZ, ez2z (norm_ez e) = ez2z e. Proof. induction e; simpl; intros; i2z; auto; try congruence; apply norm_ei_correct. - Qed. + Qed. - Lemma norm_ep_correct : + Lemma norm_ep_correct : forall e:ExprP, ep2p (norm_ep e) <-> ep2p e. Proof. induction e; simpl; repeat (rewrite norm_ez_correct); intuition. Qed. - Lemma norm_ep_correct2 : + Lemma norm_ep_correct2 : forall e:ExprP, ep2p (norm_ep e) -> ep2p e. Proof. intros; destruct (norm_ep_correct e); auto. Qed. - Ltac i2z_refl := + Ltac i2z_refl := i2z_gen; - match goal with |- ?t => - let e := p2ep t in + match goal with |- ?t => + let e := p2ep t in change (ep2p e); apply norm_ep_correct2; simpl end. - (* i2z_refl can be replaced below by (simpl in *; i2z). + (* i2z_refl can be replaced below by (simpl in *; i2z). The reflexive version improves compilation of AVL files by about 15% *) End MoreInt. @@ -378,7 +378,7 @@ Module Z_as_Int <: Int. Definition minus := Zminus. Definition mult := Zmult. Definition max := Zmax. - Definition gt_le_dec := Z_gt_le_dec. + Definition gt_le_dec := Z_gt_le_dec. Definition ge_lt_dec := Z_ge_lt_dec. Definition eq_dec := Z_eq_dec. Definition i2z : int -> Z := fun n => n. diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v index 7744b7e54..46f64c88d 100644 --- a/theories/ZArith/Wf_Z.v +++ b/theories/ZArith/Wf_Z.v @@ -40,7 +40,7 @@ Proof. intro x; destruct x; intros; [ exists 0%nat; auto with arith | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros; - simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x); + simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x); intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos); apply nat_of_P_inj; auto with arith | absurd (0 <= Zneg p); @@ -120,13 +120,13 @@ Proof. | assumption ]. Qed. -Section Efficient_Rec. +Section Efficient_Rec. - (** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed + (** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed to give a better extracted term. *) Let R (a b:Z) := 0 <= a /\ a < b. - + Let R_wf : well_founded R. Proof. set diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v index 767f9abc4..956221cb3 100644 --- a/theories/ZArith/ZArith_base.v +++ b/theories/ZArith/ZArith_base.v @@ -9,7 +9,7 @@ (* $Id$ *) (** Library for manipulating integers based on binary encoding. - These are the basic modules, required by [Omega] and [Ring] for instance. + These are the basic modules, required by [Omega] and [Ring] for instance. The full library is [ZArith]. *) Require Export BinPos. diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v index f024339d8..6e69350db 100644 --- a/theories/ZArith/ZArith_dec.v +++ b/theories/ZArith/ZArith_dec.v @@ -28,7 +28,7 @@ Lemma Zcompare_rect : ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. Proof. intros * H1 H2 H3. - destruct (n ?= m); auto. + destruct (n ?= m); auto. Defined. Lemma Zcompare_rec : @@ -41,13 +41,13 @@ Defined. Section decidability. Variables x y : Z. - + (** * Decidability of equality on binary integers *) Definition Z_eq_dec : {x = y} + {x <> y}. Proof. decide equality; apply positive_eq_dec. - Defined. + Defined. (** * Decidability of order on binary integers *) @@ -68,7 +68,7 @@ Section decidability. left. rewrite H. discriminate. right. tauto. Defined. - + Definition Z_gt_dec : {x > y} + {~ x > y}. Proof. unfold Zgt in |- *. diff --git a/theories/ZArith/ZOdiv.v b/theories/ZArith/ZOdiv.v index 758b22817..28b664aa4 100644 --- a/theories/ZArith/ZOdiv.v +++ b/theories/ZArith/ZOdiv.v @@ -13,19 +13,19 @@ Require Zdiv. Open Scope Z_scope. -(** This file provides results about the Round-Toward-Zero Euclidean +(** This file provides results about the Round-Toward-Zero Euclidean division [ZOdiv_eucl], whose projections are [ZOdiv] and [ZOmod]. - Definition of this division can be found in file [ZOdiv_def]. + Definition of this division can be found in file [ZOdiv_def]. - This division and the one defined in Zdiv agree only on positive - numbers. Otherwise, Zdiv performs Round-Toward-Bottom. + This division and the one defined in Zdiv agree only on positive + numbers. Otherwise, Zdiv performs Round-Toward-Bottom. - The current approach is compatible with the division of usual - programming languages such as Ocaml. In addition, it has nicer + The current approach is compatible with the division of usual + programming languages such as Ocaml. In addition, it has nicer properties with respect to opposite and other usual operations. *) -(** Since ZOdiv and Zdiv are not meant to be used concurrently, +(** Since ZOdiv and Zdiv are not meant to be used concurrently, we reuse the same notation. *) Infix "/" := ZOdiv : Z_scope. @@ -36,7 +36,7 @@ Infix "mod" := Nmod (at level 40, no associativity) : N_scope. (** Auxiliary results on the ad-hoc comparison [NPgeb]. *) -Lemma NPgeb_Zge : forall (n:N)(p:positive), +Lemma NPgeb_Zge : forall (n:N)(p:positive), NPgeb n p = true -> Z_of_N n >= Zpos p. Proof. destruct n as [|n]; simpl; intros. @@ -44,7 +44,7 @@ Proof. red; simpl; destruct Pcompare; now auto. Qed. -Lemma NPgeb_Zlt : forall (n:N)(p:positive), +Lemma NPgeb_Zlt : forall (n:N)(p:positive), NPgeb n p = false -> Z_of_N n < Zpos p. Proof. destruct n as [|n]; simpl; intros. @@ -54,7 +54,7 @@ Qed. (** * Relation between division on N and on Z. *) -Lemma Ndiv_Z0div : forall a b:N, +Lemma Ndiv_Z0div : forall a b:N, Z_of_N (a/b) = (Z_of_N a / Z_of_N b). Proof. intros. @@ -62,7 +62,7 @@ Proof. unfold Ndiv, ZOdiv; simpl; destruct Pdiv_eucl; auto. Qed. -Lemma Nmod_Z0mod : forall a b:N, +Lemma Nmod_Z0mod : forall a b:N, Z_of_N (a mod b) = (Z_of_N a) mod (Z_of_N b). Proof. intros. @@ -72,11 +72,11 @@ Qed. (** * Characterization of this euclidean division. *) -(** First, the usual equation [a=q*b+r]. Notice that [a mod 0] +(** First, the usual equation [a=q*b+r]. Notice that [a mod 0] has been chosen to be [a], so this equation holds even for [b=0]. *) -Theorem N_div_mod_eq : forall a b, +Theorem N_div_mod_eq : forall a b, a = (b * (Ndiv a b) + (Nmod a b))%N. Proof. intros; generalize (Ndiv_eucl_correct a b). @@ -84,7 +84,7 @@ Proof. intro H; rewrite H; rewrite Nmult_comm; auto. Qed. -Theorem ZO_div_mod_eq : forall a b, +Theorem ZO_div_mod_eq : forall a b, a = b * (ZOdiv a b) + (ZOmod a b). Proof. intros; generalize (ZOdiv_eucl_correct a b). @@ -94,8 +94,8 @@ Qed. (** Then, the inequalities constraining the remainder. *) -Theorem Pdiv_eucl_remainder : forall a b:positive, - Z_of_N (snd (Pdiv_eucl a b)) < Zpos b. +Theorem Pdiv_eucl_remainder : forall a b:positive, + Z_of_N (snd (Pdiv_eucl a b)) < Zpos b. Proof. induction a; cbv beta iota delta [Pdiv_eucl]; fold Pdiv_eucl; cbv zeta. intros b; generalize (IHa b); case Pdiv_eucl. @@ -111,7 +111,7 @@ Proof. destruct b; simpl; romega with *. Qed. -Theorem Nmod_lt : forall (a b:N), b<>0%N -> +Theorem Nmod_lt : forall (a b:N), b<>0%N -> (a mod b < b)%N. Proof. destruct b as [ |b]; intro H; try solve [elim H;auto]. @@ -122,20 +122,20 @@ Qed. (** The remainder is bounded by the divisor, in term of absolute values *) -Theorem ZOmod_lt : forall a b:Z, b<>0 -> +Theorem ZOmod_lt : forall a b:Z, b<>0 -> Zabs (a mod b) < Zabs b. Proof. - destruct b as [ |b|b]; intro H; try solve [elim H;auto]; - destruct a as [ |a|a]; try solve [compute;auto]; unfold ZOmod, ZOdiv_eucl; - generalize (Pdiv_eucl_remainder a b); destruct Pdiv_eucl; simpl; + destruct b as [ |b|b]; intro H; try solve [elim H;auto]; + destruct a as [ |a|a]; try solve [compute;auto]; unfold ZOmod, ZOdiv_eucl; + generalize (Pdiv_eucl_remainder a b); destruct Pdiv_eucl; simpl; try rewrite Zabs_Zopp; rewrite Zabs_eq; auto; apply Z_of_N_le_0. Qed. -(** The sign of the remainder is the one of [a]. Due to the possible +(** The sign of the remainder is the one of [a]. Due to the possible nullity of [a], a general result is to be stated in the following form: -*) +*) -Theorem ZOmod_sgn : forall a b:Z, +Theorem ZOmod_sgn : forall a b:Z, 0 <= Zsgn (a mod b) * Zsgn a. Proof. destruct b as [ |b|b]; destruct a as [ |a|a]; simpl; auto with zarith; @@ -150,16 +150,16 @@ Proof. destruct z; simpl; intuition auto with zarith. Qed. -Theorem ZOmod_sgn2 : forall a b:Z, +Theorem ZOmod_sgn2 : forall a b:Z, 0 <= (a mod b) * a. Proof. intros; rewrite <-Zsgn_pos_iff, Zsgn_Zmult; apply ZOmod_sgn. -Qed. +Qed. -(** Reformulation of [ZOdiv_lt] and [ZOmod_sgn] in 2 +(** Reformulation of [ZOdiv_lt] and [ZOmod_sgn] in 2 then 4 particular cases. *) -Theorem ZOmod_lt_pos : forall a b:Z, 0<=a -> b<>0 -> +Theorem ZOmod_lt_pos : forall a b:Z, 0<=a -> b<>0 -> 0 <= a mod b < Zabs b. Proof. intros. @@ -171,7 +171,7 @@ Proof. generalize (ZOmod_lt a b H0); romega with *. Qed. -Theorem ZOmod_lt_neg : forall a b:Z, a<=0 -> b<>0 -> +Theorem ZOmod_lt_neg : forall a b:Z, a<=0 -> b<>0 -> -Zabs b < a mod b <= 0. Proof. intros. @@ -209,49 +209,49 @@ Qed. Theorem ZOdiv_opp_l : forall a b:Z, (-a)/b = -(a/b). Proof. - destruct a; destruct b; simpl; auto; + destruct a; destruct b; simpl; auto; unfold ZOdiv, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith. Qed. Theorem ZOdiv_opp_r : forall a b:Z, a/(-b) = -(a/b). Proof. - destruct a; destruct b; simpl; auto; + destruct a; destruct b; simpl; auto; unfold ZOdiv, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith. Qed. Theorem ZOmod_opp_l : forall a b:Z, (-a) mod b = -(a mod b). Proof. - destruct a; destruct b; simpl; auto; + destruct a; destruct b; simpl; auto; unfold ZOmod, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith. Qed. Theorem ZOmod_opp_r : forall a b:Z, a mod (-b) = a mod b. Proof. - destruct a; destruct b; simpl; auto; + destruct a; destruct b; simpl; auto; unfold ZOmod, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith. Qed. Theorem ZOdiv_opp_opp : forall a b:Z, (-a)/(-b) = a/b. Proof. - destruct a; destruct b; simpl; auto; + destruct a; destruct b; simpl; auto; unfold ZOdiv, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith. Qed. Theorem ZOmod_opp_opp : forall a b:Z, (-a) mod (-b) = -(a mod b). Proof. - destruct a; destruct b; simpl; auto; + destruct a; destruct b; simpl; auto; unfold ZOmod, ZOdiv_eucl; destruct Pdiv_eucl; simpl; auto with zarith. Qed. (** * Unicity results *) -Definition Remainder a b r := +Definition Remainder a b r := (0 <= a /\ 0 <= r < Zabs b) \/ (a <= 0 /\ -Zabs b < r <= 0). -Definition Remainder_alt a b r := +Definition Remainder_alt a b r := Zabs r < Zabs b /\ 0 <= r * a. -Lemma Remainder_equiv : forall a b r, +Lemma Remainder_equiv : forall a b r, Remainder a b r <-> Remainder_alt a b r. Proof. unfold Remainder, Remainder_alt; intuition. @@ -259,12 +259,12 @@ Proof. romega with *. rewrite <-(Zmult_opp_opp). apply Zmult_le_0_compat; romega. - assert (0 <= Zsgn r * Zsgn a) by (rewrite <-Zsgn_Zmult, Zsgn_pos_iff; auto). + assert (0 <= Zsgn r * Zsgn a) by (rewrite <-Zsgn_Zmult, Zsgn_pos_iff; auto). destruct r; simpl Zsgn in *; romega with *. Qed. Theorem ZOdiv_mod_unique_full: - forall a b q r, Remainder a b r -> + forall a b q r, Remainder a b r -> a = b*q + r -> q = a/b /\ r = a mod b. Proof. destruct 1 as [(H,H0)|(H,H0)]; intros. @@ -281,30 +281,30 @@ Proof. romega with *. Qed. -Theorem ZOdiv_unique_full: - forall a b q r, Remainder a b r -> +Theorem ZOdiv_unique_full: + forall a b q r, Remainder a b r -> a = b*q + r -> q = a/b. Proof. intros; destruct (ZOdiv_mod_unique_full a b q r); auto. Qed. Theorem ZOdiv_unique: - forall a b q r, 0 <= a -> 0 <= r < b -> + forall a b q r, 0 <= a -> 0 <= r < b -> a = b*q + r -> q = a/b. Proof. intros; eapply ZOdiv_unique_full; eauto. red; romega with *. Qed. -Theorem ZOmod_unique_full: - forall a b q r, Remainder a b r -> +Theorem ZOmod_unique_full: + forall a b q r, Remainder a b r -> a = b*q + r -> r = a mod b. Proof. intros; destruct (ZOdiv_mod_unique_full a b q r); auto. Qed. Theorem ZOmod_unique: - forall a b q r, 0 <= a -> 0 <= r < b -> + forall a b q r, 0 <= a -> 0 <= r < b -> a = b*q + r -> r = a mod b. Proof. intros; eapply ZOmod_unique_full; eauto. @@ -345,7 +345,7 @@ Proof. rewrite Remainder_equiv; red; simpl; auto with zarith. Qed. -Hint Resolve ZOmod_0_l ZOmod_0_r ZOdiv_0_l ZOdiv_0_r ZOdiv_1_r ZOmod_1_r +Hint Resolve ZOmod_0_l ZOmod_0_r ZOdiv_0_l ZOdiv_0_r ZOdiv_1_r ZOmod_1_r : zarith. Lemma ZOdiv_1_l: forall a, 1 < a -> 1/a = 0. @@ -381,7 +381,7 @@ Qed. Lemma ZO_div_mult : forall a b:Z, b <> 0 -> (a*b)/b = a. Proof. - intros; symmetry; apply ZOdiv_unique_full with 0; auto with zarith; + intros; symmetry; apply ZOdiv_unique_full with 0; auto with zarith; [ red; romega with * | ring]. Qed. @@ -403,12 +403,12 @@ Proof. subst b; rewrite ZOdiv_0_r; auto. Qed. -(** As soon as the divisor is greater or equal than 2, +(** As soon as the divisor is greater or equal than 2, the division is strictly decreasing. *) Lemma ZO_div_lt : forall a b:Z, 0 < a -> 2 <= b -> a/b < a. Proof. - intros. + intros. assert (Hb : 0 < b) by romega. assert (H1 : 0 <= a/b) by (apply ZO_div_pos; auto with zarith). assert (H2 : 0 <= a mod b < b) by (apply ZOmod_lt_pos_pos; auto with zarith). @@ -441,7 +441,7 @@ Lemma ZO_div_monotone_pos : forall a b c:Z, 0<=c -> 0<=a<=b -> a/c <= b/c. Proof. intros. destruct H0. - destruct (Zle_lt_or_eq 0 c H); + destruct (Zle_lt_or_eq 0 c H); [ clear H | subst c; do 2 rewrite ZOdiv_0_r; auto]. generalize (ZO_div_mod_eq a c). generalize (ZOmod_lt_pos_pos a c H0 H2). @@ -452,7 +452,7 @@ Proof. intro. absurd (a - b >= 1). omega. - replace (a-b) with (c * (a/c-b/c) + a mod c - b mod c) by + replace (a-b) with (c * (a/c-b/c) + a mod c - b mod c) by (symmetry; pattern a at 1; rewrite H5; pattern b at 1; rewrite H3; ring). assert (c * (a / c - b / c) >= c * 1). apply Zmult_ge_compat_l. @@ -519,7 +519,7 @@ Proof. apply ZO_div_pos; auto with zarith. Qed. -(** The previous inequalities between [b*(a/b)] and [a] are exact +(** The previous inequalities between [b*(a/b)] and [a] are exact iff the modulo is zero. *) Lemma ZO_div_exact_full_1 : forall a b:Z, a = b*(a/b) -> a mod b = 0. @@ -535,7 +535,7 @@ Qed. (** A modulo cannot grow beyond its starting point. *) Theorem ZOmod_le: forall a b, 0 <= a -> 0 <= b -> a mod b <= a. -Proof. +Proof. intros a b H1 H2. destruct (Zle_lt_or_eq _ _ H2). case (Zle_or_lt b a); intros H3. @@ -546,7 +546,7 @@ Qed. (** Some additionnal inequalities about Zdiv. *) -Theorem ZOdiv_le_upper_bound: +Theorem ZOdiv_le_upper_bound: forall a b q, 0 < b -> a <= q*b -> a/b <= q. Proof. intros. @@ -572,21 +572,21 @@ Proof. apply ZO_div_monotone; auto with zarith. Qed. -Theorem ZOdiv_sgn: forall a b, +Theorem ZOdiv_sgn: forall a b, 0 <= Zsgn (a/b) * Zsgn a * Zsgn b. Proof. - destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith; + destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith; unfold ZOdiv; simpl; destruct Pdiv_eucl; simpl; destruct n; simpl; auto with zarith. Qed. (** * Relations between usual operations and Zmod and Zdiv *) -(** First, a result that used to be always valid with Zdiv, - but must be restricted here. +(** First, a result that used to be always valid with Zdiv, + but must be restricted here. For instance, now (9+(-5)*2) mod 2 = -1 <> 1 = 9 mod 2 *) -Lemma ZO_mod_plus : forall a b c:Z, - 0 <= (a+b*c) * a -> +Lemma ZO_mod_plus : forall a b c:Z, + 0 <= (a+b*c) * a -> (a + b * c) mod c = a mod c. Proof. intros; destruct (Z_eq_dec a 0) as [Ha|Ha]. @@ -605,8 +605,8 @@ Proof. generalize (ZO_div_mod_eq a c); romega. Qed. -Lemma ZO_div_plus : forall a b c:Z, - 0 <= (a+b*c) * a -> c<>0 -> +Lemma ZO_div_plus : forall a b c:Z, + 0 <= (a+b*c) * a -> c<>0 -> (a + b * c) / c = a / c + b. Proof. intros; destruct (Z_eq_dec a 0) as [Ha|Ha]. @@ -624,17 +624,17 @@ Proof. generalize (ZO_div_mod_eq a c); romega. Qed. -Theorem ZO_div_plus_l: forall a b c : Z, - 0 <= (a*b+c)*c -> b<>0 -> +Theorem ZO_div_plus_l: forall a b c : Z, + 0 <= (a*b+c)*c -> b<>0 -> b<>0 -> (a * b + c) / b = a + c / b. Proof. intros a b c; rewrite Zplus_comm; intros; rewrite ZO_div_plus; - try apply Zplus_comm; auto with zarith. + try apply Zplus_comm; auto with zarith. Qed. (** Cancellations. *) -Lemma ZOdiv_mult_cancel_r : forall a b c:Z, +Lemma ZOdiv_mult_cancel_r : forall a b c:Z, c<>0 -> (a*c)/(b*c) = a/b. Proof. intros a b c Hc. @@ -655,7 +655,7 @@ Proof. pattern a at 1; rewrite (ZO_div_mod_eq a b); ring. Qed. -Lemma ZOdiv_mult_cancel_l : forall a b c:Z, +Lemma ZOdiv_mult_cancel_l : forall a b c:Z, c<>0 -> (c*a)/(c*b) = a/b. Proof. intros. @@ -663,7 +663,7 @@ Proof. apply ZOdiv_mult_cancel_r; auto. Qed. -Lemma ZOmult_mod_distr_l: forall a b c, +Lemma ZOmult_mod_distr_l: forall a b c, (c*a) mod (c*b) = c * (a mod b). Proof. intros; destruct (Z_eq_dec c 0) as [Hc|Hc]. @@ -678,7 +678,7 @@ Proof. ring. Qed. -Lemma ZOmult_mod_distr_r: forall a b c, +Lemma ZOmult_mod_distr_r: forall a b c, (a*c) mod (b*c) = (a mod b) * c. Proof. intros; repeat rewrite (fun x => (Zmult_comm x c)). @@ -706,7 +706,7 @@ Proof. pattern a at 2 3; rewrite (ZO_div_mod_eq a n); auto with zarith. pattern b at 2 3; rewrite (ZO_div_mod_eq b n); auto with zarith. set (A:=a mod n); set (B:=b mod n); set (A':=a/n); set (B':=b/n). - replace (A*(n*A'+A)*(B*(n*B'+B))) with (((n*A' + A) * (n*B' + B))*(A*B)) + replace (A*(n*A'+A)*(B*(n*B'+B))) with (((n*A' + A) * (n*B' + B))*(A*B)) by ring. replace ((n*A' + A) * (n*B' + B)) with (A*B + (A'*B+B'*A+n*A'*B')*n) by ring. @@ -715,15 +715,15 @@ Proof. Qed. (** addition and modulo - - Generally speaking, unlike with Zdiv, we don't have - (a+b) mod n = (a mod n + b mod n) mod n - for any a and b. - For instance, take (8 + (-10)) mod 3 = -2 whereas + + Generally speaking, unlike with Zdiv, we don't have + (a+b) mod n = (a mod n + b mod n) mod n + for any a and b. + For instance, take (8 + (-10)) mod 3 = -2 whereas (8 mod 3 + (-10 mod 3)) mod 3 = 1. *) Theorem ZOplus_mod: forall a b n, - 0 <= a * b -> + 0 <= a * b -> (a + b) mod n = (a mod n + b mod n) mod n. Proof. assert (forall a b n, 0<a -> 0<b -> @@ -755,16 +755,16 @@ Proof. rewrite <-(Zopp_involutive a), <-(Zopp_involutive b). rewrite <- Zopp_plus_distr; rewrite ZOmod_opp_l. rewrite (ZOmod_opp_l (-a)),(ZOmod_opp_l (-b)). - match goal with |- _ = (-?x+-?y) mod n => + match goal with |- _ = (-?x+-?y) mod n => rewrite <-(Zopp_plus_distr x y), ZOmod_opp_l end. f_equal; apply H; auto with zarith. Qed. -Lemma ZOplus_mod_idemp_l: forall a b n, - 0 <= a * b -> +Lemma ZOplus_mod_idemp_l: forall a b n, + 0 <= a * b -> (a mod n + b) mod n = (a + b) mod n. Proof. - intros. + intros. rewrite ZOplus_mod. rewrite ZOmod_mod. symmetry. @@ -785,8 +785,8 @@ Proof. destruct b; simpl; auto with zarith. Qed. -Lemma ZOplus_mod_idemp_r: forall a b n, - 0 <= a*b -> +Lemma ZOplus_mod_idemp_r: forall a b n, + 0 <= a*b -> (b + a mod n) mod n = (b + a) mod n. Proof. intros. @@ -816,12 +816,12 @@ Proof. replace (b * (c * (a / b / c) + (a / b) mod c) + a mod b) with ((a / b / c)*(b * c) + (b * ((a / b) mod c) + a mod b)) by ring. assert (b*c<>0). - intro H2; - assert (H3: c <> 0) by auto with zarith; + intro H2; + assert (H3: c <> 0) by auto with zarith; rewrite (Zmult_integral_l _ _ H3 H2) in H0; auto with zarith. assert (0<=a/b) by (apply (ZO_div_pos a b); auto with zarith). assert (0<=a mod b < b) by (apply ZOmod_lt_pos_pos; auto with zarith). - assert (0<=(a/b) mod c < c) by + assert (0<=(a/b) mod c < c) by (apply ZOmod_lt_pos_pos; auto with zarith). rewrite ZO_div_plus_l; auto with zarith. rewrite (ZOdiv_small (b * ((a / b) mod c) + a mod b)). @@ -846,14 +846,14 @@ Proof. intros; destruct b as [ |b|b]. repeat rewrite ZOdiv_0_r; reflexivity. apply H0; auto with zarith. - change (Zneg b) with (-Zpos b); + change (Zneg b) with (-Zpos b); repeat (rewrite ZOdiv_opp_r || rewrite ZOdiv_opp_l || rewrite <- Zopp_mult_distr_l). f_equal; apply H0; auto with zarith. (* a b c general *) intros; destruct c as [ |c|c]. rewrite Zmult_0_r; repeat rewrite ZOdiv_0_r; reflexivity. apply H1; auto with zarith. - change (Zneg c) with (-Zpos c); + change (Zneg c) with (-Zpos c); rewrite <- Zopp_mult_distr_r; do 2 rewrite ZOdiv_opp_r. f_equal; apply H1; auto with zarith. Qed. @@ -864,11 +864,11 @@ Theorem ZOdiv_mult_le: forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a/b) <= (c*a)/b. Proof. intros a b c Ha Hb Hc. - destruct (Zle_lt_or_eq _ _ Ha); + destruct (Zle_lt_or_eq _ _ Ha); [ | subst; rewrite ZOdiv_0_l, Zmult_0_r, ZOdiv_0_l; auto]. - destruct (Zle_lt_or_eq _ _ Hb); + destruct (Zle_lt_or_eq _ _ Hb); [ | subst; rewrite ZOdiv_0_r, ZOdiv_0_r, Zmult_0_r; auto]. - destruct (Zle_lt_or_eq _ _ Hc); + destruct (Zle_lt_or_eq _ _ Hc); [ | subst; rewrite ZOdiv_0_l; auto]. case (ZOmod_lt_pos_pos a b); auto with zarith; intros Hu1 Hu2. case (ZOmod_lt_pos_pos c b); auto with zarith; intros Hv1 Hv2. @@ -884,14 +884,14 @@ Proof. apply (ZOmod_le ((c mod b) * (a mod b)) b); auto with zarith. apply Zmult_le_compat_r; auto with zarith. apply (ZOmod_le c b); auto. - pattern (c * a) at 1; rewrite (ZO_div_mod_eq (c * a) b); try ring; + pattern (c * a) at 1; rewrite (ZO_div_mod_eq (c * a) b); try ring; auto with zarith. pattern a at 1; rewrite (ZO_div_mod_eq a b); try ring; auto with zarith. Qed. (** ZOmod is related to divisibility (see more in Znumtheory) *) -Lemma ZOmod_divides : forall a b, +Lemma ZOmod_divides : forall a b, a mod b = 0 <-> exists c, a = b*c. Proof. split; intros. @@ -910,7 +910,7 @@ Qed. (** They agree at least on positive numbers: *) -Theorem ZOdiv_eucl_Zdiv_eucl_pos : forall a b:Z, 0 <= a -> 0 < b -> +Theorem ZOdiv_eucl_Zdiv_eucl_pos : forall a b:Z, 0 <= a -> 0 < b -> a/b = Zdiv.Zdiv a b /\ a mod b = Zdiv.Zmod a b. Proof. intros. @@ -921,7 +921,7 @@ Proof. symmetry; apply ZO_div_mod_eq; auto with *. Qed. -Theorem ZOdiv_Zdiv_pos : forall a b, 0 <= a -> 0 <= b -> +Theorem ZOdiv_Zdiv_pos : forall a b, 0 <= a -> 0 <= b -> a/b = Zdiv.Zdiv a b. Proof. intros a b Ha Hb. @@ -930,7 +930,7 @@ Proof. subst; rewrite ZOdiv_0_r, Zdiv.Zdiv_0_r; reflexivity. Qed. -Theorem ZOmod_Zmod_pos : forall a b, 0 <= a -> 0 < b -> +Theorem ZOmod_Zmod_pos : forall a b, 0 <= a -> 0 < b -> a mod b = Zdiv.Zmod a b. Proof. intros a b Ha Hb; generalize (ZOdiv_eucl_Zdiv_eucl_pos a b Ha Hb); @@ -939,9 +939,9 @@ Qed. (** Modulos are null at the same places *) -Theorem ZOmod_Zmod_zero : forall a b, b<>0 -> +Theorem ZOmod_Zmod_zero : forall a b, b<>0 -> (a mod b = 0 <-> Zdiv.Zmod a b = 0). Proof. intros. rewrite ZOmod_divides, Zdiv.Zmod_divides; intuition. -Qed. +Qed. diff --git a/theories/ZArith/ZOdiv_def.v b/theories/ZArith/ZOdiv_def.v index 2c84765ee..c73b6f091 100644 --- a/theories/ZArith/ZOdiv_def.v +++ b/theories/ZArith/ZOdiv_def.v @@ -19,7 +19,7 @@ Definition NPgeb (a:N)(b:positive) := Fixpoint Pdiv_eucl (a b:positive) {struct a} : N * N := match a with - | xH => + | xH => match b with xH => (1, 0)%N | _ => (0, 1)%N end | xO a' => let (q, r) := Pdiv_eucl a' b in @@ -33,21 +33,21 @@ Fixpoint Pdiv_eucl (a b:positive) {struct a} : N * N := else (2 * q, r')%N end. -Definition ZOdiv_eucl (a b:Z) : Z * Z := +Definition ZOdiv_eucl (a b:Z) : Z * Z := match a, b with | Z0, _ => (Z0, Z0) | _, Z0 => (Z0, a) - | Zpos na, Zpos nb => - let (nq, nr) := Pdiv_eucl na nb in + | Zpos na, Zpos nb => + let (nq, nr) := Pdiv_eucl na nb in (Z_of_N nq, Z_of_N nr) - | Zneg na, Zpos nb => - let (nq, nr) := Pdiv_eucl na nb in + | Zneg na, Zpos nb => + let (nq, nr) := Pdiv_eucl na nb in (Zopp (Z_of_N nq), Zopp (Z_of_N nr)) - | Zpos na, Zneg nb => - let (nq, nr) := Pdiv_eucl na nb in + | Zpos na, Zneg nb => + let (nq, nr) := Pdiv_eucl na nb in (Zopp (Z_of_N nq), Z_of_N nr) - | Zneg na, Zneg nb => - let (nq, nr) := Pdiv_eucl na nb in + | Zneg na, Zneg nb => + let (nq, nr) := Pdiv_eucl na nb in (Z_of_N nq, Zopp (Z_of_N nr)) end. @@ -55,7 +55,7 @@ Definition ZOdiv a b := fst (ZOdiv_eucl a b). Definition ZOmod a b := snd (ZOdiv_eucl a b). -Definition Ndiv_eucl (a b:N) : N * N := +Definition Ndiv_eucl (a b:N) : N * N := match a, b with | N0, _ => (N0, N0) | _, N0 => (N0, a) @@ -68,13 +68,13 @@ Definition Nmod a b := snd (Ndiv_eucl a b). (* Proofs of specifications for these euclidean divisions. *) -Theorem NPgeb_correct: forall (a:N)(b:positive), +Theorem NPgeb_correct: forall (a:N)(b:positive), if NPgeb a b then a = (Nminus a (Npos b) + Npos b)%N else True. Proof. destruct a; intros; simpl; auto. generalize (Pcompare_Eq_eq p b). case_eq (Pcompare p b Eq); intros; auto. - rewrite H0; auto. + rewrite H0; auto. now rewrite Pminus_mask_diag. destruct (Pminus_mask_Gt p b H) as [d [H2 [H3 _]]]. rewrite H2. rewrite <- H3. @@ -82,11 +82,11 @@ Proof. Qed. Hint Rewrite Z_of_N_plus Z_of_N_mult Z_of_N_minus Zmult_1_l Zmult_assoc - Zmult_plus_distr_l Zmult_plus_distr_r : zdiv. -Hint Rewrite <- Zplus_assoc : zdiv. + Zmult_plus_distr_l Zmult_plus_distr_r : zdiv. +Hint Rewrite <- Zplus_assoc : zdiv. Theorem Pdiv_eucl_correct: forall a b, - let (q,r) := Pdiv_eucl a b in + let (q,r) := Pdiv_eucl a b in Zpos a = Z_of_N q * Zpos b + Z_of_N r. Proof. induction a; cbv beta iota delta [Pdiv_eucl]; fold Pdiv_eucl; cbv zeta. diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v index a52df1bfc..51c2a2905 100644 --- a/theories/ZArith/Zabs.v +++ b/theories/ZArith/Zabs.v @@ -77,9 +77,9 @@ Proof. (intros H2; rewrite H2); auto. Qed. -Lemma Zabs_spec : forall x:Z, - 0 <= x /\ Zabs x = x \/ - 0 > x /\ Zabs x = -x. +Lemma Zabs_spec : forall x:Z, + 0 <= x /\ Zabs x = x \/ + 0 > x /\ Zabs x = -x. Proof. intros; unfold Zabs, Zle, Zgt; destruct x; simpl; intuition discriminate. Qed. @@ -142,7 +142,7 @@ Lemma Zabs_nat_mult: forall n m:Z, Zabs_nat (n*m) = (Zabs_nat n * Zabs_nat m)%na Proof. intros; apply inj_eq_rev. rewrite inj_mult; repeat rewrite inj_Zabs_nat; apply Zabs_Zmult. -Qed. +Qed. Lemma Zabs_nat_Zsucc: forall p, 0 <= p -> Zabs_nat (Zsucc p) = S (Zabs_nat p). @@ -151,13 +151,13 @@ Proof. rewrite inj_S; repeat rewrite inj_Zabs_nat, Zabs_eq; auto with zarith. Qed. -Lemma Zabs_nat_Zplus: +Lemma Zabs_nat_Zplus: forall x y, 0<=x -> 0<=y -> Zabs_nat (x+y) = (Zabs_nat x + Zabs_nat y)%nat. Proof. intros; apply inj_eq_rev. rewrite inj_plus; repeat rewrite inj_Zabs_nat, Zabs_eq; auto with zarith. apply Zplus_le_0_compat; auto. -Qed. +Qed. Lemma Zabs_nat_Zminus: forall x y, 0 <= x <= y -> Zabs_nat (y - x) = (Zabs_nat y - Zabs_nat x)%nat. @@ -200,11 +200,11 @@ Qed. (** A characterization of the sign function: *) -Lemma Zsgn_spec : forall x:Z, - 0 < x /\ Zsgn x = 1 \/ - 0 = x /\ Zsgn x = 0 \/ +Lemma Zsgn_spec : forall x:Z, + 0 < x /\ Zsgn x = 1 \/ + 0 = x /\ Zsgn x = 0 \/ 0 > x /\ Zsgn x = -1. -Proof. +Proof. intros; unfold Zsgn, Zle, Zgt; destruct x; compute; intuition. Qed. diff --git a/theories/ZArith/Zbinary.v b/theories/ZArith/Zbinary.v index 3149572be..4c9ee2405 100644 --- a/theories/ZArith/Zbinary.v +++ b/theories/ZArith/Zbinary.v @@ -8,7 +8,7 @@ (*i $Id$ i*) -(** Bit vectors interpreted as integers. +(** Bit vectors interpreted as integers. Contribution by Jean Duprat (ENS Lyon). *) Require Import Bvector. @@ -17,7 +17,7 @@ Require Export Zpower. Require Import Omega. (** L'évaluation des vecteurs de booléens se font à la fois en binaire et - en complément à deux. Le nombre appartient à Z. + en complément à deux. Le nombre appartient à Z. On utilise donc Omega pour faire les calculs dans Z. De plus, on utilise les fonctions 2^n où n est un naturel, ici la longueur. two_power_nat = [n:nat](POS (shift_nat n xH)) @@ -32,10 +32,10 @@ Require Import Omega. Section VALUE_OF_BOOLEAN_VECTORS. (** Les calculs sont effectués dans la convention positive usuelle. - Les valeurs correspondent soit à l'écriture binaire (nat), + Les valeurs correspondent soit à l'écriture binaire (nat), soit au complément à deux (int). On effectue le calcul suivant le schéma de Horner. - Le complément à deux n'a de sens que sur les vecteurs de taille + Le complément à deux n'a de sens que sur les vecteurs de taille supérieure ou égale à un, le bit de signe étant évalué négativement. *) @@ -44,12 +44,12 @@ Section VALUE_OF_BOOLEAN_VECTORS. | true => 1%Z | false => 0%Z end. - + Lemma binary_value : forall n:nat, Bvector n -> Z. Proof. simple induction n; intros. exact 0%Z. - + inversion H0. exact (bit_value a + 2 * H H2)%Z. Defined. @@ -98,19 +98,19 @@ Section ENCODING_VALUE. Proof. destruct z; simpl in |- *. trivial. - + destruct p; simpl in |- *; trivial. - + destruct p; simpl in |- *. destruct p as [p| p| ]; simpl in |- *. rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial. trivial. - + trivial. - + trivial. - + trivial. Qed. @@ -118,7 +118,7 @@ Section ENCODING_VALUE. Proof. simple induction n; intros. exact Bnil. - + exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))). Defined. @@ -126,7 +126,7 @@ Section ENCODING_VALUE. Proof. simple induction n; intros. exact (Bcons (Zeven.Zodd_bool H) 0 Bnil). - + exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))). Defined. @@ -206,10 +206,10 @@ Section Z_BRIC_A_BRAC. Proof. destruct z as [| p| p]. auto. - + destruct p; auto. simpl in |- *; intros; omega. - + intro H; elim H; trivial. Qed. @@ -221,11 +221,11 @@ Section Z_BRIC_A_BRAC. intros. cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros. omega. - + rewrite <- two_power_nat_S. destruct (Zeven.Zeven_odd_dec z); intros. rewrite <- Zeven.Zeven_div2; auto. - + generalize (Zeven.Zodd_div2 z H z0); omega. Qed. @@ -236,7 +236,7 @@ Section Z_BRIC_A_BRAC. Proof. intros; auto. Qed. - + Lemma Zeven_bit_value : forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z. Proof. @@ -244,7 +244,7 @@ Section Z_BRIC_A_BRAC. destruct p; tauto || (intro H; elim H). destruct p; tauto || (intro H; elim H). Qed. - + Lemma Zodd_bit_value : forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z. Proof. @@ -253,7 +253,7 @@ Section Z_BRIC_A_BRAC. destruct p; tauto || (intros; elim H). destruct p; tauto || (intros; elim H). Qed. - + Lemma Zge_minus_two_power_nat_S : forall (n:nat) (z:Z), (z >= - two_power_nat (S n))%Z -> (Zmod2 z >= - two_power_nat n)%Z. @@ -265,7 +265,7 @@ Section Z_BRIC_A_BRAC. rewrite (Zodd_bit_value z H); intros; omega. Qed. - + Lemma Zlt_two_power_nat_S : forall (n:nat) (z:Z), (z < two_power_nat (S n))%Z -> (Zmod2 z < two_power_nat n)%Z. @@ -282,7 +282,7 @@ End Z_BRIC_A_BRAC. Section COHERENT_VALUE. -(** On vérifie que dans l'intervalle de définition les fonctions sont +(** On vérifie que dans l'intervalle de définition les fonctions sont réciproques l'une de l'autre. Elles utilisent les lemmes du bric-a-brac. *) @@ -291,26 +291,26 @@ Section COHERENT_VALUE. Proof. induction bv as [| a n bv IHbv]. auto. - + rewrite binary_value_Sn. rewrite Z_to_binary_Sn. rewrite IHbv; trivial. - + apply binary_value_pos. Qed. - + Lemma two_compl_to_Z_to_two_compl : forall (n:nat) (bv:Bvector n) (b:bool), Z_to_two_compl n (two_compl_value n (Bcons b n bv)) = Bcons b n bv. Proof. induction bv as [| a n bv IHbv]; intro b. destruct b; auto. - + rewrite two_compl_value_Sn. rewrite Z_to_two_compl_Sn. rewrite IHbv; trivial. Qed. - + Lemma Z_to_binary_to_Z : forall (n:nat) (z:Z), (z >= 0)%Z -> @@ -318,17 +318,17 @@ Section COHERENT_VALUE. Proof. induction n as [| n IHn]. unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega. - + intros; rewrite Z_to_binary_Sn_z. rewrite binary_value_Sn. rewrite IHn. apply Z_div2_value; auto. - + apply Pdiv2; trivial. - + apply Zdiv2_two_power_nat; trivial. Qed. - + Lemma Z_to_two_compl_to_Z : forall (n:nat) (z:Z), (z >= - two_power_nat n)%Z -> @@ -345,7 +345,7 @@ Section COHERENT_VALUE. generalize (Zmod2_twice z); omega. apply Zge_minus_two_power_nat_S; auto. - + apply Zlt_two_power_nat_S; auto. Qed. diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index 35a900afd..f146a80e1 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -40,12 +40,12 @@ Proof. | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ]. Qed. -Ltac destr_zcompare := - match goal with |- context [Zcompare ?x ?y] => - let H := fresh "H" in +Ltac destr_zcompare := + match goal with |- context [Zcompare ?x ?y] => + let H := fresh "H" in case_eq (Zcompare x y); intro H; [generalize (Zcompare_Eq_eq _ _ H); clear H; intro H | - change (x<y)%Z in H | + change (x<y)%Z in H | change (x>y)%Z in H ] end. @@ -58,7 +58,7 @@ Qed. Lemma Zcompare_antisym : forall n m:Z, CompOpp (n ?= m) = (m ?= n). Proof. intros x y; destruct x; destruct y; simpl in |- *; - reflexivity || discriminate H || rewrite Pcompare_antisym; + reflexivity || discriminate H || rewrite Pcompare_antisym; reflexivity. Qed. @@ -133,7 +133,7 @@ Proof. [ reflexivity | apply H | rewrite (Zcompare_opp x y); rewrite Zcompare_opp; - do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg; + do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg; apply H ]. Qed. @@ -149,7 +149,7 @@ Proof. rewrite nat_of_P_minus_morphism; [ unfold gt in |- *; apply ZL16 | assumption ] | intros p; ElimPcompare z p; intros E; auto with arith; - apply nat_of_P_gt_Gt_compare_complement_morphism; + apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; apply ZL17 | intros p q; ElimPcompare q p; intros E; rewrite E; [ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl @@ -174,7 +174,7 @@ Proof. [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ] | assumption ] | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p; - intros E1; rewrite E1; ElimPcompare q p; intros E2; + intros E1; rewrite E1; ElimPcompare q p; intros E2; rewrite E2; auto with arith; [ absurd ((q ?= p)%positive Eq = Lt); [ rewrite <- (Pcompare_Eq_eq z q E0); @@ -277,7 +277,7 @@ Proof. [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q); rewrite plus_assoc; rewrite le_plus_minus_r; [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l; - apply nat_of_P_lt_Lt_compare_morphism; + apply nat_of_P_lt_Lt_compare_morphism; assumption | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption ] @@ -293,7 +293,7 @@ Proof. [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p); rewrite plus_assoc; rewrite le_plus_minus_r; [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l; - apply nat_of_P_lt_Lt_compare_morphism; + apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption ] @@ -334,7 +334,7 @@ Qed. Lemma Zcompare_succ_Gt : forall n:Z, (Zsucc n ?= n) = Gt. Proof. intro x; unfold Zsucc in |- *; pattern x at 2 in |- *; - rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat; + rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat; reflexivity. Qed. @@ -355,7 +355,7 @@ Proof. apply nat_of_P_lt_Lt_compare_morphism; change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2; rewrite <- (fun m n:Z => Zcompare_plus_compat m n y); - rewrite (Zplus_comm x); rewrite Zplus_assoc; + rewrite (Zplus_comm x); rewrite Zplus_assoc; rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ] | intros H1; rewrite H1; discriminate ] | intros H; elim_compare x (y + 1); @@ -373,7 +373,7 @@ Proof. intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1); rewrite Zcompare_plus_compat; auto with arith. Qed. - + (** * Multiplication and comparison *) Lemma Zcompare_mult_compat : @@ -398,7 +398,7 @@ Qed. Lemma rename : forall (A:Type) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x. Proof. - auto with arith. + auto with arith. Qed. Lemma Zcompare_elim : @@ -477,7 +477,7 @@ Lemma Zge_compare : | Gt => True end. Proof. - intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith. + intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith. Qed. Lemma Zgt_compare : diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v index df28b56c8..293a81f14 100644 --- a/theories/ZArith/Zcomplements.v +++ b/theories/ZArith/Zcomplements.v @@ -19,26 +19,26 @@ Open Local Scope Z_scope. (** About parity *) Lemma two_or_two_plus_one : - forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}. + forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}. Proof. intro x; destruct x. left; split with 0; reflexivity. - + destruct p. right; split with (Zpos p); reflexivity. - + left; split with (Zpos p); reflexivity. - + right; split with 0; reflexivity. - + destruct p. right; split with (Zneg (1 + p)). rewrite BinInt.Zneg_xI. rewrite BinInt.Zneg_plus_distr. omega. - + left; split with (Zneg p); reflexivity. - + right; split with (-1); reflexivity. Qed. @@ -64,24 +64,24 @@ Proof. trivial. Qed. -Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p. +Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p. Proof. unfold floor in |- *. intro a; induction a as [p| p| ]. - + simpl in |- *. repeat rewrite BinInt.Zpos_xI. - rewrite (BinInt.Zpos_xO (xO (floor_pos p))). + rewrite (BinInt.Zpos_xO (xO (floor_pos p))). rewrite (BinInt.Zpos_xO (floor_pos p)). omega. - + simpl in |- *. repeat rewrite BinInt.Zpos_xI. rewrite (BinInt.Zpos_xO (xO (floor_pos p))). rewrite (BinInt.Zpos_xO (floor_pos p)). rewrite (BinInt.Zpos_xO p). omega. - + simpl in |- *; omega. Qed. @@ -128,7 +128,7 @@ Proof. elim (Zabs_dec m); intro eq; rewrite eq; trivial. Qed. -(** To do case analysis over the sign of [z] *) +(** To do case analysis over the sign of [z] *) Lemma Zcase_sign : forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P. @@ -164,7 +164,7 @@ Fixpoint Zlength_aux (acc:Z) (A:Type) (l:list A) {struct l} : Z := match l with | nil => acc | _ :: l => Zlength_aux (Zsucc acc) A l - end. + end. Definition Zlength := Zlength_aux 0. Implicit Arguments Zlength [A]. @@ -177,7 +177,7 @@ Section Zlength_properties. Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l). Proof. - assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)). + assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)). simple induction l. simpl in |- *; auto with zarith. intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S. diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index f341b193e..3435874cc 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -12,7 +12,7 @@ (** Euclidean Division - Defines first of function that allows Coq to normalize. + Defines first of function that allows Coq to normalize. Then only after proves the main required property. *) @@ -26,15 +26,15 @@ Open Local Scope Z_scope. (** * Definitions of Euclidian operations *) -(** Euclidean division of a positive by a integer +(** Euclidean division of a positive by a integer (that is supposed to be positive). Total function than returns an arbitrary value when divisor is not positive - + *) -Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : +Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : Z * Z := match a with | xH => if Zge_bool b 2 then (0, 1) else (1, 0) @@ -50,41 +50,41 @@ Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : (** Euclidean division of integers. - - Total function than returns (0,0) when dividing by 0. -*) - -(** + + Total function than returns (0,0) when dividing by 0. +*) + +(** The pseudo-code is: - + if b = 0 : (0,0) - + if b <> 0 and a = 0 : (0,0) - if b > 0 and a < 0 : let (q,r) = div_eucl_pos (-a) b in + if b > 0 and a < 0 : let (q,r) = div_eucl_pos (-a) b in if r = 0 then (-q,0) else (-(q+1),b-r) if b < 0 and a < 0 : let (q,r) = div_eucl (-a) (-b) in (q,-r) - if b < 0 and a > 0 : let (q,r) = div_eucl a (-b) in + if b < 0 and a > 0 : let (q,r) = div_eucl a (-b) in if r = 0 then (-q,0) else (-(q+1),b+r) - In other word, when b is non-zero, q is chosen to be the greatest integer - smaller or equal to a/b. And sgn(r)=sgn(b) and |r| < |b| (at least when - r is not null). + In other word, when b is non-zero, q is chosen to be the greatest integer + smaller or equal to a/b. And sgn(r)=sgn(b) and |r| < |b| (at least when + r is not null). *) (* Nota: At least two others conventions also exist for euclidean division. - They all satify the equation a=b*q+r, but differ on the choice of (q,r) + They all satify the equation a=b*q+r, but differ on the choice of (q,r) on negative numbers. * Ocaml uses Round-Toward-Zero division: (-a)/b = a/(-b) = -(a/b). Hence (-a) mod b = - (a mod b) a mod (-b) = a mod b - And: |r| < |b| and sgn(r) = sgn(a) (notice the a here instead of b). + And: |r| < |b| and sgn(r) = sgn(a) (notice the a here instead of b). - * Another solution is to always pick a non-negative remainder: + * Another solution is to always pick a non-negative remainder: a=b*q+r with 0 <= r < |b| *) @@ -113,7 +113,7 @@ Definition Zdiv_eucl (a b:Z) : Z * Z := Definition Zdiv (a b:Z) : Z := let (q, _) := Zdiv_eucl a b in q. -Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r. +Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r. (** Syntax *) @@ -122,7 +122,7 @@ Infix "mod" := Zmod (at level 40, no associativity) : Z_scope. (* Tests: -Eval compute in (Zdiv_eucl 7 3). +Eval compute in (Zdiv_eucl 7 3). Eval compute in (Zdiv_eucl (-7) 3). @@ -133,7 +133,7 @@ Eval compute in (Zdiv_eucl (-7) (-3)). *) -(** * Main division theorem *) +(** * Main division theorem *) (** First a lemma for two positive arguments *) @@ -170,7 +170,7 @@ Theorem Z_div_mod : Proof. intros a b; case a; case b; try (simpl in |- *; intros; omega). unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial. - + intros; discriminate. intros. @@ -179,25 +179,25 @@ Proof. case (Zdiv_eucl_POS p0 (Zpos p)). intros z z0. case z0. - + intros [H1 H2]. split; trivial. change (Zneg p0) with (- Zpos p0); rewrite H1; ring. - + intros p1 [H1 H2]. split; trivial. change (Zneg p0) with (- Zpos p0); rewrite H1; ring. generalize (Zorder.Zgt_pos_0 p1); omega. - + intros p1 [H1 H2]. split; trivial. change (Zneg p0) with (- Zpos p0); rewrite H1; ring. generalize (Zorder.Zlt_neg_0 p1); omega. - + intros; discriminate. Qed. -(** For stating the fully general result, let's give a short name +(** For stating the fully general result, let's give a short name to the condition on the remainder. *) Definition Remainder r b := 0 <= r < b \/ b < r <= 0. @@ -206,7 +206,7 @@ Definition Remainder r b := 0 <= r < b \/ b < r <= 0. Definition Remainder_alt r b := Zabs r < Zabs b /\ Zsgn r <> - Zsgn b. -(* In the last formulation, [ Zsgn r <> - Zsgn b ] is less nice than saying +(* In the last formulation, [ Zsgn r <> - Zsgn b ] is less nice than saying [ Zsgn r = Zsgn b ], but at least it works even when [r] is null. *) Lemma Remainder_equiv : forall r b, Remainder r b <-> Remainder_alt r b. @@ -250,7 +250,7 @@ Proof. destruct Zdiv_eucl_POS as (q,r). destruct r as [|r|r]; change (Zneg b) with (-Zpos b). rewrite Zmult_opp_comm; omega with *. - rewrite <- Zmult_opp_comm, Zmult_plus_distr_r; + rewrite <- Zmult_opp_comm, Zmult_plus_distr_r; repeat rewrite Zmult_opp_comm; omega. rewrite Zmult_opp_comm; omega with *. Qed. @@ -331,14 +331,14 @@ elim (Zlt_not_le (Zabs (r2 - r1)) (Zabs b)). omega with *. replace (r2-r1) with (b*(q1-q2)) by (rewrite Zmult_minus_distr_l; omega). replace (Zabs b) with ((Zabs b)*1) by ring. -rewrite Zabs_Zmult. +rewrite Zabs_Zmult. apply Zmult_le_compat_l; auto with *. omega with *. Qed. Theorem Zdiv_mod_unique_2 : forall b q1 q2 r1 r2:Z, - Remainder r1 b -> Remainder r2 b -> + Remainder r1 b -> Remainder r2 b -> b*q1+r1 = b*q2+r2 -> q1=q2 /\ r1=r2. Proof. unfold Remainder. @@ -356,7 +356,7 @@ omega with *. Qed. Theorem Zdiv_unique_full: - forall a b q r, Remainder r b -> + forall a b q r, Remainder r b -> a = b*q + r -> q = a/b. Proof. intros. @@ -368,7 +368,7 @@ Proof. Qed. Theorem Zdiv_unique: - forall a b q r, 0 <= r < b -> + forall a b q r, 0 <= r < b -> a = b*q + r -> q = a/b. Proof. intros; eapply Zdiv_unique_full; eauto. @@ -425,7 +425,7 @@ Proof. intros; symmetry; apply Zdiv_unique with 0; auto with zarith. Qed. -Hint Resolve Zmod_0_l Zmod_0_r Zdiv_0_l Zdiv_0_r Zdiv_1_r Zmod_1_r +Hint Resolve Zmod_0_l Zmod_0_r Zdiv_0_l Zdiv_0_r Zdiv_1_r Zmod_1_r : zarith. Lemma Zdiv_1_l: forall a, 1 < a -> 1/a = 0. @@ -460,7 +460,7 @@ Qed. Lemma Z_div_mult_full : forall a b:Z, b <> 0 -> (a*b)/b = a. Proof. - intros; symmetry; apply Zdiv_unique_full with 0; auto with zarith; + intros; symmetry; apply Zdiv_unique_full with 0; auto with zarith; [ red; omega | ring]. Qed. @@ -485,7 +485,7 @@ Proof. intros; generalize (Z_div_pos a b H); auto with zarith. Qed. -(** As soon as the divisor is greater or equal than 2, +(** As soon as the divisor is greater or equal than 2, the division is strictly decreasing. *) Lemma Z_div_lt : forall a b:Z, b >= 2 -> a > 0 -> a/b < a. @@ -530,7 +530,7 @@ Proof. intro. absurd (b - a >= 1). omega. - replace (b-a) with (c * (b/c-a/c) + b mod c - a mod c) by + replace (b-a) with (c * (b/c-a/c) + b mod c - a mod c) by (symmetry; pattern a at 1; rewrite H2; pattern b at 1; rewrite H0; ring). assert (c * (b / c - a / c) >= c * 1). apply Zmult_ge_compat_l. @@ -580,7 +580,7 @@ Qed. (** A modulo cannot grow beyond its starting point. *) Theorem Zmod_le: forall a b, 0 < b -> 0 <= a -> a mod b <= a. -Proof. +Proof. intros a b H1 H2; case (Zle_or_lt b a); intros H3. case (Z_mod_lt a b); auto with zarith. rewrite Zmod_small; auto with zarith. @@ -619,7 +619,7 @@ Qed. Lemma Zdiv_le_compat_l: forall p q r, 0 <= p -> 0 < q < r -> p / r <= p / q. Proof. - intros p q r H H1. + intros p q r H H1. apply Zdiv_le_lower_bound; auto with zarith. rewrite Zmult_comm. pattern p at 2; rewrite (Z_div_mod_eq p r); auto with zarith. @@ -629,11 +629,11 @@ Proof. case (Z_mod_lt p r); auto with zarith. Qed. -Theorem Zdiv_sgn: forall a b, +Theorem Zdiv_sgn: forall a b, 0 <= Zsgn (a/b) * Zsgn a * Zsgn b. Proof. - destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith; - generalize (Z_div_pos (Zpos a) (Zpos b)); unfold Zdiv, Zdiv_eucl; + destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith; + generalize (Z_div_pos (Zpos a) (Zpos b)); unfold Zdiv, Zdiv_eucl; destruct Zdiv_eucl_POS as (q,r); destruct r; omega with *. Qed. @@ -661,12 +661,12 @@ Qed. Theorem Z_div_plus_full_l: forall a b c : Z, b <> 0 -> (a * b + c) / b = a + c / b. Proof. intros a b c H; rewrite Zplus_comm; rewrite Z_div_plus_full; - try apply Zplus_comm; auto with zarith. + try apply Zplus_comm; auto with zarith. Qed. (** [Zopp] and [Zdiv], [Zmod]. - Due to the choice of convention for our Euclidean division, - some of the relations about [Zopp] and divisions are rather complex. *) + Due to the choice of convention for our Euclidean division, + some of the relations about [Zopp] and divisions are rather complex. *) Lemma Zdiv_opp_opp : forall a b:Z, (-a)/(-b) = a/b. Proof. @@ -695,7 +695,7 @@ Proof. ring. Qed. -Lemma Z_mod_nz_opp_full : forall a b:Z, a mod b <> 0 -> +Lemma Z_mod_nz_opp_full : forall a b:Z, a mod b <> 0 -> (-a) mod b = b - (a mod b). Proof. intros. @@ -714,7 +714,7 @@ Proof. rewrite Z_mod_zero_opp_full; auto. Qed. -Lemma Z_mod_nz_opp_r : forall a b:Z, a mod b <> 0 -> +Lemma Z_mod_nz_opp_r : forall a b:Z, a mod b <> 0 -> a mod (-b) = (a mod b) - b. Proof. intros. @@ -733,7 +733,7 @@ Proof. rewrite H; ring. Qed. -Lemma Z_div_nz_opp_full : forall a b:Z, a mod b <> 0 -> +Lemma Z_div_nz_opp_full : forall a b:Z, a mod b <> 0 -> (-a)/b = -(a/b)-1. Proof. intros. @@ -751,7 +751,7 @@ Proof. rewrite Z_div_zero_opp_full; auto. Qed. -Lemma Z_div_nz_opp_r : forall a b:Z, a mod b <> 0 -> +Lemma Z_div_nz_opp_r : forall a b:Z, a mod b <> 0 -> a/(-b) = -(a/b)-1. Proof. intros. @@ -762,7 +762,7 @@ Qed. (** Cancellations. *) -Lemma Zdiv_mult_cancel_r : forall a b c:Z, +Lemma Zdiv_mult_cancel_r : forall a b c:Z, c <> 0 -> (a*c)/(b*c) = a/b. Proof. assert (X: forall a b c, b > 0 -> c > 0 -> (a*c) / (b*c) = a / b). @@ -774,17 +774,17 @@ assert (X: forall a b c, b > 0 -> c > 0 -> (a*c) / (b*c) = a / b). apply Zmult_lt_compat_r; auto with zarith. pattern a at 1; rewrite (Z_div_mod_eq a b Hb); ring. intros a b c Hc. -destruct (Z_dec b 0) as [Hb|Hb]. +destruct (Z_dec b 0) as [Hb|Hb]. destruct Hb as [Hb|Hb]; destruct (not_Zeq_inf _ _ Hc); auto with *. -rewrite <- (Zdiv_opp_opp a), <- (Zmult_opp_opp b), <-(Zmult_opp_opp a); +rewrite <- (Zdiv_opp_opp a), <- (Zmult_opp_opp b), <-(Zmult_opp_opp a); auto with *. -rewrite <- (Zdiv_opp_opp a), <- Zdiv_opp_opp, Zopp_mult_distr_l, +rewrite <- (Zdiv_opp_opp a), <- Zdiv_opp_opp, Zopp_mult_distr_l, Zopp_mult_distr_l; auto with *. rewrite <- Zdiv_opp_opp, Zopp_mult_distr_r, Zopp_mult_distr_r; auto with *. rewrite Hb; simpl; do 2 rewrite Zdiv_0_r; auto. Qed. -Lemma Zdiv_mult_cancel_l : forall a b c:Z, +Lemma Zdiv_mult_cancel_l : forall a b c:Z, c<>0 -> (c*a)/(c*b) = a/b. Proof. intros. @@ -792,7 +792,7 @@ Proof. apply Zdiv_mult_cancel_r; auto. Qed. -Lemma Zmult_mod_distr_l: forall a b c, +Lemma Zmult_mod_distr_l: forall a b c, (c*a) mod (c*b) = c * (a mod b). Proof. intros; destruct (Z_eq_dec c 0) as [Hc|Hc]. @@ -807,7 +807,7 @@ Proof. ring. Qed. -Lemma Zmult_mod_distr_r: forall a b c, +Lemma Zmult_mod_distr_r: forall a b c, (a*c) mod (b*c) = (a mod b) * c. Proof. intros; repeat rewrite (fun x => (Zmult_comm x c)). @@ -975,8 +975,8 @@ Proof. apply Zplus_le_compat;auto with zarith. destruct (Z_mod_lt (a/b) c);auto with zarith. replace (b * (c - 1) + (b - 1)) with (b*c-1);try ring;auto with zarith. - intro H1; - assert (H2: c <> 0) by auto with zarith; + intro H1; + assert (H2: c <> 0) by auto with zarith; rewrite (Zmult_integral_l _ _ H2 H1) in H; auto with zarith. Qed. @@ -989,7 +989,7 @@ Theorem Zdiv_mult_le: forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a/b) <= (c*a)/b. Proof. intros a b c H1 H2 H3. - destruct (Zle_lt_or_eq _ _ H2); + destruct (Zle_lt_or_eq _ _ H2); [ | subst; rewrite Zdiv_0_r, Zdiv_0_r, Zmult_0_r; auto]. case (Z_mod_lt a b); auto with zarith; intros Hu1 Hu2. case (Z_mod_lt c b); auto with zarith; intros Hv1 Hv2. @@ -1005,14 +1005,14 @@ Proof. apply (Zmod_le ((c mod b) * (a mod b)) b); auto with zarith. apply Zmult_le_compat_r; auto with zarith. apply (Zmod_le c b); auto. - pattern (c * a) at 1; rewrite (Z_div_mod_eq (c * a) b); try ring; + pattern (c * a) at 1; rewrite (Z_div_mod_eq (c * a) b); try ring; auto with zarith. pattern a at 1; rewrite (Z_div_mod_eq a b); try ring; auto with zarith. Qed. (** Zmod is related to divisibility (see more in Znumtheory) *) -Lemma Zmod_divides : forall a b, b<>0 -> +Lemma Zmod_divides : forall a b, b<>0 -> (a mod b = 0 <-> exists c, a = b*c). Proof. split; intros. @@ -1159,11 +1159,11 @@ Qed. Implicit Arguments Zdiv_eucl_extended. (** A third convention: Ocaml. - + See files ZOdiv_def.v and ZOdiv.v. - + Ocaml uses Round-Toward-Zero division: (-a)/b = a/(-b) = -(a/b). Hence (-a) mod b = - (a mod b) a mod (-b) = a mod b - And: |r| < |b| and sgn(r) = sgn(a) (notice the a here instead of b). + And: |r| < |b| and sgn(r) = sgn(a) (notice the a here instead of b). *) diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v index a0a75cf1e..091310439 100644 --- a/theories/ZArith/Zeven.v +++ b/theories/ZArith/Zeven.v @@ -96,32 +96,32 @@ Qed. Lemma Zeven_Sn : forall n:Z, Zodd n -> Zeven (Zsucc n). Proof. intro z; destruct z; unfold Zsucc in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. Lemma Zodd_Sn : forall n:Z, Zeven n -> Zodd (Zsucc n). Proof. intro z; destruct z; unfold Zsucc in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. Lemma Zeven_pred : forall n:Z, Zodd n -> Zeven (Zpred n). Proof. intro z; destruct z; unfold Zpred in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. Lemma Zodd_pred : forall n:Z, Zeven n -> Zodd (Zpred n). Proof. intro z; destruct z; unfold Zpred in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. @@ -132,7 +132,7 @@ Hint Unfold Zeven Zodd: zarith. (** * Definition of [Zdiv2] and properties wrt [Zeven] and [Zodd] *) (** [Zdiv2] is defined on all [Z], but notice that for odd negative - integers it is not the euclidean quotient: in that case we have + integers it is not the euclidean quotient: in that case we have [n = 2*(n/2)-1] *) Definition Zdiv2 (z:Z) := @@ -200,7 +200,7 @@ Proof. intros x. elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy; rewrite <- Zplus_diag_eq_mult_2 in Hy. - exists (y, y); split. + exists (y, y); split. assumption. left; reflexivity. exists (y, (y + 1)%Z); split. @@ -239,7 +239,7 @@ Proof. destruct p; simpl; auto. Qed. -Theorem Zeven_plus_Zodd: forall a b, +Theorem Zeven_plus_Zodd: forall a b, Zeven a -> Zodd b -> Zodd (a + b). Proof. intros a b H1 H2; case Zeven_ex with (1 := H1); intros x H3; try rewrite H3; auto. @@ -257,13 +257,13 @@ Proof. apply Zmult_plus_distr_r; auto. Qed. -Theorem Zodd_plus_Zeven: forall a b, +Theorem Zodd_plus_Zeven: forall a b, Zodd a -> Zeven b -> Zodd (a + b). Proof. intros a b H1 H2; rewrite Zplus_comm; apply Zeven_plus_Zodd; auto. Qed. -Theorem Zodd_plus_Zodd: forall a b, +Theorem Zodd_plus_Zodd: forall a b, Zodd a -> Zodd b -> Zeven (a + b). Proof. intros a b H1 H2; case Zodd_ex with (1 := H1); intros x H3; try rewrite H3; auto. @@ -276,7 +276,7 @@ Proof. repeat rewrite <- Zplus_assoc; auto. Qed. -Theorem Zeven_mult_Zeven_l: forall a b, +Theorem Zeven_mult_Zeven_l: forall a b, Zeven a -> Zeven (a * b). Proof. intros a b H1; case Zeven_ex with (1 := H1); intros x H3; try rewrite H3; auto. @@ -285,7 +285,7 @@ Proof. apply Zmult_assoc. Qed. -Theorem Zeven_mult_Zeven_r: forall a b, +Theorem Zeven_mult_Zeven_r: forall a b, Zeven b -> Zeven (a * b). Proof. intros a b H1; case Zeven_ex with (1 := H1); intros x H3; try rewrite H3; auto. @@ -296,10 +296,10 @@ Proof. rewrite (Zmult_comm 2 a); auto. Qed. -Hint Rewrite Zmult_plus_distr_r Zmult_plus_distr_l +Hint Rewrite Zmult_plus_distr_r Zmult_plus_distr_l Zplus_assoc Zmult_1_r Zmult_1_l : Zexpand. -Theorem Zodd_mult_Zodd: forall a b, +Theorem Zodd_mult_Zodd: forall a b, Zodd a -> Zodd b -> Zodd (a * b). Proof. intros a b H1 H2; case Zodd_ex with (1 := H1); intros x H3; try rewrite H3; auto. @@ -308,7 +308,7 @@ Proof. (* ring part *) autorewrite with Zexpand; f_equal. repeat rewrite <- Zplus_assoc; f_equal. - repeat rewrite <- Zmult_assoc; f_equal. + repeat rewrite <- Zmult_assoc; f_equal. repeat rewrite Zmult_assoc; f_equal; apply Zmult_comm. Qed. diff --git a/theories/ZArith/Zgcd_alt.v b/theories/ZArith/Zgcd_alt.v index 42feedae0..512362190 100644 --- a/theories/ZArith/Zgcd_alt.v +++ b/theories/ZArith/Zgcd_alt.v @@ -30,7 +30,7 @@ Open Scope Z_scope. (** In Coq, we need to control the number of iteration of modulo. For that, we use an explicit measure in [nat], and we prove later - that using [2*d] is enough, where [d] is the number of binary + that using [2*d] is enough, where [d] is the number of binary digits of the first argument. *) Fixpoint Zgcdn (n:nat) : Z -> Z -> Z := fun a b => @@ -43,17 +43,17 @@ Open Scope Z_scope. end end. - Definition Zgcd_bound (a:Z) := + Definition Zgcd_bound (a:Z) := match a with | Z0 => S O | Zpos p => let n := Psize p in (n+n)%nat | Zneg p => let n := Psize p in (n+n)%nat end. - + Definition Zgcd_alt a b := Zgcdn (Zgcd_bound a) a b. - + (** A first obvious fact : [Zgcd a b] is positive. *) - + Lemma Zgcdn_pos : forall n a b, 0 <= Zgcdn n a b. Proof. @@ -61,16 +61,16 @@ Open Scope Z_scope. simpl; auto with zarith. destruct a; simpl; intros; auto with zarith; auto. Qed. - + Lemma Zgcd_alt_pos : forall a b, 0 <= Zgcd_alt a b. Proof. intros; unfold Zgcd; apply Zgcdn_pos; auto. Qed. - + (** We now prove that Zgcd is indeed a gcd. *) - + (** 1) We prove a weaker & easier bound. *) - + Lemma Zgcdn_linear_bound : forall n a b, Zabs a < Z_of_nat n -> Zis_gcd a b (Zgcdn n a b). Proof. @@ -93,17 +93,17 @@ Open Scope Z_scope. apply Zis_gcd_minus; apply Zis_gcd_sym. apply Zis_gcd_for_euclid2; auto. Qed. - + (** 2) For Euclid's algorithm, the worst-case situation corresponds to Fibonacci numbers. Let's define them: *) - + Fixpoint fibonacci (n:nat) : Z := match n with | O => 1 | S O => 1 | S (S n as p) => fibonacci p + fibonacci n end. - + Lemma fibonacci_pos : forall n, 0 <= fibonacci n. Proof. cut (forall N n, (n<N)%nat -> 0<=fibonacci n). @@ -118,7 +118,7 @@ Open Scope Z_scope. change (0 <= fibonacci (S n) + fibonacci n). generalize (IHN n) (IHN (S n)); omega. Qed. - + Lemma fibonacci_incr : forall n m, (n<=m)%nat -> fibonacci n <= fibonacci m. Proof. @@ -131,11 +131,11 @@ Open Scope Z_scope. change (fibonacci (S m) <= fibonacci (S m)+fibonacci m). generalize (fibonacci_pos m); omega. Qed. - + (** 3) We prove that fibonacci numbers are indeed worst-case: for a given number [n], if we reach a conclusion about [gcd(a,b)] in exactly [n+1] loops, then [fibonacci (n+1)<=a /\ fibonacci(n+2)<=b] *) - + Lemma Zgcdn_worst_is_fibonacci : forall n a b, 0 < a < b -> Zis_gcd a b (Zgcdn (S n) a b) -> @@ -192,9 +192,9 @@ Open Scope Z_scope. simpl in H5. elim H5; auto. Qed. - + (** 3b) We reformulate the previous result in a more positive way. *) - + Lemma Zgcdn_ok_before_fibonacci : forall n a b, 0 < a < b -> a < fibonacci (S n) -> Zis_gcd a b (Zgcdn n a b). @@ -224,32 +224,32 @@ Open Scope Z_scope. replace (Zgcdn n (Zpos p) b) with (Zgcdn (S n) (Zpos p) b); auto. generalize (H2 H3); clear H2 H3; omega. Qed. - + (** 4) The proposed bound leads to a fibonacci number that is big enough. *) - + Lemma Zgcd_bound_fibonacci : forall a, 0 < a -> a < fibonacci (Zgcd_bound a). Proof. destruct a; [omega| | intro H; discriminate]. intros _. - induction p; [ | | compute; auto ]; + induction p; [ | | compute; auto ]; simpl Zgcd_bound in *; - rewrite plus_comm; simpl plus; + rewrite plus_comm; simpl plus; set (n:= (Psize p+Psize p)%nat) in *; simpl; assert (n <> O) by (unfold n; destruct p; simpl; auto). - + destruct n as [ |m]; [elim H; auto| ]. generalize (fibonacci_pos m); rewrite Zpos_xI; omega. destruct n as [ |m]; [elim H; auto| ]. generalize (fibonacci_pos m); rewrite Zpos_xO; omega. Qed. - + (* 5) the end: we glue everything together and take care of situations not corresponding to [0<a<b]. *) Lemma Zgcdn_is_gcd : - forall n a b, (Zgcd_bound a <= n)%nat -> + forall n a b, (Zgcd_bound a <= n)%nat -> Zis_gcd a b (Zgcdn n a b). Proof. destruct a; intros. @@ -261,7 +261,7 @@ Open Scope Z_scope. simpl Zgcd_bound in *. remember (Psize p+Psize p)%nat as m. assert (1 < m)%nat. - rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm; + rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm; auto with arith. destruct m as [ |m]; [inversion H0; auto| ]. destruct n as [ |n]; [inversion H; auto| ]. @@ -285,7 +285,7 @@ Open Scope Z_scope. simpl Zgcd_bound in *. remember (Psize p+Psize p)%nat as m. assert (1 < m)%nat. - rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm; + rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm; auto with arith. destruct m as [ |m]; [inversion H0; auto| ]. destruct n as [ |n]; [inversion H; auto| ]. @@ -307,7 +307,7 @@ Open Scope Z_scope. destruct n as [ |n]; [elimtype False; omega| ]. simpl; apply Zis_gcd_sym; apply Zis_gcd_0. Qed. - + Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Zgcd_alt a b). Proof. diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v index e2b435aba..5459e693d 100644 --- a/theories/ZArith/Zhints.v +++ b/theories/ZArith/Zhints.v @@ -40,27 +40,27 @@ Require Import Wf_Z. (** No subgoal or smaller subgoals *) -Hint Resolve +Hint Resolve (** ** Reversible simplification lemmas (no loss of information) *) (** Should clearly be declared as hints *) - + (** Lemmas ending by eq *) Zsucc_eq_compat (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *) - + (** Lemmas ending by Zgt *) Zsucc_gt_compat (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *) Zgt_succ (* :(n:Z)`(Zs n) > n` *) Zorder.Zgt_pos_0 (* :(p:positive)`(POS p) > 0` *) Zplus_gt_compat_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *) Zplus_gt_compat_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *) - + (** Lemmas ending by Zlt *) Zlt_succ (* :(n:Z)`n < (Zs n)` *) Zsucc_lt_compat (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *) Zlt_pred (* :(n:Z)`(Zpred n) < n` *) Zplus_lt_compat_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *) Zplus_lt_compat_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *) - + (** Lemmas ending by Zle *) Zle_0_nat (* :(n:nat)`0 <= (inject_nat n)` *) Zorder.Zle_0_pos (* :(p:positive)`0 <= (POS p)` *) @@ -73,24 +73,24 @@ Hint Resolve Zplus_le_compat_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *) Zplus_le_compat_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *) Zabs_pos (* :(x:Z)`0 <= |x|` *) - + (** ** Irreversible simplification lemmas *) (** Probably to be declared as hints, when no other simplification is possible *) - + (** Lemmas ending by eq *) BinInt.Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *) Zplus_eq_compat (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *) - + (** Lemmas ending by Zge *) Zorder.Zmult_ge_compat_r (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *) Zorder.Zmult_ge_compat_l (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *) Zorder.Zmult_ge_compat (* : (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *) - + (** Lemmas ending by Zlt *) Zorder.Zmult_gt_0_compat (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *) Zlt_lt_succ (* :(n,m:Z)`n < m`->`n < (Zs m)` *) - + (** Lemmas ending by Zle *) Zorder.Zmult_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *) Zorder.Zmult_le_compat_r (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *) @@ -98,9 +98,9 @@ Hint Resolve Zplus_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *) Zle_le_succ (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *) Zplus_le_compat (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *) - + : zarith. - + (**********************************************************************) (** * Reversible lemmas relating operators *) (** Probably to be declared as hints but need to define precedences *) @@ -108,7 +108,7 @@ Hint Resolve (** ** Conversion between comparisons/predicates and arithmetic operators *) (** Lemmas ending by eq *) -(** +(** << Zegal_left: (x,y:Z)`x = y`->`x+(-y) = 0` Zabs_eq: (x:Z)`0 <= x`->`|x| = x` @@ -118,7 +118,7 @@ Zodd_div2: (x:Z)`x >= 0`->(Zodd x)->`x = 2*(Zdiv2 x)+1` *) (** Lemmas ending by Zgt *) -(** +(** << Zgt_left_rev: (x,y:Z)`x+(-y) > 0`->`x > y` Zgt_left_gt: (x,y:Z)`x > y`->`x+(-y) > 0` @@ -126,7 +126,7 @@ Zgt_left_gt: (x,y:Z)`x > y`->`x+(-y) > 0` *) (** Lemmas ending by Zlt *) -(** +(** << Zlt_left_rev: (x,y:Z)`0 < y+(-x)`->`x < y` Zlt_left_lt: (x,y:Z)`x < y`->`0 < y+(-x)` @@ -135,7 +135,7 @@ Zlt_O_minus_lt: (n,m:Z)`0 < n-m`->`m < n` *) (** Lemmas ending by Zle *) -(** +(** << Zle_left: (x,y:Z)`x <= y`->`0 <= y+(-x)` Zle_left_rev: (x,y:Z)`0 <= y+(-x)`->`x <= y` @@ -148,35 +148,35 @@ Zgt_left: (x,y:Z)`x > y`->`0 <= x+(-1)+(-y)` (** ** Conversion between nat comparisons and Z comparisons *) (** Lemmas ending by eq *) -(** +(** << inj_eq: (x,y:nat)x=y->`(inject_nat x) = (inject_nat y)` >> *) (** Lemmas ending by Zge *) -(** +(** << inj_ge: (x,y:nat)(ge x y)->`(inject_nat x) >= (inject_nat y)` >> *) (** Lemmas ending by Zgt *) -(** +(** << inj_gt: (x,y:nat)(gt x y)->`(inject_nat x) > (inject_nat y)` >> *) (** Lemmas ending by Zlt *) -(** +(** << inj_lt: (x,y:nat)(lt x y)->`(inject_nat x) < (inject_nat y)` >> *) (** Lemmas ending by Zle *) -(** +(** << inj_le: (x,y:nat)(le x y)->`(inject_nat x) <= (inject_nat y)` >> @@ -185,7 +185,7 @@ inj_le: (x,y:nat)(le x y)->`(inject_nat x) <= (inject_nat y)` (** ** Conversion between comparisons *) (** Lemmas ending by Zge *) -(** +(** << not_Zlt: (x,y:Z)~`x < y`->`x >= y` Zle_ge: (m,n:Z)`m <= n`->`n >= m` @@ -193,7 +193,7 @@ Zle_ge: (m,n:Z)`m <= n`->`n >= m` *) (** Lemmas ending by Zgt *) -(** +(** << Zle_gt_S: (n,p:Z)`n <= p`->`(Zs p) > n` not_Zle: (x,y:Z)~`x <= y`->`x > y` @@ -203,7 +203,7 @@ Zle_S_gt: (n,m:Z)`(Zs n) <= m`->`m > n` *) (** Lemmas ending by Zlt *) -(** +(** << not_Zge: (x,y:Z)~`x >= y`->`x < y` Zgt_lt: (m,n:Z)`m > n`->`n < m` @@ -212,7 +212,7 @@ Zle_lt_n_Sm: (n,m:Z)`n <= m`->`n < (Zs m)` *) (** Lemmas ending by Zle *) -(** +(** << Zlt_ZERO_pred_le_ZERO: (x:Z)`0 < x`->`0 <= (Zpred x)` not_Zgt: (x,y:Z)~`x > y`->`x <= y` @@ -230,7 +230,7 @@ Zle_refl: (n,m:Z)`n = m`->`n <= m` (** useful with clear precedences *) (** Lemmas ending by Zlt *) -(** +(** << Zlt_le_reg :(a,b,c,d:Z)`a < b`->`c <= d`->`a+c < b+d` Zle_lt_reg : (a,b,c,d:Z)`a <= b`->`c < d`->`a+c < b+d` @@ -240,21 +240,21 @@ Zle_lt_reg : (a,b,c,d:Z)`a <= b`->`c < d`->`a+c < b+d` (** ** What is decreasing here ? *) (** Lemmas ending by eq *) -(** +(** << Zplus_minus: (n,m,p:Z)`n = m+p`->`p = n-m` >> *) (** Lemmas ending by Zgt *) -(** +(** << Zgt_pred: (n,p:Z)`p > (Zs n)`->`(Zpred p) > n` >> *) (** Lemmas ending by Zlt *) -(** +(** << Zlt_pred: (n,p:Z)`(Zs n) < p`->`n < (Zpred p)` >> @@ -266,8 +266,8 @@ Zlt_pred: (n,p:Z)`(Zs n) < p`->`n < (Zpred p)` (** ** Bottom-up simplification: should be used *) (** Lemmas ending by eq *) -(** -<< +(** +<< Zeq_add_S: (n,m:Z)`(Zs n) = (Zs m)`->`n = m` Zsimpl_plus_l: (n,m,p:Z)`n+m = n+p`->`m = p` Zplus_unit_left: (n,m:Z)`n+0 = m`->`n = m` @@ -276,21 +276,21 @@ Zplus_unit_right: (n,m:Z)`n = m+0`->`n = m` *) (** Lemmas ending by Zgt *) -(** -<< +(** +<< Zsimpl_gt_plus_l: (n,m,p:Z)`p+n > p+m`->`n > m` Zsimpl_gt_plus_r: (n,m,p:Z)`n+p > m+p`->`n > m` -Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n` ->> +Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n` +>> *) (** Lemmas ending by Zlt *) -(** -<< +(** +<< Zsimpl_lt_plus_l: (n,m,p:Z)`p+n < p+m`->`n < m` Zsimpl_lt_plus_r: (n,m,p:Z)`n+p < m+p`->`n < m` -Zlt_S_n: (n,m:Z)`(Zs n) < (Zs m)`->`n < m` ->> +Zlt_S_n: (n,m:Z)`(Zs n) < (Zs m)`->`n < m` +>> *) (** Lemmas ending by Zle *) @@ -301,7 +301,7 @@ Zle_S_n: (n,m:Z)`(Zs m) <= (Zs n)`->`m <= n` >> *) (** ** Bottom-up irreversible (syntactic) simplification *) (** Lemmas ending by Zle *) -(** +(** << Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m` >> @@ -310,78 +310,78 @@ Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m` (** ** Other unclearly simplifying lemmas *) (** Lemmas ending by Zeq *) -(** -<< -Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0` ->> +(** +<< +Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0` +>> *) (* Lemmas ending by Zgt *) -(** -<< +(** +<< Zmult_gt: (x,y:Z)`x > 0`->`x*y > 0`->`y > 0` >> *) (* Lemmas ending by Zlt *) -(** -<< +(** +<< pZmult_lt: (x,y:Z)`x > 0`->`0 < y*x`->`0 < y` ->> +>> *) (* Lemmas ending by Zle *) -(** -<< +(** +<< Zmult_le: (x,y:Z)`x > 0`->`0 <= y*x`->`0 <= y` OMEGA1: (x,y:Z)`x = y`->`0 <= x`->`0 <= y` ->> +>> *) (**********************************************************************) (** * Irreversible lemmas with meta-variables *) -(** To be used by EAuto *) +(** To be used by EAuto *) (* Hints Immediate *) (** Lemmas ending by eq *) -(** -<< +(** +<< Zle_antisym: (n,m:Z)`n <= m`->`m <= n`->`n = m` >> *) (** Lemmas ending by Zge *) -(** -<< +(** +<< Zge_trans: (n,m,p:Z)`n >= m`->`m >= p`->`n >= p` ->> +>> *) (** Lemmas ending by Zgt *) -(** -<< +(** +<< Zgt_trans: (n,m,p:Z)`n > m`->`m > p`->`n > p` Zgt_trans_S: (n,m,p:Z)`(Zs n) > m`->`m > p`->`n > p` Zle_gt_trans: (n,m,p:Z)`m <= n`->`m > p`->`n > p` Zgt_le_trans: (n,m,p:Z)`n > m`->`p <= m`->`n > p` ->> +>> *) (** Lemmas ending by Zlt *) -(** -<< +(** +<< Zlt_trans: (n,m,p:Z)`n < m`->`m < p`->`n < p` Zlt_le_trans: (n,m,p:Z)`n < m`->`m <= p`->`n < p` Zle_lt_trans: (n,m,p:Z)`n <= m`->`m < p`->`n < p` ->> +>> *) (** Lemmas ending by Zle *) -(** -<< +(** +<< Zle_trans: (n,m,p:Z)`n <= m`->`m <= p`->`n <= p` ->> +>> *) diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v index 68e9c7733..70a959c2a 100644 --- a/theories/ZArith/Zlogarithm.v +++ b/theories/ZArith/Zlogarithm.v @@ -9,7 +9,7 @@ (*i $Id$ i*) (**********************************************************************) -(** The integer logarithms with base 2. +(** The integer logarithms with base 2. There are three logarithms, depending on the rounding of the real 2-based logarithm: @@ -27,7 +27,7 @@ Require Import Zpower. Open Local Scope Z_scope. Section Log_pos. (* Log of positive integers *) - + (** First we build [log_inf] and [log_sup] *) Fixpoint log_inf (p:positive) : Z := @@ -43,12 +43,12 @@ Section Log_pos. (* Log of positive integers *) | xO n => Zsucc (log_sup n) (* 2n *) | xI n => Zsucc (Zsucc (log_inf n)) (* 2n+1 *) end. - + Hint Unfold log_inf log_sup. - - (** Then we give the specifications of [log_inf] and [log_sup] + + (** Then we give the specifications of [log_inf] and [log_sup] and prove their validity *) - + Hint Resolve Zle_trans: zarith. Theorem log_inf_correct : @@ -100,11 +100,11 @@ Section Log_pos. (* Log of positive integers *) [ left; simpl in |- *; rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0)); - rewrite <- (proj1 Hif); rewrite <- (proj2 Hif); + rewrite <- (proj1 Hif); rewrite <- (proj2 Hif); auto | right; simpl in |- *; rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; + rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; omega ] | left; auto ]. Qed. @@ -141,7 +141,7 @@ Section Log_pos. (* Log of positive integers *) | xI xH => 2 | xO y => Zsucc (log_near y) | xI y => Zsucc (log_near y) - end. + end. Theorem log_near_correct1 : forall p:positive, 0 <= log_near p. Proof. @@ -186,7 +186,7 @@ End Log_pos. Section divers. (** Number of significative digits. *) - + Definition N_digits (x:Z) := match x with | Zpos p => log_inf p diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v index 59fcfa494..413b685a2 100644 --- a/theories/ZArith/Zmax.v +++ b/theories/ZArith/Zmax.v @@ -30,15 +30,15 @@ Proof. intros n m P H1 H2; unfold Zmax in |- *; case (n ?= m); auto with arith. Qed. -Lemma Zmax_case_strong : forall (n m:Z) (P:Z -> Type), +Lemma Zmax_case_strong : forall (n m:Z) (P:Z -> Type), (m<=n -> P n) -> (n<=m -> P m) -> P (Zmax n m). Proof. intros n m P H1 H2; unfold Zmax, Zle, Zge in *. rewrite <- (Zcompare_antisym n m) in H1. - destruct (n ?= m); (apply H1|| apply H2); discriminate. + destruct (n ?= m); (apply H1|| apply H2); discriminate. Qed. -Lemma Zmax_spec : forall x y:Z, +Lemma Zmax_spec : forall x y:Z, x >= y /\ Zmax x y = x \/ x < y /\ Zmax x y = y. Proof. @@ -90,13 +90,13 @@ Qed. Lemma Zmax_comm : forall n m:Z, Zmax n m = Zmax m n. Proof. - intros; do 2 apply Zmax_case_strong; intros; + intros; do 2 apply Zmax_case_strong; intros; apply Zle_antisym; auto with zarith. Qed. Lemma Zmax_assoc : forall n m p:Z, Zmax n (Zmax m p) = Zmax (Zmax n m) p. Proof. - intros n m p; repeat apply Zmax_case_strong; intros; + intros n m p; repeat apply Zmax_case_strong; intros; reflexivity || (try apply Zle_antisym); eauto with zarith. Qed. @@ -114,7 +114,7 @@ Qed. (** * Operations preserving max *) -Lemma Zsucc_max_distr : +Lemma Zsucc_max_distr : forall n m:Z, Zsucc (Zmax n m) = Zmax (Zsucc n) (Zsucc m). Proof. intros n m; unfold Zmax in |- *; rewrite (Zcompare_succ_compat n m); diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v index beb91a738..fa454fa96 100644 --- a/theories/ZArith/Zmin.v +++ b/theories/ZArith/Zmin.v @@ -30,12 +30,12 @@ Unboxed Definition Zmin (n m:Z) := (** * Characterization of the minimum on binary integer numbers *) -Lemma Zmin_case_strong : forall (n m:Z) (P:Z -> Type), +Lemma Zmin_case_strong : forall (n m:Z) (P:Z -> Type), (n<=m -> P n) -> (m<=n -> P m) -> P (Zmin n m). Proof. intros n m P H1 H2; unfold Zmin, Zle, Zge in *. rewrite <- (Zcompare_antisym n m) in H2. - destruct (n ?= m); (apply H1|| apply H2); discriminate. + destruct (n ?= m); (apply H1|| apply H2); discriminate. Qed. Lemma Zmin_case : forall (n m:Z) (P:Z -> Type), P n -> P m -> P (Zmin n m). @@ -43,7 +43,7 @@ Proof. intros n m P H1 H2; unfold Zmin in |- *; case (n ?= m); auto with arith. Qed. -Lemma Zmin_spec : forall x y:Z, +Lemma Zmin_spec : forall x y:Z, x <= y /\ Zmin x y = x \/ x > y /\ Zmin x y = y. Proof. @@ -93,7 +93,7 @@ Qed. Lemma Zmin_assoc : forall n m p:Z, Zmin n (Zmin m p) = Zmin (Zmin n m) p. Proof. - intros n m p; repeat apply Zmin_case_strong; intros; + intros n m p; repeat apply Zmin_case_strong; intros; reflexivity || (try apply Zle_antisym); eauto with zarith. Qed. @@ -118,7 +118,7 @@ Qed. (** * Operations preserving min *) -Lemma Zsucc_min_distr : +Lemma Zsucc_min_distr : forall n m:Z, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m). Proof. intros n m; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m); diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v index 6ea02a483..83dceb84b 100644 --- a/theories/ZArith/Zminmax.v +++ b/theories/ZArith/Zminmax.v @@ -18,32 +18,32 @@ Open Local Scope Z_scope. Lemma Zmin_max_absorption_r_r : forall n m, Zmax n (Zmin n m) = n. Proof. - intros; apply Zmin_case_strong; intro; apply Zmax_case_strong; intro; + intros; apply Zmin_case_strong; intro; apply Zmax_case_strong; intro; reflexivity || apply Zle_antisym; trivial. Qed. Lemma Zmax_min_absorption_r_r : forall n m, Zmin n (Zmax n m) = n. Proof. - intros; apply Zmax_case_strong; intro; apply Zmin_case_strong; intro; + intros; apply Zmax_case_strong; intro; apply Zmin_case_strong; intro; reflexivity || apply Zle_antisym; trivial. Qed. (** Distributivity *) -Lemma Zmax_min_distr_r : +Lemma Zmax_min_distr_r : forall n m p, Zmax n (Zmin m p) = Zmin (Zmax n m) (Zmax n p). Proof. intros. - repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; + repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; reflexivity || apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). Qed. -Lemma Zmin_max_distr_r : +Lemma Zmin_max_distr_r : forall n m p, Zmin n (Zmax m p) = Zmax (Zmin n m) (Zmin n p). Proof. intros. - repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; + repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; reflexivity || apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). Qed. diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v index 34e76b8ac..93ac74d54 100644 --- a/theories/ZArith/Zmisc.v +++ b/theories/ZArith/Zmisc.v @@ -37,14 +37,14 @@ Definition iter (n:Z) (A:Type) (f:A -> A) (x:A) := Theorem iter_nat_of_P : forall (p:positive) (A:Type) (f:A -> A) (x:A), iter_pos p A f x = iter_nat (nat_of_P p) A f x. -Proof. +Proof. intro n; induction n as [p H| p H| ]; [ intros; simpl in |- *; rewrite (H A f x); - rewrite (H A f (iter_nat (nat_of_P p) A f x)); + rewrite (H A f (iter_nat (nat_of_P p) A f x)); rewrite (ZL6 p); symmetry in |- *; apply f_equal with (f := f); apply iter_nat_plus | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x); - rewrite (H A f (iter_nat (nat_of_P p) A f x)); + rewrite (H A f (iter_nat (nat_of_P p) A f x)); rewrite (ZL6 p); symmetry in |- *; apply iter_nat_plus | simpl in |- *; auto with arith ]. Qed. @@ -59,7 +59,7 @@ Qed. Theorem iter_pos_plus : forall (p q:positive) (A:Type) (f:A -> A) (x:A), iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x). -Proof. +Proof. intros n m; intros. rewrite (iter_nat_of_P m A f x). rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)). @@ -68,14 +68,14 @@ Proof. apply iter_nat_plus. Qed. -(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv], +(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv], then the iterates of [f] also preserve it. *) Theorem iter_nat_invariant : forall (n:nat) (A:Type) (f:A -> A) (Inv:A -> Prop), (forall x:A, Inv x -> Inv (f x)) -> forall x:A, Inv x -> Inv (iter_nat n A f x). -Proof. +Proof. simple induction n; intros; [ trivial with arith | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H; @@ -86,6 +86,6 @@ Theorem iter_pos_invariant : forall (p:positive) (A:Type) (f:A -> A) (Inv:A -> Prop), (forall x:A, Inv x -> Inv (f x)) -> forall x:A, Inv x -> Inv (iter_pos p A f x). -Proof. +Proof. intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith. Qed. diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v index 5d3b20160..46b23fe63 100644 --- a/theories/ZArith/Znat.v +++ b/theories/ZArith/Znat.v @@ -57,9 +57,9 @@ Proof. | discriminate H0 | discriminate H0 | simpl in H0; injection H0; - do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ; + do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ; intros E; rewrite E; auto with arith ]. -Qed. +Qed. Theorem inj_eq_rev : forall n m:nat, Z_of_nat n = Z_of_nat m -> n = m. Proof. @@ -169,7 +169,7 @@ Proof. Qed. (** Injection and usual operations *) - + Theorem inj_plus : forall n m:nat, Z_of_nat (n + m) = Z_of_nat n + Z_of_nat m. Proof. intro x; induction x as [| n H]; intro y; destruct y as [| m]; @@ -186,7 +186,7 @@ Proof. intro x; induction x as [| n H]; [ simpl in |- *; trivial with arith | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H; - rewrite <- inj_plus; simpl in |- *; rewrite plus_comm; + rewrite <- inj_plus; simpl in |- *; rewrite plus_comm; trivial with arith ]. Qed. @@ -195,17 +195,17 @@ Theorem inj_minus1 : Proof. intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *; rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus; - rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r; + rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r; trivial with arith. Qed. - + Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z_of_nat (n - m) = 0. Proof. intros x y H; rewrite not_le_minus_0; [ trivial with arith | apply gt_not_le; assumption ]. Qed. -Theorem inj_minus : forall n m:nat, +Theorem inj_minus : forall n m:nat, Z_of_nat (minus n m) = Zmax 0 (Z_of_nat n - Z_of_nat m). Proof. intros. @@ -225,7 +225,7 @@ Proof. unfold Zminus; rewrite H'; auto. Qed. -Theorem inj_min : forall n m:nat, +Theorem inj_min : forall n m:nat, Z_of_nat (min n m) = Zmin (Z_of_nat n) (Z_of_nat m). Proof. induction n; destruct m; try (compute; auto; fail). @@ -234,7 +234,7 @@ Proof. rewrite <- Zsucc_min_distr; f_equal; auto. Qed. -Theorem inj_max : forall n m:nat, +Theorem inj_max : forall n m:nat, Z_of_nat (max n m) = Zmax (Z_of_nat n) (Z_of_nat m). Proof. induction n; destruct m; try (compute; auto; fail). @@ -269,11 +269,11 @@ Proof. intros x; exists (Z_of_nat x); split; [ trivial with arith | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r; - unfold Zle in |- *; elim x; intros; simpl in |- *; + unfold Zle in |- *; elim x; intros; simpl in |- *; discriminate ]. Qed. -Lemma Zpos_P_of_succ_nat : forall n:nat, +Lemma Zpos_P_of_succ_nat : forall n:nat, Zpos (P_of_succ_nat n) = Zsucc (Z_of_nat n). Proof. intros. diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index f6d73d7eb..dac4a6928 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -15,13 +15,13 @@ Require Import Zdiv. Require Import Wf_nat. Open Local Scope Z_scope. -(** This file contains some notions of number theory upon Z numbers: +(** This file contains some notions of number theory upon Z numbers: - a divisibility predicate [Zdivide] - a gcd predicate [gcd] - Euclid algorithm [euclid] - a relatively prime predicate [rel_prime] - a prime predicate [prime] - - an efficient [Zgcd] function + - an efficient [Zgcd] function *) (** * Divisibility *) @@ -171,7 +171,7 @@ Proof. rewrite H1 in H0; left; omega. rewrite H1 in H0; right; omega. Qed. - + Theorem Zdivide_trans: forall a b c, (a | b) -> (b | c) -> (a | c). Proof. intros a b c [d H1] [e H2]; exists (d * e); auto with zarith. @@ -220,7 +220,7 @@ Lemma Zdivide_dec : forall a b:Z, {(a | b)} + {~ (a | b)}. Proof. intros a b; elim (Ztrichotomy_inf a 0). (* a<0 *) - intros H; elim H; intros. + intros H; elim H; intros. case (Z_eq_dec (b mod - a) 0). left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith. intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. @@ -234,7 +234,7 @@ Proof. intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. Qed. -Theorem Zdivide_Zdiv_eq: forall a b : Z, +Theorem Zdivide_Zdiv_eq: forall a b : Z, 0 < a -> (a | b) -> b = a * (b / a). Proof. intros a b Hb Hc. @@ -242,7 +242,7 @@ Proof. rewrite (Zdivide_mod b a); auto with zarith. Qed. -Theorem Zdivide_Zdiv_eq_2: forall a b c : Z, +Theorem Zdivide_Zdiv_eq_2: forall a b c : Z, 0 < a -> (a | b) -> (c * b)/a = c * (b / a). Proof. intros a b c H1 H2. @@ -250,7 +250,7 @@ Proof. rewrite Hz; rewrite Zmult_assoc. repeat rewrite Z_div_mult; auto with zarith. Qed. - + Theorem Zdivide_Zabs_l: forall a b, (Zabs a | b) -> (a | b). Proof. intros a b [x H]; subst b. @@ -258,7 +258,7 @@ Proof. exists (- x); ring. exists x; ring. Qed. - + Theorem Zdivide_Zabs_inv_l: forall a b, (a | b) -> (Zabs a | b). Proof. intros a b [x H]; subst b. @@ -267,7 +267,7 @@ Proof. exists x; ring. Qed. -Theorem Zdivide_le: forall a b : Z, +Theorem Zdivide_le: forall a b : Z, 0 <= a -> 0 < b -> (a | b) -> a <= b. Proof. intros a b H1 H2 [q H3]; subst b. @@ -278,7 +278,7 @@ Proof. intros H4; subst q; omega. Qed. -Theorem Zdivide_Zdiv_lt_pos: forall a b : Z, +Theorem Zdivide_Zdiv_lt_pos: forall a b : Z, 1 < a -> 0 < b -> (a | b) -> 0 < b / a < b . Proof. intros a b H1 H2 H3; split. @@ -305,7 +305,7 @@ Proof. rewrite Zplus_0_l; rewrite Zmod_mod; auto with zarith. Qed. -Lemma Zmod_divide_minus: forall a b c : Z, 0 < b -> +Lemma Zmod_divide_minus: forall a b c : Z, 0 < b -> a mod b = c -> (b | a - c). Proof. intros a b c H H1; apply Zmod_divide; auto with zarith. @@ -315,7 +315,7 @@ Proof. subst; apply Z_mod_lt; auto with zarith. Qed. -Lemma Zdivide_mod_minus: forall a b c : Z, 0 <= c < b -> +Lemma Zdivide_mod_minus: forall a b c : Z, 0 <= c < b -> (b | a - c) -> a mod b = c. Proof. intros a b c (H1, H2) H3; assert (0 < b); try apply Zle_lt_trans with c; auto. @@ -326,9 +326,9 @@ Proof. Qed. (** * Greatest common divisor (gcd). *) - -(** There is no unicity of the gcd; hence we define the predicate [gcd a b d] - expressing that [d] is a gcd of [a] and [b]. + +(** There is no unicity of the gcd; hence we define the predicate [gcd a b d] + expressing that [d] is a gcd of [a] and [b]. (We show later that the [gcd] is actually unique if we discard its sign.) *) Inductive Zis_gcd (a b d:Z) : Prop := @@ -377,8 +377,8 @@ Proof. Qed. Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith. - -Theorem Zis_gcd_unique: forall a b c d : Z, + +Theorem Zis_gcd_unique: forall a b c d : Z, Zis_gcd a b c -> Zis_gcd a b d -> c = d \/ c = (- d). Proof. intros a b c d H1 H2. @@ -429,7 +429,7 @@ Section extended_euclid_algorithm. (** The recursive part of Euclid's algorithm uses well-founded recursion of non-negative integers. It maintains 6 integers [u1,u2,u3,v1,v2,v3] such that the following invariant holds: - [u1*a+u2*b=u3] and [v1*a+v2*b=v3] and [gcd(u2,v3)=gcd(a,b)]. + [u1*a+u2*b=u3] and [v1*a+v2*b=v3] and [gcd(u2,v3)=gcd(a,b)]. *) Lemma euclid_rec : @@ -453,8 +453,8 @@ Section extended_euclid_algorithm. replace (u3 - q * x) with (u3 mod x). apply Z_mod_lt; omega. assert (xpos : x > 0). omega. - generalize (Z_div_mod_eq u3 x xpos). - unfold q in |- *. + generalize (Z_div_mod_eq u3 x xpos). + unfold q in |- *. intro eq; pattern u3 at 2 in |- *; rewrite eq; ring. apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)). tauto. @@ -529,7 +529,7 @@ Proof. rewrite H6; rewrite H7; ring. ring. Qed. - + (** * Relative primality *) @@ -610,16 +610,16 @@ Proof. intros a b g; intros. assert (g <> 0). intro. - elim H1; intros. + elim H1; intros. elim H4; intros. rewrite H2 in H6; subst b; omega. unfold rel_prime in |- *. destruct H1. destruct H1 as (a',H1). destruct H3 as (b',H3). - replace (a/g) with a'; + replace (a/g) with a'; [|rewrite H1; rewrite Z_div_mult; auto with zarith]. - replace (b/g) with b'; + replace (b/g) with b'; [|rewrite H3; rewrite Z_div_mult; auto with zarith]. constructor. exists a'; auto with zarith. @@ -641,7 +641,7 @@ Proof. red; apply Zis_gcd_sym; auto with zarith. Qed. -Theorem rel_prime_div: forall p q r, +Theorem rel_prime_div: forall p q r, rel_prime p q -> (r | p) -> rel_prime r q. Proof. intros p q r H (u, H1); subst. @@ -668,7 +668,7 @@ Proof. exists 1; auto with zarith. Qed. -Theorem rel_prime_mod: forall p q, 0 < q -> +Theorem rel_prime_mod: forall p q, 0 < q -> rel_prime p q -> rel_prime (p mod q) q. Proof. intros p q H H0. @@ -681,7 +681,7 @@ Proof. pattern p at 3; rewrite (Z_div_mod_eq p q); try ring; auto with zarith. Qed. -Theorem rel_prime_mod_rev: forall p q, 0 < q -> +Theorem rel_prime_mod_rev: forall p q, 0 < q -> rel_prime (p mod q) q -> rel_prime p q. Proof. intros p q H H0. @@ -713,7 +713,7 @@ Proof. assert (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p). assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ]. - generalize H3. + generalize H3. pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *; apply Zabs_ind; intros; omega. intuition idtac. @@ -783,7 +783,7 @@ Proof. intros H1; absurd (1 < 1); auto with zarith. inversion H1; auto. Qed. - + Lemma prime_2: prime 2. Proof. apply prime_intro; auto with zarith. @@ -793,7 +793,7 @@ Proof. subst n; red; auto with zarith. apply Zis_gcd_intro; auto with zarith. Qed. - + Theorem prime_3: prime 3. Proof. apply prime_intro; auto with zarith. @@ -810,7 +810,7 @@ Proof. subst n; red; auto with zarith. apply Zis_gcd_intro; auto with zarith. Qed. - + Theorem prime_ge_2: forall p, prime p -> 2 <= p. Proof. intros p Hp; inversion Hp; auto with zarith. @@ -818,7 +818,7 @@ Qed. Definition prime' p := 1<p /\ (forall n, 1<n<p -> ~ (n|p)). -Theorem prime_alt: +Theorem prime_alt: forall p, prime' p <-> prime p. Proof. split; destruct 1; intros. @@ -846,7 +846,7 @@ Proof. apply Zis_gcd_intro; auto with zarith. apply H0; auto with zarith. Qed. - + Theorem square_not_prime: forall a, ~ prime (a * a). Proof. intros a Ha. @@ -862,10 +862,10 @@ Proof. exists b; auto. Qed. -Theorem prime_div_prime: forall p q, +Theorem prime_div_prime: forall p q, prime p -> prime q -> (p | q) -> p = q. Proof. - intros p q H H1 H2; + intros p q H H1 H2; assert (Hp: 0 < p); try apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. assert (Hq: 0 < q); try apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. case prime_divisors with (2 := H2); auto. @@ -876,10 +876,10 @@ Proof. Qed. -(** We could obtain a [Zgcd] function via Euclid algorithm. But we propose +(** We could obtain a [Zgcd] function via Euclid algorithm. But we propose here a binary version of [Zgcd], faster and executable within Coq. - Algorithm: + Algorithm: gcd 0 b = b gcd a 0 = a @@ -887,23 +887,23 @@ Qed. gcd (2a+1) (2b) = gcd (2a+1) b gcd (2a) (2b+1) = gcd a (2b+1) gcd (2a+1) (2b+1) = gcd (b-a) (2*a+1) - or gcd (a-b) (2*b+1), depending on whether a<b -*) + or gcd (a-b) (2*b+1), depending on whether a<b +*) Open Scope positive_scope. -Fixpoint Pgcdn (n: nat) (a b : positive) { struct n } : positive := - match n with +Fixpoint Pgcdn (n: nat) (a b : positive) { struct n } : positive := + match n with | O => 1 - | S n => - match a,b with - | xH, _ => 1 + | S n => + match a,b with + | xH, _ => 1 | _, xH => 1 | xO a, xO b => xO (Pgcdn n a b) | a, xO b => Pgcdn n a b | xO a, b => Pgcdn n a b - | xI a', xI b' => - match Pcompare a' b' Eq with + | xI a', xI b' => + match Pcompare a' b' Eq with | Eq => a | Lt => Pgcdn n (b'-a') a | Gt => Pgcdn n (a'-b') b @@ -917,7 +917,7 @@ Close Scope positive_scope. Definition Zgcd (a b : Z) : Z := match a,b with - | Z0, _ => Zabs b + | Z0, _ => Zabs b | _, Z0 => Zabs a | Zpos a, Zpos b => Zpos (Pgcd a b) | Zpos a, Zneg b => Zpos (Pgcd a b) @@ -930,8 +930,8 @@ Proof. unfold Zgcd; destruct a; destruct b; auto with zarith. Qed. -Lemma Zis_gcd_even_odd : forall a b g, Zis_gcd (Zpos a) (Zpos (xI b)) g -> - Zis_gcd (Zpos (xO a)) (Zpos (xI b)) g. +Lemma Zis_gcd_even_odd : forall a b g, Zis_gcd (Zpos a) (Zpos (xI b)) g -> + Zis_gcd (Zpos (xO a)) (Zpos (xI b)) g. Proof. intros. destruct H. @@ -949,7 +949,7 @@ Proof. omega. Qed. -Lemma Pgcdn_correct : forall n a b, (Psize a + Psize b<=n)%nat -> +Lemma Pgcdn_correct : forall n a b, (Psize a + Psize b<=n)%nat -> Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcdn n a b)). Proof. intro n; pattern n; apply lt_wf_ind; clear n; intros. @@ -975,7 +975,7 @@ Proof. rewrite (Zpos_minus_morphism _ _ H1). assert (0 < Zpos a) by (compute; auto). omega. - omega. + omega. rewrite Zpos_xO; do 2 rewrite Zpos_xI. rewrite Zpos_minus_morphism; auto. omega. @@ -993,7 +993,7 @@ Proof. assert (0 < Zpos b) by (compute; auto). omega. rewrite ZC4; rewrite H1; auto. - omega. + omega. rewrite Zpos_xO; do 2 rewrite Zpos_xI. rewrite Zpos_minus_morphism; auto. omega. @@ -1060,7 +1060,7 @@ Proof. split; [apply Zgcd_is_gcd | apply Zgcd_is_pos]. Qed. -Theorem Zdivide_Zgcd: forall p q r : Z, +Theorem Zdivide_Zgcd: forall p q r : Z, (p | q) -> (p | r) -> (p | Zgcd q r). Proof. intros p q r H1 H2. @@ -1069,7 +1069,7 @@ Proof. inversion_clear H3; auto. Qed. -Theorem Zis_gcd_gcd: forall a b c : Z, +Theorem Zis_gcd_gcd: forall a b c : Z, 0 <= c -> Zis_gcd a b c -> Zgcd a b = c. Proof. intros a b c H1 H2. @@ -1101,7 +1101,7 @@ Proof. rewrite H1; ring. Qed. -Theorem Zgcd_div_swap0 : forall a b : Z, +Theorem Zgcd_div_swap0 : forall a b : Z, 0 < Zgcd a b -> 0 < b -> (a / Zgcd a b) * b = a * (b/Zgcd a b). @@ -1114,7 +1114,7 @@ Proof. rewrite <- Zdivide_Zdiv_eq; auto. Qed. -Theorem Zgcd_div_swap : forall a b c : Z, +Theorem Zgcd_div_swap : forall a b c : Z, 0 < Zgcd a b -> 0 < b -> (c * a) / Zgcd a b * b = c * a * (b/Zgcd a b). @@ -1165,7 +1165,7 @@ Proof. Qed. Hint Resolve Zgcd_0 Zgcd_1 : zarith. -Theorem Zgcd_1_rel_prime : forall a b, +Theorem Zgcd_1_rel_prime : forall a b, Zgcd a b = 1 <-> rel_prime a b. Proof. unfold rel_prime; split; intro H. @@ -1176,7 +1176,7 @@ Proof. generalize (Zgcd_is_pos a b); auto with zarith. Qed. -Definition rel_prime_dec: forall a b, +Definition rel_prime_dec: forall a b, { rel_prime a b }+{ ~ rel_prime a b }. Proof. intros a b; case (Z_eq_dec (Zgcd a b) 1); intros H1. @@ -1190,7 +1190,7 @@ Definition prime_dec_aux: { exists n, 1 < n < m /\ ~ rel_prime n p }. Proof. intros p m. - case (Z_lt_dec 1 m); intros H1; + case (Z_lt_dec 1 m); intros H1; [ | left; intros; elimtype False; omega ]. pattern m; apply natlike_rec; auto with zarith. left; intros; elimtype False; omega. @@ -1255,34 +1255,34 @@ Qed. Open Scope positive_scope. -Fixpoint Pggcdn (n: nat) (a b : positive) { struct n } : (positive*(positive*positive)) := - match n with +Fixpoint Pggcdn (n: nat) (a b : positive) { struct n } : (positive*(positive*positive)) := + match n with | O => (1,(a,b)) - | S n => - match a,b with - | xH, b => (1,(1,b)) + | S n => + match a,b with + | xH, b => (1,(1,b)) | a, xH => (1,(a,1)) - | xO a, xO b => - let (g,p) := Pggcdn n a b in + | xO a, xO b => + let (g,p) := Pggcdn n a b in (xO g,p) - | a, xO b => - let (g,p) := Pggcdn n a b in - let (aa,bb) := p in + | a, xO b => + let (g,p) := Pggcdn n a b in + let (aa,bb) := p in (g,(aa, xO bb)) - | xO a, b => - let (g,p) := Pggcdn n a b in - let (aa,bb) := p in + | xO a, b => + let (g,p) := Pggcdn n a b in + let (aa,bb) := p in (g,(xO aa, bb)) - | xI a', xI b' => - match Pcompare a' b' Eq with + | xI a', xI b' => + match Pcompare a' b' Eq with | Eq => (a,(1,1)) - | Lt => - let (g,p) := Pggcdn n (b'-a') a in - let (ba,aa) := p in + | Lt => + let (g,p) := Pggcdn n (b'-a') a in + let (ba,aa) := p in (g,(aa, aa + xO ba)) - | Gt => - let (g,p) := Pggcdn n (a'-b') b in - let (ab,bb) := p in + | Gt => + let (g,p) := Pggcdn n (a'-b') b in + let (ab,bb) := p in (g,(bb+xO ab, bb)) end end @@ -1294,28 +1294,28 @@ Open Scope Z_scope. Definition Zggcd (a b : Z) : Z*(Z*Z) := match a,b with - | Z0, _ => (Zabs b,(0, Zsgn b)) + | Z0, _ => (Zabs b,(0, Zsgn b)) | _, Z0 => (Zabs a,(Zsgn a, 0)) - | Zpos a, Zpos b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in + | Zpos a, Zpos b => + let (g,p) := Pggcd a b in + let (aa,bb) := p in (Zpos g, (Zpos aa, Zpos bb)) - | Zpos a, Zneg b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in + | Zpos a, Zneg b => + let (g,p) := Pggcd a b in + let (aa,bb) := p in (Zpos g, (Zpos aa, Zneg bb)) - | Zneg a, Zpos b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in + | Zneg a, Zpos b => + let (g,p) := Pggcd a b in + let (aa,bb) := p in (Zpos g, (Zneg aa, Zpos bb)) | Zneg a, Zneg b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in + let (g,p) := Pggcd a b in + let (aa,bb) := p in (Zpos g, (Zneg aa, Zneg bb)) end. -Lemma Pggcdn_gcdn : forall n a b, +Lemma Pggcdn_gcdn : forall n a b, fst (Pggcdn n a b) = Pgcdn n a b. Proof. induction n. @@ -1336,15 +1336,15 @@ Qed. Lemma Zggcd_gcd : forall a b, fst (Zggcd a b) = Zgcd a b. Proof. - destruct a; destruct b; simpl; auto; rewrite <- Pggcd_gcd; + destruct a; destruct b; simpl; auto; rewrite <- Pggcd_gcd; destruct (Pggcd p p0) as (g,(aa,bb)); simpl; auto. Qed. Open Scope positive_scope. -Lemma Pggcdn_correct_divisors : forall n a b, - let (g,p) := Pggcdn n a b in - let (aa,bb):=p in +Lemma Pggcdn_correct_divisors : forall n a b, + let (g,p) := Pggcdn n a b in + let (aa,bb):=p in (a=g*aa) /\ (b=g*bb). Proof. induction n. @@ -1371,7 +1371,7 @@ Proof. rewrite <- H1; rewrite <- H0. simpl; f_equal; symmetry. apply Pplus_minus; auto. - (* Then... *) + (* Then... *) generalize (IHn (xI a) b); destruct (Pggcdn n (xI a) b) as (g,(ab,bb)); simpl. intros (H0,H1); split; auto. rewrite Pmult_xO_permute_r; rewrite H1; auto. @@ -1382,9 +1382,9 @@ Proof. intros (H0,H1); split; subst; auto. Qed. -Lemma Pggcd_correct_divisors : forall a b, - let (g,p) := Pggcd a b in - let (aa,bb):=p in +Lemma Pggcd_correct_divisors : forall a b, + let (g,p) := Pggcd a b in + let (aa,bb):=p in (a=g*aa) /\ (b=g*bb). Proof. intros a b; exact (Pggcdn_correct_divisors (Psize a + Psize b)%nat a b). @@ -1392,17 +1392,17 @@ Qed. Close Scope positive_scope. -Lemma Zggcd_correct_divisors : forall a b, - let (g,p) := Zggcd a b in - let (aa,bb):=p in +Lemma Zggcd_correct_divisors : forall a b, + let (g,p) := Zggcd a b in + let (aa,bb):=p in (a=g*aa) /\ (b=g*bb). Proof. - destruct a; destruct b; simpl; auto; try solve [rewrite Pmult_comm; simpl; auto]; - generalize (Pggcd_correct_divisors p p0); destruct (Pggcd p p0) as (g,(aa,bb)); + destruct a; destruct b; simpl; auto; try solve [rewrite Pmult_comm; simpl; auto]; + generalize (Pggcd_correct_divisors p p0); destruct (Pggcd p p0) as (g,(aa,bb)); destruct 1; subst; auto. Qed. -Theorem Zggcd_opp: forall x y, +Theorem Zggcd_opp: forall x y, Zggcd (-x) y = let (p1,p) := Zggcd x y in let (p2,p3) := p in (p1,(-p2,p3)). diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v index 9ab0aadfd..7aef3ea8e 100644 --- a/theories/ZArith/Zorder.v +++ b/theories/ZArith/Zorder.v @@ -49,7 +49,7 @@ Proof. [ tauto | intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4); intros H5; discriminate H5 ]. -Qed. +Qed. Theorem dec_Zne : forall n m:Z, decidable (Zne n m). Proof. @@ -79,7 +79,7 @@ Proof. intros x y; unfold decidable, Zge in |- *; elim (x ?= y); [ left; discriminate | right; unfold not in |- *; intros H; apply H; trivial with arith - | left; discriminate ]. + | left; discriminate ]. Qed. Theorem dec_Zlt : forall n m:Z, decidable (n < m). @@ -96,7 +96,7 @@ Proof. | unfold Zlt in |- *; intros H; elim H; intros H1; [ auto with arith | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ]. -Qed. +Qed. (** * Relating strict and large orders *) @@ -180,7 +180,7 @@ Proof. intros x y. split. intro. apply Zgt_lt. assumption. intro. apply Zlt_gt. assumption. Qed. - + (** * Equivalence and order properties *) (** Reflexivity *) @@ -188,7 +188,7 @@ Qed. Lemma Zle_refl : forall n:Z, n <= n. Proof. intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate. -Qed. +Qed. Lemma Zeq_le : forall n m:Z, n = m -> n <= m. Proof. @@ -201,7 +201,7 @@ Hint Resolve Zle_refl: zarith. Lemma Zle_antisym : forall n m:Z, n <= m -> m <= n -> n = m. Proof. - intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]. + intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]. absurd (m > n); [ apply Zle_not_gt | apply Zlt_gt ]; assumption. assumption. absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption. @@ -399,7 +399,7 @@ Qed. Lemma Zgt_le_succ : forall n m:Z, m > n -> Zsucc n <= m. Proof. unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n); - intros H1 H2; unfold not in |- *; intros H3; unfold not in H1; + intros H1 H2; unfold not in |- *; intros H3; unfold not in H1; apply H1; [ assumption | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ]. @@ -477,9 +477,9 @@ Hint Resolve Zle_le_succ: zarith. Lemma Zgt_succ_pred : forall n m:Z, m > Zsucc n -> Zpred m > n. Proof. unfold Zgt, Zsucc, Zpred in |- *; intros n p H; - rewrite <- (fun x y => Zcompare_plus_compat x y 1); + rewrite <- (fun x y => Zcompare_plus_compat x y 1); rewrite (Zplus_comm p); rewrite Zplus_assoc; - rewrite (fun x => Zplus_comm x n); simpl in |- *; + rewrite (fun x => Zplus_comm x n); simpl in |- *; assumption. Qed. @@ -562,7 +562,7 @@ Proof. assert (Hle : m <= n). apply Zgt_succ_le; assumption. destruct (Zle_lt_or_eq _ _ Hle) as [Hlt| Heq]. - left; apply Zlt_gt; assumption. + left; apply Zlt_gt; assumption. right; assumption. Qed. @@ -679,7 +679,7 @@ Proof. rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. Qed. -(** ** Multiplication *) +(** ** Multiplication *) (** Compatibility of multiplication by a positive wrt to order *) Lemma Zmult_le_compat_r : forall n m p:Z, n <= m -> 0 <= p -> n * p <= m * p. @@ -776,7 +776,7 @@ Proof. intros a b c d H0 H1 H2 H3. apply Zge_trans with (a * d). apply Zmult_ge_compat_l; trivial. - apply Zge_trans with c; trivial. + apply Zge_trans with c; trivial. apply Zmult_ge_compat_r; trivial. Qed. @@ -964,17 +964,17 @@ Qed. Lemma Zeq_plus_swap : forall n m p:Z, n + p = m <-> n = m - p. Proof. - intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry in |- *. rewrite Zplus_comm. + intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry in |- *. rewrite Zplus_comm. assumption. - intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse. + intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse. rewrite Zplus_opp_l. apply Zplus_0_r. Qed. Lemma Zlt_minus_simpl_swap : forall n m:Z, 0 < m -> n - m < n. Proof. intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus; - pattern n at 1 in |- *; rewrite <- (Zplus_0_r n); - rewrite (Zplus_comm m n); apply Zplus_lt_compat_l; + pattern n at 1 in |- *; rewrite <- (Zplus_0_r n); + rewrite (Zplus_comm m n); apply Zplus_lt_compat_l; assumption. Qed. @@ -992,8 +992,8 @@ Qed. Lemma Zle_minus_le_0 : forall n m:Z, m <= n -> 0 <= n - m. Proof. - intros n m H; unfold Zminus; apply Zplus_le_reg_r with (p := m); - rewrite <- Zplus_assoc; rewrite Zplus_opp_l; rewrite Zplus_0_r; exact H. + intros n m H; unfold Zminus; apply Zplus_le_reg_r with (p := m); + rewrite <- Zplus_assoc; rewrite Zplus_opp_l; rewrite Zplus_0_r; exact H. Qed. Lemma Zmult_lt_compat: @@ -1011,7 +1011,7 @@ Proof. rewrite <- H5; simpl; apply Zmult_lt_0_compat; auto with zarith. Qed. -Lemma Zmult_lt_compat2: +Lemma Zmult_lt_compat2: forall n m p q : Z, 0 < n <= p -> 0 < m < q -> n * m < p * q. Proof. intros n m p q (H1, H2) (H3, H4). diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v index b0f372deb..620d6324f 100644 --- a/theories/ZArith/Zpow_def.v +++ b/theories/ZArith/Zpow_def.v @@ -2,11 +2,11 @@ Require Import ZArith_base. Require Import Ring_theory. Open Local Scope Z_scope. - + (** [Zpower_pos z n] is the n-th power of [z] when [n] is an binary - integer (type [positive]) and [z] a signed integer (type [Z]) *) + integer (type [positive]) and [z] a signed integer (type [Z]) *) Definition Zpower_pos (z:Z) (n:positive) := iter_pos n Z (fun x:Z => z * x) 1. - + Definition Zpower (x y:Z) := match y with | Zpos p => Zpower_pos x p @@ -24,4 +24,4 @@ Proof. repeat rewrite Zmult_assoc;trivial. rewrite H;rewrite Zmult_1_r;trivial. Qed. - + diff --git a/theories/ZArith/Zpow_facts.v b/theories/ZArith/Zpow_facts.v index bf25de4d6..40917519e 100644 --- a/theories/ZArith/Zpow_facts.v +++ b/theories/ZArith/Zpow_facts.v @@ -37,7 +37,7 @@ Proof. Qed. Lemma Zpower_pos_0_l: forall p, Zpower_pos 0 p = 0. -Proof. +Proof. induction p. change (xI p) with (1 + (xO p))%positive. rewrite Zpower_pos_is_exp, Zpower_pos_1_r; auto. @@ -133,7 +133,7 @@ Proof. apply Zle_ge; replace 0 with (0 * r1); try apply Zmult_le_compat_r; auto. Qed. -Theorem Zpower_le_monotone: forall a b c, +Theorem Zpower_le_monotone: forall a b c, 0 < a -> 0 <= b <= c -> a^b <= a^c. Proof. intros a b c H (H1, H2). @@ -145,7 +145,7 @@ Proof. apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. Qed. -Theorem Zpower_lt_monotone: forall a b c, +Theorem Zpower_lt_monotone: forall a b c, 1 < a -> 0 <= b < c -> a^b < a^c. Proof. intros a b c H (H1, H2). @@ -160,7 +160,7 @@ Proof. apply Zpower_le_monotone; auto with zarith. Qed. -Theorem Zpower_gt_1 : forall x y, +Theorem Zpower_gt_1 : forall x y, 1 < x -> 0 < y -> 1 < x^y. Proof. intros x y H1 H2. @@ -168,14 +168,14 @@ Proof. apply Zpower_lt_monotone; auto with zarith. Qed. -Theorem Zpower_ge_0: forall x y, 0 <= x -> 0 <= x^y. +Theorem Zpower_ge_0: forall x y, 0 <= x -> 0 <= x^y. Proof. intros x y; case y; auto with zarith. simpl ; auto with zarith. intros p H1; assert (H: 0 <= Zpos p); auto with zarith. generalize H; pattern (Zpos p); apply natlike_ind; auto with zarith. - intros p1 H2 H3 _; unfold Zsucc; rewrite Zpower_exp; simpl; auto with zarith. - apply Zmult_le_0_compat; auto with zarith. + intros p1 H2 H3 _; unfold Zsucc; rewrite Zpower_exp; simpl; auto with zarith. + apply Zmult_le_0_compat; auto with zarith. generalize H1; case x; compute; intros; auto; try discriminate. Qed. @@ -195,7 +195,7 @@ Proof. destruct b;trivial;unfold Zgt in z;discriminate z. Qed. -Theorem Zmult_power: forall p q r, 0 <= r -> +Theorem Zmult_power: forall p q r, 0 <= r -> (p*q)^r = p^r * q^r. Proof. intros p q r H1; generalize H1; pattern r; apply natlike_ind; auto. @@ -206,7 +206,7 @@ Qed. Hint Resolve Zpower_ge_0 Zpower_gt_0: zarith. -Theorem Zpower_le_monotone3: forall a b c, +Theorem Zpower_le_monotone3: forall a b c, 0 <= c -> 0 <= a <= b -> a^c <= b^c. Proof. intros a b c H (H1, H2). @@ -216,7 +216,7 @@ Proof. apply Zle_trans with (a^x * b); auto with zarith. Qed. -Lemma Zpower_le_monotone_inv: forall a b c, +Lemma Zpower_le_monotone_inv: forall a b c, 1 < a -> 0 < b -> a^b <= a^c -> b <= c. Proof. intros a b c H H0 H1. @@ -227,14 +227,14 @@ Proof. apply Zpower_le_monotone;auto with zarith. apply Zpower_le_monotone3;auto with zarith. assert (c > 0). - destruct (Z_le_gt_dec 0 c);trivial. + destruct (Z_le_gt_dec 0 c);trivial. destruct (Zle_lt_or_eq _ _ z0);auto with zarith. rewrite <- H3 in H1;simpl in H1; elimtype False;omega. destruct c;try discriminate z0. simpl in H1. elimtype False;omega. assert (H4 := Zpower_lt_monotone a c b H). elimtype False;omega. Qed. -Theorem Zpower_nat_Zpower: forall p q, 0 <= q -> +Theorem Zpower_nat_Zpower: forall p q, 0 <= q -> p^q = Zpower_nat p (Zabs_nat q). Proof. intros p1 q1; case q1; simpl. @@ -262,7 +262,7 @@ Proof. intros; apply Zlt_le_weak; apply Zpower2_lt_lin; auto. Qed. -Lemma Zpower2_Psize : +Lemma Zpower2_Psize : forall n p, Zpos p < 2^(Z_of_nat n) <-> (Psize p <= n)%nat. Proof. induction n. @@ -311,14 +311,14 @@ Fixpoint Zpow_mod_pos (a: Z)(m: positive)(n : Z) {struct m} : Z := end end. -Definition Zpow_mod a m n := - match m with - | 0 => 1 - | Zpos p => Zpow_mod_pos a p n - | Zneg p => 0 +Definition Zpow_mod a m n := + match m with + | 0 => 1 + | Zpos p => Zpow_mod_pos a p n + | Zneg p => 0 end. -Theorem Zpow_mod_pos_correct: forall a m n, 0 < n -> +Theorem Zpow_mod_pos_correct: forall a m n, 0 < n -> Zpow_mod_pos a m n = (Zpower_pos a m) mod n. Proof. intros a m; elim m; simpl; auto. @@ -327,12 +327,12 @@ Proof. repeat rewrite Rec; auto. rewrite Zpower_pos_1_r. repeat rewrite (fun x => (Zmult_mod x a)); auto with zarith. - rewrite (Zmult_mod (Zpower_pos a p)); auto with zarith. + rewrite (Zmult_mod (Zpower_pos a p)); auto with zarith. case (Zpower_pos a p mod n); auto. intros p Rec n H1; rewrite <- Pplus_diag; auto. repeat rewrite Zpower_pos_is_exp; auto. repeat rewrite Rec; auto. - rewrite (Zmult_mod (Zpower_pos a p)); auto with zarith. + rewrite (Zmult_mod (Zpower_pos a p)); auto with zarith. case (Zpower_pos a p mod n); auto. unfold Zpower_pos; simpl; rewrite Zmult_1_r; auto with zarith. Qed. @@ -354,7 +354,7 @@ Proof. pattern p at 3; rewrite <- (Zpower_1_r p); rewrite <- Zpower_exp; try f_equal; auto with zarith. Qed. -Theorem rel_prime_Zpower_r: forall i p q, 0 < i -> +Theorem rel_prime_Zpower_r: forall i p q, 0 < i -> rel_prime p q -> rel_prime p (q^i). Proof. intros i p q Hi Hpq; generalize Hi; pattern i; apply natlike_ind; auto with zarith; clear i Hi. @@ -365,7 +365,7 @@ Proof. rewrite Zpower_0_r; apply rel_prime_sym; apply rel_prime_1. Qed. -Theorem rel_prime_Zpower: forall i j p q, 0 <= i -> 0 <= j -> +Theorem rel_prime_Zpower: forall i j p q, 0 <= i -> 0 <= j -> rel_prime p q -> rel_prime (p^i) (q^j). Proof. intros i j p q Hi; generalize Hi j p q; pattern i; apply natlike_ind; auto with zarith; clear i Hi j p q. @@ -379,7 +379,7 @@ Proof. rewrite Zpower_0_r; apply rel_prime_sym; apply rel_prime_1. Qed. -Theorem prime_power_prime: forall p q n, 0 <= n -> +Theorem prime_power_prime: forall p q n, 0 <= n -> prime p -> prime q -> (p | q^n) -> p = q. Proof. intros p q n Hn Hp Hq; pattern n; apply natlike_ind; auto; clear n Hn. @@ -442,15 +442,15 @@ Fixpoint Psquare (p: positive): positive := end. Definition Zsquare p := - match p with - | Z0 => Z0 - | Zpos p => Zpos (Psquare p) + match p with + | Z0 => Z0 + | Zpos p => Zpos (Psquare p) | Zneg p => Zpos (Psquare p) end. Theorem Psquare_correct: forall p, Psquare p = (p * p)%positive. Proof. - induction p; simpl; auto; f_equal; rewrite IHp. + induction p; simpl; auto; f_equal; rewrite IHp. apply trans_equal with (xO p + xO (p*p))%positive; auto. rewrite (Pplus_comm (xO p)); auto. rewrite Pmult_xI_permute_r; rewrite Pplus_assoc. diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v index 7ee8b9766..508e6601c 100644 --- a/theories/ZArith/Zpower.v +++ b/theories/ZArith/Zpower.v @@ -20,7 +20,7 @@ Infix "^" := Zpower : Z_scope. (** * Definition of powers over [Z]*) (** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary - integer (type [nat]) and [z] a signed integer (type [Z]) *) + integer (type [nat]) and [z] a signed integer (type [Z]) *) Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun x:Z => z * x) 1. @@ -83,12 +83,12 @@ Section Powers_of_2. (** For the powers of two, that will be widely used, a more direct calculus is possible. We will also prove some properties such as [(x:positive) x < 2^x] that are true for all integers bigger - than 2 but more difficult to prove and useless. *) + than 2 but more difficult to prove and useless. *) (** [shift n m] computes [2^n * m], or [m] shifted by [n] positions *) - Definition shift_nat (n:nat) (z:positive) := iter_nat n positive xO z. - Definition shift_pos (n z:positive) := iter_pos n positive xO z. + Definition shift_nat (n:nat) (z:positive) := iter_nat n positive xO z. + Definition shift_pos (n z:positive) := iter_pos n positive xO z. Definition shift (n:Z) (z:positive) := match n with | Z0 => z @@ -130,7 +130,7 @@ Section Powers_of_2. rewrite (shift_nat_correct n). omega. Qed. - + (** Second we show that [two_power_pos] and [two_power_nat] are the same *) Lemma shift_pos_nat : forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x. @@ -181,12 +181,12 @@ Section Powers_of_2. apply Zpower_pos_is_exp. Qed. - (** The exponentiation [z -> 2^z] for [z] a signed integer. + (** The exponentiation [z -> 2^z] for [z] a signed integer. For convenience, we assume that [2^z = 0] for all [z < 0] We could also define a inductive type [Log_result] with 3 contructors [ Zero | Pos positive -> | minus_infty] but it's more complexe and not so useful. *) - + Definition two_p (x:Z) := match x with | Z0 => 1 @@ -227,7 +227,7 @@ Section Powers_of_2. Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x. Proof. - intros; unfold Zsucc in |- *. + intros; unfold Zsucc in |- *. rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)). apply Zmult_comm. Qed. @@ -247,10 +247,10 @@ Section Powers_of_2. | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *; auto with zarith ] | assumption ]. - Qed. + Qed. Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y. - intros; omega. Qed. + intros; omega. Qed. End Powers_of_2. @@ -286,13 +286,13 @@ Section power_div_with_rest. let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p. Proof. intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1)); - rewrite (two_power_pos_nat p); elim (nat_of_P p); + rewrite (two_power_pos_nat p); elim (nat_of_P p); simpl in |- *; [ trivial with zarith | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *; - elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)); + elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)); destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z); - assumption ]. + assumption ]. Qed. Lemma Zdiv_rest_correct2 : @@ -327,7 +327,7 @@ Section power_div_with_rest. apply f_equal with (f := fun z:Z => z + r); do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc; - apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z); + apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z); omega | omega ] | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros; diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt.v index a97750d77..b845cf47a 100644 --- a/theories/ZArith/Zsqrt.v +++ b/theories/ZArith/Zsqrt.v @@ -119,7 +119,7 @@ Definition Zsqrt : | Zneg p => fun h => False_rec - {s : Z & + {s : Z & {r : Z | Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}} (h (refl_equal Datatypes.Gt)) @@ -199,7 +199,7 @@ Qed. Theorem Zsqrt_le: forall p q, 0 <= p <= q -> Zsqrt_plain p <= Zsqrt_plain q. Proof. - intros p q [H1 H2]; case Zle_lt_or_eq with (1:=H2); clear H2; intros H2; + intros p q [H1 H2]; case Zle_lt_or_eq with (1:=H2); clear H2; intros H2; [ | subst q; auto with zarith]. case (Zle_or_lt (Zsqrt_plain p) (Zsqrt_plain q)); auto; intros H3. assert (Hp: (0 <= Zsqrt_plain q)). diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v index 650c79745..32d6de19a 100644 --- a/theories/ZArith/Zwf.v +++ b/theories/ZArith/Zwf.v @@ -15,7 +15,7 @@ Open Local Scope Z_scope. (** Well-founded relations on Z. *) -(** We define the following family of relations on [Z x Z]: +(** We define the following family of relations on [Z x Z]: [x (Zwf c) y] iff [x < y & c <= y] *) diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v index 5edf68013..6ebdcb50a 100644 --- a/theories/ZArith/auxiliary.v +++ b/theories/ZArith/auxiliary.v @@ -25,7 +25,7 @@ Open Local Scope Z_scope. Theorem Zne_left : forall n m:Z, Zne n m -> Zne (n + - m) 0. Proof. intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1; - apply Zplus_reg_l with (- y); rewrite Zplus_opp_l; + apply Zplus_reg_l with (- y); rewrite Zplus_opp_l; rewrite Zplus_comm; trivial with arith. Qed. @@ -97,7 +97,7 @@ Proof. intros x y z H1 H2 H3; apply Zle_trans with (m := y * x); [ apply Zmult_gt_0_le_0_compat; assumption | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r; - apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt; + apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt; assumption ]. Qed. |