summaryrefslogtreecommitdiff
path: root/theories/Numbers/Natural
diff options
context:
space:
mode:
authorGravatar Stephane Glondu <steph@glondu.net>2010-07-21 09:46:51 +0200
committerGravatar Stephane Glondu <steph@glondu.net>2010-07-21 09:46:51 +0200
commit5b7eafd0f00a16d78f99a27f5c7d5a0de77dc7e6 (patch)
tree631ad791a7685edafeb1fb2e8faeedc8379318ae /theories/Numbers/Natural
parentda178a880e3ace820b41d38b191d3785b82991f5 (diff)
Imported Upstream snapshot 8.3~beta0+13298
Diffstat (limited to 'theories/Numbers/Natural')
-rw-r--r--theories/Numbers/Natural/Abstract/NAdd.v109
-rw-r--r--theories/Numbers/Natural/Abstract/NAddOrder.v88
-rw-r--r--theories/Numbers/Natural/Abstract/NAxioms.v58
-rw-r--r--theories/Numbers/Natural/Abstract/NBase.v180
-rw-r--r--theories/Numbers/Natural/Abstract/NDefOps.v477
-rw-r--r--theories/Numbers/Natural/Abstract/NDiv.v239
-rw-r--r--theories/Numbers/Natural/Abstract/NIso.v84
-rw-r--r--theories/Numbers/Natural/Abstract/NMul.v87
-rw-r--r--theories/Numbers/Natural/Abstract/NMulOrder.v101
-rw-r--r--theories/Numbers/Natural/Abstract/NOrder.v390
-rw-r--r--theories/Numbers/Natural/Abstract/NProperties.v22
-rw-r--r--theories/Numbers/Natural/Abstract/NStrongRec.v231
-rw-r--r--theories/Numbers/Natural/Abstract/NSub.v196
-rw-r--r--theories/Numbers/Natural/BigN/BigN.v192
-rw-r--r--theories/Numbers/Natural/BigN/NMake.v524
-rw-r--r--theories/Numbers/Natural/BigN/NMake_gen.ml929
-rw-r--r--theories/Numbers/Natural/BigN/Nbasic.v64
-rw-r--r--theories/Numbers/Natural/Binary/NBinDefs.v267
-rw-r--r--theories/Numbers/Natural/Binary/NBinary.v173
-rw-r--r--theories/Numbers/Natural/Peano/NPeano.v249
-rw-r--r--theories/Numbers/Natural/SpecViaZ/NSig.v119
-rw-r--r--theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v292
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.