diff options
| author |  Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
|---|---|---|
| committer | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
| commit | 5b7eafd0f00a16d78f99a27f5c7d5a0de77dc7e6 (patch) | |
| tree | 631ad791a7685edafeb1fb2e8faeedc8379318ae /theories/Numbers/Natural | |
| parent | da178a880e3ace820b41d38b191d3785b82991f5 (diff) | |
Imported Upstream snapshot 8.3~beta0+13298
Diffstat (limited to 'theories/Numbers/Natural')
22 files changed, 2486 insertions, 2585 deletions
diff --git a/theories/Numbers/Natural/Abstract/NAdd.v b/theories/Numbers/Natural/Abstract/NAdd.v index 91ae5b70..9f0b54a6 100644 --- a/theories/Numbers/Natural/Abstract/NAdd.v +++ b/theories/Numbers/Natural/Abstract/NAdd.v @@ -8,74 +8,30 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NAdd.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Export NBase. -Module NAddPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NBasePropMod := NBasePropFunct NAxiomsMod. +Module NAddPropFunct (Import N : NAxiomsSig'). +Include NBasePropFunct N. -Open Local Scope NatScope. +(** For theorems about [add] that are both valid for [N] and [Z], see [NZAdd] *) +(** Now comes theorems valid for natural numbers but not for Z *) -Theorem add_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> n1 + m1 == n2 + m2. -Proof NZadd_wd. - -Theorem add_0_l : forall n : N, 0 + n == n. -Proof NZadd_0_l. - -Theorem add_succ_l : forall n m : N, (S n) + m == S (n + m). -Proof NZadd_succ_l. - -(** Theorems that are valid for both natural numbers and integers *) - -Theorem add_0_r : forall n : N, n + 0 == n. -Proof NZadd_0_r. - -Theorem add_succ_r : forall n m : N, n + S m == S (n + m). -Proof NZadd_succ_r. - -Theorem add_comm : forall n m : N, n + m == m + n. -Proof NZadd_comm. - -Theorem add_assoc : forall n m p : N, n + (m + p) == (n + m) + p. -Proof NZadd_assoc. - -Theorem add_shuffle1 : forall n m p q : N, (n + m) + (p + q) == (n + p) + (m + q). -Proof NZadd_shuffle1. - -Theorem add_shuffle2 : forall n m p q : N, (n + m) + (p + q) == (n + q) + (m + p). -Proof NZadd_shuffle2. - -Theorem add_1_l : forall n : N, 1 + n == S n. -Proof NZadd_1_l. - -Theorem add_1_r : forall n : N, n + 1 == S n. -Proof NZadd_1_r. - -Theorem add_cancel_l : forall n m p : N, p + n == p + m <-> n == m. -Proof NZadd_cancel_l. - -Theorem add_cancel_r : forall n m p : N, n + p == m + p <-> n == m. -Proof NZadd_cancel_r. - -(* Theorems that are valid for natural numbers but cannot be proved for Z *) - -Theorem eq_add_0 : forall n m : N, n + m == 0 <-> n == 0 /\ m == 0. +Theorem eq_add_0 : forall n m, n + m == 0 <-> n == 0 /\ m == 0. Proof. intros n m; induct n. -(* The next command does not work with the axiom add_0_l from NAddSig *) -rewrite add_0_l. intuition reflexivity. -intros n IH. rewrite add_succ_l. -setoid_replace (S (n + m) == 0) with False using relation iff by +nzsimpl; intuition. +intros n IH. nzsimpl. +setoid_replace (S (n + m) == 0) with False by (apply -> neg_false; apply neq_succ_0). -setoid_replace (S n == 0) with False using relation iff by +setoid_replace (S n == 0) with False by (apply -> neg_false; apply neq_succ_0). tauto. Qed. Theorem eq_add_succ : - forall n m : N, (exists p : N, n + m == S p) <-> - (exists n' : N, n == S n') \/ (exists m' : N, m == S m'). + forall n m, (exists p, n + m == S p) <-> + (exists n', n == S n') \/ (exists m', m == S m'). Proof. intros n m; cases n. split; intro H. @@ -88,11 +44,11 @@ left; now exists n. exists (n + m); now rewrite add_succ_l. Qed. -Theorem eq_add_1 : forall n m : N, +Theorem eq_add_1 : forall n m, n + m == 1 -> n == 1 /\ m == 0 \/ n == 0 /\ m == 1. Proof. intros n m H. -assert (H1 : exists p : N, n + m == S p) by now exists 0. +assert (H1 : exists p, n + m == S p) by now exists 0. apply -> eq_add_succ in H1. destruct H1 as [[n' H1] | [m' H1]]. left. rewrite H1 in H; rewrite add_succ_l in H; apply succ_inj in H. apply -> eq_add_0 in H. destruct H as [H2 H3]; rewrite H2 in H1; now split. @@ -100,7 +56,7 @@ right. rewrite H1 in H; rewrite add_succ_r in H; apply succ_inj in H. apply -> eq_add_0 in H. destruct H as [H2 H3]; rewrite H3 in H1; now split. Qed. -Theorem succ_add_discr : forall n m : N, m ~= S (n + m). +Theorem succ_add_discr : forall n m, m ~= S (n + m). Proof. intro n; induct m. apply neq_sym. apply neq_succ_0. @@ -108,49 +64,18 @@ intros m IH H. apply succ_inj in H. rewrite add_succ_r in H. unfold not in IH; now apply IH. Qed. -Theorem add_pred_l : forall n m : N, n ~= 0 -> P n + m == P (n + m). +Theorem add_pred_l : forall n m, n ~= 0 -> P n + m == P (n + m). Proof. intros n m; cases n. intro H; now elim H. intros n IH; rewrite add_succ_l; now do 2 rewrite pred_succ. Qed. -Theorem add_pred_r : forall n m : N, m ~= 0 -> n + P m == P (n + m). +Theorem add_pred_r : forall n m, m ~= 0 -> n + P m == P (n + m). Proof. intros n m H; rewrite (add_comm n (P m)); rewrite (add_comm n m); now apply add_pred_l. Qed. -(* One could define n <= m as exists p : N, p + n == m. Then we have -dichotomy: - -forall n m : N, n <= m \/ m <= n, - -i.e., - -forall n m : N, (exists p : N, p + n == m) \/ (exists p : N, p + m == n) (1) - -We will need (1) in the proof of induction principle for integers -constructed as pairs of natural numbers. The formula (1) can be proved -using properties of order and truncated subtraction. Thus, p would be -m - n or n - m and (1) would hold by theorem sub_add from Sub.v -depending on whether n <= m or m <= n. However, in proving induction -for integers constructed from natural numbers we do not need to -require implementations of order and sub; it is enough to prove (1) -here. *) - -Theorem add_dichotomy : - forall n m : N, (exists p : N, p + n == m) \/ (exists p : N, p + m == n). -Proof. -intros n m; induct n. -left; exists m; apply add_0_r. -intros n IH. -destruct IH as [[p H] | [p H]]. -destruct (zero_or_succ p) as [H1 | [p' H1]]; rewrite H1 in H. -rewrite add_0_l in H. right; exists (S 0); rewrite H; rewrite add_succ_l; now rewrite add_0_l. -left; exists p'; rewrite add_succ_r; now rewrite add_succ_l in H. -right; exists (S p). rewrite add_succ_l; now rewrite H. -Qed. - End NAddPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NAddOrder.v b/theories/Numbers/Natural/Abstract/NAddOrder.v index 7024fd00..0ce04e54 100644 --- a/theories/Numbers/Natural/Abstract/NAddOrder.v +++ b/theories/Numbers/Natural/Abstract/NAddOrder.v @@ -8,107 +8,41 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NAddOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NOrder. -Module NAddOrderPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NOrderPropMod := NOrderPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NAddOrderPropFunct (Import N : NAxiomsSig'). +Include NOrderPropFunct N. -Theorem add_lt_mono_l : forall n m p : N, n < m <-> p + n < p + m. -Proof NZadd_lt_mono_l. +(** Theorems true for natural numbers, not for integers *) -Theorem add_lt_mono_r : forall n m p : N, n < m <-> n + p < m + p. -Proof NZadd_lt_mono_r. - -Theorem add_lt_mono : forall n m p q : N, n < m -> p < q -> n + p < m + q. -Proof NZadd_lt_mono. - -Theorem add_le_mono_l : forall n m p : N, n <= m <-> p + n <= p + m. -Proof NZadd_le_mono_l. - -Theorem add_le_mono_r : forall n m p : N, n <= m <-> n + p <= m + p. -Proof NZadd_le_mono_r. - -Theorem add_le_mono : forall n m p q : N, n <= m -> p <= q -> n + p <= m + q. -Proof NZadd_le_mono. - -Theorem add_lt_le_mono : forall n m p q : N, n < m -> p <= q -> n + p < m + q. -Proof NZadd_lt_le_mono. - -Theorem add_le_lt_mono : forall n m p q : N, n <= m -> p < q -> n + p < m + q. -Proof NZadd_le_lt_mono. - -Theorem add_pos_pos : forall n m : N, 0 < n -> 0 < m -> 0 < n + m. -Proof NZadd_pos_pos. - -Theorem lt_add_pos_l : forall n m : N, 0 < n -> m < n + m. -Proof NZlt_add_pos_l. - -Theorem lt_add_pos_r : forall n m : N, 0 < n -> m < m + n. -Proof NZlt_add_pos_r. - -Theorem le_lt_add_lt : forall n m p q : N, n <= m -> p + m < q + n -> p < q. -Proof NZle_lt_add_lt. - -Theorem lt_le_add_lt : forall n m p q : N, n < m -> p + m <= q + n -> p < q. -Proof NZlt_le_add_lt. - -Theorem le_le_add_le : forall n m p q : N, n <= m -> p + m <= q + n -> p <= q. -Proof NZle_le_add_le. - -Theorem add_lt_cases : forall n m p q : N, n + m < p + q -> n < p \/ m < q. -Proof NZadd_lt_cases. - -Theorem add_le_cases : forall n m p q : N, n + m <= p + q -> n <= p \/ m <= q. -Proof NZadd_le_cases. - -Theorem add_pos_cases : forall n m : N, 0 < n + m -> 0 < n \/ 0 < m. -Proof NZadd_pos_cases. - -(* Theorems true for natural numbers *) - -Theorem le_add_r : forall n m : N, n <= n + m. +Theorem le_add_r : forall n m, n <= n + m. Proof. intro n; induct m. rewrite add_0_r; now apply eq_le_incl. intros m IH. rewrite add_succ_r; now apply le_le_succ_r. Qed. -Theorem lt_lt_add_r : forall n m p : N, n < m -> n < m + p. +Theorem lt_lt_add_r : forall n m p, n < m -> n < m + p. Proof. intros n m p H; rewrite <- (add_0_r n). apply add_lt_le_mono; [assumption | apply le_0_l]. Qed. -Theorem lt_lt_add_l : forall n m p : N, n < m -> n < p + m. +Theorem lt_lt_add_l : forall n m p, n < m -> n < p + m. Proof. intros n m p; rewrite add_comm; apply lt_lt_add_r. Qed. -Theorem add_pos_l : forall n m : N, 0 < n -> 0 < n + m. +Theorem add_pos_l : forall n m, 0 < n -> 0 < n + m. Proof. -intros; apply NZadd_pos_nonneg. assumption. apply le_0_l. +intros; apply add_pos_nonneg. assumption. apply le_0_l. Qed. -Theorem add_pos_r : forall n m : N, 0 < m -> 0 < n + m. -Proof. -intros; apply NZadd_nonneg_pos. apply le_0_l. assumption. -Qed. - -(* The following property is used to prove the correctness of the -definition of order on integers constructed from pairs of natural numbers *) - -Theorem add_lt_repl_pair : forall n m n' m' u v : N, - n + u < m + v -> n + m' == n' + m -> n' + u < m' + v. +Theorem add_pos_r : forall n m, 0 < m -> 0 < n + m. Proof. -intros n m n' m' u v H1 H2. -symmetry in H2. assert (H3 : n' + m <= n + m') by now apply eq_le_incl. -pose proof (add_lt_le_mono _ _ _ _ H1 H3) as H4. -rewrite (add_shuffle2 n u), (add_shuffle1 m v), (add_comm m n) in H4. -do 2 rewrite <- add_assoc in H4. do 2 apply <- add_lt_mono_l in H4. -now rewrite (add_comm n' u), (add_comm m' v). +intros; apply add_nonneg_pos. apply le_0_l. assumption. Qed. End NAddOrderPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NAxioms.v b/theories/Numbers/Natural/Abstract/NAxioms.v index 750cc977..42016ab1 100644 --- a/theories/Numbers/Natural/Abstract/NAxioms.v +++ b/theories/Numbers/Natural/Abstract/NAxioms.v @@ -8,64 +8,32 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NZAxioms. Set Implicit Arguments. -Module Type NAxiomsSig. -Declare Module Export NZOrdAxiomsMod : NZOrdAxiomsSig. +Module Type NAxioms (Import NZ : NZDomainSig'). -Delimit Scope NatScope with Nat. -Notation N := NZ. -Notation Neq := NZeq. -Notation N0 := NZ0. -Notation N1 := (NZsucc NZ0). -Notation S := NZsucc. -Notation P := NZpred. -Notation add := NZadd. -Notation mul := NZmul. -Notation sub := NZsub. -Notation lt := NZlt. -Notation le := NZle. -Notation min := NZmin. -Notation max := NZmax. -Notation "x == y" := (Neq x y) (at level 70) : NatScope. -Notation "x ~= y" := (~ Neq x y) (at level 70) : NatScope. -Notation "0" := NZ0 : NatScope. -Notation "1" := (NZsucc NZ0) : NatScope. -Notation "x + y" := (NZadd x y) : NatScope. -Notation "x - y" := (NZsub x y) : NatScope. -Notation "x * y" := (NZmul x y) : NatScope. -Notation "x < y" := (NZlt x y) : NatScope. -Notation "x <= y" := (NZle x y) : NatScope. -Notation "x > y" := (NZlt y x) (only parsing) : NatScope. -Notation "x >= y" := (NZle y x) (only parsing) : NatScope. - -Open Local Scope NatScope. +Axiom pred_0 : P 0 == 0. -Parameter Inline recursion : forall A : Type, A -> (N -> A -> A) -> N -> A. +Parameter Inline recursion : forall A : Type, A -> (t -> A -> A) -> t -> A. Implicit Arguments recursion [A]. -Axiom pred_0 : P 0 == 0. - -Axiom recursion_wd : forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : N -> A -> A, fun2_eq Neq Aeq Aeq f f' -> - forall x x' : N, x == x' -> - Aeq (recursion a f x) (recursion a' f' x'). +Declare Instance recursion_wd (A : Type) (Aeq : relation A) : + Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A). Axiom recursion_0 : - forall (A : Type) (a : A) (f : N -> A -> A), recursion a f 0 = a. + forall (A : Type) (a : A) (f : t -> A -> A), recursion a f 0 = a. Axiom recursion_succ : - forall (A : Type) (Aeq : relation A) (a : A) (f : N -> A -> A), - Aeq a a -> fun2_wd Neq Aeq Aeq f -> - forall n : N, Aeq (recursion a f (S n)) (f n (recursion a f n)). + forall (A : Type) (Aeq : relation A) (a : A) (f : t -> A -> A), + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> + forall n, Aeq (recursion a f (S n)) (f n (recursion a f n)). -(*Axiom dep_rec : - forall A : N -> Type, A 0 -> (forall n : N, A n -> A (S n)) -> forall n : N, A n.*) +End NAxioms. -End NAxiomsSig. +Module Type NAxiomsSig := NZOrdAxiomsSig <+ NAxioms. +Module Type NAxiomsSig' := NZOrdAxiomsSig' <+ NAxioms. diff --git a/theories/Numbers/Natural/Abstract/NBase.v b/theories/Numbers/Natural/Abstract/NBase.v index 85e2c2ab..842f4bcf 100644 --- a/theories/Numbers/Natural/Abstract/NBase.v +++ b/theories/Numbers/Natural/Abstract/NBase.v @@ -8,135 +8,78 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NBase.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Export Decidable. Require Export NAxioms. -Require Import NZMulOrder. (* The last property functor on NZ, which subsumes all others *) +Require Import NZProperties. -Module NBasePropFunct (Import NAxiomsMod : NAxiomsSig). +Module NBasePropFunct (Import N : NAxiomsSig'). +(** First, we import all known facts about both natural numbers and integers. *) +Include NZPropFunct N. -Open Local Scope NatScope. - -(* We call the last property functor on NZ, which includes all the previous -ones, to get all properties of NZ at once. This way we will include them -only one time. *) - -Module Export NZMulOrderMod := NZMulOrderPropFunct NZOrdAxiomsMod. - -(* Here we probably need to re-prove all axioms declared in NAxioms.v to -make sure that the definitions like N, S and add are unfolded in them, -since unfolding is done only inside a functor. In fact, we'll do it in the -files that prove the corresponding properties. In those files, we will also -rename properties proved in NZ files by removing NZ from their names. In -this way, one only has to consult, for example, NAdd.v to see all -available properties for add, i.e., one does not have to go to NAxioms.v -for axioms and NZAdd.v for theorems. *) - -Theorem succ_wd : forall n1 n2 : N, n1 == n2 -> S n1 == S n2. -Proof NZsucc_wd. - -Theorem pred_wd : forall n1 n2 : N, n1 == n2 -> P n1 == P n2. -Proof NZpred_wd. - -Theorem pred_succ : forall n : N, P (S n) == n. -Proof NZpred_succ. - -Theorem pred_0 : P 0 == 0. -Proof pred_0. - -Theorem Neq_refl : forall n : N, n == n. -Proof (proj1 NZeq_equiv). - -Theorem Neq_sym : forall n m : N, n == m -> m == n. -Proof (proj2 (proj2 NZeq_equiv)). - -Theorem Neq_trans : forall n m p : N, n == m -> m == p -> n == p. -Proof (proj1 (proj2 NZeq_equiv)). - -Theorem neq_sym : forall n m : N, n ~= m -> m ~= n. -Proof NZneq_sym. - -Theorem succ_inj : forall n1 n2 : N, S n1 == S n2 -> n1 == n2. -Proof NZsucc_inj. - -Theorem succ_inj_wd : forall n1 n2 : N, S n1 == S n2 <-> n1 == n2. -Proof NZsucc_inj_wd. - -Theorem succ_inj_wd_neg : forall n m : N, S n ~= S m <-> n ~= m. -Proof NZsucc_inj_wd_neg. - -(* Decidability and stability of equality was proved only in NZOrder, but -since it does not mention order, we'll put it here *) - -Theorem eq_dec : forall n m : N, decidable (n == m). -Proof NZeq_dec. - -Theorem eq_dne : forall n m : N, ~ ~ n == m <-> n == m. -Proof NZeq_dne. - -(* Now we prove that the successor of a number is not zero by defining a +(** We prove that the successor of a number is not zero by defining a function (by recursion) that maps 0 to false and the successor to true *) -Definition if_zero (A : Set) (a b : A) (n : N) : A := +Definition if_zero (A : Type) (a b : A) (n : N.t) : A := recursion a (fun _ _ => b) n. -Add Parametric Morphism (A : Set) : (if_zero A) with signature (@eq _ ==> @eq _ ==> Neq ==> @eq _) as if_zero_wd. +Implicit Arguments if_zero [A]. + +Instance if_zero_wd (A : Type) : + Proper (Logic.eq ==> Logic.eq ==> N.eq ==> Logic.eq) (@if_zero A). Proof. -intros; unfold if_zero. apply recursion_wd with (Aeq := (@eq A)). -reflexivity. unfold fun2_eq; now intros. assumption. +intros; unfold if_zero. +repeat red; intros. apply recursion_wd; auto. repeat red; auto. Qed. -Theorem if_zero_0 : forall (A : Set) (a b : A), if_zero A a b 0 = a. +Theorem if_zero_0 : forall (A : Type) (a b : A), if_zero a b 0 = a. Proof. unfold if_zero; intros; now rewrite recursion_0. Qed. -Theorem if_zero_succ : forall (A : Set) (a b : A) (n : N), if_zero A a b (S n) = b. +Theorem if_zero_succ : + forall (A : Type) (a b : A) (n : N.t), if_zero a b (S n) = b. Proof. intros; unfold if_zero. -now rewrite (@recursion_succ A (@eq A)); [| | unfold fun2_wd; now intros]. +now rewrite recursion_succ. Qed. -Implicit Arguments if_zero [A]. - -Theorem neq_succ_0 : forall n : N, S n ~= 0. +Theorem neq_succ_0 : forall n, S n ~= 0. Proof. intros n H. -assert (true = false); [| discriminate]. -replace true with (if_zero false true (S n)) by apply if_zero_succ. -pattern false at 2; replace false with (if_zero false true 0) by apply if_zero_0. -now rewrite H. +generalize (Logic.eq_refl (if_zero false true 0)). +rewrite <- H at 1. rewrite if_zero_0, if_zero_succ; discriminate. Qed. -Theorem neq_0_succ : forall n : N, 0 ~= S n. +Theorem neq_0_succ : forall n, 0 ~= S n. Proof. intro n; apply neq_sym; apply neq_succ_0. Qed. -(* Next, we show that all numbers are nonnegative and recover regular induction -from the bidirectional induction on NZ *) +(** Next, we show that all numbers are nonnegative and recover regular + induction from the bidirectional induction on NZ *) -Theorem le_0_l : forall n : N, 0 <= n. +Theorem le_0_l : forall n, 0 <= n. Proof. -NZinduct n. -now apply NZeq_le_incl. +nzinduct n. +now apply eq_le_incl. intro n; split. -apply NZle_le_succ_r. -intro H; apply -> NZle_succ_r in H; destruct H as [H | H]. +apply le_le_succ_r. +intro H; apply -> le_succ_r in H; destruct H as [H | H]. assumption. symmetry in H; false_hyp H neq_succ_0. Qed. Theorem induction : - forall A : N -> Prop, predicate_wd Neq A -> - A 0 -> (forall n : N, A n -> A (S n)) -> forall n : N, A n. + forall A : N.t -> Prop, Proper (N.eq==>iff) A -> + A 0 -> (forall n, A n -> A (S n)) -> forall n, A n. Proof. -intros A A_wd A0 AS n; apply NZright_induction with 0; try assumption. +intros A A_wd A0 AS n; apply right_induction with 0; try assumption. intros; auto; apply le_0_l. apply le_0_l. Qed. -(* The theorems NZinduction, NZcentral_induction and the tactic NZinduct +(** The theorems [bi_induction], [central_induction] and the tactic [nzinduct] refer to bidirectional induction, which is not useful on natural numbers. Therefore, we define a new induction tactic for natural numbers. We do not have to call "Declare Left Step" and "Declare Right Step" @@ -146,8 +89,8 @@ from NZ. *) Ltac induct n := induction_maker n ltac:(apply induction). Theorem case_analysis : - forall A : N -> Prop, predicate_wd Neq A -> - A 0 -> (forall n : N, A (S n)) -> forall n : N, A n. + forall A : N.t -> Prop, Proper (N.eq==>iff) A -> + A 0 -> (forall n, A (S n)) -> forall n, A n. Proof. intros; apply induction; auto. Qed. @@ -173,7 +116,7 @@ now left. intro n; right; now exists n. Qed. -Theorem eq_pred_0 : forall n : N, P n == 0 <-> n == 0 \/ n == 1. +Theorem eq_pred_0 : forall n, P n == 0 <-> n == 0 \/ n == 1. Proof. cases n. rewrite pred_0. setoid_replace (0 == 1) with False using relation iff. tauto. @@ -184,34 +127,29 @@ setoid_replace (S n == 0) with False using relation iff by rewrite succ_inj_wd. tauto. Qed. -Theorem succ_pred : forall n : N, n ~= 0 -> S (P n) == n. +Theorem succ_pred : forall n, n ~= 0 -> S (P n) == n. Proof. cases n. -intro H; elimtype False; now apply H. +intro H; exfalso; now apply H. intros; now rewrite pred_succ. Qed. -Theorem pred_inj : forall n m : N, n ~= 0 -> m ~= 0 -> P n == P m -> n == m. +Theorem pred_inj : forall n m, n ~= 0 -> m ~= 0 -> P n == P m -> n == m. Proof. intros n m; cases n. -intros H; elimtype False; now apply H. +intros H; exfalso; now apply H. intros n _; cases m. -intros H; elimtype False; now apply H. +intros H; exfalso; now apply H. intros m H2 H3. do 2 rewrite pred_succ in H3. now rewrite H3. Qed. -(* The following induction principle is useful for reasoning about, e.g., +(** The following induction principle is useful for reasoning about, e.g., Fibonacci numbers *) Section PairInduction. -Variable A : N -> Prop. -Hypothesis A_wd : predicate_wd Neq A. - -Add Morphism A with signature Neq ==> iff as A_morph. -Proof. -exact A_wd. -Qed. +Variable A : N.t -> Prop. +Hypothesis A_wd : Proper (N.eq==>iff) A. Theorem pair_induction : A 0 -> A 1 -> @@ -224,18 +162,12 @@ Qed. End PairInduction. -(*Ltac pair_induct n := induction_maker n ltac:(apply pair_induction).*) +(** The following is useful for reasoning about, e.g., Ackermann function *) -(* The following is useful for reasoning about, e.g., Ackermann function *) Section TwoDimensionalInduction. -Variable R : N -> N -> Prop. -Hypothesis R_wd : relation_wd Neq Neq R. - -Add Morphism R with signature Neq ==> Neq ==> iff as R_morph. -Proof. -exact R_wd. -Qed. +Variable R : N.t -> N.t -> Prop. +Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem two_dim_induction : R 0 0 -> @@ -251,26 +183,16 @@ Qed. End TwoDimensionalInduction. -(*Ltac two_dim_induct n m := - try intros until n; - try intros until m; - pattern n, m; apply two_dim_induction; clear n m; - [solve_relation_wd | | | ].*) Section DoubleInduction. -Variable R : N -> N -> Prop. -Hypothesis R_wd : relation_wd Neq Neq R. - -Add Morphism R with signature Neq ==> Neq ==> iff as R_morph1. -Proof. -exact R_wd. -Qed. +Variable R : N.t -> N.t -> Prop. +Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem double_induction : - (forall m : N, R 0 m) -> - (forall n : N, R (S n) 0) -> - (forall n m : N, R n m -> R (S n) (S m)) -> forall n m : N, R n m. + (forall m, R 0 m) -> + (forall n, R (S n) 0) -> + (forall n m, R n m -> R (S n) (S m)) -> forall n m, R n m. Proof. intros H1 H2 H3; induct n; auto. intros n H; cases m; auto. diff --git a/theories/Numbers/Natural/Abstract/NDefOps.v b/theories/Numbers/Natural/Abstract/NDefOps.v index 0a8f5f1e..22eb2cb3 100644 --- a/theories/Numbers/Natural/Abstract/NDefOps.v +++ b/theories/Numbers/Natural/Abstract/NDefOps.v @@ -8,45 +8,47 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NDefOps.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Import Bool. (* To get the orb and negb function *) +Require Import RelationPairs. Require Export NStrongRec. -Module NdefOpsPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NStrongRecPropMod := NStrongRecPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NdefOpsPropFunct (Import N : NAxiomsSig'). +Include NStrongRecPropFunct N. (*****************************************************) (** Addition *) -Definition def_add (x y : N) := recursion y (fun _ p => S p) x. +Definition def_add (x y : N.t) := recursion y (fun _ => S) x. -Infix Local "++" := def_add (at level 50, left associativity). +Local Infix "+++" := def_add (at level 50, left associativity). -Add Morphism def_add with signature Neq ==> Neq ==> Neq as def_add_wd. +Instance def_add_prewd : Proper (N.eq==>N.eq==>N.eq) (fun _ => S). Proof. -unfold def_add. -intros x x' Exx' y y' Eyy'. -apply recursion_wd with (Aeq := Neq). -assumption. -unfold fun2_eq; intros _ _ _ p p' Epp'; now rewrite Epp'. -assumption. +intros _ _ _ p p' Epp'; now rewrite Epp'. +Qed. + +Instance def_add_wd : Proper (N.eq ==> N.eq ==> N.eq) def_add. +Proof. +intros x x' Exx' y y' Eyy'. unfold def_add. +(* TODO: why rewrite Exx' don't work here (or verrrry slowly) ? *) +apply recursion_wd with (Aeq := N.eq); auto with *. +apply def_add_prewd. Qed. -Theorem def_add_0_l : forall y : N, 0 ++ y == y. +Theorem def_add_0_l : forall y, 0 +++ y == y. Proof. intro y. unfold def_add. now rewrite recursion_0. Qed. -Theorem def_add_succ_l : forall x y : N, S x ++ y == S (x ++ y). +Theorem def_add_succ_l : forall x y, S x +++ y == S (x +++ y). Proof. intros x y; unfold def_add. -rewrite (@recursion_succ N Neq); try reflexivity. -unfold fun2_wd. intros _ _ _ m1 m2 H2. now rewrite H2. +rewrite recursion_succ; auto with *. Qed. -Theorem def_add_add : forall n m : N, n ++ m == n + m. +Theorem def_add_add : forall n m, n +++ m == n + m. Proof. intros n m; induct n. now rewrite def_add_0_l, add_0_l. @@ -56,42 +58,37 @@ Qed. (*****************************************************) (** Multiplication *) -Definition def_mul (x y : N) := recursion 0 (fun _ p => p ++ x) y. +Definition def_mul (x y : N.t) := recursion 0 (fun _ p => p +++ x) y. -Infix Local "**" := def_mul (at level 40, left associativity). +Local Infix "**" := def_mul (at level 40, left associativity). -Lemma def_mul_step_wd : forall x : N, fun2_wd Neq Neq Neq (fun _ p => def_add p x). +Instance def_mul_prewd : + Proper (N.eq==>N.eq==>N.eq==>N.eq) (fun x _ p => p +++ x). Proof. -unfold fun2_wd. intros. now apply def_add_wd. +repeat red; intros; now apply def_add_wd. Qed. -Lemma def_mul_step_equal : - forall x x' : N, x == x' -> - fun2_eq Neq Neq Neq (fun _ p => def_add p x) (fun x p => def_add p x'). -Proof. -unfold fun2_eq; intros; apply def_add_wd; assumption. -Qed. - -Add Morphism def_mul with signature Neq ==> Neq ==> Neq as def_mul_wd. +Instance def_mul_wd : Proper (N.eq ==> N.eq ==> N.eq) def_mul. Proof. unfold def_mul. intros x x' Exx' y y' Eyy'. -apply recursion_wd with (Aeq := Neq). -reflexivity. apply def_mul_step_equal. assumption. assumption. +apply recursion_wd; auto with *. +now apply def_mul_prewd. Qed. -Theorem def_mul_0_r : forall x : N, x ** 0 == 0. +Theorem def_mul_0_r : forall x, x ** 0 == 0. Proof. intro. unfold def_mul. now rewrite recursion_0. Qed. -Theorem def_mul_succ_r : forall x y : N, x ** S y == x ** y ++ x. +Theorem def_mul_succ_r : forall x y, x ** S y == x ** y +++ x. Proof. intros x y; unfold def_mul. -now rewrite (@recursion_succ N Neq); [| apply def_mul_step_wd |]. +rewrite recursion_succ; auto with *. +now apply def_mul_prewd. Qed. -Theorem def_mul_mul : forall n m : N, n ** m == n * m. +Theorem def_mul_mul : forall n m, n ** m == n * m. Proof. intros n m; induct m. now rewrite def_mul_0_r, mul_0_r. @@ -101,120 +98,99 @@ Qed. (*****************************************************) (** Order *) -Definition def_ltb (m : N) : N -> bool := +Definition ltb (m : N.t) : N.t -> bool := recursion (if_zero false true) - (fun _ f => fun n => recursion false (fun n' _ => f n') n) + (fun _ f n => recursion false (fun n' _ => f n') n) m. -Infix Local "<<" := def_ltb (at level 70, no associativity). - -Lemma lt_base_wd : fun_wd Neq (@eq bool) (if_zero false true). -unfold fun_wd; intros; now apply if_zero_wd. -Qed. +Local Infix "<<" := ltb (at level 70, no associativity). -Lemma lt_step_wd : -fun2_wd Neq (fun_eq Neq (@eq bool)) (fun_eq Neq (@eq bool)) - (fun _ f => fun n => recursion false (fun n' _ => f n') n). +Instance ltb_prewd1 : Proper (N.eq==>Logic.eq) (if_zero false true). Proof. -unfold fun2_wd, fun_eq. -intros x x' Exx' f f' Eff' y y' Eyy'. -apply recursion_wd with (Aeq := @eq bool). -reflexivity. -unfold fun2_eq; intros; now apply Eff'. -assumption. +red; intros; apply if_zero_wd; auto. Qed. -Lemma lt_curry_wd : - forall m m' : N, m == m' -> fun_eq Neq (@eq bool) (def_ltb m) (def_ltb m'). +Instance ltb_prewd2 : Proper (N.eq==>(N.eq==>Logic.eq)==>N.eq==>Logic.eq) + (fun _ f n => recursion false (fun n' _ => f n') n). Proof. -unfold def_ltb. -intros m m' Emm'. -apply recursion_wd with (Aeq := fun_eq Neq (@eq bool)). -apply lt_base_wd. -apply lt_step_wd. -assumption. +repeat red; intros; simpl. +apply recursion_wd; auto with *. +repeat red; auto. Qed. -Add Morphism def_ltb with signature Neq ==> Neq ==> (@eq bool) as def_ltb_wd. +Instance ltb_wd : Proper (N.eq ==> N.eq ==> Logic.eq) ltb. Proof. -intros; now apply lt_curry_wd. +unfold ltb. +intros n n' Hn m m' Hm. +apply f_equiv; auto with *. +apply recursion_wd; auto; [ apply ltb_prewd1 | apply ltb_prewd2 ]. Qed. -Theorem def_ltb_base : forall n : N, 0 << n = if_zero false true n. +Theorem ltb_base : forall n, 0 << n = if_zero false true n. Proof. -intro n; unfold def_ltb; now rewrite recursion_0. +intro n; unfold ltb; now rewrite recursion_0. Qed. -Theorem def_ltb_step : - forall m n : N, S m << n = recursion false (fun n' _ => m << n') n. +Theorem ltb_step : + forall m n, S m << n = recursion false (fun n' _ => m << n') n. Proof. -intros m n; unfold def_ltb. -pose proof - (@recursion_succ - (N -> bool) - (fun_eq Neq (@eq bool)) - (if_zero false true) - (fun _ f => fun n => recursion false (fun n' _ => f n') n) - lt_base_wd - lt_step_wd - m n n) as H. -now rewrite H. +intros m n; unfold ltb at 1. +apply f_equiv; auto with *. +rewrite recursion_succ by (apply ltb_prewd1||apply ltb_prewd2). +fold (ltb m). +repeat red; intros. apply recursion_wd; auto. +repeat red; intros; now apply ltb_wd. Qed. (* Above, we rewrite applications of function. Is it possible to rewrite functions themselves, i.e., rewrite (recursion lt_base lt_step (S n)) to lt_step n (recursion lt_base lt_step n)? *) -Theorem def_ltb_0 : forall n : N, n << 0 = false. +Theorem ltb_0 : forall n, n << 0 = false. Proof. cases n. -rewrite def_ltb_base; now rewrite if_zero_0. -intro n; rewrite def_ltb_step. now rewrite recursion_0. +rewrite ltb_base; now rewrite if_zero_0. +intro n; rewrite ltb_step. now rewrite recursion_0. Qed. -Theorem def_ltb_0_succ : forall n : N, 0 << S n = true. +Theorem ltb_0_succ : forall n, 0 << S n = true. Proof. -intro n; rewrite def_ltb_base; now rewrite if_zero_succ. +intro n; rewrite ltb_base; now rewrite if_zero_succ. Qed. -Theorem succ_def_ltb_mono : forall n m : N, (S n << S m) = (n << m). +Theorem succ_ltb_mono : forall n m, (S n << S m) = (n << m). Proof. intros n m. -rewrite def_ltb_step. rewrite (@recursion_succ bool (@eq bool)); try reflexivity. -unfold fun2_wd; intros; now apply def_ltb_wd. +rewrite ltb_step. rewrite recursion_succ; try reflexivity. +repeat red; intros; now apply ltb_wd. Qed. -Theorem def_ltb_lt : forall n m : N, n << m = true <-> n < m. +Theorem ltb_lt : forall n m, n << m = true <-> n < m. Proof. double_induct n m. cases m. -rewrite def_ltb_0. split; intro H; [discriminate H | false_hyp H nlt_0_r]. -intro n. rewrite def_ltb_0_succ. split; intro; [apply lt_0_succ | reflexivity]. -intro n. rewrite def_ltb_0. split; intro H; [discriminate | false_hyp H nlt_0_r]. -intros n m. rewrite succ_def_ltb_mono. now rewrite <- succ_lt_mono. +rewrite ltb_0. split; intro H; [discriminate H | false_hyp H nlt_0_r]. +intro n. rewrite ltb_0_succ. split; intro; [apply lt_0_succ | reflexivity]. +intro n. rewrite ltb_0. split; intro H; [discriminate | false_hyp H nlt_0_r]. +intros n m. rewrite succ_ltb_mono. now rewrite <- succ_lt_mono. +Qed. + +Theorem ltb_ge : forall n m, n << m = false <-> n >= m. +Proof. +intros. rewrite <- not_true_iff_false, ltb_lt. apply nlt_ge. Qed. -(* (*****************************************************) (** Even *) -Definition even (x : N) := recursion true (fun _ p => negb p) x. - -Lemma even_step_wd : fun2_wd Neq (@eq bool) (@eq bool) (fun x p => if p then false else true). -Proof. -unfold fun2_wd. -intros x x' Exx' b b' Ebb'. -unfold eq_bool; destruct b; destruct b'; now simpl. -Qed. +Definition even (x : N.t) := recursion true (fun _ p => negb p) x. -Add Morphism even with signature Neq ==> (@eq bool) as even_wd. +Instance even_wd : Proper (N.eq==>Logic.eq) even. Proof. -unfold even; intros. -apply recursion_wd with (A := bool) (Aeq := (@eq bool)). -now unfold eq_bool. -unfold fun2_eq. intros _ _ _ b b' Ebb'. unfold eq_bool; destruct b; destruct b'; now simpl. -assumption. +intros n n' Hn. unfold even. +apply recursion_wd; auto. +congruence. Qed. Theorem even_0 : even 0 = true. @@ -223,76 +199,281 @@ unfold even. now rewrite recursion_0. Qed. -Theorem even_succ : forall x : N, even (S x) = negb (even x). +Theorem even_succ : forall x, even (S x) = negb (even x). Proof. unfold even. -intro x; rewrite (recursion_succ (@eq bool)); try reflexivity. -unfold fun2_wd. -intros _ _ _ b b' Ebb'. destruct b; destruct b'; now simpl. +intro x; rewrite recursion_succ; try reflexivity. +congruence. Qed. (*****************************************************) (** Division by 2 *) -Definition half_aux (x : N) : N * N := - recursion (0, 0) (fun _ p => let (x1, x2) := p in ((S x2, x1))) x. +Local Notation "a <= b <= c" := (a<=b /\ b<=c). +Local Notation "a <= b < c" := (a<=b /\ b<c). +Local Notation "a < b <= c" := (a<b /\ b<=c). +Local Notation "a < b < c" := (a<b /\ b<c). +Local Notation "2" := (S 1). -Definition half (x : N) := snd (half_aux x). +Definition half_aux (x : N.t) : N.t * N.t := + recursion (0, 0) (fun _ p => let (x1, x2) := p in (S x2, x1)) x. -Definition E2 := prod_rel Neq Neq. +Definition half (x : N.t) := snd (half_aux x). -Add Relation (prod N N) E2 -reflexivity proved by (prod_rel_refl N N Neq Neq E_equiv E_equiv) -symmetry proved by (prod_rel_sym N N Neq Neq E_equiv E_equiv) -transitivity proved by (prod_rel_trans N N Neq Neq E_equiv E_equiv) -as E2_rel. +Instance half_aux_wd : Proper (N.eq ==> N.eq*N.eq) half_aux. +Proof. +intros x x' Hx. unfold half_aux. +apply recursion_wd; auto with *. +intros y y' Hy (u,v) (u',v') (Hu,Hv). compute in *. +rewrite Hu, Hv; auto with *. +Qed. -Lemma half_step_wd: fun2_wd Neq E2 E2 (fun _ p => let (x1, x2) := p in ((S x2, x1))). +Instance half_wd : Proper (N.eq==>N.eq) half. Proof. -unfold fun2_wd, E2, prod_rel. -intros _ _ _ p1 p2 [H1 H2]. -destruct p1; destruct p2; simpl in *. -now split; [rewrite H2 |]. +intros x x' Hx. unfold half. rewrite Hx; auto with *. Qed. -Add Morphism half with signature Neq ==> Neq as half_wd. +Lemma half_aux_0 : half_aux 0 = (0,0). Proof. -unfold half. -assert (H: forall x y, x == y -> E2 (half_aux x) (half_aux y)). -intros x y Exy; unfold half_aux; apply recursion_wd with (Aeq := E2); unfold E2. -unfold E2. -unfold prod_rel; simpl; now split. -unfold fun2_eq, prod_rel; simpl. -intros _ _ _ p1 p2; destruct p1; destruct p2; simpl. -intros [H1 H2]; split; [rewrite H2 | assumption]. reflexivity. assumption. -unfold E2, prod_rel in H. intros x y Exy; apply H in Exy. -exact (proj2 Exy). +unfold half_aux. rewrite recursion_0; auto. Qed. +Lemma half_aux_succ : forall x, + half_aux (S x) = (S (snd (half_aux x)), fst (half_aux x)). +Proof. +intros. +remember (half_aux x) as h. +destruct h as (f,s); simpl in *. +unfold half_aux in *. +rewrite recursion_succ, <- Heqh; simpl; auto. +repeat red; intros; subst; auto. +Qed. + +Theorem half_aux_spec : forall n, + n == fst (half_aux n) + snd (half_aux n). +Proof. +apply induction. +intros x x' Hx. setoid_rewrite Hx; auto with *. +rewrite half_aux_0; simpl; rewrite add_0_l; auto with *. +intros. +rewrite half_aux_succ. simpl. +rewrite add_succ_l, add_comm; auto. +apply succ_wd; auto. +Qed. + +Theorem half_aux_spec2 : forall n, + fst (half_aux n) == snd (half_aux n) \/ + fst (half_aux n) == S (snd (half_aux n)). +Proof. +apply induction. +intros x x' Hx. setoid_rewrite Hx; auto with *. +rewrite half_aux_0; simpl. auto with *. +intros. +rewrite half_aux_succ; simpl. +destruct H; auto with *. +right; apply succ_wd; auto with *. +Qed. + +Theorem half_0 : half 0 == 0. +Proof. +unfold half. rewrite half_aux_0; simpl; auto with *. +Qed. + +Theorem half_1 : half 1 == 0. +Proof. +unfold half. rewrite half_aux_succ, half_aux_0; simpl; auto with *. +Qed. + +Theorem half_double : forall n, + n == 2 * half n \/ n == 1 + 2 * half n. +Proof. +intros. unfold half. +nzsimpl. +destruct (half_aux_spec2 n) as [H|H]; [left|right]. +rewrite <- H at 1. apply half_aux_spec. +rewrite <- add_succ_l. rewrite <- H at 1. apply half_aux_spec. +Qed. + +Theorem half_upper_bound : forall n, 2 * half n <= n. +Proof. +intros. +destruct (half_double n) as [E|E]; rewrite E at 2. +apply le_refl. +nzsimpl. +apply le_le_succ_r, le_refl. +Qed. + +Theorem half_lower_bound : forall n, n <= 1 + 2 * half n. +Proof. +intros. +destruct (half_double n) as [E|E]; rewrite E at 1. +nzsimpl. +apply le_le_succ_r, le_refl. +apply le_refl. +Qed. + +Theorem half_nz : forall n, 1 < n -> 0 < half n. +Proof. +intros n LT. +assert (LE : 0 <= half n) by apply le_0_l. +le_elim LE; auto. +destruct (half_double n) as [E|E]; + rewrite <- LE, mul_0_r, ?add_0_r in E; rewrite E in LT. +destruct (nlt_0_r _ LT). +rewrite <- succ_lt_mono in LT. +destruct (nlt_0_r _ LT). +Qed. + +Theorem half_decrease : forall n, 0 < n -> half n < n. +Proof. +intros n LT. +destruct (half_double n) as [E|E]; rewrite E at 2; + rewrite ?mul_succ_l, ?mul_0_l, ?add_0_l, ?add_assoc. +rewrite <- add_0_l at 1. +rewrite <- add_lt_mono_r. +assert (LE : 0 <= half n) by apply le_0_l. +le_elim LE; auto. +rewrite <- LE, mul_0_r in E. rewrite E in LT. destruct (nlt_0_r _ LT). +rewrite <- add_0_l at 1. +rewrite <- add_lt_mono_r. +rewrite add_succ_l. apply lt_0_succ. +Qed. + + +(*****************************************************) +(** Power *) + +Definition pow (n m : N.t) := recursion 1 (fun _ r => n*r) m. + +Local Infix "^^" := pow (at level 30, right associativity). + +Instance pow_prewd : + Proper (N.eq==>N.eq==>N.eq==>N.eq) (fun n _ r => n*r). +Proof. +intros n n' Hn x x' Hx y y' Hy. rewrite Hn, Hy; auto with *. +Qed. + +Instance pow_wd : Proper (N.eq==>N.eq==>N.eq) pow. +Proof. +intros n n' Hn m m' Hm. unfold pow. +apply recursion_wd; auto with *. +now apply pow_prewd. +Qed. + +Lemma pow_0 : forall n, n^^0 == 1. +Proof. +intros. unfold pow. rewrite recursion_0. auto with *. +Qed. + +Lemma pow_succ : forall n m, n^^(S m) == n*(n^^m). +Proof. +intros. unfold pow. rewrite recursion_succ; auto with *. +now apply pow_prewd. +Qed. + + (*****************************************************) (** Logarithm for the base 2 *) -Definition log (x : N) : N := +Definition log (x : N.t) : N.t := strong_rec 0 - (fun x g => - if (e x 0) then 0 - else if (e x 1) then 0 + (fun g x => + if x << 2 then 0 else S (g (half x))) x. -Add Morphism log with signature Neq ==> Neq as log_wd. +Instance log_prewd : + Proper ((N.eq==>N.eq)==>N.eq==>N.eq) + (fun g x => if x<<2 then 0 else S (g (half x))). +Proof. +intros g g' Hg n n' Hn. +rewrite Hn. +destruct (n' << 2); auto with *. +apply succ_wd. +apply Hg. rewrite Hn; auto with *. +Qed. + +Instance log_wd : Proper (N.eq==>N.eq) log. Proof. intros x x' Exx'. unfold log. -apply strong_rec_wd with (Aeq := Neq); try (reflexivity || assumption). -unfold fun2_eq. intros y y' Eyy' g g' Egg'. -assert (H : e y 0 = e y' 0); [now apply e_wd|]. -rewrite <- H; clear H. -assert (H : e y 1 = e y' 1); [now apply e_wd|]. -rewrite <- H; clear H. -assert (H : S (g (half y)) == S (g' (half y'))); -[apply succ_wd; apply Egg'; now apply half_wd|]. -now destruct (e y 0); destruct (e y 1). +apply strong_rec_wd; auto with *. +apply log_prewd. Qed. + +Lemma log_good_step : forall n h1 h2, + (forall m, m < n -> h1 m == h2 m) -> + (if n << 2 then 0 else S (h1 (half n))) == + (if n << 2 then 0 else S (h2 (half n))). +Proof. +intros n h1 h2 E. +destruct (n<<2) as [ ]_eqn:H. +auto with *. +apply succ_wd, E, half_decrease. +rewrite <- not_true_iff_false, ltb_lt, nlt_ge, le_succ_l in H. +apply lt_succ_l; auto. +Qed. +Hint Resolve log_good_step. + +Theorem log_init : forall n, n < 2 -> log n == 0. +Proof. +intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *. +replace (n << 2) with true; auto with *. +symmetry. now rewrite ltb_lt. +Qed. + +Theorem log_step : forall n, 2 <= n -> log n == S (log (half n)). +Proof. +intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *. +replace (n << 2) with false; auto with *. +symmetry. rewrite <- not_true_iff_false, ltb_lt, nlt_ge; auto. +Qed. + +Theorem pow2_log : forall n, 0 < n -> half n < 2^^(log n) <= n. +Proof. +intro n; generalize (le_refl n). set (k:=n) at -2. clearbody k. +revert k. pattern n. apply induction; clear n. +intros n n' Hn; setoid_rewrite Hn; auto with *. +intros k Hk1 Hk2. + le_elim Hk1. destruct (nlt_0_r _ Hk1). + rewrite Hk1 in Hk2. destruct (nlt_0_r _ Hk2). + +intros n IH k Hk1 Hk2. +destruct (lt_ge_cases k 2) as [LT|LE]. +(* base *) +rewrite log_init, pow_0 by auto. +rewrite <- le_succ_l in Hk2. +le_elim Hk2. +rewrite <- nle_gt, le_succ_l in LT. destruct LT; auto. +rewrite <- Hk2. +rewrite half_1; auto using lt_0_1, le_refl. +(* step *) +rewrite log_step, pow_succ by auto. +rewrite le_succ_l in LE. +destruct (IH (half k)) as (IH1,IH2). + rewrite <- lt_succ_r. apply lt_le_trans with k; auto. + now apply half_decrease. + apply half_nz; auto. +set (K:=2^^log (half k)) in *; clearbody K. +split. +rewrite <- le_succ_l in IH1. +apply mul_le_mono_l with (p:=2) in IH1. +eapply lt_le_trans; eauto. +nzsimpl. +rewrite lt_succ_r. +eapply le_trans; [ eapply half_lower_bound | ]. +nzsimpl; apply le_refl. +eapply le_trans; [ | eapply half_upper_bound ]. +apply mul_le_mono_l; auto. +Qed. + +(** Later: + +Theorem log_mul : forall n m, 0 < n -> 0 < m -> + log (n*m) == log n + log m. + +Theorem log_pow2 : forall n, log (2^^n) = n. + *) + End NdefOpsPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NDiv.v b/theories/Numbers/Natural/Abstract/NDiv.v new file mode 100644 index 00000000..0cb5665a --- /dev/null +++ b/theories/Numbers/Natural/Abstract/NDiv.v @@ -0,0 +1,239 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(** Euclidean Division *) + +Require Import NAxioms NProperties NZDiv. + +Module Type NDivSpecific (Import N : NAxiomsSig')(Import DM : DivMod' N). + Axiom mod_upper_bound : forall a b, b ~= 0 -> a mod b < b. +End NDivSpecific. + +Module Type NDivSig := NAxiomsSig <+ DivMod <+ NZDivCommon <+ NDivSpecific. +Module Type NDivSig' := NAxiomsSig' <+ DivMod' <+ NZDivCommon <+ NDivSpecific. + +Module NDivPropFunct (Import N : NDivSig')(Import NP : NPropSig N). + +(** We benefit from what already exists for NZ *) + + Module ND <: NZDiv N. + Definition div := div. + Definition modulo := modulo. + Definition div_wd := div_wd. + Definition mod_wd := mod_wd. + Definition div_mod := div_mod. + Lemma mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b. + Proof. split. apply le_0_l. apply mod_upper_bound. order. Qed. + End ND. + Module Import NZDivP := NZDivPropFunct N NP ND. + + Ltac auto' := try rewrite <- neq_0_lt_0; auto using le_0_l. + +(** Let's now state again theorems, but without useless hypothesis. *) + +(** Uniqueness theorems *) + +Theorem div_mod_unique : + forall b q1 q2 r1 r2, r1<b -> r2<b -> + b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. +Proof. intros. apply div_mod_unique with b; auto'. Qed. + +Theorem div_unique: + forall a b q r, r<b -> a == b*q + r -> q == a/b. +Proof. intros; apply div_unique with r; auto'. Qed. + +Theorem mod_unique: + forall a b q r, r<b -> a == b*q + r -> r == a mod b. +Proof. intros. apply mod_unique with q; auto'. Qed. + +(** A division by itself returns 1 *) + +Lemma div_same : forall a, a~=0 -> a/a == 1. +Proof. intros. apply div_same; auto'. Qed. + +Lemma mod_same : forall a, a~=0 -> a mod a == 0. +Proof. intros. apply mod_same; auto'. Qed. + +(** A division of a small number by a bigger one yields zero. *) + +Theorem div_small: forall a b, a<b -> a/b == 0. +Proof. intros. apply div_small; auto'. Qed. + +(** Same situation, in term of modulo: *) + +Theorem mod_small: forall a b, a<b -> a mod b == a. +Proof. intros. apply mod_small; auto'. Qed. + +(** * Basic values of divisions and modulo. *) + +Lemma div_0_l: forall a, a~=0 -> 0/a == 0. +Proof. intros. apply div_0_l; auto'. Qed. + +Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. +Proof. intros. apply mod_0_l; auto'. Qed. + +Lemma div_1_r: forall a, a/1 == a. +Proof. intros. apply div_1_r; auto'. Qed. + +Lemma mod_1_r: forall a, a mod 1 == 0. +Proof. intros. apply mod_1_r; auto'. Qed. + +Lemma div_1_l: forall a, 1<a -> 1/a == 0. +Proof. exact div_1_l. Qed. + +Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1. +Proof. exact mod_1_l. Qed. + +Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. +Proof. intros. apply div_mul; auto'. Qed. + +Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. +Proof. intros. apply mod_mul; auto'. Qed. + + +(** * Order results about mod and div *) + +(** A modulo cannot grow beyond its starting point. *) + +Theorem mod_le: forall a b, b~=0 -> a mod b <= a. +Proof. intros. apply mod_le; auto'. Qed. + +Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b. +Proof. exact div_str_pos. Qed. + +Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> a<b). +Proof. intros. apply div_small_iff; auto'. Qed. + +Lemma mod_small_iff : forall a b, b~=0 -> (a mod b == a <-> a<b). +Proof. intros. apply mod_small_iff; auto'. Qed. + +Lemma div_str_pos_iff : forall a b, b~=0 -> (0<a/b <-> b<=a). +Proof. intros. apply div_str_pos_iff; auto'. Qed. + + +(** As soon as the divisor is strictly greater than 1, + the division is strictly decreasing. *) + +Lemma div_lt : forall a b, 0<a -> 1<b -> a/b < a. +Proof. exact div_lt. Qed. + +(** [le] is compatible with a positive division. *) + +Lemma div_le_mono : forall a b c, c~=0 -> a<=b -> a/c <= b/c. +Proof. intros. apply div_le_mono; auto'. Qed. + +Lemma mul_div_le : forall a b, b~=0 -> b*(a/b) <= a. +Proof. intros. apply mul_div_le; auto'. Qed. + +Lemma mul_succ_div_gt: forall a b, b~=0 -> a < b*(S (a/b)). +Proof. intros; apply mul_succ_div_gt; auto'. Qed. + +(** The previous inequality is exact iff the modulo is zero. *) + +Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). +Proof. intros. apply div_exact; auto'. Qed. + +(** Some additionnal inequalities about div. *) + +Theorem div_lt_upper_bound: + forall a b q, b~=0 -> a < b*q -> a/b < q. +Proof. intros. apply div_lt_upper_bound; auto'. Qed. + +Theorem div_le_upper_bound: + forall a b q, b~=0 -> a <= b*q -> a/b <= q. +Proof. intros; apply div_le_upper_bound; auto'. Qed. + +Theorem div_le_lower_bound: + forall a b q, b~=0 -> b*q <= a -> q <= a/b. +Proof. intros; apply div_le_lower_bound; auto'. Qed. + +(** A division respects opposite monotonicity for the divisor *) + +Lemma div_le_compat_l: forall p q r, 0<q<=r -> p/r <= p/q. +Proof. intros. apply div_le_compat_l. auto'. auto. Qed. + +(** * Relations between usual operations and mod and div *) + +Lemma mod_add : forall a b c, c~=0 -> + (a + b * c) mod c == a mod c. +Proof. intros. apply mod_add; auto'. Qed. + +Lemma div_add : forall a b c, c~=0 -> + (a + b * c) / c == a / c + b. +Proof. intros. apply div_add; auto'. Qed. + +Lemma div_add_l: forall a b c, b~=0 -> + (a * b + c) / b == a + c / b. +Proof. intros. apply div_add_l; auto'. Qed. + +(** Cancellations. *) + +Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> + (a*c)/(b*c) == a/b. +Proof. intros. apply div_mul_cancel_r; auto'. Qed. + +Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> + (c*a)/(c*b) == a/b. +Proof. intros. apply div_mul_cancel_l; auto'. Qed. + +Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 -> + (a*c) mod (b*c) == (a mod b) * c. +Proof. intros. apply mul_mod_distr_r; auto'. Qed. + +Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 -> + (c*a) mod (c*b) == c * (a mod b). +Proof. intros. apply mul_mod_distr_l; auto'. Qed. + +(** Operations modulo. *) + +Theorem mod_mod: forall a n, n~=0 -> + (a mod n) mod n == a mod n. +Proof. intros. apply mod_mod; auto'. Qed. + +Lemma mul_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)*b) mod n == (a*b) mod n. +Proof. intros. apply mul_mod_idemp_l; auto'. Qed. + +Lemma mul_mod_idemp_r : forall a b n, n~=0 -> + (a*(b mod n)) mod n == (a*b) mod n. +Proof. intros. apply mul_mod_idemp_r; auto'. Qed. + +Theorem mul_mod: forall a b n, n~=0 -> + (a * b) mod n == ((a mod n) * (b mod n)) mod n. +Proof. intros. apply mul_mod; auto'. Qed. + +Lemma add_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)+b) mod n == (a+b) mod n. +Proof. intros. apply add_mod_idemp_l; auto'. Qed. + +Lemma add_mod_idemp_r : forall a b n, n~=0 -> + (a+(b mod n)) mod n == (a+b) mod n. +Proof. intros. apply add_mod_idemp_r; auto'. Qed. + +Theorem add_mod: forall a b n, n~=0 -> + (a+b) mod n == (a mod n + b mod n) mod n. +Proof. intros. apply add_mod; auto'. Qed. + +Lemma div_div : forall a b c, b~=0 -> c~=0 -> + (a/b)/c == a/(b*c). +Proof. intros. apply div_div; auto'. Qed. + +(** A last inequality: *) + +Theorem div_mul_le: + forall a b c, b~=0 -> c*(a/b) <= (c*a)/b. +Proof. intros. apply div_mul_le; auto'. Qed. + +(** mod is related to divisibility *) + +Lemma mod_divides : forall a b, b~=0 -> + (a mod b == 0 <-> exists c, a == b*c). +Proof. intros. apply mod_divides; auto'. Qed. + +End NDivPropFunct. + diff --git a/theories/Numbers/Natural/Abstract/NIso.v b/theories/Numbers/Natural/Abstract/NIso.v index f6ccf3db..47bf38cb 100644 --- a/theories/Numbers/Natural/Abstract/NIso.v +++ b/theories/Numbers/Natural/Abstract/NIso.v @@ -8,51 +8,41 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NIso.v 10934 2008-05-15 21:58:20Z letouzey $ i*) +(*i $Id$ i*) Require Import NBase. -Module Homomorphism (NAxiomsMod1 NAxiomsMod2 : NAxiomsSig). +Module Homomorphism (N1 N2 : NAxiomsSig). -Module NBasePropMod2 := NBasePropFunct NAxiomsMod2. +Local Notation "n == m" := (N2.eq n m) (at level 70, no associativity). -Notation Local N1 := NAxiomsMod1.N. -Notation Local N2 := NAxiomsMod2.N. -Notation Local Eq1 := NAxiomsMod1.Neq. -Notation Local Eq2 := NAxiomsMod2.Neq. -Notation Local O1 := NAxiomsMod1.N0. -Notation Local O2 := NAxiomsMod2.N0. -Notation Local S1 := NAxiomsMod1.S. -Notation Local S2 := NAxiomsMod2.S. -Notation Local "n == m" := (Eq2 n m) (at level 70, no associativity). +Definition homomorphism (f : N1.t -> N2.t) : Prop := + f N1.zero == N2.zero /\ forall n, f (N1.succ n) == N2.succ (f n). -Definition homomorphism (f : N1 -> N2) : Prop := - f O1 == O2 /\ forall n : N1, f (S1 n) == S2 (f n). +Definition natural_isomorphism : N1.t -> N2.t := + N1.recursion N2.zero (fun (n : N1.t) (p : N2.t) => N2.succ p). -Definition natural_isomorphism : N1 -> N2 := - NAxiomsMod1.recursion O2 (fun (n : N1) (p : N2) => S2 p). - -Add Morphism natural_isomorphism with signature Eq1 ==> Eq2 as natural_isomorphism_wd. +Instance natural_isomorphism_wd : Proper (N1.eq ==> N2.eq) natural_isomorphism. Proof. unfold natural_isomorphism. intros n m Eqxy. -apply NAxiomsMod1.recursion_wd with (Aeq := Eq2). +apply N1.recursion_wd. reflexivity. -unfold fun2_eq. intros _ _ _ y' y'' H. now apply NBasePropMod2.succ_wd. +intros _ _ _ y' y'' H. now apply N2.succ_wd. assumption. Qed. -Theorem natural_isomorphism_0 : natural_isomorphism O1 == O2. +Theorem natural_isomorphism_0 : natural_isomorphism N1.zero == N2.zero. Proof. -unfold natural_isomorphism; now rewrite NAxiomsMod1.recursion_0. +unfold natural_isomorphism; now rewrite N1.recursion_0. Qed. Theorem natural_isomorphism_succ : - forall n : N1, natural_isomorphism (S1 n) == S2 (natural_isomorphism n). + forall n : N1.t, natural_isomorphism (N1.succ n) == N2.succ (natural_isomorphism n). Proof. unfold natural_isomorphism. -intro n. now rewrite (@NAxiomsMod1.recursion_succ N2 NAxiomsMod2.Neq) ; -[ | | unfold fun2_wd; intros; apply NBasePropMod2.succ_wd]. +intro n. rewrite N1.recursion_succ; auto with *. +repeat red; intros. apply N2.succ_wd; auto. Qed. Theorem hom_nat_iso : homomorphism natural_isomorphism. @@ -63,23 +53,20 @@ Qed. End Homomorphism. -Module Inverse (NAxiomsMod1 NAxiomsMod2 : NAxiomsSig). +Module Inverse (N1 N2 : NAxiomsSig). -Module Import NBasePropMod1 := NBasePropFunct NAxiomsMod1. +Module Import NBasePropMod1 := NBasePropFunct N1. (* This makes the tactic induct available. Since it is taken from (NBasePropFunct NAxiomsMod1), it refers to induction on N1. *) -Module Hom12 := Homomorphism NAxiomsMod1 NAxiomsMod2. -Module Hom21 := Homomorphism NAxiomsMod2 NAxiomsMod1. - -Notation Local N1 := NAxiomsMod1.N. -Notation Local N2 := NAxiomsMod2.N. -Notation Local h12 := Hom12.natural_isomorphism. -Notation Local h21 := Hom21.natural_isomorphism. +Module Hom12 := Homomorphism N1 N2. +Module Hom21 := Homomorphism N2 N1. -Notation Local "n == m" := (NAxiomsMod1.Neq n m) (at level 70, no associativity). +Local Notation h12 := Hom12.natural_isomorphism. +Local Notation h21 := Hom21.natural_isomorphism. +Local Notation "n == m" := (N1.eq n m) (at level 70, no associativity). -Lemma inverse_nat_iso : forall n : N1, h21 (h12 n) == n. +Lemma inverse_nat_iso : forall n : N1.t, h21 (h12 n) == n. Proof. induct n. now rewrite Hom12.natural_isomorphism_0, Hom21.natural_isomorphism_0. @@ -89,25 +76,20 @@ Qed. End Inverse. -Module Isomorphism (NAxiomsMod1 NAxiomsMod2 : NAxiomsSig). - -Module Hom12 := Homomorphism NAxiomsMod1 NAxiomsMod2. -Module Hom21 := Homomorphism NAxiomsMod2 NAxiomsMod1. +Module Isomorphism (N1 N2 : NAxiomsSig). -Module Inverse12 := Inverse NAxiomsMod1 NAxiomsMod2. -Module Inverse21 := Inverse NAxiomsMod2 NAxiomsMod1. +Module Hom12 := Homomorphism N1 N2. +Module Hom21 := Homomorphism N2 N1. +Module Inverse12 := Inverse N1 N2. +Module Inverse21 := Inverse N2 N1. -Notation Local N1 := NAxiomsMod1.N. -Notation Local N2 := NAxiomsMod2.N. -Notation Local Eq1 := NAxiomsMod1.Neq. -Notation Local Eq2 := NAxiomsMod2.Neq. -Notation Local h12 := Hom12.natural_isomorphism. -Notation Local h21 := Hom21.natural_isomorphism. +Local Notation h12 := Hom12.natural_isomorphism. +Local Notation h21 := Hom21.natural_isomorphism. -Definition isomorphism (f1 : N1 -> N2) (f2 : N2 -> N1) : Prop := +Definition isomorphism (f1 : N1.t -> N2.t) (f2 : N2.t -> N1.t) : Prop := Hom12.homomorphism f1 /\ Hom21.homomorphism f2 /\ - forall n : N1, Eq1 (f2 (f1 n)) n /\ - forall n : N2, Eq2 (f1 (f2 n)) n. + forall n, N1.eq (f2 (f1 n)) n /\ + forall n, N2.eq (f1 (f2 n)) n. Theorem iso_nat_iso : isomorphism h12 h21. Proof. diff --git a/theories/Numbers/Natural/Abstract/NMul.v b/theories/Numbers/Natural/Abstract/NMul.v deleted file mode 100644 index 0b00f689..00000000 --- a/theories/Numbers/Natural/Abstract/NMul.v +++ /dev/null @@ -1,87 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(* Evgeny Makarov, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: NMul.v 11040 2008-06-03 00:04:16Z letouzey $ i*) - -Require Export NAdd. - -Module NMulPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NAddPropMod := NAddPropFunct NAxiomsMod. -Open Local Scope NatScope. - -Theorem mul_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> n1 * m1 == n2 * m2. -Proof NZmul_wd. - -Theorem mul_0_l : forall n : N, 0 * n == 0. -Proof NZmul_0_l. - -Theorem mul_succ_l : forall n m : N, (S n) * m == n * m + m. -Proof NZmul_succ_l. - -(** Theorems that are valid for both natural numbers and integers *) - -Theorem mul_0_r : forall n, n * 0 == 0. -Proof NZmul_0_r. - -Theorem mul_succ_r : forall n m, n * (S m) == n * m + n. -Proof NZmul_succ_r. - -Theorem mul_comm : forall n m : N, n * m == m * n. -Proof NZmul_comm. - -Theorem mul_add_distr_r : forall n m p : N, (n + m) * p == n * p + m * p. -Proof NZmul_add_distr_r. - -Theorem mul_add_distr_l : forall n m p : N, n * (m + p) == n * m + n * p. -Proof NZmul_add_distr_l. - -Theorem mul_assoc : forall n m p : N, n * (m * p) == (n * m) * p. -Proof NZmul_assoc. - -Theorem mul_1_l : forall n : N, 1 * n == n. -Proof NZmul_1_l. - -Theorem mul_1_r : forall n : N, n * 1 == n. -Proof NZmul_1_r. - -(* Theorems that cannot be proved in NZMul *) - -(* In proving the correctness of the definition of multiplication on -integers constructed from pairs of natural numbers, we'll need the -following fact about natural numbers: - -a * n + u == a * m + v -> n + m' == n' + m -> a * n' + u = a * m' + v - -Here n + m' == n' + m expresses equality of integers (n, m) and (n', m'), -since a pair (a, b) of natural numbers represents the integer a - b. On -integers, the formula above could be proved by moving a * m to the left, -factoring out a and replacing n - m by n' - m'. However, the formula is -required in the process of constructing integers, so it has to be proved -for natural numbers, where terms cannot be moved from one side of an -equation to the other. The proof uses the cancellation laws add_cancel_l -and add_cancel_r. *) - -Theorem add_mul_repl_pair : forall a n m n' m' u v : N, - a * n + u == a * m + v -> n + m' == n' + m -> a * n' + u == a * m' + v. -Proof. -intros a n m n' m' u v H1 H2. -apply (@NZmul_wd a a) in H2; [| reflexivity]. -do 2 rewrite mul_add_distr_l in H2. symmetry in H2. -pose proof (NZadd_wd _ _ H1 _ _ H2) as H3. -rewrite (add_shuffle1 (a * m)), (add_comm (a * m) (a * n)) in H3. -do 2 rewrite <- add_assoc in H3. apply -> add_cancel_l in H3. -rewrite (add_assoc u), (add_comm (a * m)) in H3. -apply -> add_cancel_r in H3. -now rewrite (add_comm (a * n') u), (add_comm (a * m') v). -Qed. - -End NMulPropFunct. - diff --git a/theories/Numbers/Natural/Abstract/NMulOrder.v b/theories/Numbers/Natural/Abstract/NMulOrder.v index aa21fb50..a2162b13 100644 --- a/theories/Numbers/Natural/Abstract/NMulOrder.v +++ b/theories/Numbers/Natural/Abstract/NMulOrder.v @@ -8,122 +8,71 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NMulOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NAddOrder. -Module NMulOrderPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NAddOrderPropMod := NAddOrderPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NMulOrderPropFunct (Import N : NAxiomsSig'). +Include NAddOrderPropFunct N. -Theorem mul_lt_pred : - forall p q n m : N, S p == q -> (p * n < p * m <-> q * n + m < q * m + n). -Proof NZmul_lt_pred. +(** Theorems that are either not valid on Z or have different proofs + on N and Z *) -Theorem mul_lt_mono_pos_l : forall p n m : N, 0 < p -> (n < m <-> p * n < p * m). -Proof NZmul_lt_mono_pos_l. - -Theorem mul_lt_mono_pos_r : forall p n m : N, 0 < p -> (n < m <-> n * p < m * p). -Proof NZmul_lt_mono_pos_r. - -Theorem mul_cancel_l : forall n m p : N, p ~= 0 -> (p * n == p * m <-> n == m). -Proof NZmul_cancel_l. - -Theorem mul_cancel_r : forall n m p : N, p ~= 0 -> (n * p == m * p <-> n == m). -Proof NZmul_cancel_r. - -Theorem mul_id_l : forall n m : N, m ~= 0 -> (n * m == m <-> n == 1). -Proof NZmul_id_l. - -Theorem mul_id_r : forall n m : N, n ~= 0 -> (n * m == n <-> m == 1). -Proof NZmul_id_r. - -Theorem mul_le_mono_pos_l : forall n m p : N, 0 < p -> (n <= m <-> p * n <= p * m). -Proof NZmul_le_mono_pos_l. - -Theorem mul_le_mono_pos_r : forall n m p : N, 0 < p -> (n <= m <-> n * p <= m * p). -Proof NZmul_le_mono_pos_r. - -Theorem mul_pos_pos : forall n m : N, 0 < n -> 0 < m -> 0 < n * m. -Proof NZmul_pos_pos. - -Theorem lt_1_mul_pos : forall n m : N, 1 < n -> 0 < m -> 1 < n * m. -Proof NZlt_1_mul_pos. - -Theorem eq_mul_0 : forall n m : N, n * m == 0 <-> n == 0 \/ m == 0. -Proof NZeq_mul_0. - -Theorem neq_mul_0 : forall n m : N, n ~= 0 /\ m ~= 0 <-> n * m ~= 0. -Proof NZneq_mul_0. - -Theorem eq_square_0 : forall n : N, n * n == 0 <-> n == 0. -Proof NZeq_square_0. - -Theorem eq_mul_0_l : forall n m : N, n * m == 0 -> m ~= 0 -> n == 0. -Proof NZeq_mul_0_l. - -Theorem eq_mul_0_r : forall n m : N, n * m == 0 -> n ~= 0 -> m == 0. -Proof NZeq_mul_0_r. - -Theorem square_lt_mono : forall n m : N, n < m <-> n * n < m * m. +Theorem square_lt_mono : forall n m, n < m <-> n * n < m * m. Proof. intros n m; split; intro; -[apply NZsquare_lt_mono_nonneg | apply NZsquare_lt_simpl_nonneg]; +[apply square_lt_mono_nonneg | apply square_lt_simpl_nonneg]; try assumption; apply le_0_l. Qed. -Theorem square_le_mono : forall n m : N, n <= m <-> n * n <= m * m. +Theorem square_le_mono : forall n m, n <= m <-> n * n <= m * m. Proof. intros n m; split; intro; -[apply NZsquare_le_mono_nonneg | apply NZsquare_le_simpl_nonneg]; +[apply square_le_mono_nonneg | apply square_le_simpl_nonneg]; try assumption; apply le_0_l. Qed. -Theorem mul_2_mono_l : forall n m : N, n < m -> 1 + (1 + 1) * n < (1 + 1) * m. -Proof NZmul_2_mono_l. - -(* Theorems that are either not valid on Z or have different proofs on N and Z *) - -Theorem mul_le_mono_l : forall n m p : N, n <= m -> p * n <= p * m. +Theorem mul_le_mono_l : forall n m p, n <= m -> p * n <= p * m. Proof. -intros; apply NZmul_le_mono_nonneg_l. apply le_0_l. assumption. +intros; apply mul_le_mono_nonneg_l. apply le_0_l. assumption. Qed. -Theorem mul_le_mono_r : forall n m p : N, n <= m -> n * p <= m * p. +Theorem mul_le_mono_r : forall n m p, n <= m -> n * p <= m * p. Proof. -intros; apply NZmul_le_mono_nonneg_r. apply le_0_l. assumption. +intros; apply mul_le_mono_nonneg_r. apply le_0_l. assumption. Qed. -Theorem mul_lt_mono : forall n m p q : N, n < m -> p < q -> n * p < m * q. +Theorem mul_lt_mono : forall n m p q, n < m -> p < q -> n * p < m * q. Proof. -intros; apply NZmul_lt_mono_nonneg; try assumption; apply le_0_l. +intros; apply mul_lt_mono_nonneg; try assumption; apply le_0_l. Qed. -Theorem mul_le_mono : forall n m p q : N, n <= m -> p <= q -> n * p <= m * q. +Theorem mul_le_mono : forall n m p q, n <= m -> p <= q -> n * p <= m * q. Proof. -intros; apply NZmul_le_mono_nonneg; try assumption; apply le_0_l. +intros; apply mul_le_mono_nonneg; try assumption; apply le_0_l. Qed. -Theorem lt_0_mul : forall n m : N, n * m > 0 <-> n > 0 /\ m > 0. +Theorem lt_0_mul' : forall n m, n * m > 0 <-> n > 0 /\ m > 0. Proof. intros n m; split; [intro H | intros [H1 H2]]. -apply -> NZlt_0_mul in H. destruct H as [[H1 H2] | [H1 H2]]. now split. false_hyp H1 nlt_0_r. -now apply NZmul_pos_pos. +apply -> lt_0_mul in H. destruct H as [[H1 H2] | [H1 H2]]. now split. + false_hyp H1 nlt_0_r. +now apply mul_pos_pos. Qed. -Notation mul_pos := lt_0_mul (only parsing). +Notation mul_pos := lt_0_mul' (only parsing). -Theorem eq_mul_1 : forall n m : N, n * m == 1 <-> n == 1 /\ m == 1. +Theorem eq_mul_1 : forall n m, n * m == 1 <-> n == 1 /\ m == 1. Proof. intros n m. split; [| intros [H1 H2]; now rewrite H1, H2, mul_1_l]. -intro H; destruct (NZlt_trichotomy n 1) as [H1 | [H1 | H1]]. +intro H; destruct (lt_trichotomy n 1) as [H1 | [H1 | H1]]. apply -> lt_1_r in H1. rewrite H1, mul_0_l in H. false_hyp H neq_0_succ. rewrite H1, mul_1_l in H; now split. destruct (eq_0_gt_0_cases m) as [H2 | H2]. rewrite H2, mul_0_r in H; false_hyp H neq_0_succ. apply -> (mul_lt_mono_pos_r m) in H1; [| assumption]. rewrite mul_1_l in H1. -assert (H3 : 1 < n * m) by now apply (lt_1_l 0 m). +assert (H3 : 1 < n * m) by now apply (lt_1_l m). rewrite H in H3; false_hyp H3 lt_irrefl. Qed. diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v index 15aed7ab..090c02ec 100644 --- a/theories/Numbers/Natural/Abstract/NOrder.v +++ b/theories/Numbers/Natural/Abstract/NOrder.v @@ -8,355 +8,62 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NOrder.v 11282 2008-07-28 11:51:53Z msozeau $ i*) +(*i $Id$ i*) -Require Export NMul. +Require Export NAdd. -Module NOrderPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NMulPropMod := NMulPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NOrderPropFunct (Import N : NAxiomsSig'). +Include NAddPropFunct N. -(* The tactics le_less, le_equal and le_elim are inherited from NZOrder.v *) - -(* Axioms *) - -Theorem lt_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> (n1 < m1 <-> n2 < m2). -Proof NZlt_wd. - -Theorem le_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> (n1 <= m1 <-> n2 <= m2). -Proof NZle_wd. - -Theorem min_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> min n1 m1 == min n2 m2. -Proof NZmin_wd. - -Theorem max_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> max n1 m1 == max n2 m2. -Proof NZmax_wd. - -Theorem lt_eq_cases : forall n m : N, n <= m <-> n < m \/ n == m. -Proof NZlt_eq_cases. - -Theorem lt_irrefl : forall n : N, ~ n < n. -Proof NZlt_irrefl. - -Theorem lt_succ_r : forall n m : N, n < S m <-> n <= m. -Proof NZlt_succ_r. - -Theorem min_l : forall n m : N, n <= m -> min n m == n. -Proof NZmin_l. - -Theorem min_r : forall n m : N, m <= n -> min n m == m. -Proof NZmin_r. - -Theorem max_l : forall n m : N, m <= n -> max n m == n. -Proof NZmax_l. - -Theorem max_r : forall n m : N, n <= m -> max n m == m. -Proof NZmax_r. - -(* Renaming theorems from NZOrder.v *) - -Theorem lt_le_incl : forall n m : N, n < m -> n <= m. -Proof NZlt_le_incl. - -Theorem eq_le_incl : forall n m : N, n == m -> n <= m. -Proof NZeq_le_incl. - -Theorem lt_neq : forall n m : N, n < m -> n ~= m. -Proof NZlt_neq. - -Theorem le_neq : forall n m : N, n < m <-> n <= m /\ n ~= m. -Proof NZle_neq. - -Theorem le_refl : forall n : N, n <= n. -Proof NZle_refl. - -Theorem lt_succ_diag_r : forall n : N, n < S n. -Proof NZlt_succ_diag_r. - -Theorem le_succ_diag_r : forall n : N, n <= S n. -Proof NZle_succ_diag_r. - -Theorem lt_0_1 : 0 < 1. -Proof NZlt_0_1. - -Theorem le_0_1 : 0 <= 1. -Proof NZle_0_1. - -Theorem lt_lt_succ_r : forall n m : N, n < m -> n < S m. -Proof NZlt_lt_succ_r. - -Theorem le_le_succ_r : forall n m : N, n <= m -> n <= S m. -Proof NZle_le_succ_r. - -Theorem le_succ_r : forall n m : N, n <= S m <-> n <= m \/ n == S m. -Proof NZle_succ_r. - -Theorem neq_succ_diag_l : forall n : N, S n ~= n. -Proof NZneq_succ_diag_l. - -Theorem neq_succ_diag_r : forall n : N, n ~= S n. -Proof NZneq_succ_diag_r. - -Theorem nlt_succ_diag_l : forall n : N, ~ S n < n. -Proof NZnlt_succ_diag_l. - -Theorem nle_succ_diag_l : forall n : N, ~ S n <= n. -Proof NZnle_succ_diag_l. - -Theorem le_succ_l : forall n m : N, S n <= m <-> n < m. -Proof NZle_succ_l. - -Theorem lt_succ_l : forall n m : N, S n < m -> n < m. -Proof NZlt_succ_l. - -Theorem succ_lt_mono : forall n m : N, n < m <-> S n < S m. -Proof NZsucc_lt_mono. - -Theorem succ_le_mono : forall n m : N, n <= m <-> S n <= S m. -Proof NZsucc_le_mono. - -Theorem lt_asymm : forall n m : N, n < m -> ~ m < n. -Proof NZlt_asymm. - -Notation lt_ngt := lt_asymm (only parsing). - -Theorem lt_trans : forall n m p : N, n < m -> m < p -> n < p. -Proof NZlt_trans. - -Theorem le_trans : forall n m p : N, n <= m -> m <= p -> n <= p. -Proof NZle_trans. - -Theorem le_lt_trans : forall n m p : N, n <= m -> m < p -> n < p. -Proof NZle_lt_trans. - -Theorem lt_le_trans : forall n m p : N, n < m -> m <= p -> n < p. -Proof NZlt_le_trans. - -Theorem le_antisymm : forall n m : N, n <= m -> m <= n -> n == m. -Proof NZle_antisymm. - -(** Trichotomy, decidability, and double negation elimination *) - -Theorem lt_trichotomy : forall n m : N, n < m \/ n == m \/ m < n. -Proof NZlt_trichotomy. - -Notation lt_eq_gt_cases := lt_trichotomy (only parsing). - -Theorem lt_gt_cases : forall n m : N, n ~= m <-> n < m \/ n > m. -Proof NZlt_gt_cases. - -Theorem le_gt_cases : forall n m : N, n <= m \/ n > m. -Proof NZle_gt_cases. - -Theorem lt_ge_cases : forall n m : N, n < m \/ n >= m. -Proof NZlt_ge_cases. - -Theorem le_ge_cases : forall n m : N, n <= m \/ n >= m. -Proof NZle_ge_cases. - -Theorem le_ngt : forall n m : N, n <= m <-> ~ n > m. -Proof NZle_ngt. - -Theorem nlt_ge : forall n m : N, ~ n < m <-> n >= m. -Proof NZnlt_ge. - -Theorem lt_dec : forall n m : N, decidable (n < m). -Proof NZlt_dec. - -Theorem lt_dne : forall n m : N, ~ ~ n < m <-> n < m. -Proof NZlt_dne. - -Theorem nle_gt : forall n m : N, ~ n <= m <-> n > m. -Proof NZnle_gt. - -Theorem lt_nge : forall n m : N, n < m <-> ~ n >= m. -Proof NZlt_nge. - -Theorem le_dec : forall n m : N, decidable (n <= m). -Proof NZle_dec. - -Theorem le_dne : forall n m : N, ~ ~ n <= m <-> n <= m. -Proof NZle_dne. - -Theorem nlt_succ_r : forall n m : N, ~ m < S n <-> n < m. -Proof NZnlt_succ_r. - -Theorem lt_exists_pred : - forall z n : N, z < n -> exists k : N, n == S k /\ z <= k. -Proof NZlt_exists_pred. - -Theorem lt_succ_iter_r : - forall (n : nat) (m : N), m < NZsucc_iter (Datatypes.S n) m. -Proof NZlt_succ_iter_r. - -Theorem neq_succ_iter_l : - forall (n : nat) (m : N), NZsucc_iter (Datatypes.S n) m ~= m. -Proof NZneq_succ_iter_l. - -(** Stronger variant of induction with assumptions n >= 0 (n < 0) -in the induction step *) - -Theorem right_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, z <= n -> A n -> A (S n)) -> - forall n : N, z <= n -> A n. -Proof NZright_induction. - -Theorem left_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, n < z -> A (S n) -> A n) -> - forall n : N, n <= z -> A n. -Proof NZleft_induction. - -Theorem right_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, n <= z -> A n) -> - (forall n : N, z <= n -> A n -> A (S n)) -> - forall n : N, A n. -Proof NZright_induction'. - -Theorem left_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, z <= n -> A n) -> - (forall n : N, n < z -> A (S n) -> A n) -> - forall n : N, A n. -Proof NZleft_induction'. - -Theorem strong_right_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, z <= n -> (forall m : N, z <= m -> m < n -> A m) -> A n) -> - forall n : N, z <= n -> A n. -Proof NZstrong_right_induction. - -Theorem strong_left_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, n <= z -> (forall m : N, m <= z -> S n <= m -> A m) -> A n) -> - forall n : N, n <= z -> A n. -Proof NZstrong_left_induction. - -Theorem strong_right_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, n <= z -> A n) -> - (forall n : N, z <= n -> (forall m : N, z <= m -> m < n -> A m) -> A n) -> - forall n : N, A n. -Proof NZstrong_right_induction'. - -Theorem strong_left_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, z <= n -> A n) -> - (forall n : N, n <= z -> (forall m : N, m <= z -> S n <= m -> A m) -> A n) -> - forall n : N, A n. -Proof NZstrong_left_induction'. - -Theorem order_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, z <= n -> A n -> A (S n)) -> - (forall n : N, n < z -> A (S n) -> A n) -> - forall n : N, A n. -Proof NZorder_induction. - -Theorem order_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, z <= n -> A n -> A (S n)) -> - (forall n : N, n <= z -> A n -> A (P n)) -> - forall n : N, A n. -Proof NZorder_induction'. - -(* We don't need order_induction_0 and order_induction'_0 (see NZOrder and -ZOrder) since they boil down to regular induction *) - -(** Elimintation principle for < *) - -Theorem lt_ind : - forall A : N -> Prop, predicate_wd Neq A -> - forall n : N, - A (S n) -> - (forall m : N, n < m -> A m -> A (S m)) -> - forall m : N, n < m -> A m. -Proof NZlt_ind. - -(** Elimintation principle for <= *) - -Theorem le_ind : - forall A : N -> Prop, predicate_wd Neq A -> - forall n : N, - A n -> - (forall m : N, n <= m -> A m -> A (S m)) -> - forall m : N, n <= m -> A m. -Proof NZle_ind. - -(** Well-founded relations *) - -Theorem lt_wf : forall z : N, well_founded (fun n m : N => z <= n /\ n < m). -Proof NZlt_wf. - -Theorem gt_wf : forall z : N, well_founded (fun n m : N => m < n /\ n <= z). -Proof NZgt_wf. +(* Theorems that are true for natural numbers but not for integers *) Theorem lt_wf_0 : well_founded lt. Proof. -setoid_replace lt with (fun n m : N => 0 <= n /\ n < m) - using relation (@relations_eq N N). +setoid_replace lt with (fun n m => 0 <= n /\ n < m). apply lt_wf. intros x y; split. intro H; split; [apply le_0_l | assumption]. now intros [_ H]. Defined. -(* Theorems that are true for natural numbers but not for integers *) - (* "le_0_l : forall n : N, 0 <= n" was proved in NBase.v *) -Theorem nlt_0_r : forall n : N, ~ n < 0. +Theorem nlt_0_r : forall n, ~ n < 0. Proof. intro n; apply -> le_ngt. apply le_0_l. Qed. -Theorem nle_succ_0 : forall n : N, ~ (S n <= 0). +Theorem nle_succ_0 : forall n, ~ (S n <= 0). Proof. intros n H; apply -> le_succ_l in H; false_hyp H nlt_0_r. Qed. -Theorem le_0_r : forall n : N, n <= 0 <-> n == 0. +Theorem le_0_r : forall n, n <= 0 <-> n == 0. Proof. intros n; split; intro H. le_elim H; [false_hyp H nlt_0_r | assumption]. now apply eq_le_incl. Qed. -Theorem lt_0_succ : forall n : N, 0 < S n. +Theorem lt_0_succ : forall n, 0 < S n. Proof. induct n; [apply lt_succ_diag_r | intros n H; now apply lt_lt_succ_r]. Qed. -Theorem neq_0_lt_0 : forall n : N, n ~= 0 <-> 0 < n. +Theorem neq_0_lt_0 : forall n, n ~= 0 <-> 0 < n. Proof. cases n. split; intro H; [now elim H | intro; now apply lt_irrefl with 0]. intro n; split; intro H; [apply lt_0_succ | apply neq_succ_0]. Qed. -Theorem eq_0_gt_0_cases : forall n : N, n == 0 \/ 0 < n. +Theorem eq_0_gt_0_cases : forall n, n == 0 \/ 0 < n. Proof. cases n. now left. intro; right; apply lt_0_succ. Qed. -Theorem zero_one : forall n : N, n == 0 \/ n == 1 \/ 1 < n. +Theorem zero_one : forall n, n == 0 \/ n == 1 \/ 1 < n. Proof. induct n. now left. cases n. intros; right; now left. @@ -366,7 +73,7 @@ right; right. rewrite H. apply lt_succ_diag_r. right; right. now apply lt_lt_succ_r. Qed. -Theorem lt_1_r : forall n : N, n < 1 <-> n == 0. +Theorem lt_1_r : forall n, n < 1 <-> n == 0. Proof. cases n. split; intro; [reflexivity | apply lt_succ_diag_r]. @@ -374,7 +81,7 @@ intros n. rewrite <- succ_lt_mono. split; intro H; [false_hyp H nlt_0_r | false_hyp H neq_succ_0]. Qed. -Theorem le_1_r : forall n : N, n <= 1 <-> n == 0 \/ n == 1. +Theorem le_1_r : forall n, n <= 1 <-> n == 0 \/ n == 1. Proof. cases n. split; intro; [now left | apply le_succ_diag_r]. @@ -382,36 +89,30 @@ intro n. rewrite <- succ_le_mono, le_0_r, succ_inj_wd. split; [intro; now right | intros [H | H]; [false_hyp H neq_succ_0 | assumption]]. Qed. -Theorem lt_lt_0 : forall n m : N, n < m -> 0 < m. +Theorem lt_lt_0 : forall n m, n < m -> 0 < m. Proof. intros n m; induct n. trivial. intros n IH H. apply IH; now apply lt_succ_l. Qed. -Theorem lt_1_l : forall n m p : N, n < m -> m < p -> 1 < p. +Theorem lt_1_l' : forall n m p, n < m -> m < p -> 1 < p. Proof. -intros n m p H1 H2. -apply le_lt_trans with m. apply <- le_succ_l. apply le_lt_trans with n. -apply le_0_l. assumption. assumption. +intros. apply lt_1_l with m; auto. +apply le_lt_trans with n; auto. now apply le_0_l. Qed. (** Elimination principlies for < and <= for relations *) Section RelElim. -(* FIXME: Variable R : relation N. -- does not work *) - -Variable R : N -> N -> Prop. -Hypothesis R_wd : relation_wd Neq Neq R. - -Add Morphism R with signature Neq ==> Neq ==> iff as R_morph2. -Proof. apply R_wd. Qed. +Variable R : relation N.t. +Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem le_ind_rel : - (forall m : N, R 0 m) -> - (forall n m : N, n <= m -> R n m -> R (S n) (S m)) -> - forall n m : N, n <= m -> R n m. + (forall m, R 0 m) -> + (forall n m, n <= m -> R n m -> R (S n) (S m)) -> + forall n m, n <= m -> R n m. Proof. intros Base Step; induct n. intros; apply Base. @@ -422,9 +123,9 @@ intros k H1 H2. apply -> le_succ_l in H1. apply lt_le_incl in H1. auto. Qed. Theorem lt_ind_rel : - (forall m : N, R 0 (S m)) -> - (forall n m : N, n < m -> R n m -> R (S n) (S m)) -> - forall n m : N, n < m -> R n m. + (forall m, R 0 (S m)) -> + (forall n m, n < m -> R n m -> R (S n) (S m)) -> + forall n m, n < m -> R n m. Proof. intros Base Step; induct n. intros m H. apply lt_exists_pred in H; destruct H as [m' [H _]]. @@ -439,61 +140,64 @@ End RelElim. (** Predecessor and order *) -Theorem succ_pred_pos : forall n : N, 0 < n -> S (P n) == n. +Theorem succ_pred_pos : forall n, 0 < n -> S (P n) == n. Proof. intros n H; apply succ_pred; intro H1; rewrite H1 in H. false_hyp H lt_irrefl. Qed. -Theorem le_pred_l : forall n : N, P n <= n. +Theorem le_pred_l : forall n, P n <= n. Proof. cases n. rewrite pred_0; now apply eq_le_incl. intros; rewrite pred_succ; apply le_succ_diag_r. Qed. -Theorem lt_pred_l : forall n : N, n ~= 0 -> P n < n. +Theorem lt_pred_l : forall n, n ~= 0 -> P n < n. Proof. cases n. -intro H; elimtype False; now apply H. +intro H; exfalso; now apply H. intros; rewrite pred_succ; apply lt_succ_diag_r. Qed. -Theorem le_le_pred : forall n m : N, n <= m -> P n <= m. +Theorem le_le_pred : forall n m, n <= m -> P n <= m. Proof. intros n m H; apply le_trans with n. apply le_pred_l. assumption. Qed. -Theorem lt_lt_pred : forall n m : N, n < m -> P n < m. +Theorem lt_lt_pred : forall n m, n < m -> P n < m. Proof. intros n m H; apply le_lt_trans with n. apply le_pred_l. assumption. Qed. -Theorem lt_le_pred : forall n m : N, n < m -> n <= P m. (* Converse is false for n == m == 0 *) +Theorem lt_le_pred : forall n m, n < m -> n <= P m. + (* Converse is false for n == m == 0 *) Proof. intro n; cases m. intro H; false_hyp H nlt_0_r. intros m IH. rewrite pred_succ; now apply -> lt_succ_r. Qed. -Theorem lt_pred_le : forall n m : N, P n < m -> n <= m. (* Converse is false for n == m == 0 *) +Theorem lt_pred_le : forall n m, P n < m -> n <= m. + (* Converse is false for n == m == 0 *) Proof. intros n m; cases n. rewrite pred_0; intro H; now apply lt_le_incl. intros n IH. rewrite pred_succ in IH. now apply <- le_succ_l. Qed. -Theorem lt_pred_lt : forall n m : N, n < P m -> n < m. +Theorem lt_pred_lt : forall n m, n < P m -> n < m. Proof. intros n m H; apply lt_le_trans with (P m); [assumption | apply le_pred_l]. Qed. -Theorem le_pred_le : forall n m : N, n <= P m -> n <= m. +Theorem le_pred_le : forall n m, n <= P m -> n <= m. Proof. intros n m H; apply le_trans with (P m); [assumption | apply le_pred_l]. Qed. -Theorem pred_le_mono : forall n m : N, n <= m -> P n <= P m. (* Converse is false for n == 1, m == 0 *) +Theorem pred_le_mono : forall n m, n <= m -> P n <= P m. + (* Converse is false for n == 1, m == 0 *) Proof. intros n m H; elim H using le_ind_rel. solve_relation_wd. @@ -501,7 +205,7 @@ intro; rewrite pred_0; apply le_0_l. intros p q H1 _; now do 2 rewrite pred_succ. Qed. -Theorem pred_lt_mono : forall n m : N, n ~= 0 -> (n < m <-> P n < P m). +Theorem pred_lt_mono : forall n m, n ~= 0 -> (n < m <-> P n < P m). Proof. intros n m H1; split; intro H2. assert (m ~= 0). apply <- neq_0_lt_0. now apply lt_lt_0 with n. @@ -512,22 +216,24 @@ apply lt_le_trans with (P m). assumption. apply le_pred_l. apply -> succ_lt_mono in H2. now do 2 rewrite succ_pred in H2. Qed. -Theorem lt_succ_lt_pred : forall n m : N, S n < m <-> n < P m. +Theorem lt_succ_lt_pred : forall n m, S n < m <-> n < P m. Proof. intros n m. rewrite pred_lt_mono by apply neq_succ_0. now rewrite pred_succ. Qed. -Theorem le_succ_le_pred : forall n m : N, S n <= m -> n <= P m. (* Converse is false for n == m == 0 *) +Theorem le_succ_le_pred : forall n m, S n <= m -> n <= P m. + (* Converse is false for n == m == 0 *) Proof. intros n m H. apply lt_le_pred. now apply -> le_succ_l. Qed. -Theorem lt_pred_lt_succ : forall n m : N, P n < m -> n < S m. (* Converse is false for n == m == 0 *) +Theorem lt_pred_lt_succ : forall n m, P n < m -> n < S m. + (* Converse is false for n == m == 0 *) Proof. intros n m H. apply <- lt_succ_r. now apply lt_pred_le. Qed. -Theorem le_pred_le_succ : forall n m : N, P n <= m <-> n <= S m. +Theorem le_pred_le_succ : forall n m, P n <= m <-> n <= S m. Proof. intros n m; cases n. rewrite pred_0. split; intro H; apply le_0_l. diff --git a/theories/Numbers/Natural/Abstract/NProperties.v b/theories/Numbers/Natural/Abstract/NProperties.v new file mode 100644 index 00000000..30262bd9 --- /dev/null +++ b/theories/Numbers/Natural/Abstract/NProperties.v @@ -0,0 +1,22 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id$ i*) + +Require Export NAxioms NSub. + +(** This functor summarizes all known facts about N. + For the moment it is only an alias to [NSubPropFunct], which + subsumes all others. +*) + +Module Type NPropSig := NSubPropFunct. + +Module NPropFunct (N:NAxiomsSig) <: NPropSig N. + Include NPropSig N. +End NPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NStrongRec.v b/theories/Numbers/Natural/Abstract/NStrongRec.v index c6a6da48..cbbcdbff 100644 --- a/theories/Numbers/Natural/Abstract/NStrongRec.v +++ b/theories/Numbers/Natural/Abstract/NStrongRec.v @@ -8,123 +8,200 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NStrongRec.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) (** This file defined the strong (course-of-value, well-founded) recursion and proves its properties *) Require Export NSub. -Module NStrongRecPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NSubPropMod := NSubPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NStrongRecPropFunct (Import N : NAxiomsSig'). +Include NSubPropFunct N. Section StrongRecursion. -Variable A : Set. +Variable A : Type. Variable Aeq : relation A. +Variable Aeq_equiv : Equivalence Aeq. + +(** [strong_rec] allows to define a recursive function [phi] given by + an equation [phi(n) = F(phi)(n)] where recursive calls to [phi] + in [F] are made on strictly lower numbers than [n]. + + For [strong_rec a F n]: + - Parameter [a:A] is a default value used internally, it has no + effect on the final result. + - Parameter [F:(N->A)->N->A] is the step function: + [F f n] should return [phi(n)] when [f] is a function + that coincide with [phi] for numbers strictly less than [n]. +*) -Notation Local "x ==A y" := (Aeq x y) (at level 70, no associativity). +Definition strong_rec (a : A) (f : (N.t -> A) -> N.t -> A) (n : N.t) : A := + recursion (fun _ => a) (fun _ => f) (S n) n. -Hypothesis Aeq_equiv : equiv A Aeq. +(** For convenience, we use in proofs an intermediate definition + between [recursion] and [strong_rec]. *) -Add Relation A Aeq - reflexivity proved by (proj1 Aeq_equiv) - symmetry proved by (proj2 (proj2 Aeq_equiv)) - transitivity proved by (proj1 (proj2 Aeq_equiv)) -as Aeq_rel. +Definition strong_rec0 (a : A) (f : (N.t -> A) -> N.t -> A) : N.t -> N.t -> A := + recursion (fun _ => a) (fun _ => f). -Definition strong_rec (a : A) (f : N -> (N -> A) -> A) (n : N) : A := -recursion - (fun _ : N => a) - (fun (m : N) (p : N -> A) (k : N) => f k p) - (S n) - n. +Lemma strong_rec_alt : forall a f n, + strong_rec a f n = strong_rec0 a f (S n) n. +Proof. +reflexivity. +Qed. -Theorem strong_rec_wd : -forall a a' : A, a ==A a' -> - forall f f', fun2_eq Neq (fun_eq Neq Aeq) Aeq f f' -> - forall n n', n == n' -> - strong_rec a f n ==A strong_rec a' f' n'. +(** We need a result similar to [f_equal], but for setoid equalities. *) +Lemma f_equiv : forall f g x y, + (N.eq==>Aeq)%signature f g -> N.eq x y -> Aeq (f x) (g y). +Proof. +auto. +Qed. + +Instance strong_rec0_wd : + Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> N.eq ==> Aeq) + strong_rec0. +Proof. +unfold strong_rec0. +repeat red; intros. +apply f_equiv; auto. +apply recursion_wd; try red; auto. +Qed. + +Instance strong_rec_wd : + Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> Aeq) strong_rec. Proof. intros a a' Eaa' f f' Eff' n n' Enn'. -(* First we prove that recursion (which is on type N -> A) returns -extensionally equal functions, and then we use the fact that n == n' *) -assert (H : fun_eq Neq Aeq - (recursion - (fun _ : N => a) - (fun (m : N) (p : N -> A) (k : N) => f k p) - (S n)) - (recursion - (fun _ : N => a') - (fun (m : N) (p : N -> A) (k : N) => f' k p) - (S n'))). -apply recursion_wd with (Aeq := fun_eq Neq Aeq). -unfold fun_eq; now intros. -unfold fun2_eq. intros y y' Eyy' p p' Epp'. unfold fun_eq. auto. +rewrite !strong_rec_alt. +apply strong_rec0_wd; auto. now rewrite Enn'. -unfold strong_rec. -now apply H. Qed. -(*Section FixPoint. - -Variable a : A. -Variable f : N -> (N -> A) -> A. +Section FixPoint. -Hypothesis f_wd : fun2_wd Neq (fun_eq Neq Aeq) Aeq f. +Variable f : (N.t -> A) -> N.t -> A. +Variable f_wd : Proper ((N.eq==>Aeq)==>N.eq==>Aeq) f. -Let g (n : N) : A := strong_rec a f n. +Lemma strong_rec0_0 : forall a m, + (strong_rec0 a f 0 m) = a. +Proof. +intros. unfold strong_rec0. rewrite recursion_0; auto. +Qed. -Add Morphism g with signature Neq ==> Aeq as g_wd. +Lemma strong_rec0_succ : forall a n m, + Aeq (strong_rec0 a f (S n) m) (f (strong_rec0 a f n) m). Proof. -intros n1 n2 H. unfold g. now apply strong_rec_wd. +intros. unfold strong_rec0. +apply f_equiv; auto with *. +rewrite recursion_succ; try (repeat red; auto with *; fail). +apply f_wd. +apply recursion_wd; try red; auto with *. Qed. -Theorem NtoA_eq_sym : symmetric (N -> A) (fun_eq Neq Aeq). +Lemma strong_rec_0 : forall a, + Aeq (strong_rec a f 0) (f (fun _ => a) 0). Proof. -apply fun_eq_sym. -exact (proj2 (proj2 NZeq_equiv)). -exact (proj2 (proj2 Aeq_equiv)). +intros. rewrite strong_rec_alt, strong_rec0_succ. +apply f_wd; auto with *. +red; intros; rewrite strong_rec0_0; auto with *. Qed. -Theorem NtoA_eq_trans : transitive (N -> A) (fun_eq Neq Aeq). +(* We need an assumption saying that for every n, the step function (f h n) +calls h only on the segment [0 ... n - 1]. This means that if h1 and h2 +coincide on values < n, then (f h1 n) coincides with (f h2 n) *) + +Hypothesis step_good : + forall (n : N.t) (h1 h2 : N.t -> A), + (forall m : N.t, m < n -> Aeq (h1 m) (h2 m)) -> Aeq (f h1 n) (f h2 n). + +Lemma strong_rec0_more_steps : forall a k n m, m < n -> + Aeq (strong_rec0 a f n m) (strong_rec0 a f (n+k) m). Proof. -apply fun_eq_trans. -exact (proj1 NZeq_equiv). -exact (proj1 (proj2 NZeq_equiv)). -exact (proj1 (proj2 Aeq_equiv)). + intros a k n. pattern n. + apply induction; clear n. + + intros n n' Hn; setoid_rewrite Hn; auto with *. + + intros m Hm. destruct (nlt_0_r _ Hm). + + intros n IH m Hm. + rewrite lt_succ_r in Hm. + rewrite add_succ_l. + rewrite 2 strong_rec0_succ. + apply step_good. + intros m' Hm'. + apply IH. + apply lt_le_trans with m; auto. Qed. -Add Relation (N -> A) (fun_eq Neq Aeq) - symmetry proved by NtoA_eq_sym - transitivity proved by NtoA_eq_trans -as NtoA_eq_rel. +Lemma strong_rec0_fixpoint : forall (a : A) (n : N.t), + Aeq (strong_rec0 a f (S n) n) (f (fun n => strong_rec0 a f (S n) n) n). +Proof. +intros. +rewrite strong_rec0_succ. +apply step_good. +intros m Hm. +symmetry. +setoid_replace n with (S m + (n - S m)). +apply strong_rec0_more_steps. +apply lt_succ_diag_r. +rewrite add_comm. +symmetry. +apply sub_add. +rewrite le_succ_l; auto. +Qed. -Add Morphism f with signature Neq ==> (fun_eq Neq Aeq) ==> Aeq as f_morph. +Theorem strong_rec_fixpoint : forall (a : A) (n : N.t), + Aeq (strong_rec a f n) (f (strong_rec a f) n). Proof. -apply f_wd. +intros. +transitivity (f (fun n => strong_rec0 a f (S n) n) n). +rewrite strong_rec_alt. +apply strong_rec0_fixpoint. +apply f_wd; auto with *. +intros x x' Hx; rewrite strong_rec_alt, Hx; auto with *. Qed. -(* We need an assumption saying that for every n, the step function (f n h) -calls h only on the segment [0 ... n - 1]. This means that if h1 and h2 -coincide on values < n, then (f n h1) coincides with (f n h2) *) +(** NB: without the [step_good] hypothesis, we have proved that + [strong_rec a f 0] is [f (fun _ => a) 0]. Now we can prove + that the first argument of [f] is arbitrary in this case... +*) -Hypothesis step_good : - forall (n : N) (h1 h2 : N -> A), - (forall m : N, m < n -> Aeq (h1 m) (h2 m)) -> Aeq (f n h1) (f n h2). +Theorem strong_rec_0_any : forall (a : A)(any : N.t->A), + Aeq (strong_rec a f 0) (f any 0). +Proof. +intros. +rewrite strong_rec_fixpoint. +apply step_good. +intros m Hm. destruct (nlt_0_r _ Hm). +Qed. -(* Todo: -Theorem strong_rec_fixpoint : forall n : N, Aeq (g n) (f n g). +(** ... and that first argument of [strong_rec] is always arbitrary. *) + +Lemma strong_rec_any_fst_arg : forall a a' n, + Aeq (strong_rec a f n) (strong_rec a' f n). Proof. -apply induction. -unfold predicate_wd, fun_wd. -intros x y H. rewrite H. unfold fun_eq; apply g_wd. -reflexivity. -unfold g, strong_rec. -*) +intros a a' n. +generalize (le_refl n). +set (k:=n) at -2. clearbody k. revert k. pattern n. +apply induction; clear n. +(* compat *) +intros n n' Hn. setoid_rewrite Hn; auto with *. +(* 0 *) +intros k Hk. rewrite le_0_r in Hk. +rewrite Hk, strong_rec_0. symmetry. apply strong_rec_0_any. +(* S *) +intros n IH k Hk. +rewrite 2 strong_rec_fixpoint. +apply step_good. +intros m Hm. +apply IH. +rewrite succ_le_mono. +apply le_trans with k; auto. +rewrite le_succ_l; auto. +Qed. -End FixPoint.*) +End FixPoint. End StrongRecursion. Implicit Arguments strong_rec [A]. diff --git a/theories/Numbers/Natural/Abstract/NSub.v b/theories/Numbers/Natural/Abstract/NSub.v index f67689dd..35d3b8aa 100644 --- a/theories/Numbers/Natural/Abstract/NSub.v +++ b/theories/Numbers/Natural/Abstract/NSub.v @@ -8,49 +8,33 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NSub.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NMulOrder. -Module NSubPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NMulOrderPropMod := NMulOrderPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module Type NSubPropFunct (Import N : NAxiomsSig'). +Include NMulOrderPropFunct N. -Theorem sub_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> n1 - m1 == n2 - m2. -Proof NZsub_wd. - -Theorem sub_0_r : forall n : N, n - 0 == n. -Proof NZsub_0_r. - -Theorem sub_succ_r : forall n m : N, n - (S m) == P (n - m). -Proof NZsub_succ_r. - -Theorem sub_1_r : forall n : N, n - 1 == P n. -Proof. -intro n; rewrite sub_succ_r; now rewrite sub_0_r. -Qed. - -Theorem sub_0_l : forall n : N, 0 - n == 0. +Theorem sub_0_l : forall n, 0 - n == 0. Proof. induct n. apply sub_0_r. intros n IH; rewrite sub_succ_r; rewrite IH. now apply pred_0. Qed. -Theorem sub_succ : forall n m : N, S n - S m == n - m. +Theorem sub_succ : forall n m, S n - S m == n - m. Proof. intro n; induct m. rewrite sub_succ_r. do 2 rewrite sub_0_r. now rewrite pred_succ. intros m IH. rewrite sub_succ_r. rewrite IH. now rewrite sub_succ_r. Qed. -Theorem sub_diag : forall n : N, n - n == 0. +Theorem sub_diag : forall n, n - n == 0. Proof. induct n. apply sub_0_r. intros n IH; rewrite sub_succ; now rewrite IH. Qed. -Theorem sub_gt : forall n m : N, n > m -> n - m ~= 0. +Theorem sub_gt : forall n m, n > m -> n - m ~= 0. Proof. intros n m H; elim H using lt_ind_rel; clear n m H. solve_relation_wd. @@ -58,7 +42,7 @@ intro; rewrite sub_0_r; apply neq_succ_0. intros; now rewrite sub_succ. Qed. -Theorem add_sub_assoc : forall n m p : N, p <= m -> n + (m - p) == (n + m) - p. +Theorem add_sub_assoc : forall n m p, p <= m -> n + (m - p) == (n + m) - p. Proof. intros n m p; induct p. intro; now do 2 rewrite sub_0_r. @@ -68,32 +52,32 @@ rewrite add_pred_r by (apply sub_gt; now apply -> le_succ_l). reflexivity. Qed. -Theorem sub_succ_l : forall n m : N, n <= m -> S m - n == S (m - n). +Theorem sub_succ_l : forall n m, n <= m -> S m - n == S (m - n). Proof. intros n m H. rewrite <- (add_1_l m). rewrite <- (add_1_l (m - n)). symmetry; now apply add_sub_assoc. Qed. -Theorem add_sub : forall n m : N, (n + m) - m == n. +Theorem add_sub : forall n m, (n + m) - m == n. Proof. intros n m. rewrite <- add_sub_assoc by (apply le_refl). rewrite sub_diag; now rewrite add_0_r. Qed. -Theorem sub_add : forall n m : N, n <= m -> (m - n) + n == m. +Theorem sub_add : forall n m, n <= m -> (m - n) + n == m. Proof. intros n m H. rewrite add_comm. rewrite add_sub_assoc by assumption. rewrite add_comm. apply add_sub. Qed. -Theorem add_sub_eq_l : forall n m p : N, m + p == n -> n - m == p. +Theorem add_sub_eq_l : forall n m p, m + p == n -> n - m == p. Proof. intros n m p H. symmetry. assert (H1 : m + p - m == n - m) by now rewrite H. rewrite add_comm in H1. now rewrite add_sub in H1. Qed. -Theorem add_sub_eq_r : forall n m p : N, m + p == n -> n - p == m. +Theorem add_sub_eq_r : forall n m p, m + p == n -> n - p == m. Proof. intros n m p H; rewrite add_comm in H; now apply add_sub_eq_l. Qed. @@ -101,7 +85,7 @@ Qed. (* This could be proved by adding m to both sides. Then the proof would use add_sub_assoc and sub_0_le, which is proven below. *) -Theorem add_sub_eq_nz : forall n m p : N, p ~= 0 -> n - m == p -> m + p == n. +Theorem add_sub_eq_nz : forall n m p, p ~= 0 -> n - m == p -> m + p == n. Proof. intros n m p H; double_induct n m. intros m H1; rewrite sub_0_l in H1. symmetry in H1; false_hyp H1 H. @@ -110,14 +94,14 @@ intros n m IH H1. rewrite sub_succ in H1. apply IH in H1. rewrite add_succ_l; now rewrite H1. Qed. -Theorem sub_add_distr : forall n m p : N, n - (m + p) == (n - m) - p. +Theorem sub_add_distr : forall n m p, n - (m + p) == (n - m) - p. Proof. intros n m; induct p. rewrite add_0_r; now rewrite sub_0_r. intros p IH. rewrite add_succ_r; do 2 rewrite sub_succ_r. now rewrite IH. Qed. -Theorem add_sub_swap : forall n m p : N, p <= n -> n + m - p == n - p + m. +Theorem add_sub_swap : forall n m p, p <= n -> n + m - p == n - p + m. Proof. intros n m p H. rewrite (add_comm n m). @@ -127,7 +111,7 @@ Qed. (** Sub and order *) -Theorem le_sub_l : forall n m : N, n - m <= n. +Theorem le_sub_l : forall n m, n - m <= n. Proof. intro n; induct m. rewrite sub_0_r; now apply eq_le_incl. @@ -135,7 +119,7 @@ intros m IH. rewrite sub_succ_r. apply le_trans with (n - m); [apply le_pred_l | assumption]. Qed. -Theorem sub_0_le : forall n m : N, n - m == 0 <-> n <= m. +Theorem sub_0_le : forall n m, n - m == 0 <-> n <= m. Proof. double_induct n m. intro m; split; intro; [apply le_0_l | apply sub_0_l]. @@ -144,9 +128,86 @@ intro m; rewrite sub_0_r; split; intro H; intros n m H. rewrite <- succ_le_mono. now rewrite sub_succ. Qed. +Theorem sub_add_le : forall n m, n <= n - m + m. +Proof. +intros. +destruct (le_ge_cases n m) as [LE|GE]. +rewrite <- sub_0_le in LE. rewrite LE; nzsimpl. +now rewrite <- sub_0_le. +rewrite sub_add by assumption. apply le_refl. +Qed. + +Theorem le_sub_le_add_r : forall n m p, + n - p <= m <-> n <= m + p. +Proof. +intros n m p. +split; intros LE. +rewrite (add_le_mono_r _ _ p) in LE. +apply le_trans with (n-p+p); auto using sub_add_le. +destruct (le_ge_cases n p) as [LE'|GE]. +rewrite <- sub_0_le in LE'. rewrite LE'. apply le_0_l. +rewrite (add_le_mono_r _ _ p). now rewrite sub_add. +Qed. + +Theorem le_sub_le_add_l : forall n m p, n - m <= p <-> n <= m + p. +Proof. +intros n m p. rewrite add_comm; apply le_sub_le_add_r. +Qed. + +Theorem lt_sub_lt_add_r : forall n m p, + n - p < m -> n < m + p. +Proof. +intros n m p LT. +rewrite (add_lt_mono_r _ _ p) in LT. +apply le_lt_trans with (n-p+p); auto using sub_add_le. +Qed. + +(** Unfortunately, we do not have [n < m + p -> n - p < m]. + For instance [1<0+2] but not [1-2<0]. *) + +Theorem lt_sub_lt_add_l : forall n m p, n - m < p -> n < m + p. +Proof. +intros n m p. rewrite add_comm; apply lt_sub_lt_add_r. +Qed. + +Theorem le_add_le_sub_r : forall n m p, n + p <= m -> n <= m - p. +Proof. +intros n m p LE. +apply (add_le_mono_r _ _ p). +rewrite sub_add. assumption. +apply le_trans with (n+p); trivial. +rewrite <- (add_0_l p) at 1. rewrite <- add_le_mono_r. apply le_0_l. +Qed. + +(** Unfortunately, we do not have [n <= m - p -> n + p <= m]. + For instance [0<=1-2] but not [2+0<=1]. *) + +Theorem le_add_le_sub_l : forall n m p, n + p <= m -> p <= m - n. +Proof. +intros n m p. rewrite add_comm; apply le_add_le_sub_r. +Qed. + +Theorem lt_add_lt_sub_r : forall n m p, n + p < m <-> n < m - p. +Proof. +intros n m p. +destruct (le_ge_cases p m) as [LE|GE]. +rewrite <- (sub_add p m) at 1 by assumption. +now rewrite <- add_lt_mono_r. +assert (GE' := GE). rewrite <- sub_0_le in GE'; rewrite GE'. +split; intros LT. +elim (lt_irrefl m). apply le_lt_trans with (n+p); trivial. + rewrite <- (add_0_l m). apply add_le_mono. apply le_0_l. assumption. +now elim (nlt_0_r n). +Qed. + +Theorem lt_add_lt_sub_l : forall n m p, n + p < m <-> p < m - n. +Proof. +intros n m p. rewrite add_comm; apply lt_add_lt_sub_r. +Qed. + (** Sub and mul *) -Theorem mul_pred_r : forall n m : N, n * (P m) == n * m - n. +Theorem mul_pred_r : forall n m, n * (P m) == n * m - n. Proof. intros n m; cases m. now rewrite pred_0, mul_0_r, sub_0_l. @@ -155,7 +216,7 @@ now rewrite sub_diag, add_0_r. now apply eq_le_incl. Qed. -Theorem mul_sub_distr_r : forall n m p : N, (n - m) * p == n * p - m * p. +Theorem mul_sub_distr_r : forall n m p, (n - m) * p == n * p - m * p. Proof. intros n m p; induct n. now rewrite sub_0_l, mul_0_l, sub_0_l. @@ -170,11 +231,72 @@ setoid_replace ((S n * p) - m * p) with 0 by (apply <- sub_0_le; now apply mul_l apply mul_0_l. Qed. -Theorem mul_sub_distr_l : forall n m p : N, p * (n - m) == p * n - p * m. +Theorem mul_sub_distr_l : forall n m p, p * (n - m) == p * n - p * m. Proof. intros n m p; rewrite (mul_comm p (n - m)), (mul_comm p n), (mul_comm p m). apply mul_sub_distr_r. Qed. +(** Alternative definitions of [<=] and [<] based on [+] *) + +Definition le_alt n m := exists p, p + n == m. +Definition lt_alt n m := exists p, S p + n == m. + +Lemma le_equiv : forall n m, le_alt n m <-> n <= m. +Proof. +split. +intros (p,H). rewrite <- H, add_comm. apply le_add_r. +intro H. exists (m-n). now apply sub_add. +Qed. + +Lemma lt_equiv : forall n m, lt_alt n m <-> n < m. +Proof. +split. +intros (p,H). rewrite <- H, add_succ_l, lt_succ_r, add_comm. apply le_add_r. +intro H. exists (m-S n). rewrite add_succ_l, <- add_succ_r. +apply sub_add. now rewrite le_succ_l. +Qed. + +Instance le_alt_wd : Proper (eq==>eq==>iff) le_alt. +Proof. + intros x x' Hx y y' Hy; unfold le_alt. + setoid_rewrite Hx. setoid_rewrite Hy. auto with *. +Qed. + +Instance lt_alt_wd : Proper (eq==>eq==>iff) lt_alt. +Proof. + intros x x' Hx y y' Hy; unfold lt_alt. + setoid_rewrite Hx. setoid_rewrite Hy. auto with *. +Qed. + +(** With these alternative definition, the dichotomy: + +[forall n m, n <= m \/ m <= n] + +becomes: + +[forall n m, (exists p, p + n == m) \/ (exists p, p + m == n)] + +We will need this in the proof of induction principle for integers +constructed as pairs of natural numbers. This formula can be proved +from know properties of [<=]. However, it can also be done directly. *) + +Theorem le_alt_dichotomy : forall n m, le_alt n m \/ le_alt m n. +Proof. +intros n m; induct n. +left; exists m; apply add_0_r. +intros n IH. +destruct IH as [[p H] | [p H]]. +destruct (zero_or_succ p) as [H1 | [p' H1]]; rewrite H1 in H. +rewrite add_0_l in H. right; exists (S 0); rewrite H, add_succ_l; + now rewrite add_0_l. +left; exists p'; rewrite add_succ_r; now rewrite add_succ_l in H. +right; exists (S p). rewrite add_succ_l; now rewrite H. +Qed. + +Theorem add_dichotomy : + forall n m, (exists p, p + n == m) \/ (exists p, p + m == n). +Proof. exact le_alt_dichotomy. Qed. + End NSubPropFunct. diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v index 16007656..cab4b154 100644 --- a/theories/Numbers/Natural/BigN/BigN.v +++ b/theories/Numbers/Natural/BigN/BigN.v @@ -6,28 +6,32 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: BigN.v 11576 2008-11-10 19:13:15Z msozeau $ i*) +(** * Efficient arbitrary large natural numbers in base 2^31 *) -(** * Natural numbers in base 2^31 *) - -(** -Author: Arnaud Spiwack -*) +(** Initial Author: Arnaud Spiwack *) Require Export Int31. -Require Import CyclicAxioms. -Require Import Cyclic31. -Require Import NSig. -Require Import NSigNAxioms. -Require Import NMake. -Require Import NSub. +Require Import CyclicAxioms Cyclic31 Ring31 NSig NSigNAxioms NMake + NProperties NDiv GenericMinMax. + +(** The following [BigN] module regroups both the operations and + all the abstract properties: -Module BigN <: NType := NMake.Make Int31Cyclic. + - [NMake.Make Int31Cyclic] provides the operations and basic specs + w.r.t. ZArith + - [NTypeIsNAxioms] shows (mainly) that these operations implement + the interface [NAxioms] + - [NPropSig] adds all generic properties derived from [NAxioms] + - [NDivPropFunct] provides generic properties of [div] and [mod]. + - [MinMax*Properties] provides properties of [min] and [max]. + +*) -(** Module [BigN] implements [NAxiomsSig] *) +Module BigN <: NType <: OrderedTypeFull <: TotalOrder := + NMake.Make Int31Cyclic <+ NTypeIsNAxioms + <+ !NPropSig <+ !NDivPropFunct <+ HasEqBool2Dec + <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties. -Module Export BigNAxiomsMod := NSig_NAxioms BigN. -Module Export BigNSubPropMod := NSubPropFunct BigNAxiomsMod. (** Notations about [BigN] *) @@ -37,49 +41,171 @@ Delimit Scope bigN_scope with bigN. Bind Scope bigN_scope with bigN. Bind Scope bigN_scope with BigN.t. Bind Scope bigN_scope with BigN.t_. - -Notation Local "0" := BigN.zero : bigN_scope. (* temporary notation *) +(* Bind Scope has no retroactive effect, let's declare scopes by hand. *) +Arguments Scope BigN.to_Z [bigN_scope]. +Arguments Scope BigN.succ [bigN_scope]. +Arguments Scope BigN.pred [bigN_scope]. +Arguments Scope BigN.square [bigN_scope]. +Arguments Scope BigN.add [bigN_scope bigN_scope]. +Arguments Scope BigN.sub [bigN_scope bigN_scope]. +Arguments Scope BigN.mul [bigN_scope bigN_scope]. +Arguments Scope BigN.div [bigN_scope bigN_scope]. +Arguments Scope BigN.eq [bigN_scope bigN_scope]. +Arguments Scope BigN.lt [bigN_scope bigN_scope]. +Arguments Scope BigN.le [bigN_scope bigN_scope]. +Arguments Scope BigN.eq [bigN_scope bigN_scope]. +Arguments Scope BigN.compare [bigN_scope bigN_scope]. +Arguments Scope BigN.min [bigN_scope bigN_scope]. +Arguments Scope BigN.max [bigN_scope bigN_scope]. +Arguments Scope BigN.eq_bool [bigN_scope bigN_scope]. +Arguments Scope BigN.power_pos [bigN_scope positive_scope]. +Arguments Scope BigN.power [bigN_scope N_scope]. +Arguments Scope BigN.sqrt [bigN_scope]. +Arguments Scope BigN.div_eucl [bigN_scope bigN_scope]. +Arguments Scope BigN.modulo [bigN_scope bigN_scope]. +Arguments Scope BigN.gcd [bigN_scope bigN_scope]. + +Local Notation "0" := BigN.zero : bigN_scope. (* temporary notation *) +Local Notation "1" := BigN.one : bigN_scope. (* temporary notation *) Infix "+" := BigN.add : bigN_scope. Infix "-" := BigN.sub : bigN_scope. Infix "*" := BigN.mul : bigN_scope. Infix "/" := BigN.div : bigN_scope. +Infix "^" := BigN.power : bigN_scope. Infix "?=" := BigN.compare : bigN_scope. Infix "==" := BigN.eq (at level 70, no associativity) : bigN_scope. +Notation "x != y" := (~x==y)%bigN (at level 70, no associativity) : bigN_scope. Infix "<" := BigN.lt : bigN_scope. Infix "<=" := BigN.le : bigN_scope. Notation "x > y" := (BigN.lt y x)(only parsing) : bigN_scope. Notation "x >= y" := (BigN.le y x)(only parsing) : bigN_scope. +Notation "x < y < z" := (x<y /\ y<z)%bigN : bigN_scope. +Notation "x < y <= z" := (x<y /\ y<=z)%bigN : bigN_scope. +Notation "x <= y < z" := (x<=y /\ y<z)%bigN : bigN_scope. +Notation "x <= y <= z" := (x<=y /\ y<=z)%bigN : bigN_scope. Notation "[ i ]" := (BigN.to_Z i) : bigN_scope. +Infix "mod" := BigN.modulo (at level 40, no associativity) : bigN_scope. -Open Scope bigN_scope. +Local Open Scope bigN_scope. (** Example of reasoning about [BigN] *) -Theorem succ_pred: forall q:bigN, +Theorem succ_pred: forall q : bigN, 0 < q -> BigN.succ (BigN.pred q) == q. Proof. -intros; apply succ_pred. +intros; apply BigN.succ_pred. intro H'; rewrite H' in H; discriminate. Qed. (** [BigN] is a semi-ring *) -Lemma BigNring : - semi_ring_theory BigN.zero BigN.one BigN.add BigN.mul BigN.eq. +Lemma BigNring : semi_ring_theory 0 1 BigN.add BigN.mul BigN.eq. +Proof. +constructor. +exact BigN.add_0_l. exact BigN.add_comm. exact BigN.add_assoc. +exact BigN.mul_1_l. exact BigN.mul_0_l. exact BigN.mul_comm. +exact BigN.mul_assoc. exact BigN.mul_add_distr_r. +Qed. + +Lemma BigNeqb_correct : forall x y, BigN.eq_bool x y = true -> x==y. +Proof. now apply BigN.eqb_eq. Qed. + +Lemma BigNpower : power_theory 1 BigN.mul BigN.eq (@id N) BigN.power. Proof. constructor. -exact add_0_l. -exact add_comm. -exact add_assoc. -exact mul_1_l. -exact mul_0_l. -exact mul_comm. -exact mul_assoc. -exact mul_add_distr_r. +intros. red. rewrite BigN.spec_power. unfold id. +destruct Zpower_theory as [EQ]. rewrite EQ. +destruct n; simpl. reflexivity. +induction p; simpl; intros; BigN.zify; rewrite ?IHp; auto. +Qed. + +Lemma BigNdiv : div_theory BigN.eq BigN.add BigN.mul (@id _) + (fun a b => if BigN.eq_bool b 0 then (0,a) else BigN.div_eucl a b). +Proof. +constructor. unfold id. intros a b. +BigN.zify. +generalize (Zeq_bool_if [b] 0); destruct (Zeq_bool [b] 0). +BigN.zify. auto with zarith. +intros NEQ. +generalize (BigN.spec_div_eucl a b). +generalize (Z_div_mod_full [a] [b] NEQ). +destruct BigN.div_eucl as (q,r), Zdiv_eucl as (q',r'). +intros (EQ,_). injection 1. intros EQr EQq. +BigN.zify. rewrite EQr, EQq; auto. +Qed. + + +(** Detection of constants *) + +Ltac isStaticWordCst t := + match t with + | W0 => constr:true + | WW ?t1 ?t2 => + match isStaticWordCst t1 with + | false => constr:false + | true => isStaticWordCst t2 + end + | _ => isInt31cst t + end. + +Ltac isBigNcst t := + match t with + | BigN.N0 ?t => isStaticWordCst t + | BigN.N1 ?t => isStaticWordCst t + | BigN.N2 ?t => isStaticWordCst t + | BigN.N3 ?t => isStaticWordCst t + | BigN.N4 ?t => isStaticWordCst t + | BigN.N5 ?t => isStaticWordCst t + | BigN.N6 ?t => isStaticWordCst t + | BigN.Nn ?n ?t => match isnatcst n with + | true => isStaticWordCst t + | false => constr:false + end + | BigN.zero => constr:true + | BigN.one => constr:true + | _ => constr:false + end. + +Ltac BigNcst t := + match isBigNcst t with + | true => constr:t + | false => constr:NotConstant + end. + +Ltac Ncst t := + match isNcst t with + | true => constr:t + | false => constr:NotConstant + end. + +(** Registration for the "ring" tactic *) + +Add Ring BigNr : BigNring + (decidable BigNeqb_correct, + constants [BigNcst], + power_tac BigNpower [Ncst], + div BigNdiv). + +Section TestRing. +Let test : forall x y, 1 + x*y + x^2 + 1 == 1*1 + 1 + y*x + 1*x*x. +intros. ring_simplify. reflexivity. Qed. +End TestRing. + +(** We benefit also from an "order" tactic *) + +Ltac bigN_order := BigN.order. + +Section TestOrder. +Let test : forall x y : bigN, x<=y -> y<=x -> x==y. +Proof. bigN_order. Qed. +End TestOrder. -Add Ring BigNr : BigNring. +(** We can use at least a bit of (r)omega by translating to [Z]. *) -(** Todo: tactic translating from [BigN] to [Z] + omega *) +Section TestOmega. +Let test : forall x y : bigN, x<=y -> y<=x -> x==y. +Proof. intros x y. BigN.zify. omega. Qed. +End TestOmega. (** Todo: micromega *) diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v new file mode 100644 index 00000000..925b0535 --- /dev/null +++ b/theories/Numbers/Natural/BigN/NMake.v @@ -0,0 +1,524 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) +(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) +(************************************************************************) + +(** * NMake *) + +(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*) + +(** NB: This file contain the part which is independent from the underlying + representation. The representation-dependent (and macro-generated) part + is now in [NMake_gen]. *) + +Require Import BigNumPrelude ZArith CyclicAxioms. +Require Import Nbasic Wf_nat StreamMemo NSig NMake_gen. + +Module Make (Import W0:CyclicType) <: NType. + + (** Macro-generated part *) + + Include NMake_gen.Make W0. + + + (** * Predecessor *) + + Lemma spec_pred : forall x, [pred x] = Zmax 0 ([x]-1). + Proof. + intros. destruct (Zle_lt_or_eq _ _ (spec_pos x)). + rewrite Zmax_r; auto with zarith. + apply spec_pred_pos; auto. + rewrite <- H; apply spec_pred0; auto. + Qed. + + + (** * Subtraction *) + + Lemma spec_sub : forall x y, [sub x y] = Zmax 0 ([x]-[y]). + Proof. + intros. destruct (Zle_or_lt [y] [x]). + rewrite Zmax_r; auto with zarith. apply spec_sub_pos; auto. + rewrite Zmax_l; auto with zarith. apply spec_sub0; auto. + Qed. + + (** * Comparison *) + + Theorem spec_compare : forall x y, compare x y = Zcompare [x] [y]. + Proof. + intros x y. generalize (spec_compare_aux x y); destruct compare; + intros; symmetry; try rewrite Zcompare_Eq_iff_eq; assumption. + Qed. + + Definition eq_bool x y := + match compare x y with + | Eq => true + | _ => false + end. + + Theorem spec_eq_bool : forall x y, eq_bool x y = Zeq_bool [x] [y]. + Proof. + intros. unfold eq_bool, Zeq_bool. rewrite spec_compare; reflexivity. + Qed. + + Theorem spec_eq_bool_aux: forall x y, + if eq_bool x y then [x] = [y] else [x] <> [y]. + Proof. + intros x y; unfold eq_bool. + generalize (spec_compare_aux x y); case compare; auto with zarith. + Qed. + + Definition lt n m := [n] < [m]. + Definition le n m := [n] <= [m]. + + 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. + + Theorem spec_max : forall n m, [max n m] = Zmax [n] [m]. + Proof. + intros. unfold max, Zmax. rewrite spec_compare; destruct Zcompare; reflexivity. + Qed. + + Theorem spec_min : forall n m, [min n m] = Zmin [n] [m]. + Proof. + intros. unfold min, Zmin. rewrite spec_compare; destruct Zcompare; reflexivity. + Qed. + + + (** * Power *) + + Fixpoint power_pos (x:t) (p:positive) {struct p} : t := + match p with + | xH => x + | xO p => square (power_pos x p) + | xI p => mul (square (power_pos x p)) x + end. + + Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. + Proof. + intros x n; generalize x; elim n; clear n x; simpl power_pos. + intros; rewrite spec_mul; rewrite spec_square; rewrite H. + rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith. + rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. + rewrite Zpower_2; rewrite Zpower_1_r; auto. + intros; rewrite spec_square; rewrite H. + rewrite Zpos_xO; auto with zarith. + rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. + rewrite Zpower_2; auto. + intros; rewrite Zpower_1_r; auto. + Qed. + + Definition power x (n:N) := match n with + | BinNat.N0 => one + | BinNat.Npos p => power_pos x p + end. + + Theorem spec_power: forall x n, [power x n] = [x] ^ Z_of_N n. + Proof. + destruct n; simpl. apply (spec_1 w0_spec). + apply spec_power_pos. + Qed. + + + (** * Div *) + + Definition div_eucl x y := + if eq_bool y zero then (zero,zero) else + match compare x y with + | Eq => (one, zero) + | Lt => (zero, x) + | Gt => div_gt x y + end. + + Theorem spec_div_eucl: forall x y, + let (q,r) := div_eucl x y in + ([q], [r]) = Zdiv_eucl [x] [y]. + Proof. + assert (F0: [zero] = 0). + exact (spec_0 w0_spec). + assert (F1: [one] = 1). + exact (spec_1 w0_spec). + intros x y. unfold div_eucl. + generalize (spec_eq_bool_aux y zero). destruct eq_bool; rewrite F0. + intro H. rewrite H. destruct [x]; auto. + intro H'. + assert (0 < [y]) by (generalize (spec_pos y); auto with zarith). + clear H'. + generalize (spec_compare_aux x y); case compare; try rewrite F0; + try rewrite F1; intros; auto with zarith. + rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H)) + (Z_mod_same [y] (Zlt_gt _ _ H)); + unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. + assert (F2: 0 <= [x] < [y]). + generalize (spec_pos x); auto. + generalize (Zdiv_small _ _ F2) + (Zmod_small _ _ F2); + unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. + generalize (spec_div_gt _ _ H0 H); auto. + unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt. + intros a b c d (H1, H2); subst; auto. + Qed. + + Definition div x y := fst (div_eucl x y). + + Theorem spec_div: + forall x y, [div x y] = [x] / [y]. + Proof. + intros x y; unfold div; generalize (spec_div_eucl x y); + case div_eucl; simpl fst. + intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; + injection H; auto. + Qed. + + + (** * Modulo *) + + Definition modulo x y := + if eq_bool y zero then zero else + match compare x y with + | Eq => zero + | Lt => x + | Gt => mod_gt x y + end. + + Theorem spec_modulo: + forall x y, [modulo x y] = [x] mod [y]. + Proof. + assert (F0: [zero] = 0). + exact (spec_0 w0_spec). + assert (F1: [one] = 1). + exact (spec_1 w0_spec). + intros x y. unfold modulo. + generalize (spec_eq_bool_aux y zero). destruct eq_bool; rewrite F0. + intro H; rewrite H. destruct [x]; auto. + intro H'. + assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith). + clear H'. + generalize (spec_compare_aux x y); case compare; try rewrite F0; + try rewrite F1; intros; try split; auto with zarith. + rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith. + apply sym_equal; apply Zmod_small; auto with zarith. + generalize (spec_pos x); auto with zarith. + apply spec_mod_gt; auto. + Qed. + + + (** * Gcd *) + + Definition gcd_gt_body a b cont := + match compare b zero with + | Gt => + let r := mod_gt a b in + match compare r zero with + | Gt => cont r (mod_gt b r) + | _ => b + end + | _ => a + end. + + Theorem Zspec_gcd_gt_body: forall a b cont p, + [a] > [b] -> [a] < 2 ^ p -> + (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] -> + Zis_gcd [a1] [b1] [cont a1 b1]) -> + Zis_gcd [a] [b] [gcd_gt_body a b cont]. + Proof. + assert (F1: [zero] = 0). + unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto. + intros a b cont p H2 H3 H4; unfold gcd_gt_body. + generalize (spec_compare_aux b zero); case compare; try rewrite F1. + intros HH; rewrite HH; apply Zis_gcd_0. + intros HH; absurd (0 <= [b]); auto with zarith. + case (spec_digits b); auto with zarith. + intros H5; generalize (spec_compare_aux (mod_gt a b) zero); + case compare; try rewrite F1. + intros H6; rewrite <- (Zmult_1_r [b]). + rewrite (Z_div_mod_eq [a] [b]); auto with zarith. + rewrite <- spec_mod_gt; auto with zarith. + rewrite H6; rewrite Zplus_0_r. + apply Zis_gcd_mult; apply Zis_gcd_1. + intros; apply False_ind. + case (spec_digits (mod_gt a b)); auto with zarith. + intros H6; apply DoubleDiv.Zis_gcd_mod; auto with zarith. + apply DoubleDiv.Zis_gcd_mod; auto with zarith. + rewrite <- spec_mod_gt; auto with zarith. + assert (F2: [b] > [mod_gt a b]). + case (Z_mod_lt [a] [b]); auto with zarith. + repeat rewrite <- spec_mod_gt; auto with zarith. + assert (F3: [mod_gt a b] > [mod_gt b (mod_gt a b)]). + case (Z_mod_lt [b] [mod_gt a b]); auto with zarith. + rewrite <- spec_mod_gt; auto with zarith. + repeat rewrite <- spec_mod_gt; auto with zarith. + apply H4; auto with zarith. + apply Zmult_lt_reg_r with 2; auto with zarith. + apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith. + apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith. + apply Zplus_le_compat_r. + pattern [b] at 1; rewrite <- (Zmult_1_l [b]). + apply Zmult_le_compat_r; auto with zarith. + case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith. + intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2; + try rewrite <- HH in H2; auto with zarith. + case (Z_mod_lt [a] [b]); auto with zarith. + rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith. + rewrite <- Z_div_mod_eq; auto with zarith. + pattern 2 at 2; rewrite <- (Zpower_1_r 2). + rewrite <- Zpower_exp; auto with zarith. + ring_simplify (p - 1 + 1); auto. + case (Zle_lt_or_eq 0 p); auto with zarith. + generalize H3; case p; simpl Zpower; auto with zarith. + intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith. + Qed. + + Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t := + gcd_gt_body a b + (fun a b => + match p with + | xH => cont a b + | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b + | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b + end). + + Theorem Zspec_gcd_gt_aux: forall p n a b cont, + [a] > [b] -> [a] < 2 ^ (Zpos p + n) -> + (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] -> + Zis_gcd [a1] [b1] [cont a1 b1]) -> + Zis_gcd [a] [b] [gcd_gt_aux p cont a b]. + intros p; elim p; clear p. + intros p Hrec n a b cont H2 H3 H4. + unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto. + intros a1 b1 H6 H7. + apply Hrec with (Zpos p + n); auto. + replace (Zpos p + (Zpos p + n)) with + (Zpos (xI p) + n - 1); auto. + rewrite Zpos_xI; ring. + intros a2 b2 H9 H10. + apply Hrec with n; auto. + intros p Hrec n a b cont H2 H3 H4. + unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto. + intros a1 b1 H6 H7. + apply Hrec with (Zpos p + n - 1); auto. + replace (Zpos p + (Zpos p + n - 1)) with + (Zpos (xO p) + n - 1); auto. + rewrite Zpos_xO; ring. + intros a2 b2 H9 H10. + apply Hrec with (n - 1); auto. + replace (Zpos p + (n - 1)) with + (Zpos p + n - 1); auto with zarith. + intros a3 b3 H12 H13; apply H4; auto with zarith. + apply Zlt_le_trans with (1 := H12). + case (Zle_or_lt 1 n); intros HH. + apply Zpower_le_monotone; auto with zarith. + apply Zle_trans with 0; auto with zarith. + assert (HH1: n - 1 < 0); auto with zarith. + generalize HH1; case (n - 1); auto with zarith. + intros p1 HH2; discriminate. + intros n a b cont H H2 H3. + simpl gcd_gt_aux. + apply Zspec_gcd_gt_body with (n + 1); auto with zarith. + rewrite Zplus_comm; auto. + intros a1 b1 H5 H6; apply H3; auto. + replace n with (n + 1 - 1); auto; try ring. + Qed. + + Definition gcd_cont a b := + match compare one b with + | Eq => one + | _ => a + end. + + Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b. + + Theorem spec_gcd_gt: forall a b, + [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]. + Proof. + intros a b H2. + case (spec_digits (gcd_gt a b)); intros H3 H4. + case (spec_digits a); intros H5 H6. + apply sym_equal; apply Zis_gcd_gcd; auto with zarith. + unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith. + intros a1 a2; rewrite Zpower_0_r. + case (spec_digits a2); intros H7 H8; + intros; apply False_ind; auto with zarith. + Qed. + + Definition gcd a b := + match compare a b with + | Eq => a + | Lt => gcd_gt b a + | Gt => gcd_gt a b + end. + + Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]. + Proof. + intros a b. + case (spec_digits a); intros H1 H2. + case (spec_digits b); intros H3 H4. + unfold gcd; generalize (spec_compare_aux a b); case compare. + intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto. + apply Zis_gcd_refl. + intros; apply trans_equal with (Zgcd [b] [a]). + apply spec_gcd_gt; auto with zarith. + apply Zis_gcd_gcd; auto with zarith. + apply Zgcd_is_pos. + apply Zis_gcd_sym; apply Zgcd_is_gcd. + intros; apply spec_gcd_gt; auto. + Qed. + + + (** * Conversion *) + + Definition of_N x := + match x with + | BinNat.N0 => zero + | Npos p => of_pos p + end. + + Theorem spec_of_N: forall x, + [of_N x] = Z_of_N x. + Proof. + intros x; case x. + simpl of_N. + unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto. + intros p; exact (spec_of_pos p). + Qed. + + + (** * Shift *) + + Definition shiftr n x := + match compare n (Ndigits x) with + | Lt => unsafe_shiftr n x + | _ => N0 w_0 + end. + + Theorem spec_shiftr: forall n x, + [shiftr n x] = [x] / 2 ^ [n]. + Proof. + intros n x; unfold shiftr; + generalize (spec_compare_aux n (Ndigits x)); case compare; intros H. + apply trans_equal with (1 := spec_0 w0_spec). + apply sym_equal; apply Zdiv_small; rewrite H. + rewrite spec_Ndigits; exact (spec_digits x). + rewrite <- spec_unsafe_shiftr; auto with zarith. + apply trans_equal with (1 := spec_0 w0_spec). + apply sym_equal; apply Zdiv_small. + rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2. + split; auto. + apply Zlt_le_trans with (1 := H2). + apply Zpower_le_monotone; auto with zarith. + Qed. + + Definition shiftl_aux_body cont n x := + match compare n (head0 x) with + Gt => cont n (double_size x) + | _ => unsafe_shiftl n x + end. + + Theorem spec_shiftl_aux_body: forall n p x cont, + 2^ Zpos p <= [head0 x] -> + (forall x, 2 ^ (Zpos p + 1) <= [head0 x]-> + [cont n x] = [x] * 2 ^ [n]) -> + [shiftl_aux_body cont n x] = [x] * 2 ^ [n]. + Proof. + intros n p x cont H1 H2; unfold shiftl_aux_body. + generalize (spec_compare_aux n (head0 x)); case compare; intros H. + apply spec_unsafe_shiftl; auto with zarith. + apply spec_unsafe_shiftl; auto with zarith. + rewrite H2. + rewrite spec_double_size; auto. + rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith. + apply Zle_trans with (2 := spec_double_size_head0 x). + rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith. + Qed. + + Fixpoint shiftl_aux p cont n x {struct p} := + shiftl_aux_body + (fun n x => match p with + | xH => cont n x + | xO p => shiftl_aux p (shiftl_aux p cont) n x + | xI p => shiftl_aux p (shiftl_aux p cont) n x + end) n x. + + Theorem spec_shiftl_aux: forall p q n x cont, + 2 ^ (Zpos q) <= [head0 x] -> + (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] -> + [cont n x] = [x] * 2 ^ [n]) -> + [shiftl_aux p cont n x] = [x] * 2 ^ [n]. + Proof. + intros p; elim p; unfold shiftl_aux; fold shiftl_aux; clear p. + intros p Hrec q n x cont H1 H2. + apply spec_shiftl_aux_body with (q); auto. + intros x1 H3; apply Hrec with (q + 1)%positive; auto. + intros x2 H4; apply Hrec with (p + q + 1)%positive; auto. + rewrite <- Pplus_assoc. + rewrite Zpos_plus_distr; auto. + intros x3 H5; apply H2. + rewrite Zpos_xI. + replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1)); + auto. + repeat rewrite Zpos_plus_distr; ring. + intros p Hrec q n x cont H1 H2. + apply spec_shiftl_aux_body with (q); auto. + intros x1 H3; apply Hrec with (q); auto. + apply Zle_trans with (2 := H3); auto with zarith. + apply Zpower_le_monotone; auto with zarith. + intros x2 H4; apply Hrec with (p + q)%positive; auto. + intros x3 H5; apply H2. + rewrite (Zpos_xO p). + replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q)); + auto. + repeat rewrite Zpos_plus_distr; ring. + intros q n x cont H1 H2. + apply spec_shiftl_aux_body with (q); auto. + rewrite Zplus_comm; auto. + Qed. + + Definition shiftl n x := + shiftl_aux_body + (shiftl_aux_body + (shiftl_aux (digits n) unsafe_shiftl)) n x. + + Theorem spec_shiftl: forall n x, + [shiftl n x] = [x] * 2 ^ [n]. + Proof. + intros n x; unfold shiftl, shiftl_aux_body. + generalize (spec_compare_aux n (head0 x)); case compare; intros H. + apply spec_unsafe_shiftl; auto with zarith. + apply spec_unsafe_shiftl; auto with zarith. + rewrite <- (spec_double_size x). + generalize (spec_compare_aux n (head0 (double_size x))); case compare; intros H1. + apply spec_unsafe_shiftl; auto with zarith. + apply spec_unsafe_shiftl; auto with zarith. + rewrite <- (spec_double_size (double_size x)). + apply spec_shiftl_aux with 1%positive. + apply Zle_trans with (2 := spec_double_size_head0 (double_size x)). + replace (2 ^ 1) with (2 * 1). + apply Zmult_le_compat_l; auto with zarith. + generalize (spec_double_size_head0_pos x); auto with zarith. + rewrite Zpower_1_r; ring. + intros x1 H2; apply spec_unsafe_shiftl. + apply Zle_trans with (2 := H2). + apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith. + case (spec_digits n); auto with zarith. + apply Zpower_le_monotone; auto with zarith. + Qed. + + + (** * Zero and One *) + + Theorem spec_0: [zero] = 0. + Proof. + exact (spec_0 w0_spec). + Qed. + + Theorem spec_1: [one] = 1. + Proof. + exact (spec_1 w0_spec). + Qed. + + +End Make. diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml index 04c7b96d..b8552a39 100644 --- a/theories/Numbers/Natural/BigN/NMake_gen.ml +++ b/theories/Numbers/Natural/BigN/NMake_gen.ml @@ -8,14 +8,14 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: NMake_gen.ml 11576 2008-11-10 19:13:15Z msozeau $ i*) +(*i $Id$ i*) (*S NMake_gen.ml : this file generates NMake.v *) (*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,21 +67,13 @@ 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."; - pr "Require Import CyclicAxioms."; - pr "Require Import DoubleType."; - pr "Require Import DoubleMul."; - pr "Require Import DoubleDivn1."; - pr "Require Import DoubleCyclic."; - pr "Require Import Nbasic."; - pr "Require Import Wf_nat."; - pr "Require Import StreamMemo."; - pr "Require Import NSig."; + pr "Require Import BigNumPrelude ZArith CyclicAxioms"; + pr " DoubleType DoubleMul DoubleDivn1 DoubleCyclic Nbasic"; + pr " Wf_nat StreamMemo."; pr ""; - pr "Module Make (Import W0:CyclicType) <: NType."; + pr "Module Make (Import W0:CyclicType)."; pr ""; pr " Definition w0 := W0.w."; @@ -132,7 +124,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,20 +159,20 @@ let _ = pr " Definition to_N x := Zabs_N (to_Z x)."; pr ""; - + pr " Definition eq x y := (to_Z x = to_Z y)."; pr ""; pp " (* Regular make op (no karatsuba) *)"; - pp " Fixpoint nmake_op (ww:Type) (ww_op: znz_op ww) (n: nat) : "; + pp " Fixpoint nmake_op (ww:Type) (ww_op: znz_op ww) (n: nat) :"; pp " znz_op (word ww n) :="; - pp " match n return znz_op (word ww n) with "; + pp " match n return znz_op (word ww n) with"; pp " O => ww_op"; - pp " | S n1 => mk_zn2z_op (nmake_op ww ww_op n1) "; + pp " | S n1 => mk_zn2z_op (nmake_op ww ww_op n1)"; pp " end."; pp ""; pp " (* Simplification by rewriting for nmake_op *)"; - pp " Theorem nmake_op_S: forall ww (w_op: znz_op ww) x, "; + pp " Theorem nmake_op_S: forall ww (w_op: znz_op ww) x,"; pp " nmake_op _ w_op (S x) = mk_zn2z_op (nmake_op _ w_op x)."; pp " auto."; pp " Qed."; @@ -191,7 +183,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; @@ -199,8 +191,8 @@ let _ = pr ""; - pp " Theorem digits_doubled:forall n ww (w_op: znz_op ww), "; - pp " znz_digits (nmake_op _ w_op n) = "; + pp " Theorem digits_doubled:forall n ww (w_op: znz_op ww),"; + pp " znz_digits (nmake_op _ w_op n) ="; pp " DoubleBase.double_digits (znz_digits w_op) n."; pp " Proof."; pp " intros n; elim n; auto; clear n."; @@ -208,7 +200,7 @@ let _ = pp " rewrite <- Hrec; auto."; pp " Qed."; pp ""; - pp " Theorem nmake_double: forall n ww (w_op: znz_op ww), "; + pp " Theorem nmake_double: forall n ww (w_op: znz_op ww),"; pp " znz_to_Z (nmake_op _ w_op n) ="; pp " @DoubleBase.double_to_Z _ (znz_digits w_op) (znz_to_Z w_op) n."; pp " Proof."; @@ -220,8 +212,8 @@ let _ = pp ""; - pp " Theorem digits_nmake:forall n ww (w_op: znz_op ww), "; - pp " znz_digits (nmake_op _ w_op (S n)) = "; + pp " Theorem digits_nmake:forall n ww (w_op: znz_op ww),"; + pp " znz_digits (nmake_op _ w_op (S n)) ="; pp " xO (znz_digits (nmake_op _ w_op n))."; pp " Proof."; pp " auto."; @@ -257,30 +249,30 @@ let _ = pp " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op n))))."; pp " rewrite Hrec; auto with arith."; pp " Qed."; - pp " "; + pp ""; for i = 1 to size + 2 do pp " Let znz_to_Z_%i: forall x y," i; - pp " znz_to_Z w%i_op (WW x y) = " i; + pp " znz_to_Z w%i_op (WW x y) =" i; pp " znz_to_Z w%i_op x * base (znz_digits w%i_op) + znz_to_Z w%i_op y." (i-1) (i-1) (i-1); pp " Proof."; pp " auto."; - pp " Qed. "; + pp " Qed."; pp ""; done; pp " Let znz_to_Z_n: forall n x y,"; - pp " znz_to_Z (make_op (S n)) (WW x y) = "; + pp " znz_to_Z (make_op (S n)) (WW x y) ="; pp " znz_to_Z (make_op n) x * base (znz_digits (make_op n)) + znz_to_Z (make_op n) y."; pp " Proof."; pp " intros n x y; rewrite make_op_S; auto."; - pp " Qed. "; + pp " Qed."; pp ""; 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 +301,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 +317,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 +338,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 +355,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 +385,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 +397,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 +422,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 +438,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."; @@ -478,7 +470,6 @@ let _ = pp " unfold to_Z."; pp " case n1; auto; intros n2; repeat rewrite make_op_S; auto."; pp " Qed."; - pp " Hint Rewrite spec_extendn_0: extr."; pp ""; pp " Let spec_extendn0_0: forall n wx, [%sn (S n) (WW W0 wx)] = [%sn n wx]." c c; pp " Proof."; @@ -489,7 +480,6 @@ let _ = pp " case n; auto."; pp " intros n1; rewrite make_op_S; auto."; pp " Qed."; - pp " Hint Rewrite spec_extendn_0: extr."; pp ""; pp " Let spec_extend_tr: forall m n (w: word _ (S n)),"; pp " [%sn (m + n) (extend_tr w m)] = [%sn n w]." c c; @@ -498,7 +488,6 @@ let _ = pp " intros n x; simpl extend_tr."; pp " simpl plus; rewrite spec_extendn0_0; auto."; pp " Qed."; - pp " Hint Rewrite spec_extend_tr: extr."; pp ""; pp " Let spec_cast_l: forall n m x1,"; pp " [%sn (Max.max n m)" c; @@ -508,7 +497,6 @@ let _ = pp " intros n m x1; case (diff_r n m); simpl castm."; pp " rewrite spec_extend_tr; auto."; pp " Qed."; - pp " Hint Rewrite spec_cast_l: extr."; pp ""; pp " Let spec_cast_r: forall n m x1,"; pp " [%sn (Max.max n m)" c; @@ -518,7 +506,6 @@ let _ = pp " intros n m x1; case (diff_l n m); simpl castm."; pp " rewrite spec_extend_tr; auto."; pp " Qed."; - pp " Hint Rewrite spec_cast_r: extr."; pp ""; @@ -578,14 +565,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,17 +598,17 @@ 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); "; + pp " intros m y; rewrite <- (spec_cast_l n m x);"; pp " rewrite <- (spec_cast_r n m y); apply Pfnn."; pp " Qed."; pp ""; @@ -644,7 +631,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 +640,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 +652,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 +694,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,16 +708,16 @@ 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); "; + pp " intros m y; rewrite <- (spec_cast_l n m x);"; pp " rewrite <- (spec_cast_r n m y); apply Pfnn."; pp " Qed."; pp ""; pr " (* We iter the smaller argument with the bigger *)"; - pr " Definition iter (x y: t_): res := "; + pr " Definition iter (x y: t_): res :="; pr0 " Eval lazy zeta beta iota delta ["; for i = 0 to size do pr0 "extend%i " i; @@ -748,14 +735,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; @@ -765,6 +752,7 @@ let _ = pp " Ltac zg_tac := try"; pp " (red; simpl Zcompare; auto;"; pp " let t := fresh \"H\" in (intros t; discriminate t))."; + pp ""; pp " Lemma spec_iter: forall x y, P [x] [y] (iter x y)."; pp " Proof."; pp " intros x; case x; clear x; unfold iter."; @@ -779,14 +767,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 +808,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 +820,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 +857,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 +871,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."; @@ -897,27 +885,27 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Reduction *)"; + pr " (** * Reduction *)"; pr " (* *)"; 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 " Definition reduce_n n :="; pr " Eval lazy beta iota delta[reduce_n] in"; pr " reduce_n _ _ zero reduce_%i %sn n." (size + 1) c; pr ""; @@ -927,7 +915,7 @@ let _ = pp " intros x; unfold to_Z, reduce_0."; pp " auto."; pp " Qed."; - pp " "; + pp ""; for i = 1 to size + 1 do if i == size + 1 then @@ -938,14 +926,14 @@ let _ = pp " intros x; case x; unfold reduce_%i." i; pp " exact (spec_0 w0_spec)."; pp " intros x1 y1."; - pp " generalize (spec_w%i_eq0 x1); " (i - 1); + 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."; pp " Qed."; - pp " "; + pp ""; done; pp " Let spec_reduce_n: forall n x, [reduce_n n x] = [%sn n x]." c; @@ -959,11 +947,11 @@ let _ = pp " rewrite Hrec."; pp " rewrite spec_extendn0_0; auto."; pp " Qed."; - pp " "; + pp ""; pr " (***************************************************************)"; pr " (* *)"; - pr " (* Successor *)"; + pr " (** * Successor *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -983,19 +971,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."; @@ -1027,13 +1015,13 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Adddition *)"; + pr " (** * Adddition *)"; pr " (* *)"; pr " (***************************************************************)"; 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,26 +1045,24 @@ 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;"; pp " exact (spec_1 w%i_spec)." i; pp " Qed."; - pp " Hint Rewrite spec_w%i_add: addr." i; pp ""; done; pp " Let spec_wn_add: forall n x y, [addn n x y] = [%sn n x] + [%sn n y]." c c; 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;"; pp " exact (spec_1 (wn_spec k))."; pp " Qed."; - pp " Hint Rewrite spec_wn_add: addr."; pr " Definition add := Eval lazy beta delta [same_level] in"; pr0 " (same_level t_ "; @@ -1101,7 +1087,7 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Predecessor *)"; + pr " (** * Predecessor *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1116,25 +1102,25 @@ 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."; pr ""; - pr " Theorem spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1."; + pr " Theorem spec_pred_pos : forall x, 0 < [x] -> [pred x] = [x] - 1."; pa " Admitted."; pp " Proof."; pp " intros x; case x; unfold pred."; for i = 0 to size do - pp " intros x1 H1; unfold w%i_pred_c; " i; + pp " intros x1 H1; unfold w%i_pred_c;" i; pp " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i; pp " rewrite spec_reduce_%i; auto." i; pp " unfold interp_carry; unfold to_Z."; @@ -1143,7 +1129,7 @@ let _ = pp " assert (znz_to_Z w%i_op x1 - 1 < 0); auto with zarith." i; pp " unfold to_Z in H1; auto with zarith."; done; - pp " intros n x1 H1; "; + pp " intros n x1 H1;"; pp " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1."; pp " rewrite spec_reduce_n; auto."; pp " unfold interp_carry; unfold to_Z."; @@ -1152,32 +1138,31 @@ let _ = pp " assert (znz_to_Z (make_op n) x1 - 1 < 0); auto with zarith."; pp " unfold to_Z in H1; auto with zarith."; pp " Qed."; - pp " "; - + pp ""; + pp " Let spec_pred0: forall x, [x] = 0 -> [pred x] = 0."; pp " Proof."; pp " intros x; case x; unfold pred."; for i = 0 to size do - pp " intros x1 H1; unfold w%i_pred_c; " i; + pp " intros x1 H1; unfold w%i_pred_c;" i; pp " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i; pp " unfold interp_carry; unfold to_Z."; pp " unfold to_Z in H1; auto with zarith."; pp " case (spec_to_Z w%i_spec y1); intros HH3 HH4; auto with zarith." i; pp " intros; exact (spec_0 w0_spec)."; done; - pp " intros n x1 H1; "; + pp " intros n x1 H1;"; pp " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1."; pp " unfold interp_carry; unfold to_Z."; pp " unfold to_Z in H1; auto with zarith."; pp " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4; auto with zarith."; pp " intros; exact (spec_0 w0_spec)."; pp " Qed."; - pr " "; - + pr ""; pr " (***************************************************************)"; pr " (* *)"; - pr " (* Subtraction *)"; + pr " (** * Subtraction *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1187,7 +1172,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; @@ -1208,8 +1193,8 @@ let _ = pp " Let spec_w%i_sub: forall x y, [%s%i y] <= [%s%i x] -> [w%i_sub x y] = [%s%i x] - [%s%i y]." i c i c i i c i c i; 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 + pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c;" i; + if i == 0 then pp " intros x; auto." else pp " intros x; try rewrite spec_reduce_%i; auto." i; @@ -1219,11 +1204,11 @@ 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."; - pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; "; + pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c;"; pp " intros x; auto."; pp " unfold interp_carry, to_Z."; pp " case (spec_to_Z (wn_spec k) x); intros; auto with zarith."; @@ -1238,7 +1223,7 @@ let _ = pr "subn)."; pr ""; - pr " Theorem spec_sub: forall x y, [y] <= [x] -> [sub x y] = [x] - [y]."; + pr " Theorem spec_sub_pos : forall x y, [y] <= [x] -> [sub x y] = [x] - [y]."; pa " Admitted."; pp " Proof."; pp " unfold sub."; @@ -1255,7 +1240,7 @@ let _ = pp " Let spec_w%i_sub0: forall x y, [%s%i x] < [%s%i y] -> [w%i_sub x y] = 0." i c i c i i; 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; + pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c;" i; pp " intros x; unfold interp_carry."; pp " unfold to_Z; case (spec_to_Z w%i_spec x); intros; auto with zarith." i; pp " intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto."; @@ -1266,7 +1251,7 @@ let _ = pp " Let spec_wn_sub0: forall n x y, [%sn n x] < [%sn n y] -> [subn n x y] = 0." c c; pp " Proof."; pp " intros k n m; unfold subn."; - pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; "; + pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c;"; pp " intros x; unfold interp_carry."; pp " unfold to_Z; case (spec_to_Z (wn_spec k) x); intros; auto with zarith."; pp " intros; unfold to_Z, w_0; rewrite (spec_0 (w0_spec)); auto."; @@ -1289,7 +1274,7 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Comparison *)"; + pr " (** * Comparison *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1299,7 +1284,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"; @@ -1310,8 +1295,8 @@ let _ = pr " (castm (diff_l n m) (extend_tr wy (fst d)))."; pr ""; - pr " Definition compare := Eval lazy beta delta [iter] in "; - pr " (iter _ "; + pr " Definition compare := Eval lazy beta delta [iter] in"; + pr " (iter _"; for i = 0 to size do pr " compare_%i" i; pr " (fun n x y => opp_compare (comparen_%i (S n) y x))" i; @@ -1320,15 +1305,9 @@ let _ = pr " comparenm)."; pr ""; - pr " Definition lt n m := compare n m = Lt."; - pr " Definition le n m := compare n m <> Gt."; - pr " Definition min n m := match compare n m with Gt => m | _ => n end."; - pr " Definition max n m := match compare n m with Lt => m | _ => n end."; - pr ""; - for i = 0 to size do pp " Let spec_compare_%i: forall x y," i; - pp " match compare_%i x y with " i; + pp " match compare_%i x y with" i; pp " Eq => [%s%i x] = [%s%i y]" c i c i; pp " | Lt => [%s%i x] < [%s%i y]" c i c i; pp " | Gt => [%s%i x] > [%s%i y]" c i c i; @@ -1337,7 +1316,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; @@ -1367,16 +1346,16 @@ let _ = pp ""; - pr " Theorem spec_compare: forall x y,"; - pr " match compare x y with "; + pr " Theorem spec_compare_aux: forall x y,"; + pr " match compare x y with"; pr " Eq => [x] = [y]"; pr " | Lt => [x] < [y]"; pr " | Gt => [x] > [y]"; pr " end."; pa " Admitted."; pp " Proof."; - pp " refine (spec_iter _ (fun x y res => "; - pp " match res with "; + pp " refine (spec_iter _ (fun x y res =>"; + pp " match res with"; pp " Eq => x = y"; pp " | Lt => x < y"; pp " | Gt => x > y"; @@ -1387,12 +1366,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; @@ -1402,28 +1381,9 @@ let _ = pp " Qed."; pr ""; - pr " Definition eq_bool x y :="; - pr " match compare x y with"; - pr " | Eq => true"; - pr " | _ => false"; - pr " end."; - pr ""; - - - pr " Theorem spec_eq_bool: forall x y,"; - pr " if eq_bool x y then [x] = [y] else [x] <> [y]."; - pa " Admitted."; - pp " Proof."; - pp " intros x y; unfold eq_bool."; - pp " generalize (spec_compare x y); case compare; auto with zarith."; - pp " Qed."; - pr ""; - - - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Multiplication *)"; + pr " (** * Multiplication *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1461,7 +1421,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 +1431,7 @@ let _ = pr " | _ => fun _ => N0 w_0"; pr " end."; pr ""; - done; + done; for i = 0 to size - 1 do @@ -1486,7 +1446,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 +1457,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; @@ -1514,10 +1474,10 @@ let _ = pr " (castm (diff_l n m) (extend_tr y (fst d))))."; pr ""; - pr " Definition mul := Eval lazy beta delta [iter0] in "; - pr " (iter0 t_ "; + pr " Definition mul := Eval lazy beta delta [iter0] in"; + pr " (iter0 t_"; for i = 0 to size do - pr " (fun x y => reduce_%i (w%i_mul_c x y)) " (i + 1) i; + pr " (fun x y => reduce_%i (w%i_mul_c x y))" (i + 1) i; pr " (fun n x y => w%i_mul n y x)" i; pr " w%i_mul" i; done; @@ -1556,7 +1516,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,21 +1524,21 @@ 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; + pp " znz_to_Z (nmake_op _ w%i_op (S n)) (extend%i n x1) =" i i; pp " znz_to_Z w%i_op x1." i; pp " Proof."; 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; @@ -1588,12 +1548,13 @@ let _ = pp " rewrite make_op_S."; pp " case znz_mul_c; auto."; pp " Qed."; + pr ""; pr " Theorem spec_mul: forall x y, [mul x y] = [x] * [y]."; pa " Admitted."; pp " Proof."; for i = 0 to size do - pp " assert(F%i: " i; + pp " assert(F%i:" i; pp " forall n x y,"; if i <> size then pp0 " Z_of_nat n <= %i -> " (size - i); @@ -1614,7 +1575,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 @@ -1627,7 +1588,7 @@ let _ = done; pp " refine (spec_iter0 t_ (fun x y res => [res] = x * y)"; for i = 0 to size do - pp " (fun x y => reduce_%i (w%i_mul_c x y)) " (i + 1) i; + pp " (fun x y => reduce_%i (w%i_mul_c x y))" (i + 1) i; pp " (fun n x y => w%i_mul n y x)" i; pp " w%i_mul _ _ _" i; done; @@ -1643,12 +1604,12 @@ let _ = if i == size then begin pp " intros n x y; rewrite F%i; auto with zarith." i; - pp " intros n x y; rewrite F%i; auto with zarith. " i; + pp " intros n x y; rewrite F%i; auto with zarith." i; end else begin pp " intros n x y H; rewrite F%i; auto with zarith." i; - pp " intros n x y H; rewrite F%i; auto with zarith. " i; + pp " intros n x y H; rewrite F%i; auto with zarith." i; end; done; pp " intros n m x y; unfold mulnm."; @@ -1663,7 +1624,7 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Square *)"; + pr " (** * Square *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1702,42 +1663,9 @@ let _ = pp "Qed."; pr ""; - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Power *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - pr " Fixpoint power_pos (x:%s) (p:positive) {struct p} : %s :=" t t; - pr " match p with"; - pr " | xH => x"; - pr " | xO p => square (power_pos x p)"; - pr " | xI p => mul (square (power_pos x p)) x"; - pr " end."; - pr ""; - - pr " Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n."; - 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."; - pp " rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith."; - pp " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith."; - pp " rewrite Zpower_2; rewrite Zpower_1_r; auto."; - pp " intros; rewrite spec_square; rewrite H."; - pp " rewrite Zpos_xO; auto with zarith."; - pp " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith."; - pp " rewrite Zpower_2; auto."; - pp " intros; rewrite Zpower_1_r; auto."; - pp " Qed."; - pp ""; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (* Square root *)"; + pr " (** * Square root *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1772,26 +1700,26 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Division *)"; + 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 done; pr ""; - pp " Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := "; - pp " (spec_double_divn1 "; + pp " Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) :="; + pp " (spec_double_divn1"; pp " ww_op.(znz_zdigits) ww_op.(znz_0)"; pp " (znz_WW ww_op) ww_op.(znz_head0)"; pp " ww_op.(znz_add_mul_div) ww_op.(znz_div21)"; pp " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)"; - pp " (spec_to_Z ww_spec) "; + pp " (spec_to_Z ww_spec)"; pp " (spec_zdigits ww_spec)"; pp " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)"; - pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) "; + pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec)"; pp " (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec))."; pp ""; @@ -1811,7 +1739,7 @@ let _ = for i = 0 to size do pp " Lemma spec_get_end%i: forall n x y," i; - pp " eval%in n x <= [%s%i y] -> " i c i; + pp " eval%in n x <= [%s%i y] ->" i c i; pp " [%s%i (DoubleBase.get_low %s n x)] = eval%in n x." c i (pz i) i; pp " Proof."; pp " intros n x y H."; @@ -1843,8 +1771,8 @@ let _ = pr ""; pr " Definition div_gt := Eval lazy beta delta [iter] in"; - pr " (iter _ "; - for i = 0 to size do + pr " (iter _"; + 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 +1790,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; @@ -1879,11 +1807,11 @@ let _ = pp " intros n x y H2 H3; unfold div_gt%i, w%i_div_gt." i i else pp " intros n x y H1 H2 H3; unfold div_gt%i, w%i_div_gt." i i; - pp " generalize (spec_div_gt w%i_spec x " i; + pp " generalize (spec_div_gt w%i_spec x" i; pp " (DoubleBase.get_low %s (S n) y))." (pz i); - pp0 " "; + 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 +1825,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."; @@ -1936,61 +1864,12 @@ let _ = pp " Qed."; pr ""; - pr " Definition div_eucl x y :="; - pr " match compare x y with"; - pr " | Eq => (one, zero)"; - pr " | Lt => (zero, x)"; - pr " | Gt => div_gt x y"; - pr " end."; - pr ""; - - pr " Theorem spec_div_eucl: forall x y,"; - pr " 0 < [y] ->"; - pr " let (q,r) := div_eucl x y in"; - pr " ([q], [r]) = Zdiv_eucl [x] [y]."; - pa " Admitted."; - pp " Proof."; - pp " assert (F0: [zero] = 0)."; - pp " exact (spec_0 w0_spec)."; - pp " assert (F1: [one] = 1)."; - pp " exact (spec_1 w0_spec)."; - pp " intros x y H; generalize (spec_compare x y);"; - pp " unfold div_eucl; case compare; try rewrite F0;"; - pp " try rewrite F1; intros; auto with zarith."; - pp " rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H))"; - pp " (Z_mod_same [y] (Zlt_gt _ _ H));"; - pp " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto."; - pp " assert (F2: 0 <= [x] < [y])."; - pp " generalize (spec_pos x); auto."; - pp " generalize (Zdiv_small _ _ F2)"; - pp " (Zmod_small _ _ F2);"; - pp " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto."; - pp " generalize (spec_div_gt _ _ H0 H); auto."; - pp " unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt."; - pp " intros a b c d (H1, H2); subst; auto."; - pp " Qed."; - pr ""; - - pr " Definition div x y := fst (div_eucl x y)."; - pr ""; - - pr " Theorem spec_div:"; - pr " forall x y, 0 < [y] -> [div x y] = [x] / [y]."; - pa " Admitted."; - pp " Proof."; - pp " intros x y H1; unfold div; generalize (spec_div_eucl x y H1);"; - pp " case div_eucl; simpl fst."; - pp " intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; "; - pp " injection H; auto."; - pp " Qed."; - pr ""; - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Modulo *)"; + 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 @@ -2015,7 +1894,7 @@ let _ = pr ""; pr " Definition mod_gt := Eval lazy beta delta[iter] in"; - pr " (iter _ "; + pr " (iter _"; for i = 0 to size do pr " (fun x y => reduce_%i (w%i_mod_gt x y))" i i; pr " (fun n x y => reduce_%i (w%i_mod_gt x (DoubleBase.get_low %s (S n) y)))" i i (pz i); @@ -2024,16 +1903,16 @@ let _ = pr " mod_gtnm)."; pr ""; - pp " Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := "; - pp " (spec_double_modn1 "; + pp " Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) :="; + pp " (spec_double_modn1"; pp " ww_op.(znz_zdigits) ww_op.(znz_0)"; pp " (znz_WW ww_op) ww_op.(znz_head0)"; pp " ww_op.(znz_add_mul_div) ww_op.(znz_div21)"; pp " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)"; - pp " (spec_to_Z ww_spec) "; + pp " (spec_to_Z ww_spec)"; pp " (spec_zdigits ww_spec)"; pp " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)"; - pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) "; + pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec)"; pp " (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec))."; pp ""; @@ -2063,7 +1942,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; @@ -2079,39 +1958,9 @@ let _ = pp " Qed."; pr ""; - pr " Definition modulo x y := "; - pr " match compare x y with"; - pr " | Eq => zero"; - pr " | Lt => x"; - pr " | Gt => mod_gt x y"; - pr " end."; + pr " (** digits: a measure for gcd *)"; pr ""; - pr " Theorem spec_modulo:"; - pr " forall x y, 0 < [y] -> [modulo x y] = [x] mod [y]."; - pa " Admitted."; - pp " Proof."; - pp " assert (F0: [zero] = 0)."; - pp " exact (spec_0 w0_spec)."; - pp " assert (F1: [one] = 1)."; - pp " exact (spec_1 w0_spec)."; - pp " intros x y H; generalize (spec_compare x y);"; - pp " unfold modulo; case compare; try rewrite F0;"; - pp " try rewrite F1; intros; try split; auto with zarith."; - pp " rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith."; - pp " apply sym_equal; apply Zmod_small; auto with zarith."; - pp " generalize (spec_pos x); auto with zarith."; - pp " apply spec_mod_gt; auto."; - pp " Qed."; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (* Gcd *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - pr " Definition digits x :="; pr " match x with"; for i = 0 to size do @@ -2134,189 +1983,18 @@ let _ = pp " Qed."; pr ""; - pr " Definition gcd_gt_body a b cont :="; - pr " match compare b zero with"; - pr " | Gt =>"; - pr " let r := mod_gt a b in"; - pr " match compare r zero with"; - pr " | Gt => cont r (mod_gt b r)"; - pr " | _ => b"; - pr " end"; - pr " | _ => a"; - pr " end."; - pr ""; - - pp " Theorem Zspec_gcd_gt_body: forall a b cont p,"; - pp " [a] > [b] -> [a] < 2 ^ p ->"; - pp " (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] ->"; - pp " Zis_gcd [a1] [b1] [cont a1 b1]) -> "; - pp " Zis_gcd [a] [b] [gcd_gt_body a b cont]."; - pp " Proof."; - pp " assert (F1: [zero] = 0)."; - pp " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto."; - pp " intros a b cont p H2 H3 H4; unfold gcd_gt_body."; - pp " generalize (spec_compare b zero); case compare; try rewrite F1."; - pp " intros HH; rewrite HH; apply Zis_gcd_0."; - pp " intros HH; absurd (0 <= [b]); auto with zarith."; - pp " case (spec_digits b); auto with zarith."; - pp " intros H5; generalize (spec_compare (mod_gt a b) zero); "; - pp " case compare; try rewrite F1."; - pp " intros H6; rewrite <- (Zmult_1_r [b])."; - pp " rewrite (Z_div_mod_eq [a] [b]); auto with zarith."; - pp " rewrite <- spec_mod_gt; auto with zarith."; - pp " rewrite H6; rewrite Zplus_0_r."; - pp " apply Zis_gcd_mult; apply Zis_gcd_1."; - pp " intros; apply False_ind."; - pp " case (spec_digits (mod_gt a b)); auto with zarith."; - pp " intros H6; apply DoubleDiv.Zis_gcd_mod; auto with zarith."; - pp " apply DoubleDiv.Zis_gcd_mod; auto with zarith."; - pp " rewrite <- spec_mod_gt; auto with zarith."; - pp " assert (F2: [b] > [mod_gt a b])."; - pp " case (Z_mod_lt [a] [b]); auto with zarith."; - pp " repeat rewrite <- spec_mod_gt; auto with zarith."; - pp " assert (F3: [mod_gt a b] > [mod_gt b (mod_gt a b)])."; - pp " case (Z_mod_lt [b] [mod_gt a b]); auto with zarith."; - pp " rewrite <- spec_mod_gt; auto with zarith."; - pp " repeat rewrite <- spec_mod_gt; auto with zarith."; - pp " apply H4; auto with zarith."; - pp " apply Zmult_lt_reg_r with 2; auto with zarith."; - pp " apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith."; - pp " apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith."; - pp " apply Zplus_le_compat_r."; - pp " pattern [b] at 1; rewrite <- (Zmult_1_l [b])."; - pp " apply Zmult_le_compat_r; auto with zarith."; - pp " case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith."; - pp " intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2;"; - pp " try rewrite <- HH in H2; auto with zarith."; - pp " case (Z_mod_lt [a] [b]); auto with zarith."; - pp " rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith."; - pp " rewrite <- Z_div_mod_eq; auto with zarith."; - pp " pattern 2 at 2; rewrite <- (Zpower_1_r 2)."; - pp " rewrite <- Zpower_exp; auto with zarith."; - pp " ring_simplify (p - 1 + 1); auto."; - pp " case (Zle_lt_or_eq 0 p); auto with zarith."; - pp " generalize H3; case p; simpl Zpower; auto with zarith."; - pp " intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith."; - pp " Qed."; - pp ""; - - pr " Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t :="; - pr " gcd_gt_body a b"; - pr " (fun a b =>"; - pr " match p with"; - pr " | xH => cont a b"; - pr " | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b"; - pr " | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b"; - pr " end)."; - pr ""; - - pp " Theorem Zspec_gcd_gt_aux: forall p n a b cont,"; - pp " [a] > [b] -> [a] < 2 ^ (Zpos p + n) ->"; - pp " (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] ->"; - pp " Zis_gcd [a1] [b1] [cont a1 b1]) ->"; - pp " Zis_gcd [a] [b] [gcd_gt_aux p cont a b]."; - pp " intros p; elim p; clear p."; - pp " intros p Hrec n a b cont H2 H3 H4."; - pp " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto."; - pp " intros a1 b1 H6 H7."; - pp " apply Hrec with (Zpos p + n); auto."; - pp " replace (Zpos p + (Zpos p + n)) with"; - pp " (Zpos (xI p) + n - 1); auto."; - pp " rewrite Zpos_xI; ring."; - pp " intros a2 b2 H9 H10."; - pp " apply Hrec with n; auto."; - pp " intros p Hrec n a b cont H2 H3 H4."; - pp " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto."; - pp " intros a1 b1 H6 H7."; - pp " apply Hrec with (Zpos p + n - 1); auto."; - pp " replace (Zpos p + (Zpos p + n - 1)) with"; - pp " (Zpos (xO p) + n - 1); auto."; - pp " rewrite Zpos_xO; ring."; - pp " intros a2 b2 H9 H10."; - pp " apply Hrec with (n - 1); auto."; - pp " replace (Zpos p + (n - 1)) with"; - pp " (Zpos p + n - 1); auto with zarith."; - pp " intros a3 b3 H12 H13; apply H4; auto with zarith."; - pp " apply Zlt_le_trans with (1 := H12)."; - pp " case (Zle_or_lt 1 n); intros HH."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " apply Zle_trans with 0; auto with zarith."; - pp " assert (HH1: n - 1 < 0); auto with zarith."; - pp " generalize HH1; case (n - 1); auto with zarith."; - pp " intros p1 HH2; discriminate."; - pp " intros n a b cont H H2 H3."; - pp " simpl gcd_gt_aux."; - pp " apply Zspec_gcd_gt_body with (n + 1); auto with zarith."; - pp " rewrite Zplus_comm; auto."; - pp " intros a1 b1 H5 H6; apply H3; auto."; - pp " replace n with (n + 1 - 1); auto; try ring."; - pp " Qed."; - pp ""; - - pr " Definition gcd_cont a b :="; - pr " match compare one b with"; - pr " | Eq => one"; - pr " | _ => a"; - pr " end."; - pr ""; - - pr " Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b."; - pr ""; - - pr " Theorem spec_gcd_gt: forall a b,"; - pr " [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]."; - pa " Admitted."; - pp " Proof."; - pp " intros a b H2."; - pp " case (spec_digits (gcd_gt a b)); intros H3 H4."; - pp " case (spec_digits a); intros H5 H6."; - pp " apply sym_equal; apply Zis_gcd_gcd; auto with zarith."; - pp " unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith."; - pp " intros a1 a2; rewrite Zpower_0_r."; - pp " case (spec_digits a2); intros H7 H8;"; - pp " intros; apply False_ind; auto with zarith."; - pp " Qed."; - pr ""; - - pr " Definition gcd a b :="; - pr " match compare a b with"; - pr " | Eq => a"; - pr " | Lt => gcd_gt b a"; - pr " | Gt => gcd_gt a b"; - pr " end."; - pr ""; - - pr " Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]."; - pa " Admitted."; - pp " Proof."; - pp " intros a b."; - pp " case (spec_digits a); intros H1 H2."; - pp " case (spec_digits b); intros H3 H4."; - pp " unfold gcd; generalize (spec_compare a b); case compare."; - pp " intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto."; - pp " apply Zis_gcd_refl."; - pp " intros; apply trans_equal with (Zgcd [b] [a])."; - pp " apply spec_gcd_gt; auto with zarith."; - pp " apply Zis_gcd_gcd; auto with zarith."; - pp " apply Zgcd_is_pos."; - pp " apply Zis_gcd_sym; apply Zgcd_is_gcd."; - pp " intros; apply spec_gcd_gt; auto."; - pp " Qed."; - pr ""; - - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Conversion *)"; + pr " (** * Conversion *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; - pr " Definition pheight p := "; + pr " Definition pheight p :="; pr " Peano.pred (nat_of_P (get_height w0_op.(znz_digits) (plength p)))."; pr ""; - pr " Theorem pheight_correct: forall p, "; + pr " Theorem pheight_correct: forall p,"; pr " Zpos p < 2 ^ (Zpos (znz_digits w0_op) * 2 ^ (Z_of_nat (pheight p)))."; pr " Proof."; pr " intros p; unfold pheight."; @@ -2400,30 +2078,12 @@ let _ = pp " Qed."; pr ""; - pr " Definition of_N x :="; - pr " match x with"; - pr " | BinNat.N0 => zero"; - pr " | Npos p => of_pos p"; - pr " end."; - pr ""; - - pr " Theorem spec_of_N: forall x,"; - pr " [of_N x] = Z_of_N x."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x."; - pp " simpl of_N."; - pp " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto."; - pp " intros p; exact (spec_of_pos p)."; - pp " Qed."; - pr ""; - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Shift *)"; + pr " (** * Shift *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; (* Head0 *) pr " Definition head0 w := match w with"; @@ -2443,21 +2103,21 @@ let _ = done; pp " intros n x; rewrite spec_reduce_n; exact (spec_head00 (wn_spec n) x)."; pp " Qed."; - pr " "; + pr ""; pr " Theorem spec_head0: forall x, 0 < [x] ->"; pr " 2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x)."; pa " Admitted."; pp " Proof."; pp " assert (F0: forall x, (x - 1) + 1 = x)."; - pp " intros; ring. "; + pp " intros; ring."; pp " intros x; case x; unfold digits, head0; clear x."; for i = 0 to size do pp " intros x Hx; rewrite spec_reduce_%i." i; pp " assert (F1:= spec_more_than_1_digit w%i_spec)." i; pp " generalize (spec_head0 w%i_spec x Hx)." i; pp " unfold base."; - pp " pattern (Zpos (znz_digits w%i_op)) at 1; " i; + pp " pattern (Zpos (znz_digits w%i_op)) at 1;" i; pp " rewrite <- (fun x => (F0 (Zpos x)))."; pp " rewrite Zpower_exp; auto with zarith."; pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith."; @@ -2466,7 +2126,7 @@ let _ = pp " assert (F1:= spec_more_than_1_digit (wn_spec n))."; pp " generalize (spec_head0 (wn_spec n) x Hx)."; pp " unfold base."; - pp " pattern (Zpos (znz_digits (make_op n))) at 1; "; + pp " pattern (Zpos (znz_digits (make_op n))) at 1;"; pp " rewrite <- (fun x => (F0 (Zpos x)))."; pp " rewrite Zpower_exp; auto with zarith."; pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith."; @@ -2493,7 +2153,7 @@ let _ = done; pp " intros n x; rewrite spec_reduce_n; exact (spec_tail00 (wn_spec n) x)."; pp " Qed."; - pr " "; + pr ""; pr " Theorem spec_tail0: forall x,"; @@ -2513,7 +2173,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; @@ -2534,22 +2194,22 @@ let _ = (* Shiftr *) for i = 0 to size do - pr " Definition shiftr%i n x := w%i_op.(znz_add_mul_div) (w%i_op.(znz_sub) w%i_op.(znz_zdigits) n) w%i_op.(znz_0) x." i i i i i; + pr " Definition unsafe_shiftr%i n x := w%i_op.(znz_add_mul_div) (w%i_op.(znz_sub) w%i_op.(znz_zdigits) n) w%i_op.(znz_0) x." i i i i i; done; - pr " Definition shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x."; + pr " Definition unsafe_shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x."; pr ""; - pr " Definition shiftr := Eval lazy beta delta [same_level] in "; - pr " same_level _ (fun n x => %s0 (shiftr0 n x))" c; + pr " Definition unsafe_shiftr := Eval lazy beta delta [same_level] in"; + pr " same_level _ (fun n x => %s0 (unsafe_shiftr0 n x))" c; for i = 1 to size do - pr " (fun n x => reduce_%i (shiftr%i n x))" i i; + pr " (fun n x => reduce_%i (unsafe_shiftr%i n x))" i i; done; - pr " (fun n p x => reduce_n n (shiftrn n p x))."; + pr " (fun n p x => reduce_n n (unsafe_shiftrn n p x))."; pr ""; - pr " Theorem spec_shiftr: forall n x,"; - pr " [n] <= [Ndigits x] -> [shiftr n x] = [x] / 2 ^ [n]."; + pr " Theorem spec_unsafe_shiftr: forall n x,"; + pr " [n] <= [Ndigits x] -> [unsafe_shiftr n x] = [x] / 2 ^ [n]."; pa " Admitted."; pp " Proof."; pp " assert (F0: forall x y, x - (x - y) = y)."; @@ -2568,7 +2228,7 @@ let _ = pp " split; auto with zarith."; pp " apply Zle_lt_trans with xx; auto with zarith."; pp " apply Zpower2_lt_lin; auto with zarith."; - pp " assert (F4: forall ww ww1 ww2 "; + pp " assert (F4: forall ww ww1 ww2"; pp " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)"; pp " xx yy xx1 yy1,"; pp " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_zdigits ww1_op) ->"; @@ -2586,7 +2246,7 @@ let _ = pp " rewrite <- Hy."; pp " generalize (spec_add_mul_div Hw"; pp " (znz_0 ww_op) xx1"; - pp " (znz_sub ww_op (znz_zdigits ww_op) "; + pp " (znz_sub ww_op (znz_zdigits ww_op)"; pp " yy1)"; pp " )."; pp " rewrite (spec_0 Hw)."; @@ -2612,11 +2272,11 @@ let _ = pp " rewrite Zpos_xO."; pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size; pp " apply F5; auto with arith."; - pp " intros x; case x; clear x; unfold shiftr, same_level."; + pp " intros x; case x; clear x; unfold unsafe_shiftr, same_level."; for i = 0 to size do pp " intros x y; case y; clear y."; for j = 0 to i - 1 do - pp " intros y; unfold shiftr%i, Ndigits." i; + pp " intros y; unfold unsafe_shiftr%i, Ndigits." i; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i; pp " rewrite (spec_zdigits w%i_spec)." i; @@ -2628,25 +2288,25 @@ let _ = pp " try (apply sym_equal; exact (spec_extend%in%i y))." j i; done; - pp " intros y; unfold shiftr%i, Ndigits." i; + pp " intros y; unfold unsafe_shiftr%i, Ndigits." i; pp " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i; for j = i + 1 to size do - pp " intros y; unfold shiftr%i, Ndigits." j; + pp " intros y; unfold unsafe_shiftr%i, Ndigits." j; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i; pp " try (apply sym_equal; exact (spec_extend%in%i x))." i j; done; if i == size then begin - pp " intros m y; unfold shiftrn, Ndigits."; + pp " intros m y; unfold unsafe_shiftrn, Ndigits."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; 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 " intros m y; unfold unsafe_shiftrn, Ndigits."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i; pp " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i; @@ -2654,7 +2314,7 @@ let _ = end done; pp " intros n x y; case y; clear y;"; - pp " intros y; unfold shiftrn, Ndigits; try rewrite spec_reduce_n."; + pp " intros y; unfold unsafe_shiftrn, Ndigits; try rewrite spec_reduce_n."; for i = 0 to size do pp " try rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i; @@ -2684,52 +2344,23 @@ let _ = pp " Qed."; pr ""; - pr " Definition safe_shiftr n x := "; - pr " match compare n (Ndigits x) with"; - pr " | Lt => shiftr n x "; - pr " | _ => %s0 w_0" c; - pr " end."; - pr ""; - - - pr " Theorem spec_safe_shiftr: forall n x,"; - pr " [safe_shiftr n x] = [x] / 2 ^ [n]."; - pa " Admitted."; - pp " Proof."; - pp " intros n x; unfold safe_shiftr;"; - pp " generalize (spec_compare n (Ndigits x)); case compare; intros H."; - pp " apply trans_equal with (1 := spec_0 w0_spec)."; - pp " apply sym_equal; apply Zdiv_small; rewrite H."; - pp " rewrite spec_Ndigits; exact (spec_digits x)."; - pp " rewrite <- spec_shiftr; auto with zarith."; - pp " apply trans_equal with (1 := spec_0 w0_spec)."; - pp " apply sym_equal; apply Zdiv_small."; - pp " rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2."; - pp " split; auto."; - pp " apply Zlt_le_trans with (1 := H2)."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " Qed."; - pr ""; - - pr ""; - - (* Shiftl *) + (* Unsafe_Shiftl *) for i = 0 to size do - pr " Definition shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0)." i i i + pr " Definition unsafe_shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0)." i i i done; - pr " Definition shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0)."; - pr " Definition shiftl := Eval lazy beta delta [same_level] in"; - pr " same_level _ (fun n x => %s0 (shiftl0 n x))" c; + pr " Definition unsafe_shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0)."; + pr " Definition unsafe_shiftl := Eval lazy beta delta [same_level] in"; + pr " same_level _ (fun n x => %s0 (unsafe_shiftl0 n x))" c; for i = 1 to size do - pr " (fun n x => reduce_%i (shiftl%i n x))" i i; + pr " (fun n x => reduce_%i (unsafe_shiftl%i n x))" i i; done; - pr " (fun n p x => reduce_n n (shiftln n p x))."; + pr " (fun n p x => reduce_n n (unsafe_shiftln n p x))."; pr ""; pr ""; - pr " Theorem spec_shiftl: forall n x,"; - pr " [n] <= [head0 x] -> [shiftl n x] = [x] * 2 ^ [n]."; + pr " Theorem spec_unsafe_shiftl: forall n x,"; + pr " [n] <= [head0 x] -> [unsafe_shiftl n x] = [x] * 2 ^ [n]."; pa " Admitted."; pp " Proof."; pp " assert (F0: forall x y, x - (x - y) = y)."; @@ -2748,7 +2379,7 @@ let _ = pp " split; auto with zarith."; pp " apply Zle_lt_trans with xx; auto with zarith."; pp " apply Zpower2_lt_lin; auto with zarith."; - pp " assert (F4: forall ww ww1 ww2 "; + pp " assert (F4: forall ww ww1 ww2"; pp " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)"; pp " xx yy xx1 yy1,"; pp " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_head0 ww1_op xx) ->"; @@ -2788,7 +2419,7 @@ let _ = pp " rewrite Zmod_small; auto with zarith."; pp " intros HH; apply HH."; pp " rewrite Hy; apply Zle_trans with (1:= Hl)."; - pp " rewrite <- (spec_zdigits Hw). "; + pp " rewrite <- (spec_zdigits Hw)."; pp " apply Zle_trans with (2 := Hl1); auto."; pp " rewrite (spec_zdigits Hw1); auto with zarith."; pp " split; auto with zarith ."; @@ -2826,11 +2457,11 @@ let _ = pp " rewrite Zpos_xO."; pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size; pp " apply F5; auto with arith."; - pp " intros x; case x; clear x; unfold shiftl, same_level."; + pp " intros x; case x; clear x; unfold unsafe_shiftl, same_level."; for i = 0 to size do pp " intros x y; case y; clear y."; for j = 0 to i - 1 do - pp " intros y; unfold shiftl%i, head0." i; + pp " intros y; unfold unsafe_shiftl%i, head0." i; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i; pp " rewrite (spec_zdigits w%i_spec)." i; @@ -2841,25 +2472,25 @@ let _ = pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." j; pp " try (apply sym_equal; exact (spec_extend%in%i y))." j i; done; - pp " intros y; unfold shiftl%i, head0." i; + pp " intros y; unfold unsafe_shiftl%i, head0." i; pp " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i; for j = i + 1 to size do - pp " intros y; unfold shiftl%i, head0." j; + pp " intros y; unfold unsafe_shiftl%i, head0." j; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i; pp " try (apply sym_equal; exact (spec_extend%in%i x))." i j; done; if i == size then begin - pp " intros m y; unfold shiftln, head0."; + pp " intros m y; unfold unsafe_shiftln, head0."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; 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 " intros m y; unfold unsafe_shiftln, head0."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i; pp " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i; @@ -2867,7 +2498,7 @@ let _ = end done; pp " intros n x y; case y; clear y;"; - pp " intros y; unfold shiftln, head0; try rewrite spec_reduce_n."; + pp " intros y; unfold unsafe_shiftln, head0; try rewrite spec_reduce_n."; for i = 0 to size do pp " try rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i; @@ -2907,7 +2538,7 @@ let _ = pr " end."; pr ""; - pr " Theorem spec_double_size_digits: "; + pr " Theorem spec_double_size_digits:"; pr " forall x, digits (double_size x) = xO (digits x)."; pa " Admitted."; pp " Proof."; @@ -2922,7 +2553,7 @@ let _ = pp " Proof."; pp " intros x; case x; unfold double_size; clear x."; for i = 0 to size do - pp " intros x; unfold to_Z, make_op; "; + pp " intros x; unfold to_Z, make_op;"; pp " rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto with zarith." (i + 1) i; done; pp " intros n x; unfold to_Z;"; @@ -2934,7 +2565,7 @@ let _ = pr ""; - pr " Theorem spec_double_size_head0: "; + pr " Theorem spec_double_size_head0:"; pr " forall x, 2 * [head0 x] <= [head0 (double_size x)]."; pa " Admitted."; pp " Proof."; @@ -2963,7 +2594,7 @@ let _ = pp " apply Zmult_le_compat_l; auto with zarith."; pp " rewrite Zpower_1_r; auto with zarith."; pp " apply Zpower_le_monotone; auto with zarith."; - pp " split; auto with zarith. "; + pp " split; auto with zarith."; pp " case (Zle_or_lt (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6."; pp " absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith."; pp " rewrite <- HH5; rewrite Zmult_1_r."; @@ -2988,7 +2619,7 @@ let _ = pp " Qed."; pr ""; - pr " Theorem spec_double_size_head0_pos: "; + pr " Theorem spec_double_size_head0_pos:"; pr " forall x, 0 < [head0 (double_size x)]."; pa " Admitted."; pp " Proof."; @@ -3015,114 +2646,6 @@ let _ = pp " Qed."; pr ""; - - (* Safe shiftl *) - - pr " Definition safe_shiftl_aux_body cont n x :="; - pr " match compare n (head0 x) with"; - pr " Gt => cont n (double_size x)"; - pr " | _ => shiftl n x"; - pr " end."; - pr ""; - - pr " Theorem spec_safe_shift_aux_body: forall n p x cont,"; - pr " 2^ Zpos p <= [head0 x] ->"; - 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."; - 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."; - pp " apply spec_shiftl; auto with zarith."; - pp " apply spec_shiftl; auto with zarith."; - pp " rewrite H2."; - pp " rewrite spec_double_size; auto."; - pp " rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith."; - pp " apply Zle_trans with (2 := spec_double_size_head0 x)."; - pp " rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith."; - pp " Qed."; - pr ""; - - pr " Fixpoint safe_shiftl_aux p cont n x {struct p} :="; - pr " safe_shiftl_aux_body "; - pr " (fun n x => match p with"; - pr " | xH => cont n x"; - pr " | xO p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x"; - pr " | xI p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x"; - pr " end) n x."; - pr ""; - - pr " Theorem spec_safe_shift_aux: forall p q n x cont,"; - pr " 2 ^ (Zpos q) <= [head0 x] ->"; - pr " (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] ->"; - pr " [cont n x] = [x] * 2 ^ [n]) -> "; - pr " [safe_shiftl_aux p cont n x] = [x] * 2 ^ [n]."; - pa " Admitted."; - pp " Proof."; - pp " intros p; elim p; unfold safe_shiftl_aux; fold safe_shiftl_aux; clear p."; - pp " intros p Hrec q n x cont H1 H2."; - pp " apply spec_safe_shift_aux_body with (q); auto."; - pp " intros x1 H3; apply Hrec with (q + 1)%spositive; auto." "%"; - pp " intros x2 H4; apply Hrec with (p + q + 1)%spositive; auto." "%"; - pp " rewrite <- Pplus_assoc."; - pp " rewrite Zpos_plus_distr; auto."; - pp " intros x3 H5; apply H2."; - pp " rewrite Zpos_xI."; - pp " replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1));"; - pp " auto."; - pp " repeat rewrite Zpos_plus_distr; ring."; - pp " intros p Hrec q n x cont H1 H2."; - pp " apply spec_safe_shift_aux_body with (q); auto."; - pp " intros x1 H3; apply Hrec with (q); auto."; - pp " apply Zle_trans with (2 := H3); auto with zarith."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " intros x2 H4; apply Hrec with (p + q)%spositive; auto." "%"; - pp " intros x3 H5; apply H2."; - pp " rewrite (Zpos_xO p)."; - pp " replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q));"; - pp " auto."; - pp " repeat rewrite Zpos_plus_distr; ring."; - pp " intros q n x cont H1 H2."; - pp " apply spec_safe_shift_aux_body with (q); auto."; - pp " rewrite Zplus_comm; auto."; - pp " Qed."; - pr ""; - - - pr " Definition safe_shiftl n x :="; - pr " safe_shiftl_aux_body"; - pr " (safe_shiftl_aux_body"; - pr " (safe_shiftl_aux (digits n) shiftl)) n x."; - pr ""; - - pr " Theorem spec_safe_shift: forall n x,"; - pr " [safe_shiftl n x] = [x] * 2 ^ [n]."; - pa " Admitted."; - pp " Proof."; - pp " intros n x; unfold safe_shiftl, safe_shiftl_aux_body."; - pp " generalize (spec_compare n (head0 x)); case compare; intros H."; - pp " apply spec_shiftl; auto with zarith."; - pp " apply spec_shiftl; auto with zarith."; - pp " rewrite <- (spec_double_size x)."; - pp " generalize (spec_compare n (head0 (double_size x))); case compare; intros H1."; - pp " apply spec_shiftl; auto with zarith."; - pp " apply spec_shiftl; auto with zarith."; - pp " rewrite <- (spec_double_size (double_size x))."; - pp " apply spec_safe_shift_aux with 1%spositive." "%"; - pp " apply Zle_trans with (2 := spec_double_size_head0 (double_size x))."; - pp " replace (2 ^ 1) with (2 * 1)."; - pp " apply Zmult_le_compat_l; auto with zarith."; - pp " generalize (spec_double_size_head0_pos x); auto with zarith."; - pp " rewrite Zpower_1_r; ring."; - pp " intros x1 H2; apply spec_shiftl."; - pp " apply Zle_trans with (2 := H2)."; - pp " apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith."; - pp " case (spec_digits n); auto with zarith."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " Qed."; - pr ""; - (* even *) pr " Definition is_even x :="; pr " match x with"; @@ -3146,20 +2669,6 @@ let _ = pp " Qed."; pr ""; - pr " Theorem spec_0: [zero] = 0."; - pa " Admitted."; - pp " Proof."; - pp " exact (spec_0 w0_spec)."; - pp " Qed."; - pr ""; - - pr " Theorem spec_1: [one] = 1."; - pa " Admitted."; - pp " Proof."; - pp " exact (spec_1 w0_spec)."; - pp " Qed."; - pr ""; - pr "End Make."; pr ""; diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v index ae2cfd30..d42db97d 100644 --- a/theories/Numbers/Natural/BigN/Nbasic.v +++ b/theories/Numbers/Natural/BigN/Nbasic.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: Nbasic.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Require Import ZArith. Require Import BigNumPrelude. @@ -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/Binary/NBinDefs.v b/theories/Numbers/Natural/Binary/NBinDefs.v deleted file mode 100644 index fc2bd2df..00000000 --- a/theories/Numbers/Natural/Binary/NBinDefs.v +++ /dev/null @@ -1,267 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(* Evgeny Makarov, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: NBinDefs.v 11040 2008-06-03 00:04:16Z letouzey $ i*) - -Require Import BinPos. -Require Export BinNat. -Require Import NSub. - -Open Local Scope N_scope. - -(** Implementation of [NAxiomsSig] module type via [BinNat.N] *) - -Module NBinaryAxiomsMod <: NAxiomsSig. -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. - -Definition NZ := N. -Definition NZeq := @eq N. -Definition NZ0 := N0. -Definition NZsucc := Nsucc. -Definition NZpred := Npred. -Definition NZadd := Nplus. -Definition NZsub := Nminus. -Definition NZmul := Nmult. - -Theorem NZeq_equiv : equiv N NZeq. -Proof (eq_equiv N). - -Add Relation N NZeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. - -Add Morphism NZsucc with signature NZeq ==> NZeq as NZsucc_wd. -Proof. -congruence. -Qed. - -Add Morphism NZpred with signature NZeq ==> NZeq as NZpred_wd. -Proof. -congruence. -Qed. - -Add Morphism NZadd with signature NZeq ==> NZeq ==> NZeq as NZadd_wd. -Proof. -congruence. -Qed. - -Add Morphism NZsub with signature NZeq ==> NZeq ==> NZeq as NZsub_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmul with signature NZeq ==> NZeq ==> NZeq as NZmul_wd. -Proof. -congruence. -Qed. - -Theorem NZinduction : - forall A : NZ -> Prop, predicate_wd NZeq A -> - A N0 -> (forall n, A n <-> A (NZsucc n)) -> forall n : NZ, A n. -Proof. -intros A A_wd A0 AS. apply Nrect. assumption. intros; now apply -> AS. -Qed. - -Theorem NZpred_succ : forall n : NZ, NZpred (NZsucc n) = n. -Proof. -destruct n as [| p]; simpl. reflexivity. -case_eq (Psucc p); try (intros q H; rewrite <- H; now rewrite Ppred_succ). -intro H; false_hyp H Psucc_not_one. -Qed. - -Theorem NZadd_0_l : forall n : NZ, N0 + n = n. -Proof. -reflexivity. -Qed. - -Theorem NZadd_succ_l : forall n m : NZ, (NZsucc n) + m = NZsucc (n + m). -Proof. -destruct n; destruct m. -simpl in |- *; reflexivity. -unfold NZsucc, NZadd, Nsucc, Nplus. rewrite <- Pplus_one_succ_l; reflexivity. -simpl in |- *; reflexivity. -simpl in |- *; rewrite Pplus_succ_permute_l; reflexivity. -Qed. - -Theorem NZsub_0_r : forall n : NZ, n - N0 = n. -Proof. -now destruct n. -Qed. - -Theorem NZsub_succ_r : forall n m : NZ, n - (NZsucc m) = NZpred (n - m). -Proof. -destruct n as [| p]; destruct m as [| q]; try reflexivity. -now destruct p. -simpl. rewrite Pminus_mask_succ_r, Pminus_mask_carry_spec. -now destruct (Pminus_mask p q) as [| r |]; [| destruct r |]. -Qed. - -Theorem NZmul_0_l : forall n : NZ, N0 * n = N0. -Proof. -destruct n; reflexivity. -Qed. - -Theorem NZmul_succ_l : forall n m : NZ, (NZsucc n) * m = n * m + m. -Proof. -destruct n as [| n]; destruct m as [| m]; simpl; try reflexivity. -now rewrite Pmult_Sn_m, Pplus_comm. -Qed. - -End NZAxiomsMod. - -Definition NZlt := Nlt. -Definition NZle := Nle. -Definition NZmin := Nmin. -Definition NZmax := Nmax. - -Add Morphism NZlt with signature NZeq ==> NZeq ==> iff as NZlt_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZle with signature NZeq ==> NZeq ==> iff as NZle_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZmin with signature NZeq ==> NZeq ==> NZeq as NZmin_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmax with signature NZeq ==> NZeq ==> NZeq as NZmax_wd. -Proof. -congruence. -Qed. - -Theorem NZlt_eq_cases : forall n m : N, n <= m <-> n < m \/ n = m. -Proof. -intros n m. unfold Nle, Nlt. rewrite <- Ncompare_eq_correct. -destruct (n ?= m); split; intro H1; (try discriminate); try (now left); try now right. -now elim H1. destruct H1; discriminate. -Qed. - -Theorem NZlt_irrefl : forall n : NZ, ~ n < n. -Proof. -intro n; unfold Nlt; now rewrite Ncompare_refl. -Qed. - -Theorem NZlt_succ_r : forall n m : NZ, n < (NZsucc m) <-> n <= m. -Proof. -intros n m; unfold Nlt, Nle; destruct n as [| p]; destruct m as [| q]; simpl; -split; intro H; try reflexivity; try discriminate. -destruct p; simpl; intros; discriminate. elimtype False; now apply H. -apply -> Pcompare_p_Sq in H. destruct H as [H | H]. -now rewrite H. now rewrite H, Pcompare_refl. -apply <- Pcompare_p_Sq. case_eq ((p ?= q)%positive Eq); intro H1. -right; now apply Pcompare_Eq_eq. now left. elimtype False; now apply H. -Qed. - -Theorem NZmin_l : forall n m : N, n <= m -> NZmin n m = n. -Proof. -unfold NZmin, Nmin, Nle; intros n m H. -destruct (n ?= m); try reflexivity. now elim H. -Qed. - -Theorem NZmin_r : forall n m : N, m <= n -> NZmin n m = m. -Proof. -unfold NZmin, Nmin, Nle; intros n m H. -case_eq (n ?= m); intro H1; try reflexivity. -now apply -> Ncompare_eq_correct. -rewrite <- Ncompare_antisym, H1 in H; elim H; auto. -Qed. - -Theorem NZmax_l : forall n m : N, m <= n -> NZmax n m = n. -Proof. -unfold NZmax, Nmax, Nle; intros n m H. -case_eq (n ?= m); intro H1; try reflexivity. -symmetry; now apply -> Ncompare_eq_correct. -rewrite <- Ncompare_antisym, H1 in H; elim H; auto. -Qed. - -Theorem NZmax_r : forall n m : N, n <= m -> NZmax n m = m. -Proof. -unfold NZmax, Nmax, Nle; intros n m H. -destruct (n ?= m); try reflexivity. now elim H. -Qed. - -End NZOrdAxiomsMod. - -Definition recursion (A : Type) (a : A) (f : N -> A -> A) (n : N) := - Nrect (fun _ => A) a f n. -Implicit Arguments recursion [A]. - -Theorem pred_0 : Npred N0 = N0. -Proof. -reflexivity. -Qed. - -Theorem recursion_wd : -forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : N -> A -> A, fun2_eq NZeq Aeq Aeq f f' -> - forall x x' : N, x = x' -> - Aeq (recursion a f x) (recursion a' f' x'). -Proof. -unfold fun2_wd, NZeq, fun2_eq. -intros A Aeq a a' Eaa' f f' Eff'. -intro x; pattern x; apply Nrect. -intros x' H; now rewrite <- H. -clear x. -intros x IH x' H; rewrite <- H. -unfold recursion in *. do 2 rewrite Nrect_step. -now apply Eff'; [| apply IH]. -Qed. - -Theorem recursion_0 : - forall (A : Type) (a : A) (f : N -> A -> A), recursion a f N0 = a. -Proof. -intros A a f; unfold recursion; now rewrite Nrect_base. -Qed. - -Theorem recursion_succ : - forall (A : Type) (Aeq : relation A) (a : A) (f : N -> A -> A), - Aeq a a -> fun2_wd NZeq Aeq Aeq f -> - forall n : N, Aeq (recursion a f (Nsucc n)) (f n (recursion a f n)). -Proof. -unfold NZeq, recursion, fun2_wd; intros A Aeq a f EAaa f_wd n; pattern n; apply Nrect. -rewrite Nrect_step; rewrite Nrect_base; now apply f_wd. -clear n; intro n; do 2 rewrite Nrect_step; intro IH. apply f_wd; [reflexivity|]. -now rewrite Nrect_step. -Qed. - -End NBinaryAxiomsMod. - -Module Export NBinarySubPropMod := NSubPropFunct NBinaryAxiomsMod. - -(* Some fun comparing the efficiency of the generic log defined -by strong (course-of-value) recursion and the log defined by recursion -on notation *) -(* Time Eval compute in (log 100000). *) (* 98 sec *) - -(* -Fixpoint binposlog (p : positive) : N := -match p with -| xH => 0 -| xO p' => Nsucc (binposlog p') -| xI p' => Nsucc (binposlog p') -end. - -Definition binlog (n : N) : N := -match n with -| 0 => 0 -| Npos p => binposlog p -end. -*) -(* Eval compute in (binlog 1000000000000000000). *) (* Works very fast *) - diff --git a/theories/Numbers/Natural/Binary/NBinary.v b/theories/Numbers/Natural/Binary/NBinary.v index 2c99128d..e593f4a5 100644 --- a/theories/Numbers/Natural/Binary/NBinary.v +++ b/theories/Numbers/Natural/Binary/NBinary.v @@ -8,8 +8,175 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NBinary.v 10934 2008-05-15 21:58:20Z letouzey $ i*) +(*i $Id$ i*) -Require Export NBinDefs. -Require Export NArithRing. +Require Import BinPos. +Require Export BinNat. +Require Import NAxioms NProperties. +Local Open Scope N_scope. + +(** * Implementation of [NAxiomsSig] module type via [BinNat.N] *) + +Module NBinaryAxiomsMod <: NAxiomsSig. + +(** Bi-directional induction. *) + +Theorem bi_induction : + forall A : N -> Prop, Proper (eq==>iff) A -> + A N0 -> (forall n, A n <-> A (Nsucc n)) -> forall n : N, A n. +Proof. +intros A A_wd A0 AS. apply Nrect. assumption. intros; now apply -> AS. +Qed. + +(** Basic operations. *) + +Definition eq_equiv : Equivalence (@eq N) := eq_equivalence. +Local Obligation Tactic := simpl_relation. +Program Instance succ_wd : Proper (eq==>eq) Nsucc. +Program Instance pred_wd : Proper (eq==>eq) Npred. +Program Instance add_wd : Proper (eq==>eq==>eq) Nplus. +Program Instance sub_wd : Proper (eq==>eq==>eq) Nminus. +Program Instance mul_wd : Proper (eq==>eq==>eq) Nmult. + +Definition pred_succ := Npred_succ. +Definition add_0_l := Nplus_0_l. +Definition add_succ_l := Nplus_succ. +Definition sub_0_r := Nminus_0_r. +Definition sub_succ_r := Nminus_succ_r. +Definition mul_0_l := Nmult_0_l. +Definition mul_succ_l n m := eq_trans (Nmult_Sn_m n m) (Nplus_comm _ _). + +(** Order *) + +Program Instance lt_wd : Proper (eq==>eq==>iff) Nlt. + +Definition lt_eq_cases := Nle_lteq. +Definition lt_irrefl := Nlt_irrefl. + +Theorem lt_succ_r : forall n m, n < (Nsucc m) <-> n <= m. +Proof. +intros n m; unfold Nlt, Nle; destruct n as [| p]; destruct m as [| q]; simpl; +split; intro H; try reflexivity; try discriminate. +destruct p; simpl; intros; discriminate. exfalso; now apply H. +apply -> Pcompare_p_Sq in H. destruct H as [H | H]. +now rewrite H. now rewrite H, Pcompare_refl. +apply <- Pcompare_p_Sq. case_eq ((p ?= q)%positive Eq); intro H1. +right; now apply Pcompare_Eq_eq. now left. exfalso; now apply H. +Qed. + +Theorem min_l : forall n m, n <= m -> Nmin n m = n. +Proof. +unfold Nmin, Nle; intros n m H. +destruct (n ?= m); try reflexivity. now elim H. +Qed. + +Theorem min_r : forall n m, m <= n -> Nmin n m = m. +Proof. +unfold Nmin, Nle; intros n m H. +case_eq (n ?= m); intro H1; try reflexivity. +now apply -> Ncompare_eq_correct. +rewrite <- Ncompare_antisym, H1 in H; elim H; auto. +Qed. + +Theorem max_l : forall n m, m <= n -> Nmax n m = n. +Proof. +unfold Nmax, Nle; intros n m H. +case_eq (n ?= m); intro H1; try reflexivity. +symmetry; now apply -> Ncompare_eq_correct. +rewrite <- Ncompare_antisym, H1 in H; elim H; auto. +Qed. + +Theorem max_r : forall n m : N, n <= m -> Nmax n m = m. +Proof. +unfold Nmax, Nle; intros n m H. +destruct (n ?= m); try reflexivity. now elim H. +Qed. + +(** Part specific to natural numbers, not integers. *) + +Theorem pred_0 : Npred 0 = 0. +Proof. +reflexivity. +Qed. + +Definition recursion (A : Type) : A -> (N -> A -> A) -> N -> A := + Nrect (fun _ => A). +Implicit Arguments recursion [A]. + +Instance recursion_wd A (Aeq : relation A) : + Proper (Aeq==>(eq==>Aeq==>Aeq)==>eq==>Aeq) (@recursion A). +Proof. +intros a a' Eaa' f f' Eff'. +intro x; pattern x; apply Nrect. +intros x' H; now rewrite <- H. +clear x. +intros x IH x' H; rewrite <- H. +unfold recursion in *. do 2 rewrite Nrect_step. +now apply Eff'; [| apply IH]. +Qed. + +Theorem recursion_0 : + forall (A : Type) (a : A) (f : N -> A -> A), recursion a f N0 = a. +Proof. +intros A a f; unfold recursion; now rewrite Nrect_base. +Qed. + +Theorem recursion_succ : + forall (A : Type) (Aeq : relation A) (a : A) (f : N -> A -> A), + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> + forall n : N, Aeq (recursion a f (Nsucc n)) (f n (recursion a f n)). +Proof. +unfold recursion; intros A Aeq a f EAaa f_wd n; pattern n; apply Nrect. +rewrite Nrect_step; rewrite Nrect_base; now apply f_wd. +clear n; intro n; do 2 rewrite Nrect_step; intro IH. apply f_wd; [reflexivity|]. +now rewrite Nrect_step. +Qed. + +(** The instantiation of operations. + Placing them at the very end avoids having indirections in above lemmas. *) + +Definition t := N. +Definition eq := @eq N. +Definition zero := N0. +Definition succ := Nsucc. +Definition pred := Npred. +Definition add := Nplus. +Definition sub := Nminus. +Definition mul := Nmult. +Definition lt := Nlt. +Definition le := Nle. +Definition min := Nmin. +Definition max := Nmax. + +End NBinaryAxiomsMod. + +Module Export NBinaryPropMod := NPropFunct NBinaryAxiomsMod. + +(* +Require Import NDefOps. +Module Import NBinaryDefOpsMod := NdefOpsPropFunct NBinaryAxiomsMod. + +(* Some fun comparing the efficiency of the generic log defined +by strong (course-of-value) recursion and the log defined by recursion +on notation *) + +Time Eval vm_compute in (log 500000). (* 11 sec *) + +Fixpoint binposlog (p : positive) : N := +match p with +| xH => 0 +| xO p' => Nsucc (binposlog p') +| xI p' => Nsucc (binposlog p') +end. + +Definition binlog (n : N) : N := +match n with +| 0 => 0 +| Npos p => binposlog p +end. + +Time Eval vm_compute in (binlog 500000). (* 0 sec *) +Time Eval vm_compute in (binlog 1000000000000000000000000000000). (* 0 sec *) + +*) diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v index 1c83da45..becbd243 100644 --- a/theories/Numbers/Natural/Peano/NPeano.v +++ b/theories/Numbers/Natural/Peano/NPeano.v @@ -8,134 +8,73 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NPeano.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) -Require Import Arith. -Require Import Min. -Require Import Max. -Require Import NSub. +Require Import Arith MinMax NAxioms NProperties. -Module NPeanoAxiomsMod <: NAxiomsSig. -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. - -Definition NZ := nat. -Definition NZeq := (@eq nat). -Definition NZ0 := 0. -Definition NZsucc := S. -Definition NZpred := pred. -Definition NZadd := plus. -Definition NZsub := minus. -Definition NZmul := mult. - -Theorem NZeq_equiv : equiv nat NZeq. -Proof (eq_equiv nat). - -Add Relation nat NZeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. - -(* If we say "Add Relation nat (@eq nat)" instead of "Add Relation nat NZeq" -then the theorem generated for succ_wd below is forall x, succ x = succ x, -which does not match the axioms in NAxiomsSig *) - -Add Morphism NZsucc with signature NZeq ==> NZeq as NZsucc_wd. -Proof. -congruence. -Qed. - -Add Morphism NZpred with signature NZeq ==> NZeq as NZpred_wd. -Proof. -congruence. -Qed. +(** * Implementation of [NAxiomsSig] by [nat] *) -Add Morphism NZadd with signature NZeq ==> NZeq ==> NZeq as NZadd_wd. -Proof. -congruence. -Qed. - -Add Morphism NZsub with signature NZeq ==> NZeq ==> NZeq as NZsub_wd. -Proof. -congruence. -Qed. +Module NPeanoAxiomsMod <: NAxiomsSig. -Add Morphism NZmul with signature NZeq ==> NZeq ==> NZeq as NZmul_wd. -Proof. -congruence. -Qed. +(** Bi-directional induction. *) -Theorem NZinduction : - forall A : nat -> Prop, predicate_wd (@eq nat) A -> +Theorem bi_induction : + forall A : nat -> Prop, Proper (eq==>iff) A -> A 0 -> (forall n : nat, A n <-> A (S n)) -> forall n : nat, A n. Proof. intros A A_wd A0 AS. apply nat_ind. assumption. intros; now apply -> AS. Qed. -Theorem NZpred_succ : forall n : nat, pred (S n) = n. +(** Basic operations. *) + +Definition eq_equiv : Equivalence (@eq nat) := eq_equivalence. +Local Obligation Tactic := simpl_relation. +Program Instance succ_wd : Proper (eq==>eq) S. +Program Instance pred_wd : Proper (eq==>eq) pred. +Program Instance add_wd : Proper (eq==>eq==>eq) plus. +Program Instance sub_wd : Proper (eq==>eq==>eq) minus. +Program Instance mul_wd : Proper (eq==>eq==>eq) mult. + +Theorem pred_succ : forall n : nat, pred (S n) = n. Proof. reflexivity. Qed. -Theorem NZadd_0_l : forall n : nat, 0 + n = n. +Theorem add_0_l : forall n : nat, 0 + n = n. Proof. reflexivity. Qed. -Theorem NZadd_succ_l : forall n m : nat, (S n) + m = S (n + m). +Theorem add_succ_l : forall n m : nat, (S n) + m = S (n + m). Proof. reflexivity. Qed. -Theorem NZsub_0_r : forall n : nat, n - 0 = n. +Theorem sub_0_r : forall n : nat, n - 0 = n. Proof. intro n; now destruct n. Qed. -Theorem NZsub_succ_r : forall n m : nat, n - (S m) = pred (n - m). +Theorem sub_succ_r : forall n m : nat, n - (S m) = pred (n - m). Proof. -intros n m; induction n m using nat_double_ind; simpl; auto. apply NZsub_0_r. +intros n m; induction n m using nat_double_ind; simpl; auto. apply sub_0_r. Qed. -Theorem NZmul_0_l : forall n : nat, 0 * n = 0. +Theorem mul_0_l : forall n : nat, 0 * n = 0. Proof. reflexivity. Qed. -Theorem NZmul_succ_l : forall n m : nat, S n * m = n * m + m. +Theorem mul_succ_l : forall n m : nat, S n * m = n * m + m. Proof. intros n m; now rewrite plus_comm. Qed. -End NZAxiomsMod. +(** Order on natural numbers *) -Definition NZlt := lt. -Definition NZle := le. -Definition NZmin := min. -Definition NZmax := max. +Program Instance lt_wd : Proper (eq==>eq==>iff) lt. -Add Morphism NZlt with signature NZeq ==> NZeq ==> iff as NZlt_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZle with signature NZeq ==> NZeq ==> iff as NZle_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZmin with signature NZeq ==> NZeq ==> NZeq as NZmin_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmax with signature NZeq ==> NZeq ==> NZeq as NZmax_wd. -Proof. -congruence. -Qed. - -Theorem NZlt_eq_cases : forall n m : nat, n <= m <-> n < m \/ n = m. +Theorem lt_eq_cases : forall n m : nat, n <= m <-> n < m \/ n = m. Proof. intros n m; split. apply le_lt_or_eq. @@ -143,59 +82,52 @@ intro H; destruct H as [H | H]. now apply lt_le_weak. rewrite H; apply le_refl. Qed. -Theorem NZlt_irrefl : forall n : nat, ~ (n < n). +Theorem lt_irrefl : forall n : nat, ~ (n < n). Proof. exact lt_irrefl. Qed. -Theorem NZlt_succ_r : forall n m : nat, n < S m <-> n <= m. +Theorem lt_succ_r : forall n m : nat, n < S m <-> n <= m. Proof. intros n m; split; [apply lt_n_Sm_le | apply le_lt_n_Sm]. Qed. -Theorem NZmin_l : forall n m : nat, n <= m -> NZmin n m = n. +Theorem min_l : forall n m : nat, n <= m -> min n m = n. Proof. exact min_l. Qed. -Theorem NZmin_r : forall n m : nat, m <= n -> NZmin n m = m. +Theorem min_r : forall n m : nat, m <= n -> min n m = m. Proof. exact min_r. Qed. -Theorem NZmax_l : forall n m : nat, m <= n -> NZmax n m = n. +Theorem max_l : forall n m : nat, m <= n -> max n m = n. Proof. exact max_l. Qed. -Theorem NZmax_r : forall n m : nat, n <= m -> NZmax n m = m. +Theorem max_r : forall n m : nat, n <= m -> max n m = m. Proof. exact max_r. Qed. -End NZOrdAxiomsMod. - -Definition recursion : forall A : Type, A -> (nat -> A -> A) -> nat -> A := - fun A : Type => nat_rect (fun _ => A). -Implicit Arguments recursion [A]. - -Theorem succ_neq_0 : forall n : nat, S n <> 0. -Proof. -intros; discriminate. -Qed. +(** Facts specific to natural numbers, not integers. *) Theorem pred_0 : pred 0 = 0. Proof. reflexivity. Qed. -Theorem recursion_wd : forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : nat -> A -> A, fun2_eq (@eq nat) Aeq Aeq f f' -> - forall n n' : nat, n = n' -> - Aeq (recursion a f n) (recursion a' f' n'). +Definition recursion (A : Type) : A -> (nat -> A -> A) -> nat -> A := + nat_rect (fun _ => A). +Implicit Arguments recursion [A]. + +Instance recursion_wd (A : Type) (Aeq : relation A) : + Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A). Proof. -unfold fun2_eq; induction n; intros n' Enn'; rewrite <- Enn' in *; simpl; auto. +intros a a' Ha f f' Hf n n' Hn. subst n'. +induction n; simpl; auto. apply Hf; auto. Qed. Theorem recursion_0 : @@ -206,15 +138,100 @@ Qed. Theorem recursion_succ : forall (A : Type) (Aeq : relation A) (a : A) (f : nat -> A -> A), - Aeq a a -> fun2_wd (@eq nat) Aeq Aeq f -> + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> forall n : nat, Aeq (recursion a f (S n)) (f n (recursion a f n)). Proof. -induction n; simpl; auto. +unfold Proper, respectful in *; induction n; simpl; auto. Qed. -End NPeanoAxiomsMod. +(** The instantiation of operations. + Placing them at the very end avoids having indirections in above lemmas. *) -(* Now we apply the largest property functor *) +Definition t := nat. +Definition eq := @eq nat. +Definition zero := 0. +Definition succ := S. +Definition pred := pred. +Definition add := plus. +Definition sub := minus. +Definition mul := mult. +Definition lt := lt. +Definition le := le. +Definition min := min. +Definition max := max. -Module Export NPeanoSubPropMod := NSubPropFunct NPeanoAxiomsMod. +End NPeanoAxiomsMod. +(** Now we apply the largest property functor *) + +Module Export NPeanoPropMod := NPropFunct NPeanoAxiomsMod. + + + +(** Euclidean Division *) + +Definition divF div x y := if leb y x then S (div (x-y) y) else 0. +Definition modF mod x y := if leb y x then mod (x-y) y else x. +Definition initF (_ _ : nat) := 0. + +Fixpoint loop {A} (F:A->A)(i:A) (n:nat) : A := + match n with + | 0 => i + | S n => F (loop F i n) + end. + +Definition div x y := loop divF initF x x y. +Definition modulo x y := loop modF initF x x y. +Infix "/" := div : nat_scope. +Infix "mod" := modulo (at level 40, no associativity) : nat_scope. + +Lemma div_mod : forall x y, y<>0 -> x = y*(x/y) + x mod y. +Proof. + cut (forall n x y, y<>0 -> x<=n -> + x = y*(loop divF initF n x y) + (loop modF initF n x y)). + intros H x y Hy. apply H; auto. + induction n. + simpl; unfold initF; simpl. intros. nzsimpl. auto with arith. + simpl; unfold divF at 1, modF at 1. + intros. + destruct (leb y x) as [ ]_eqn:L; + [apply leb_complete in L | apply leb_complete_conv in L]. + rewrite mul_succ_r, <- add_assoc, (add_comm y), add_assoc. + rewrite <- IHn; auto. + symmetry; apply sub_add; auto. + rewrite <- NPeanoAxiomsMod.lt_succ_r. + apply lt_le_trans with x; auto. + apply lt_minus; auto. rewrite <- neq_0_lt_0; auto. + nzsimpl; auto. +Qed. + +Lemma mod_upper_bound : forall x y, y<>0 -> x mod y < y. +Proof. + cut (forall n x y, y<>0 -> x<=n -> loop modF initF n x y < y). + intros H x y Hy. apply H; auto. + induction n. + simpl; unfold initF. intros. rewrite <- neq_0_lt_0; auto. + simpl; unfold modF at 1. + intros. + destruct (leb y x) as [ ]_eqn:L; + [apply leb_complete in L | apply leb_complete_conv in L]; auto. + apply IHn; auto. + rewrite <- NPeanoAxiomsMod.lt_succ_r. + apply lt_le_trans with x; auto. + apply lt_minus; auto. rewrite <- neq_0_lt_0; auto. +Qed. + +Require Import NDiv. + +Module NDivMod <: NDivSig. + Include NPeanoAxiomsMod. + Definition div := div. + Definition modulo := modulo. + Definition div_mod := div_mod. + Definition mod_upper_bound := mod_upper_bound. + Local Obligation Tactic := simpl_relation. + Program Instance div_wd : Proper (eq==>eq==>eq) div. + Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. +End NDivMod. + +Module Export NDivPropMod := NDivPropFunct NDivMod NPeanoPropMod. diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v index 0275d1e1..85639aa6 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSig.v +++ b/theories/Numbers/Natural/SpecViaZ/NSig.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: NSig.v 11027 2008-06-01 13:28:59Z letouzey $ i*) +(*i $Id$ i*) Require Import ZArith Znumtheory. @@ -25,91 +25,76 @@ Module Type NType. Parameter t : Type. Parameter to_Z : t -> Z. - Notation "[ x ]" := (to_Z x). + Local Notation "[ x ]" := (to_Z x). Parameter spec_pos: forall x, 0 <= [x]. Parameter of_N : N -> t. Parameter spec_of_N: forall x, to_Z (of_N x) = Z_of_N x. Definition to_N n := Zabs_N (to_Z n). - Definition eq n m := ([n] = [m]). - - Parameter zero : t. - Parameter one : t. - - Parameter spec_0: [zero] = 0. - Parameter spec_1: [one] = 1. + Definition eq n m := [n] = [m]. + Definition lt n m := [n] < [m]. + Definition le n m := [n] <= [m]. Parameter compare : t -> t -> comparison. - - Parameter spec_compare: forall x y, - match compare x y with - | Eq => [x] = [y] - | Lt => [x] < [y] - | Gt => [x] > [y] - end. - - Definition lt n m := compare n m = Lt. - Definition le n m := compare n m <> Gt. - 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. - Parameter eq_bool : t -> t -> bool. - - Parameter spec_eq_bool: forall x y, - if eq_bool x y then [x] = [y] else [x] <> [y]. - + Parameter max : t -> t -> t. + Parameter min : t -> t -> t. + Parameter zero : t. + Parameter one : t. Parameter succ : t -> t. - - Parameter spec_succ: forall n, [succ n] = [n] + 1. - - Parameter add : t -> t -> t. - - Parameter spec_add: forall x y, [add x y] = [x] + [y]. - Parameter pred : t -> t. - - Parameter spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1. - Parameter spec_pred0: forall x, [x] = 0 -> [pred x] = 0. - + Parameter add : t -> t -> t. Parameter sub : t -> t -> t. - - Parameter spec_sub: forall x y, [y] <= [x] -> [sub x y] = [x] - [y]. - Parameter spec_sub0: forall x y, [x] < [y]-> [sub x y] = 0. - Parameter mul : t -> t -> t. - - Parameter spec_mul: forall x y, [mul x y] = [x] * [y]. - Parameter square : t -> t. - - Parameter spec_square: forall x, [square x] = [x] * [x]. - Parameter power_pos : t -> positive -> t. - - Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. - + Parameter power : t -> N -> t. Parameter sqrt : t -> t. - - Parameter spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. - Parameter div_eucl : t -> t -> t * t. - - 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]. - Parameter modulo : t -> t -> t. - - Parameter spec_modulo: - forall x y, 0 < [y] -> [modulo x y] = [x] mod [y]. - Parameter gcd : t -> t -> t. - - Parameter spec_gcd: forall a b, [gcd a b] = Zgcd (to_Z a) (to_Z b). + Parameter shiftr : t -> t -> t. + Parameter shiftl : t -> t -> t. + Parameter is_even : t -> bool. + + Parameter spec_compare: forall x y, compare x y = Zcompare [x] [y]. + Parameter spec_eq_bool: forall x y, eq_bool x y = Zeq_bool [x] [y]. + Parameter spec_max : forall x y, [max x y] = Zmax [x] [y]. + Parameter spec_min : forall x y, [min x y] = Zmin [x] [y]. + Parameter spec_0: [zero] = 0. + Parameter spec_1: [one] = 1. + Parameter spec_succ: forall n, [succ n] = [n] + 1. + Parameter spec_add: forall x y, [add x y] = [x] + [y]. + Parameter spec_pred: forall x, [pred x] = Zmax 0 ([x] - 1). + Parameter spec_sub: forall x y, [sub x y] = Zmax 0 ([x] - [y]). + Parameter spec_mul: forall x y, [mul x y] = [x] * [y]. + Parameter spec_square: forall x, [square x] = [x] * [x]. + Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. + Parameter spec_power: forall x n, [power x n] = [x] ^ Z_of_N n. + Parameter spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. + Parameter spec_div_eucl: forall x y, + let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. + Parameter spec_div: forall x y, [div x y] = [x] / [y]. + Parameter spec_modulo: forall x y, [modulo x y] = [x] mod [y]. + Parameter spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]. + Parameter spec_shiftr: forall p x, [shiftr p x] = [x] / 2^[p]. + Parameter spec_shiftl: forall p x, [shiftl p x] = [x] * 2^[p]. + Parameter spec_is_even: forall x, + if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1. End NType. + +Module Type NType_Notation (Import N:NType). + Notation "[ x ]" := (to_Z x). + Infix "==" := eq (at level 70). + Notation "0" := zero. + Infix "+" := add. + Infix "-" := sub. + Infix "*" := mul. + Infix "<=" := le. + Infix "<" := lt. +End NType_Notation. + +Module Type NType' := NType <+ NType_Notation. diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v index 84836268..ab749bd1 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v +++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v @@ -6,101 +6,47 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: NSigNAxioms.v 11282 2008-07-28 11:51:53Z msozeau $ i*) +(*i $Id$ i*) -Require Import ZArith. -Require Import Nnat. -Require Import NAxioms. -Require Import NSig. +Require Import ZArith Nnat NAxioms NDiv NSig. (** * The interface [NSig.NType] implies the interface [NAxiomsSig] *) -Module NSig_NAxioms (N:NType) <: NAxiomsSig. - -Delimit Scope IntScope with Int. -Bind Scope IntScope with N.t. -Open Local Scope IntScope. -Notation "[ x ]" := (N.to_Z x) : IntScope. -Infix "==" := N.eq (at level 70) : IntScope. -Notation "0" := N.zero : IntScope. -Infix "+" := N.add : IntScope. -Infix "-" := N.sub : IntScope. -Infix "*" := N.mul : IntScope. - -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. - -Definition NZ := N.t. -Definition NZeq := N.eq. -Definition NZ0 := N.zero. -Definition NZsucc := N.succ. -Definition NZpred := N.pred. -Definition NZadd := N.add. -Definition NZsub := N.sub. -Definition NZmul := N.mul. - -Theorem NZeq_equiv : equiv N.t N.eq. -Proof. -repeat split; repeat red; intros; auto; congruence. -Qed. +Module NTypeIsNAxioms (Import N : NType'). -Add Relation N.t N.eq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) - as NZeq_rel. +Hint Rewrite + spec_0 spec_succ spec_add spec_mul spec_pred spec_sub + spec_div spec_modulo spec_gcd spec_compare spec_eq_bool + spec_max spec_min spec_power_pos spec_power + : nsimpl. +Ltac nsimpl := autorewrite with nsimpl. +Ltac ncongruence := unfold eq; repeat red; intros; nsimpl; congruence. +Ltac zify := unfold eq, lt, le in *; nsimpl. -Add Morphism NZsucc with signature N.eq ==> N.eq as NZsucc_wd. -Proof. -unfold N.eq; intros; rewrite 2 N.spec_succ; f_equal; auto. -Qed. +Local Obligation Tactic := ncongruence. -Add Morphism NZpred with signature N.eq ==> N.eq as NZpred_wd. -Proof. -unfold N.eq; intros. -generalize (N.spec_pos y) (N.spec_pos x) (N.spec_eq_bool x 0). -destruct N.eq_bool; rewrite N.spec_0; intros. -rewrite 2 N.spec_pred0; congruence. -rewrite 2 N.spec_pred; f_equal; auto; try omega. -Qed. +Instance eq_equiv : Equivalence eq. +Proof. unfold eq. firstorder. Qed. -Add Morphism NZadd with signature N.eq ==> N.eq ==> N.eq as NZadd_wd. -Proof. -unfold N.eq; intros; rewrite 2 N.spec_add; f_equal; auto. -Qed. +Program Instance succ_wd : Proper (eq==>eq) succ. +Program Instance pred_wd : Proper (eq==>eq) pred. +Program Instance add_wd : Proper (eq==>eq==>eq) add. +Program Instance sub_wd : Proper (eq==>eq==>eq) sub. +Program Instance mul_wd : Proper (eq==>eq==>eq) mul. -Add Morphism NZsub with signature N.eq ==> N.eq ==> N.eq as NZsub_wd. +Theorem pred_succ : forall n, pred (succ n) == n. Proof. -unfold N.eq; intros x x' Hx y y' Hy. -destruct (Z_lt_le_dec [x] [y]). -rewrite 2 N.spec_sub0; f_equal; congruence. -rewrite 2 N.spec_sub; f_equal; congruence. +intros. zify. generalize (spec_pos n); omega with *. Qed. -Add Morphism NZmul with signature N.eq ==> N.eq ==> N.eq as NZmul_wd. -Proof. -unfold N.eq; intros; rewrite 2 N.spec_mul; f_equal; auto. -Qed. - -Theorem NZpred_succ : forall n, N.pred (N.succ n) == n. -Proof. -unfold N.eq; intros. -rewrite N.spec_pred; rewrite N.spec_succ. -omega. -generalize (N.spec_pos n); omega. -Qed. - -Definition N_of_Z z := N.of_N (Zabs_N z). +Definition N_of_Z z := of_N (Zabs_N z). Section Induction. Variable A : N.t -> Prop. -Hypothesis A_wd : predicate_wd N.eq A. +Hypothesis A_wd : Proper (eq==>iff) A. Hypothesis A0 : A 0. -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. +Hypothesis AS : forall n, A n <-> A (succ n). Let B (z : Z) := A (N_of_Z z). @@ -108,17 +54,17 @@ Lemma B0 : B 0. Proof. unfold B, N_of_Z; simpl. rewrite <- (A_wd 0); auto. -red; rewrite N.spec_0, N.spec_of_N; auto. +red; rewrite spec_0, spec_of_N; auto. Qed. Lemma BS : forall z : Z, (0 <= z)%Z -> B z -> B (z + 1). Proof. intros z H1 H2. unfold B in *. apply -> AS in H2. -setoid_replace (N_of_Z (z + 1)) with (N.succ (N_of_Z z)); auto. -unfold N.eq. rewrite N.spec_succ. +setoid_replace (N_of_Z (z + 1)) with (succ (N_of_Z z)); auto. +unfold eq. rewrite spec_succ. unfold N_of_Z. -rewrite 2 N.spec_of_N, 2 Z_of_N_abs, 2 Zabs_eq; auto with zarith. +rewrite 2 spec_of_N, 2 Z_of_N_abs, 2 Zabs_eq; auto with zarith. Qed. Lemma B_holds : forall z : Z, (0 <= z)%Z -> B z. @@ -126,193 +72,144 @@ Proof. exact (natlike_ind B B0 BS). Qed. -Theorem NZinduction : forall n, A n. +Theorem bi_induction : forall n, A n. Proof. -intro n. setoid_replace n with (N_of_Z (N.to_Z n)). -apply B_holds. apply N.spec_pos. +intro n. setoid_replace n with (N_of_Z (to_Z n)). +apply B_holds. apply spec_pos. red; unfold N_of_Z. -rewrite N.spec_of_N, Z_of_N_abs, Zabs_eq; auto. -apply N.spec_pos. +rewrite spec_of_N, Z_of_N_abs, Zabs_eq; auto. +apply spec_pos. Qed. End Induction. -Theorem NZadd_0_l : forall n, 0 + n == n. +Theorem add_0_l : forall n, 0 + n == n. Proof. -intros; red; rewrite N.spec_add, N.spec_0; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZadd_succ_l : forall n m, (N.succ n) + m == N.succ (n + m). +Theorem add_succ_l : forall n m, (succ n) + m == succ (n + m). Proof. -intros; red; rewrite N.spec_add, 2 N.spec_succ, N.spec_add; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZsub_0_r : forall n, n - 0 == n. +Theorem sub_0_r : forall n, n - 0 == n. Proof. -intros; red; rewrite N.spec_sub; rewrite N.spec_0; auto with zarith. -apply N.spec_pos. +intros. zify. generalize (spec_pos n); omega with *. Qed. -Theorem NZsub_succ_r : forall n m, n - (N.succ m) == N.pred (n - m). +Theorem sub_succ_r : forall n m, n - (succ m) == pred (n - m). Proof. -intros; red. -destruct (Z_lt_le_dec [n] [N.succ m]) as [H|H]. -rewrite N.spec_sub0; auto. -rewrite N.spec_succ in H. -rewrite N.spec_pred0; auto. -destruct (Z_eq_dec [n] [m]). -rewrite N.spec_sub; auto with zarith. -rewrite N.spec_sub0; auto with zarith. - -rewrite N.spec_sub, N.spec_succ in *; auto. -rewrite N.spec_pred, N.spec_sub; auto with zarith. -rewrite N.spec_sub; auto with zarith. +intros. zify. omega with *. Qed. -Theorem NZmul_0_l : forall n, 0 * n == 0. +Theorem mul_0_l : forall n, 0 * n == 0. Proof. -intros; red. -rewrite N.spec_mul, N.spec_0; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZmul_succ_l : forall n m, (N.succ n) * m == n * m + m. +Theorem mul_succ_l : forall n m, (succ n) * m == n * m + m. Proof. -intros; red. -rewrite N.spec_add, 2 N.spec_mul, N.spec_succ; ring. +intros. zify. ring. Qed. -End NZAxiomsMod. - -Definition NZlt := N.lt. -Definition NZle := N.le. -Definition NZmin := N.min. -Definition NZmax := N.max. +(** Order *) -Infix "<=" := N.le : IntScope. -Infix "<" := N.lt : IntScope. - -Lemma spec_compare_alt : forall x y, N.compare x y = ([x] ?= [y])%Z. +Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. - intros; generalize (N.spec_compare x y). - destruct (N.compare x y); auto. - intros H; rewrite H; symmetry; apply Zcompare_refl. + intros. zify. destruct (Zcompare_spec [x] [y]); auto. Qed. -Lemma spec_lt : forall x y, (x<y) <-> ([x]<[y])%Z. -Proof. - intros; unfold N.lt, Zlt; rewrite spec_compare_alt; intuition. -Qed. +Definition eqb := eq_bool. -Lemma spec_le : forall x y, (x<=y) <-> ([x]<=[y])%Z. +Lemma eqb_eq : forall x y, eq_bool x y = true <-> x == y. Proof. - intros; unfold N.le, Zle; rewrite spec_compare_alt; intuition. + intros. zify. symmetry. apply Zeq_is_eq_bool. Qed. -Lemma spec_min : forall x y, [N.min x y] = Zmin [x] [y]. +Instance compare_wd : Proper (eq ==> eq ==> Logic.eq) compare. Proof. - intros; unfold N.min, Zmin. - rewrite spec_compare_alt; destruct Zcompare; auto. +intros x x' Hx y y' Hy. rewrite 2 spec_compare, Hx, Hy; intuition. Qed. -Lemma spec_max : forall x y, [N.max x y] = Zmax [x] [y]. +Instance lt_wd : Proper (eq ==> eq ==> iff) lt. Proof. - intros; unfold N.max, Zmax. - rewrite spec_compare_alt; destruct Zcompare; auto. -Qed. - -Add Morphism N.compare with signature N.eq ==> N.eq ==> (@eq comparison) as compare_wd. -Proof. -intros x x' Hx y y' Hy. -rewrite 2 spec_compare_alt. unfold N.eq in *. rewrite Hx, Hy; intuition. +intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition. Qed. -Add Morphism N.lt with signature N.eq ==> N.eq ==> iff as NZlt_wd. +Theorem lt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. Proof. -intros x x' Hx y y' Hy; unfold N.lt; rewrite Hx, Hy; intuition. +intros. zify. omega. Qed. -Add Morphism N.le with signature N.eq ==> N.eq ==> iff as NZle_wd. +Theorem lt_irrefl : forall n, ~ n < n. Proof. -intros x x' Hx y y' Hy; unfold N.le; rewrite Hx, Hy; intuition. +intros. zify. omega. Qed. -Add Morphism N.min with signature N.eq ==> N.eq ==> N.eq as NZmin_wd. +Theorem lt_succ_r : forall n m, n < (succ m) <-> n <= m. Proof. -intros; red; rewrite 2 spec_min; congruence. +intros. zify. omega. Qed. -Add Morphism N.max with signature N.eq ==> N.eq ==> N.eq as NZmax_wd. +Theorem min_l : forall n m, n <= m -> min n m == n. Proof. -intros; red; rewrite 2 spec_max; congruence. +intros n m. zify. omega with *. Qed. -Theorem NZlt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. +Theorem min_r : forall n m, m <= n -> min n m == m. Proof. -intros. -unfold N.eq; rewrite spec_lt, spec_le; omega. +intros n m. zify. omega with *. Qed. -Theorem NZlt_irrefl : forall n, ~ n < n. +Theorem max_l : forall n m, m <= n -> max n m == n. Proof. -intros; rewrite spec_lt; auto with zarith. +intros n m. zify. omega with *. Qed. -Theorem NZlt_succ_r : forall n m, n < (N.succ m) <-> n <= m. +Theorem max_r : forall n m, n <= m -> max n m == m. Proof. -intros; rewrite spec_lt, spec_le, N.spec_succ; omega. +intros n m. zify. omega with *. Qed. -Theorem NZmin_l : forall n m, n <= m -> N.min n m == n. -Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_min. -generalize (Zmin_spec [n] [m]); omega. -Qed. +(** Properties specific to natural numbers, not integers. *) -Theorem NZmin_r : forall n m, m <= n -> N.min n m == m. +Theorem pred_0 : pred 0 == 0. Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_min. -generalize (Zmin_spec [n] [m]); omega. +zify. auto. Qed. -Theorem NZmax_l : forall n m, m <= n -> N.max n m == n. -Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_max. -generalize (Zmax_spec [n] [m]); omega. -Qed. +Program Instance div_wd : Proper (eq==>eq==>eq) div. +Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. -Theorem NZmax_r : forall n m, n <= m -> N.max n m == m. +Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b). Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_max. -generalize (Zmax_spec [n] [m]); omega. +intros a b. zify. intros. apply Z_div_mod_eq_full; auto. Qed. -End NZOrdAxiomsMod. - -Theorem pred_0 : N.pred 0 == 0. +Theorem mod_upper_bound : forall a b, ~b==0 -> modulo a b < b. Proof. -red; rewrite N.spec_pred0; rewrite N.spec_0; auto. +intros a b. zify. intros. +destruct (Z_mod_lt [a] [b]); auto. +generalize (spec_pos b); auto with zarith. Qed. Definition recursion (A : Type) (a : A) (f : N.t -> A -> A) (n : N.t) := Nrect (fun _ => A) a (fun n a => f (N.of_N n) a) (N.to_N n). Implicit Arguments recursion [A]. -Theorem recursion_wd : -forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : N.t -> A -> A, fun2_eq N.eq Aeq Aeq f f' -> - forall x x' : N.t, x == x' -> - Aeq (recursion a f x) (recursion a' f' x'). +Instance recursion_wd (A : Type) (Aeq : relation A) : + Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A). Proof. -unfold fun2_wd, N.eq, fun2_eq. -intros A Aeq a a' Eaa' f f' Eff' x x' Exx'. +unfold eq. +intros a a' Eaa' f f' Eff' x x' Exx'. unfold recursion. unfold N.to_N. rewrite <- Exx'; clear x' Exx'. replace (Zabs_N [x]) with (N_of_nat (Zabs_nat [x])). induction (Zabs_nat [x]). simpl; auto. -rewrite N_of_S, 2 Nrect_step; auto. +rewrite N_of_S, 2 Nrect_step; auto. apply Eff'; auto. destruct [x]; simpl; auto. change (nat_of_P p) with (nat_of_N (Npos p)); apply N_of_nat_of_N. change (nat_of_P p) with (nat_of_N (Npos p)); apply N_of_nat_of_N. @@ -326,11 +223,11 @@ Qed. Theorem recursion_succ : forall (A : Type) (Aeq : relation A) (a : A) (f : N.t -> A -> A), - Aeq a a -> fun2_wd N.eq Aeq Aeq f -> - forall n, Aeq (recursion a f (N.succ n)) (f n (recursion a f n)). + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> + forall n, Aeq (recursion a f (succ n)) (f n (recursion a f n)). Proof. -unfold N.eq, recursion, fun2_wd; intros A Aeq a f EAaa f_wd n. -replace (N.to_N (N.succ n)) with (Nsucc (N.to_N n)). +unfold N.eq, recursion; intros A Aeq a f EAaa f_wd n. +replace (N.to_N (succ n)) with (Nsucc (N.to_N n)). rewrite Nrect_step. apply f_wd; auto. unfold N.to_N. @@ -340,7 +237,6 @@ rewrite N.spec_of_N, Z_of_N_abs, Zabs_eq; auto. fold (recursion a f n). apply recursion_wd; auto. red; auto. -red; auto. unfold N.to_N. rewrite N.spec_succ. @@ -349,8 +245,12 @@ apply Z_of_N_eq_rev. rewrite Z_of_N_succ. rewrite 2 Z_of_N_abs. rewrite 2 Zabs_eq; auto. -generalize (N.spec_pos n); auto with zarith. -apply N.spec_pos; auto. +generalize (spec_pos n); auto with zarith. +apply spec_pos; auto. Qed. -End NSig_NAxioms. +End NTypeIsNAxioms. + +Module NType_NAxioms (N : NType) + <: NAxiomsSig <: NDivSig <: HasCompare N <: HasEqBool N <: HasMinMax N + := N <+ NTypeIsNAxioms. |