summaryrefslogtreecommitdiff
path: root/theories
diff options
context:
space:
mode:
Diffstat (limited to 'theories')
-rw-r--r--theories/Classes/EquivDec.v8
-rw-r--r--theories/Classes/Equivalence.v15
-rw-r--r--theories/Classes/Functions.v16
-rw-r--r--theories/Classes/Init.v15
-rw-r--r--theories/Classes/Morphisms.v230
-rw-r--r--theories/Classes/Morphisms_Prop.v4
-rw-r--r--theories/Classes/Morphisms_Relations.v8
-rw-r--r--theories/Classes/RelationClasses.v37
-rw-r--r--theories/Classes/SetoidClass.v14
-rw-r--r--theories/Classes/SetoidDec.v18
-rw-r--r--theories/Classes/SetoidTactics.v23
-rw-r--r--theories/FSets/FMapFacts.v4
-rw-r--r--theories/FSets/FSetFacts.v4
-rw-r--r--theories/Init/Tactics.v6
-rw-r--r--theories/Init/Wf.v19
-rw-r--r--theories/Logic/ClassicalDescription.v4
-rw-r--r--theories/Logic/ClassicalFacts.v6
-rw-r--r--theories/Logic/ConstructiveEpsilon.v4
-rw-r--r--theories/Logic/Diaconescu.v4
-rw-r--r--theories/Numbers/BigNumPrelude.v72
-rw-r--r--theories/Numbers/Cyclic/Abstract/NZCyclic.v6
-rw-r--r--theories/Numbers/Integer/BigZ/BigZ.v18
-rw-r--r--theories/Numbers/Integer/BigZ/ZMake.v3
-rw-r--r--theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v4
-rw-r--r--theories/Numbers/Natural/Abstract/NOrder.v11
-rw-r--r--theories/Numbers/Natural/BigN/BigN.v8
-rw-r--r--theories/Numbers/Natural/BigN/NMake_gen.ml4
-rw-r--r--theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v4
-rw-r--r--theories/Numbers/Rational/BigQ/BigQ.v188
-rw-r--r--theories/Numbers/Rational/BigQ/Q0Make.v1412
-rw-r--r--theories/Numbers/Rational/BigQ/QMake.v1345
-rw-r--r--theories/Numbers/Rational/BigQ/QMake_base.v34
-rw-r--r--theories/Numbers/Rational/BigQ/QbiMake.v1066
-rw-r--r--theories/Numbers/Rational/BigQ/QifMake.v979
-rw-r--r--theories/Numbers/Rational/BigQ/QpMake.v901
-rw-r--r--theories/Numbers/Rational/BigQ/QvMake.v1151
-rw-r--r--theories/Numbers/Rational/SpecViaQ/QSig.v25
-rw-r--r--theories/Program/Equality.v29
-rw-r--r--theories/Program/Tactics.v22
-rw-r--r--theories/Program/Utils.v6
-rw-r--r--theories/QArith/QArith_base.v145
-rw-r--r--theories/QArith/Qfield.v29
-rw-r--r--theories/Strings/String.v4
-rw-r--r--theories/ZArith/Zbool.v89
-rw-r--r--theories/ZArith/Zcompare.v9
-rw-r--r--theories/ZArith/Znumtheory.v4
46 files changed, 2084 insertions, 5923 deletions
diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v
index debe953a..1e58d05d 100644
--- a/theories/Classes/EquivDec.v
+++ b/theories/Classes/EquivDec.v
@@ -13,7 +13,7 @@
* Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud
* 91405 Orsay, France *)
-(* $Id: EquivDec.v 10919 2008-05-11 22:04:26Z msozeau $ *)
+(* $Id: EquivDec.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Set Implicit Arguments.
Unset Strict Implicit.
@@ -40,7 +40,7 @@ Class [ equiv : Equivalence A ] => EqDec :=
(** We define the [==] overloaded notation for deciding equality. It does not take precedence
of [==] defined in the type scope, hence we can have both at the same time. *)
-Notation " x == y " := (equiv_dec (x :>) (y :>)) (no associativity, at level 70).
+Notation " x == y " := (equiv_dec (x :>) (y :>)) (no associativity, at level 70) : equiv_scope.
Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } :=
match x with
@@ -58,7 +58,7 @@ Program Definition nequiv_dec [ EqDec A ] (x y : A) : { x =/= y } + { x === y }
(** Overloaded notation for inequality. *)
-Infix "=/=" := nequiv_dec (no associativity, at level 70).
+Infix "<>" := nequiv_dec (no associativity, at level 70) : equiv_scope.
(** Define boolean versions, losing the logical information. *)
@@ -155,4 +155,4 @@ Program Instance list_eqdec [ eqa : EqDec A eq ] : ! EqDec (list A) eq :=
Next Obligation.
Proof. clear aux. red in H0. subst.
destruct y; intuition (discriminate || eauto).
- Defined. \ No newline at end of file
+ Defined.
diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v
index 70bf3483..d52eed47 100644
--- a/theories/Classes/Equivalence.v
+++ b/theories/Classes/Equivalence.v
@@ -13,7 +13,7 @@
Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud
91405 Orsay, France *)
-(* $Id: Equivalence.v 10919 2008-05-11 22:04:26Z msozeau $ *)
+(* $Id: Equivalence.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Require Export Coq.Program.Basics.
Require Import Coq.Program.Tactics.
@@ -116,7 +116,7 @@ Section Respecting.
Definition respecting [ Equivalence A (R : relation A), Equivalence B (R' : relation B) ] : Type :=
{ morph : A -> B | respectful R R' morph morph }.
- Program Instance respecting_equiv [ Equivalence A R, Equivalence B R' ] :
+ Program Instance respecting_equiv [ eqa : Equivalence A R, eqb : Equivalence B R' ] :
Equivalence respecting
(fun (f g : respecting) => forall (x y : A), R x y -> R' (proj1_sig f x) (proj1_sig g y)).
@@ -124,18 +124,17 @@ Section Respecting.
Next Obligation.
Proof.
- unfold respecting in *. program_simpl. red in H2,H3,H4.
- transitivity (y x0) ; auto.
- transitivity (y y0) ; auto.
- symmetry. auto.
+ unfold respecting in *. program_simpl. transitivity (y y0); auto. apply H0. reflexivity.
Qed.
End Respecting.
(** The default equivalence on function spaces, with higher-priority than [eq]. *)
-Program Instance pointwise_equivalence [ Equivalence A eqA ] :
- Equivalence (B -> A) (pointwise_relation eqA) | 9.
+Program Instance pointwise_equivalence [ eqb : Equivalence B eqB ] :
+ Equivalence (A -> B) (pointwise_relation eqB) | 9.
+
+ Solve Obligations using simpl_relation ; first [ reflexivity | (symmetry ; auto) ].
Next Obligation.
Proof.
diff --git a/theories/Classes/Functions.v b/theories/Classes/Functions.v
index 49fc4f89..4c844911 100644
--- a/theories/Classes/Functions.v
+++ b/theories/Classes/Functions.v
@@ -13,7 +13,7 @@
Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud
91405 Orsay, France *)
-(* $Id: Functions.v 10739 2008-04-01 14:45:20Z herbelin $ *)
+(* $Id: Functions.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Require Import Coq.Classes.RelationClasses.
Require Import Coq.Classes.Morphisms.
@@ -21,22 +21,22 @@ Require Import Coq.Classes.Morphisms.
Set Implicit Arguments.
Unset Strict Implicit.
-Class [ m : Morphism (A -> B) (RA ++> RB) f ] => Injective : Prop :=
+Class Injective ((m : Morphism (A -> B) (RA ++> RB) f)) : Prop :=
injective : forall x y : A, RB (f x) (f y) -> RA x y.
-Class [ m : Morphism (A -> B) (RA ++> RB) f ] => Surjective : Prop :=
+Class ((m : Morphism (A -> B) (RA ++> RB) f)) => Surjective : Prop :=
surjective : forall y, exists x : A, RB y (f x).
-Definition Bijective [ m : Morphism (A -> B) (RA ++> RB) (f : A -> B) ] :=
+Definition Bijective ((m : Morphism (A -> B) (RA ++> RB) (f : A -> B))) :=
Injective m /\ Surjective m.
-Class [ m : Morphism (A -> B) (eqA ++> eqB) ] => MonoMorphism :=
+Class MonoMorphism (( m : Morphism (A -> B) (eqA ++> eqB) )) :=
monic :> Injective m.
-Class [ m : Morphism (A -> B) (eqA ++> eqB) ] => EpiMorphism :=
+Class EpiMorphism ((m : Morphism (A -> B) (eqA ++> eqB))) :=
epic :> Surjective m.
-Class [ m : Morphism (A -> B) (eqA ++> eqB) ] => IsoMorphism :=
+Class IsoMorphism ((m : Morphism (A -> B) (eqA ++> eqB))) :=
monomorphism :> MonoMorphism m ; epimorphism :> EpiMorphism m.
-Class [ m : Morphism (A -> A) (eqA ++> eqA), ! IsoMorphism m ] => AutoMorphism.
+Class ((m : Morphism (A -> A) (eqA ++> eqA))) [ ! IsoMorphism m ] => AutoMorphism.
diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v
index 6ba0c61e..e5f951d0 100644
--- a/theories/Classes/Init.v
+++ b/theories/Classes/Init.v
@@ -13,9 +13,22 @@
Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud
91405 Orsay, France *)
-(* $Id: Init.v 10739 2008-04-01 14:45:20Z herbelin $ *)
+(* $Id: Init.v 11282 2008-07-28 11:51:53Z msozeau $ *)
(* Ltac typeclass_instantiation := typeclasses eauto || eauto. *)
Tactic Notation "clapply" ident(c) :=
eapply @c ; eauto with typeclass_instances.
+
+(** The unconvertible typeclass, to test that two objects of the same type are
+ actually different. *)
+
+Class Unconvertible (A : Type) (a b : A).
+
+Ltac unconvertible :=
+ match goal with
+ | |- @Unconvertible _ ?x ?y => conv x y ; fail 1 "Convertible"
+ | |- _ => apply Build_Unconvertible
+ end.
+
+Hint Extern 0 (@Unconvertible _ _ _) => unconvertible : typeclass_instances. \ No newline at end of file
diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v
index f21c68a6..c2ae026d 100644
--- a/theories/Classes/Morphisms.v
+++ b/theories/Classes/Morphisms.v
@@ -1,4 +1,4 @@
-(* -*- coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.Morphisms"); compile-command: "make -C ../.. TIME='time'" -*- *)
+(* -*- coq-prog-name: "~/research/coq/trunk/bin/coqtop.byte"; coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.Morphisms"); compile-command: "make -C ../.. TIME='time'" -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
@@ -13,7 +13,7 @@
Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud
91405 Orsay, France *)
-(* $Id: Morphisms.v 11092 2008-06-10 18:28:26Z msozeau $ *)
+(* $Id: Morphisms.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Require Import Coq.Program.Basics.
Require Import Coq.Program.Tactics.
@@ -39,10 +39,6 @@ Class Morphism A (R : relation A) (m : A) : Prop :=
Implicit Arguments Morphism [A].
-(** We allow to unfold the [relation] definition while doing morphism search. *)
-
-Typeclasses unfold relation.
-
(** Respectful morphisms. *)
(** The fully dependent version, not used yet. *)
@@ -79,9 +75,22 @@ Arguments Scope respectful [type_scope type_scope signature_scope signature_scop
Open Local Scope signature_scope.
+(** Pointwise lifting is just respect with leibniz equality on the left. *)
+
+Definition pointwise_relation {A B : Type} (R : relation B) : relation (A -> B) :=
+ fun f g => forall x : A, R (f x) (g x).
+
+Lemma pointwise_pointwise A B (R : relation B) :
+ relation_equivalence (pointwise_relation R) (@eq A ==> R).
+Proof. intros. split. simpl_relation. firstorder. Qed.
+
(** We can build a PER on the Coq function space if we have PERs on the domain and
codomain. *)
+Hint Unfold Reflexive : core.
+Hint Unfold Symmetric : core.
+Hint Unfold Transitive : core.
+
Program Instance respectful_per [ PER A (R : relation A), PER B (R' : relation B) ] :
PER (A -> B) (R ==> R').
@@ -92,24 +101,26 @@ Program Instance respectful_per [ PER A (R : relation A), PER B (R' : relation B
transitivity (y x0)...
Qed.
-(** Subrelations induce a morphism on the identity, not used for morphism search yet. *)
+(** Subrelations induce a morphism on the identity. *)
-Lemma subrelation_id_morphism [ subrelation A R₁ R₂ ] : Morphism (R₁ ==> R₂) id.
+Instance subrelation_id_morphism [ subrelation A R₁ R₂ ] : Morphism (R₁ ==> R₂) id.
Proof. firstorder. Qed.
(** The subrelation property goes through products as usual. *)
-Instance morphisms_subrelation [ sub : subrelation A R₁ R₂ ] :
- ! subrelation (B -> A) (R ==> R₁) (R ==> R₂).
-Proof. firstorder. Qed.
+Instance morphisms_subrelation_respectful [ subl : subrelation A R₂ R₁, subr : subrelation B S₁ S₂ ] :
+ subrelation (R₁ ==> S₁) (R₂ ==> S₂).
+Proof. simpl_relation. apply subr. apply H. apply subl. apply H0. Qed.
-Instance morphisms_subrelation_left [ sub : subrelation A R₂ R₁ ] :
- ! subrelation (A -> B) (R₁ ==> R) (R₂ ==> R) | 3.
-Proof. firstorder. Qed.
+(** And of course it is reflexive. *)
+
+Instance morphisms_subrelation_refl : ! subrelation A R R | 10.
+Proof. simpl_relation. Qed.
(** [Morphism] is itself a covariant morphism for [subrelation]. *)
-Lemma subrelation_morphism [ sub : subrelation A R₁ R₂, mor : Morphism A R₁ m ] : Morphism R₂ m.
+Lemma subrelation_morphism [ mor : Morphism A R₁ m, unc : Unconvertible (relation A) R₁ R₂,
+ sub : subrelation A R₁ R₂ ] : Morphism R₂ m.
Proof.
intros. apply sub. apply mor.
Qed.
@@ -121,8 +132,9 @@ Proof. reduce. subst. firstorder. Qed.
(** We use an external tactic to manage the application of subrelation, which is otherwise
always applicable. We allow its use only once per branch. *)
-Inductive subrelation_done : Prop :=
- did_subrelation : subrelation_done.
+Inductive subrelation_done : Prop := did_subrelation : subrelation_done.
+
+Inductive normalization_done : Prop := did_normalization.
Ltac subrelation_tac :=
match goal with
@@ -131,7 +143,7 @@ Ltac subrelation_tac :=
set(H:=did_subrelation) ; eapply @subrelation_morphism
end.
-Hint Extern 4 (@Morphism _ _ _) => subrelation_tac : typeclass_instances.
+Hint Extern 5 (@Morphism _ _ _) => subrelation_tac : typeclass_instances.
(** Essential subrelation instances for [iff], [impl] and [pointwise_relation]. *)
@@ -181,20 +193,10 @@ Program Instance trans_contra_co_morphism
transitivity x0...
Qed.
-(* (** Dually... *) *)
-
-(* Program Instance [ Transitive A R ] => *)
-(* trans_co_contra_inv_impl_morphism : Morphism (R ++> R --> inverse impl) R. *)
-
-(* Next Obligation. *)
-(* Proof with auto. *)
-(* apply* trans_contra_co_morphism ; eauto. eauto. *)
-(* Qed. *)
-
(** Morphism declarations for partial applications. *)
Program Instance trans_contra_inv_impl_morphism
- [ Transitive A R ] : Morphism (R --> inverse impl) (R x).
+ [ Transitive A R ] : Morphism (R --> inverse impl) (R x) | 3.
Next Obligation.
Proof with auto.
@@ -202,7 +204,7 @@ Program Instance trans_contra_inv_impl_morphism
Qed.
Program Instance trans_co_impl_morphism
- [ Transitive A R ] : Morphism (R ==> impl) (R x).
+ [ Transitive A R ] : Morphism (R ==> impl) (R x) | 3.
Next Obligation.
Proof with auto.
@@ -210,23 +212,23 @@ Program Instance trans_co_impl_morphism
Qed.
Program Instance trans_sym_co_inv_impl_morphism
- [ Transitive A R, Symmetric A R ] : Morphism (R ==> inverse impl) (R x).
+ [ PER A R ] : Morphism (R ==> inverse impl) (R x) | 2.
Next Obligation.
Proof with auto.
- transitivity y...
+ transitivity y... symmetry...
Qed.
Program Instance trans_sym_contra_impl_morphism
- [ Transitive A R, Symmetric _ R ] : Morphism (R --> impl) (R x).
+ [ PER A R ] : Morphism (R --> impl) (R x) | 2.
Next Obligation.
Proof with auto.
- transitivity x0...
+ transitivity x0... symmetry...
Qed.
-Program Instance equivalence_partial_app_morphism
- [ Equivalence A R ] : Morphism (R ==> iff) (R x).
+Program Instance per_partial_app_morphism
+ [ PER A R ] : Morphism (R ==> iff) (R x) | 1.
Next Obligation.
Proof with auto.
@@ -240,36 +242,16 @@ Program Instance equivalence_partial_app_morphism
to get an [R y z] goal. *)
Program Instance trans_co_eq_inv_impl_morphism
- [ Transitive A R ] : Morphism (R ==> (@eq A) ==> inverse impl) R.
+ [ Transitive A R ] : Morphism (R ==> (@eq A) ==> inverse impl) R | 2.
Next Obligation.
Proof with auto.
transitivity y...
Qed.
-(* Program Instance [ Transitive A R ] => *)
-(* trans_contra_eq_impl_morphism : Morphism (R --> (@eq A) ==> impl) R. *)
-
-(* Next Obligation. *)
-(* Proof with auto. *)
-(* transitivity x... *)
-(* Qed. *)
-
(** Every Symmetric and Transitive relation gives rise to an equivariant morphism. *)
-Program Instance trans_sym_morphism
- [ Transitive A R, Symmetric _ R ] : Morphism (R ==> R ==> iff) R.
-
- Next Obligation.
- Proof with auto.
- split ; intros.
- transitivity x0... transitivity x...
-
- transitivity y... transitivity y0...
- Qed.
-
-Program Instance equiv_morphism [ Equivalence A R ] :
- Morphism (R ==> R ==> iff) R.
+Program Instance PER_morphism [ PER A R ] : Morphism (R ==> R ==> iff) R | 1.
Next Obligation.
Proof with auto.
@@ -279,27 +261,21 @@ Program Instance equiv_morphism [ Equivalence A R ] :
transitivity y... transitivity y0... symmetry...
Qed.
-(** In case the rewrite happens at top level. *)
-
-Program Instance iff_inverse_impl_id :
- Morphism (iff ==> inverse impl) id.
-
-Program Instance inverse_iff_inverse_impl_id :
- Morphism (iff --> inverse impl) id.
+Lemma symmetric_equiv_inverse [ Symmetric A R ] : relation_equivalence R (flip R).
+Proof. firstorder. Qed.
-Program Instance iff_impl_id :
- Morphism (iff ==> impl) id.
+Program Instance compose_morphism A B C R₀ R₁ R₂ :
+ Morphism ((R₁ ==> R₂) ==> (R₀ ==> R₁) ==> (R₀ ==> R₂)) (@compose A B C).
+
+ Next Obligation.
+ Proof.
+ simpl_relation.
+ unfold compose. apply H. apply H0. apply H1.
+ Qed.
-Program Instance inverse_iff_impl_id :
- Morphism (iff --> impl) id.
-
(** Coq functions are morphisms for leibniz equality,
applied only if really needed. *)
-(* Instance (A : Type) [ Reflexive B R ] => *)
-(* eq_reflexive_morphism : Morphism (@Logic.eq A ==> R) m | 3. *)
-(* Proof. simpl_relation. Qed. *)
-
Instance reflexive_eq_dom_reflexive (A : Type) [ Reflexive B R' ] :
Reflexive (@Logic.eq A ==> R').
Proof. simpl_relation. Qed.
@@ -335,49 +311,81 @@ Class MorphismProxy A (R : relation A) (m : A) : Prop :=
respect_proxy : R m m.
Instance reflexive_morphism_proxy
- [ Reflexive A R ] (x : A) : MorphismProxy A R x | 1.
+ [ Reflexive A R ] (x : A) : MorphismProxy R x | 1.
Proof. firstorder. Qed.
Instance morphism_morphism_proxy
- [ Morphism A R x ] : MorphismProxy A R x | 2.
+ [ Morphism A R x ] : MorphismProxy R x | 2.
Proof. firstorder. Qed.
-(* Instance (A : Type) [ Reflexive B R ] => *)
-(* eq_reflexive_morphism : Morphism (@Logic.eq A ==> R) m | 3. *)
-(* Proof. simpl_relation. Qed. *)
-
(** [R] is Reflexive, hence we can build the needed proof. *)
Lemma Reflexive_partial_app_morphism [ Morphism (A -> B) (R ==> R') m, MorphismProxy A R x ] :
Morphism R' (m x).
Proof. simpl_relation. Qed.
+Class Params {A : Type} (of : A) (arity : nat).
+
+Class PartialApplication.
+
Ltac partial_application_tactic :=
- let tac x :=
- match type of x with
- | Type => fail 1
- | _ => eapply @Reflexive_partial_app_morphism
+ let rec do_partial_apps H m :=
+ match m with
+ | ?m' ?x => eapply @Reflexive_partial_app_morphism ; [do_partial_apps H m'|clear H]
+ | _ => idtac
end
in
- let on_morphism m :=
- match m with
- | ?m' ?x => tac x
- | ?m' _ ?x => tac x
- | ?m' _ _ ?x => tac x
- | ?m' _ _ _ ?x => tac x
- | ?m' _ _ _ _ ?x => tac x
- | ?m' _ _ _ _ _ ?x => tac x
- | ?m' _ _ _ _ _ _ ?x => tac x
- | ?m' _ _ _ _ _ _ _ ?x => tac x
- | ?m' _ _ _ _ _ _ _ _ ?x => tac x
+ let rec do_partial H ar m :=
+ match ar with
+ | 0 => do_partial_apps H m
+ | S ?n' =>
+ match m with
+ ?m' ?x => do_partial H n' m'
+ end
end
in
+ let on_morphism m :=
+ let m' := fresh in head_of_constr m' m ;
+ let n := fresh in evar (n:nat) ;
+ let v := eval compute in n in clear n ;
+ let H := fresh in
+ assert(H:Params m' v) by typeclasses eauto ;
+ let v' := eval compute in v in
+ do_partial H v' m
+ in
match goal with
- | [ |- @Morphism _ _ ?m ] => on_morphism m
+ | [ _ : subrelation_done |- _ ] => fail 1
+ | [ _ : normalization_done |- _ ] => fail 1
+ | [ _ : @Params _ _ _ |- _ ] => fail 1
+ | [ |- @Morphism ?T _ (?m ?x) ] =>
+ match goal with
+ | [ _ : PartialApplication |- _ ] =>
+ eapply @Reflexive_partial_app_morphism
+ | _ =>
+ on_morphism (m x) ||
+ (eapply @Reflexive_partial_app_morphism ;
+ [ pose Build_PartialApplication | idtac ])
+ end
end.
-(* Program Instance [ Morphism (A -> B) (R ==> R') m, Reflexive A R ] (x : A) => *)
-(* reflexive_partial_app_morphism : Morphism R' (m x). *)
+Section PartialAppTest.
+ Instance and_ar : Params and 0.
+
+ Goal Morphism (iff) (and True True).
+ partial_application_tactic.
+ Admitted.
+
+ Goal Morphism (iff) (or True True).
+ partial_application_tactic.
+ partial_application_tactic.
+ Admitted.
+
+ Goal Morphism (iff ==> iff) (iff True).
+ partial_application_tactic.
+ (*partial_application_tactic. *)
+ Admitted.
+
+End PartialAppTest.
Hint Extern 4 (@Morphism _ _ _) => partial_application_tactic : typeclass_instances.
@@ -395,19 +403,19 @@ Class (A : Type) => Normalizes (m : relation A) (m' : relation A) : Prop :=
normalizes : relation_equivalence m m'.
Instance inverse_respectful_norm :
- Normalizes (A -> B) (inverse R ==> inverse R') (inverse (R ==> R')) .
+ ! Normalizes (A -> B) (inverse R ==> inverse R') (inverse (R ==> R')) .
Proof. firstorder. Qed.
(* If not an inverse on the left, do a double inverse. *)
Instance not_inverse_respectful_norm :
- Normalizes (A -> B) (R ==> inverse R') (inverse (inverse R ==> R')) | 4.
+ ! Normalizes (A -> B) (R ==> inverse R') (inverse (inverse R ==> R')) | 4.
Proof. firstorder. Qed.
Instance inverse_respectful_rec_norm [ Normalizes B R' (inverse R'') ] :
- Normalizes (A -> B) (inverse R ==> R') (inverse (R ==> R'')).
-Proof. red ; intros.
- pose normalizes as r.
+ ! Normalizes (A -> B) (inverse R ==> R') (inverse (R ==> R'')).
+Proof. red ; intros.
+ assert(r:=normalizes).
setoid_rewrite r.
setoid_rewrite inverse_respectful.
reflexivity.
@@ -415,8 +423,14 @@ Qed.
(** Once we have normalized, we will apply this instance to simplify the problem. *)
-Program Instance morphism_inverse_morphism
- [ Morphism A R m ] : Morphism (inverse R) m | 2.
+Definition morphism_inverse_morphism [ mor : Morphism A R m ] : Morphism (inverse R) m := mor.
+
+Ltac morphism_inverse :=
+ match goal with
+ [ |- @Morphism _ (flip _) _ ] => eapply @morphism_inverse_morphism
+ end.
+
+Hint Extern 2 (@Morphism _ _ _) => morphism_inverse : typeclass_instances.
(** Bootstrap !!! *)
@@ -434,16 +448,16 @@ Qed.
Lemma morphism_releq_morphism [ Normalizes A R R', Morphism _ R' m ] : Morphism R m.
Proof.
intros.
+
pose respect as r.
pose normalizes as norm.
setoid_rewrite norm.
assumption.
Qed.
-Inductive normalization_done : Prop := did_normalization.
-
Ltac morphism_normalization :=
match goal with
+ | [ _ : subrelation_done |- _ ] => fail 1
| [ _ : normalization_done |- _ ] => fail 1
| [ |- @Morphism _ _ _ ] => let H := fresh "H" in
set(H:=did_normalization) ; eapply @morphism_releq_morphism
@@ -464,4 +478,4 @@ Ltac morphism_reflexive :=
| [ |- @Morphism _ _ _ ] => eapply @reflexive_morphism
end.
-Hint Extern 4 (@Morphism _ _ _) => morphism_reflexive : typeclass_instances. \ No newline at end of file
+Hint Extern 7 (@Morphism _ _ _) => morphism_reflexive : typeclass_instances.
diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v
index 7dc1f95e..ec62e12e 100644
--- a/theories/Classes/Morphisms_Prop.v
+++ b/theories/Classes/Morphisms_Prop.v
@@ -29,7 +29,7 @@ Program Instance not_iff_morphism :
(** Logical conjunction. *)
-Program Instance and_impl_iff_morphism :
+Program Instance and_impl_morphism :
Morphism (impl ==> impl ==> impl) and.
(* Program Instance and_impl_iff_morphism : *)
@@ -49,7 +49,7 @@ Program Instance and_iff_morphism :
(** Logical disjunction. *)
-Program Instance or_impl_iff_morphism :
+Program Instance or_impl_morphism :
Morphism (impl ==> impl ==> impl) or.
(* Program Instance or_impl_iff_morphism : *)
diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v
index 5018fa01..1b389667 100644
--- a/theories/Classes/Morphisms_Relations.v
+++ b/theories/Classes/Morphisms_Relations.v
@@ -48,3 +48,11 @@ Proof. intro. apply (predicate_equivalence_pointwise (cons A (cons A nil))). Qed
Instance subrelation_pointwise :
Morphism (subrelation ==> pointwise_relation (A:=A) (pointwise_relation (A:=A) impl)) id.
Proof. intro. apply (predicate_implication_pointwise (cons A (cons A nil))). Qed.
+
+
+Lemma inverse_pointwise_relation A (R : relation A) :
+ relation_equivalence (pointwise_relation (inverse R)) (inverse (pointwise_relation (A:=A) R)).
+Proof. intros. split; firstorder. Qed.
+
+
+
diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v
index a9a53068..9a43a1ba 100644
--- a/theories/Classes/RelationClasses.v
+++ b/theories/Classes/RelationClasses.v
@@ -1,4 +1,4 @@
-(* -*- coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.RelationClasses") -*- *)
+(* -*- coq-prog-name: "coqtop.byte"; coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.RelationClasses") -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
@@ -14,20 +14,21 @@
Institution: LRI, CNRS UMR 8623 - UniversitÃcopyright Paris Sud
91405 Orsay, France *)
-(* $Id: RelationClasses.v 11092 2008-06-10 18:28:26Z msozeau $ *)
+(* $Id: RelationClasses.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Require Export Coq.Classes.Init.
Require Import Coq.Program.Basics.
Require Import Coq.Program.Tactics.
Require Export Coq.Relations.Relation_Definitions.
+(** We allow to unfold the [relation] definition while doing morphism search. *)
+
+Typeclasses unfold relation.
+
Notation inverse R := (flip (R:relation _) : relation _).
Definition complement {A} (R : relation A) : relation A := fun x y => R x y -> False.
-Definition pointwise_relation {A B : Type} (R : relation B) : relation (A -> B) :=
- fun f g => forall x : A, R (f x) (g x).
-
(** These are convertible. *)
Lemma complement_inverse : forall A (R : relation A), complement (inverse R) = inverse (complement R).
@@ -42,7 +43,7 @@ Class Reflexive A (R : relation A) :=
reflexivity : forall x, R x x.
Class Irreflexive A (R : relation A) :=
- irreflexivity :> Reflexive A (complement R).
+ irreflexivity :> Reflexive (complement R).
Class Symmetric A (R : relation A) :=
symmetry : forall x y, R x y -> R y x.
@@ -53,12 +54,6 @@ Class Asymmetric A (R : relation A) :=
Class Transitive A (R : relation A) :=
transitivity : forall x y z, R x y -> R y z -> R x z.
-Implicit Arguments Reflexive [A].
-Implicit Arguments Irreflexive [A].
-Implicit Arguments Symmetric [A].
-Implicit Arguments Asymmetric [A].
-Implicit Arguments Transitive [A].
-
Hint Resolve @irreflexivity : ord.
Unset Implicit Arguments.
@@ -91,7 +86,7 @@ Program Instance Reflexive_complement_Irreflexive [ Reflexive A (R : relation A)
unfold complement.
red. intros H.
intros H' ; apply H'.
- apply (reflexivity H).
+ apply reflexivity.
Qed.
@@ -129,7 +124,7 @@ Ltac simpl_relation :=
unfold flip, impl, arrow ; try reduce ; program_simpl ;
try ( solve [ intuition ]).
-Ltac obligations_tactic ::= simpl_relation.
+Ltac obligation_tactic ::= simpl_relation.
(** Logical implication. *)
@@ -171,17 +166,17 @@ Class Equivalence (carrier : Type) (equiv : relation carrier) : Prop :=
(** An Equivalence is a PER plus reflexivity. *)
-Instance Equivalence_PER [ Equivalence A R ] : PER A R :=
+Instance Equivalence_PER [ Equivalence A R ] : PER A R | 10 :=
PER_Symmetric := Equivalence_Symmetric ;
PER_Transitive := Equivalence_Transitive.
(** We can now define antisymmetry w.r.t. an equivalence relation on the carrier. *)
-Class [ Equivalence A eqA ] => Antisymmetric (R : relation A) :=
+Class Antisymmetric ((equ : Equivalence A eqA)) (R : relation A) :=
antisymmetry : forall x y, R x y -> R y x -> eqA x y.
-Program Instance flip_antiSymmetric [ eq : Equivalence A eqA, ! Antisymmetric eq R ] :
- Antisymmetric eq (flip R).
+Program Instance flip_antiSymmetric {{Antisymmetric A eqA R}} :
+ ! Antisymmetric A eqA (flip R).
(** Leibinz equality [eq] is an equivalence relation.
The instance has low priority as it is always applicable
@@ -372,7 +367,7 @@ Proof. intro A. exact (@predicate_implication_preorder (cons A (cons A nil))). Q
We give an equivalent definition, up-to an equivalence relation
on the carrier. *)
-Class [ equ : Equivalence A eqA, PreOrder A R ] => PartialOrder :=
+Class [ equ : Equivalence A eqA, preo : PreOrder A R ] => PartialOrder :=
partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (inverse R)).
(** The equivalence proof is sufficient for proving that [R] must be a morphism
@@ -394,7 +389,3 @@ Program Instance subrelation_partial_order :
Proof.
unfold relation_equivalence in *. firstorder.
Qed.
-
-Lemma inverse_pointwise_relation A (R : relation A) :
- relation_equivalence (pointwise_relation (inverse R)) (inverse (pointwise_relation (A:=A) R)).
-Proof. reflexivity. Qed.
diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v
index a9bdaa8f..178d5333 100644
--- a/theories/Classes/SetoidClass.v
+++ b/theories/Classes/SetoidClass.v
@@ -13,7 +13,7 @@
Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud
91405 Orsay, France *)
-(* $Id: SetoidClass.v 11065 2008-06-06 22:39:43Z msozeau $ *)
+(* $Id: SetoidClass.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Set Implicit Arguments.
Unset Strict Implicit.
@@ -41,13 +41,13 @@ Typeclasses unfold equiv.
(** Shortcuts to make proof search easier. *)
Definition setoid_refl [ sa : Setoid A ] : Reflexive equiv.
-Proof. eauto with typeclass_instances. Qed.
+Proof. typeclasses eauto. Qed.
Definition setoid_sym [ sa : Setoid A ] : Symmetric equiv.
-Proof. eauto with typeclass_instances. Qed.
+Proof. typeclasses eauto. Qed.
Definition setoid_trans [ sa : Setoid A ] : Transitive equiv.
-Proof. eauto with typeclass_instances. Qed.
+Proof. typeclasses eauto. Qed.
Existing Instance setoid_refl.
Existing Instance setoid_sym.
@@ -123,7 +123,7 @@ Ltac setoidify := repeat setoidify_tac.
(** Every setoid relation gives rise to a morphism, in fact every partial setoid does. *)
Program Definition setoid_morphism [ sa : Setoid A ] : Morphism (equiv ++> equiv ++> iff) equiv :=
- trans_sym_morphism.
+ PER_morphism.
(** Add this very useful instance in the database. *)
@@ -142,7 +142,7 @@ Program Instance type_equivalence : Equivalence Type type_eq.
Ltac morphism_tac := try red ; unfold arrow ; intros ; program_simpl ; try tauto.
-Ltac obligations_tactic ::= morphism_tac.
+Ltac obligation_tactic ::= morphism_tac.
(** These are morphisms used to rewrite at the top level of a proof,
using [iff_impl_id_morphism] if the proof is in [Prop] and
@@ -178,4 +178,4 @@ Infix "=~=" := pequiv (at level 70, no associativity) : type_scope.
(** Reset the default Program tactic. *)
-Ltac obligations_tactic ::= program_simpl.
+Ltac obligation_tactic ::= program_simpl.
diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v
index cf3d202d..8a069343 100644
--- a/theories/Classes/SetoidDec.v
+++ b/theories/Classes/SetoidDec.v
@@ -13,7 +13,7 @@
* Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud
* 91405 Orsay, France *)
-(* $Id: SetoidDec.v 10919 2008-05-11 22:04:26Z msozeau $ *)
+(* $Id: SetoidDec.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Set Implicit Arguments.
Unset Strict Implicit.
@@ -27,12 +27,12 @@ Require Export Coq.Classes.SetoidClass.
Require Import Coq.Logic.Decidable.
-Class [ Setoid A ] => DecidableSetoid :=
+Class DecidableSetoid A [ Setoid A ] :=
setoid_decidable : forall x y : A, decidable (x == y).
(** The [EqDec] class gives a decision procedure for a particular setoid equality. *)
-Class [ Setoid A ] => EqDec :=
+Class (( s : Setoid A )) => EqDec :=
equiv_dec : forall x y : A, { x == y } + { x =/= y }.
(** We define the [==] overloaded notation for deciding equality. It does not take precedence
@@ -75,18 +75,18 @@ Require Import Coq.Arith.Arith.
(** The equiv is burried inside the setoid, but we can recover it by specifying which setoid we're talking about. *)
-Program Instance eq_setoid : Setoid A :=
+Program Instance eq_setoid A : Setoid A :=
equiv := eq ; setoid_equiv := eq_equivalence.
-Program Instance nat_eq_eqdec : EqDec (@eq_setoid nat) :=
+Program Instance nat_eq_eqdec : EqDec (eq_setoid nat) :=
equiv_dec := eq_nat_dec.
Require Import Coq.Bool.Bool.
-Program Instance bool_eqdec : EqDec (@eq_setoid bool) :=
+Program Instance bool_eqdec : EqDec (eq_setoid bool) :=
equiv_dec := bool_dec.
-Program Instance unit_eqdec : EqDec (@eq_setoid unit) :=
+Program Instance unit_eqdec : EqDec (eq_setoid unit) :=
equiv_dec x y := in_left.
Next Obligation.
@@ -95,7 +95,7 @@ Program Instance unit_eqdec : EqDec (@eq_setoid unit) :=
reflexivity.
Qed.
-Program Instance prod_eqdec [ ! EqDec (@eq_setoid A), ! EqDec (@eq_setoid B) ] : EqDec (@eq_setoid (prod A B)) :=
+Program Instance prod_eqdec [ ! EqDec (eq_setoid A), ! EqDec (eq_setoid B) ] : EqDec (eq_setoid (prod A B)) :=
equiv_dec x y :=
let '(x1, x2) := x in
let '(y1, y2) := y in
@@ -110,7 +110,7 @@ Program Instance prod_eqdec [ ! EqDec (@eq_setoid A), ! EqDec (@eq_setoid B) ] :
Require Import Coq.Program.FunctionalExtensionality.
-Program Instance bool_function_eqdec [ ! EqDec (@eq_setoid A) ] : EqDec (@eq_setoid (bool -> A)) :=
+Program Instance bool_function_eqdec [ ! EqDec (eq_setoid A) ] : EqDec (eq_setoid (bool -> A)) :=
equiv_dec f g :=
if f true == g true then
if f false == g false then in_left
diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v
index b29a52cc..6398b125 100644
--- a/theories/Classes/SetoidTactics.v
+++ b/theories/Classes/SetoidTactics.v
@@ -13,7 +13,7 @@
* Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud
* 91405 Orsay, France *)
-(* $Id: SetoidTactics.v 10921 2008-05-12 12:27:25Z msozeau $ *)
+(* $Id: SetoidTactics.v 11282 2008-07-28 11:51:53Z msozeau $ *)
Require Export Coq.Classes.RelationClasses.
Require Export Coq.Classes.Morphisms.
@@ -24,11 +24,22 @@ Require Export Coq.Relations.Relation_Definitions.
Set Implicit Arguments.
Unset Strict Implicit.
+(** Setoid relation on a given support: declares a relation as a setoid
+ for use with rewrite. It helps choosing if a rewrite should be handled
+ by setoid_rewrite or the regular rewrite using leibniz equality.
+ Users can declare an [SetoidRelation A RA] anywhere to declare default
+ relations. This is also done automatically by the [Declare Relation A RA]
+ commands. *)
+
+Class SetoidRelation A (R : relation A).
+
+Instance impl_setoid_relation : SetoidRelation impl.
+Instance iff_setoid_relation : SetoidRelation iff.
+
(** Default relation on a given support. Can be used by tactics
to find a sensible default relation on any carrier. Users can
- declare an [Instance A RA] anywhere to declare default relations.
- This is also done by the [Declare Relation A RA] command with no
- parameters for backward compatibility. *)
+ declare an [Instance def : DefaultRelation A RA] anywhere to
+ declare default relations. *)
Class DefaultRelation A (R : relation A).
@@ -38,7 +49,7 @@ Definition default_relation [ DefaultRelation A R ] := R.
(** Every [Equivalence] gives a default relation, if no other is given (lowest priority). *)
-Instance equivalence_default [ Equivalence A R ] : DefaultRelation A R | 4.
+Instance equivalence_default [ Equivalence A R ] : DefaultRelation R | 4.
(** The setoid_replace tactics in Ltac, defined in terms of default relations and
the setoid_rewrite tactic. *)
@@ -174,3 +185,5 @@ Ltac default_add_morphism_tactic :=
end.
Ltac add_morphism_tactic := default_add_morphism_tactic.
+
+Ltac obligation_tactic ::= program_simpl.
diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v
index b307efe3..94444f5b 100644
--- a/theories/FSets/FMapFacts.v
+++ b/theories/FSets/FMapFacts.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(***********************************************************************)
-(* $Id: FMapFacts.v 10782 2008-04-12 16:08:04Z msozeau $ *)
+(* $Id: FMapFacts.v 11282 2008-07-28 11:51:53Z msozeau $ *)
(** * Finite maps library *)
@@ -660,6 +660,8 @@ Add Relation key E.eq
transitivity proved by E.eq_trans
as KeySetoid.
+Typeclasses unfold key.
+
Implicit Arguments Equal [[elt]].
Add Parametric Relation (elt : Type) : (t elt) Equal
diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v
index b4b834b1..d77d9c60 100644
--- a/theories/FSets/FSetFacts.v
+++ b/theories/FSets/FSetFacts.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(***********************************************************************)
-(* $Id: FSetFacts.v 10765 2008-04-08 16:15:23Z msozeau $ *)
+(* $Id: FSetFacts.v 11282 2008-07-28 11:51:53Z msozeau $ *)
(** * Finite sets library *)
@@ -309,6 +309,8 @@ Add Relation elt E.eq
transitivity proved by E.eq_trans
as EltSetoid.
+Typeclasses unfold elt.
+
Add Relation t Equal
reflexivity proved by eq_refl
symmetry proved by eq_sym
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
index afe8297e..10555fc0 100644
--- a/theories/Init/Tactics.v
+++ b/theories/Init/Tactics.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Tactics.v 11072 2008-06-08 16:13:37Z herbelin $ i*)
+(*i $Id: Tactics.v 11309 2008-08-06 10:30:35Z herbelin $ i*)
Require Import Notations.
Require Import Logic.
@@ -115,7 +115,7 @@ lazymatch T with
evar (a : t); pose proof (H a) as H1; unfold a in H1;
clear a; clear H; rename H1 into H; find_equiv H
| ?A <-> ?B => idtac
-| _ => fail "The given statement does not seem to end with an equivalence"
+| _ => fail "The given statement does not seem to end with an equivalence."
end.
Ltac bapply lemma todo :=
@@ -141,7 +141,7 @@ t;
match goal with
| H : _ |- _ => solve [inversion H]
| _ => solve [trivial | reflexivity | symmetry; trivial | discriminate | split]
-| _ => fail 1 "Cannot solve this goal"
+| _ => fail 1 "Cannot solve this goal."
end.
(** A tactic to document or check what is proved at some point of a script *)
diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v
index f46b2b11..d3f8f1ab 100644
--- a/theories/Init/Wf.v
+++ b/theories/Init/Wf.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Wf.v 10712 2008-03-23 11:38:38Z herbelin $ i*)
+(*i $Id: Wf.v 11251 2008-07-24 08:28:40Z herbelin $ i*)
(** * This module proves the validity of
- well-founded recursion (also known as course of values)
@@ -27,6 +27,7 @@ Section Well_founded.
Variable R : A -> A -> Prop.
(** The accessibility predicate is defined to be non-informative *)
+ (** (Acc_rect is automatically defined because Acc is a singleton type) *)
Inductive Acc (x: A) : Prop :=
Acc_intro : (forall y:A, R y x -> Acc y) -> Acc x.
@@ -35,22 +36,6 @@ Section Well_founded.
destruct 1; trivial.
Defined.
- (** Informative elimination :
- [let Acc_rec F = let rec wf x = F x wf in wf] *)
-
- Section AccRecType.
-
- Variable P : A -> Type.
- Variable F : forall x:A,
- (forall y:A, R y x -> Acc y) -> (forall y:A, R y x -> P y) -> P x.
-
- Fixpoint Acc_rect (x:A) (a:Acc x) {struct a} : P x :=
- F (Acc_inv a) (fun (y:A) (h:R y x) => Acc_rect (Acc_inv a h)).
-
- End AccRecType.
-
- Definition Acc_rec (P:A -> Set) := Acc_rect P.
-
(** A relation is well-founded if every element is accessible *)
Definition well_founded := forall a:A, Acc a.
diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v
index 3737abf6..d15e2c96 100644
--- a/theories/Logic/ClassicalDescription.v
+++ b/theories/Logic/ClassicalDescription.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: ClassicalDescription.v 10170 2007-10-03 14:41:25Z herbelin $ i*)
+(*i $Id: ClassicalDescription.v 11238 2008-07-19 09:34:03Z herbelin $ i*)
(** This file provides classical logic and definite description, which is
equivalent to providing classical logic and Church's iota operator *)
@@ -21,7 +21,7 @@ Set Implicit Arguments.
Require Export Classical.
Require Import ChoiceFacts.
-Notation Local "'inhabited' A" := A (at level 200, only parsing).
+Notation Local inhabited A := A.
Axiom constructive_definite_description :
forall (A : Type) (P : A->Prop), (exists! x : A, P x) -> { x : A | P x }.
diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v
index 734de52d..8a045ec8 100644
--- a/theories/Logic/ClassicalFacts.v
+++ b/theories/Logic/ClassicalFacts.v
@@ -7,7 +7,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: ClassicalFacts.v 10156 2007-09-30 19:02:14Z herbelin $ i*)
+(*i $Id: ClassicalFacts.v 11238 2008-07-19 09:34:03Z herbelin $ i*)
(** Some facts and definitions about classical logic
@@ -119,7 +119,7 @@ Qed.
*)
-Definition inhabited (A:Prop) := A.
+Notation Local inhabited A := A.
Lemma prop_ext_A_eq_A_imp_A :
prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A.
@@ -514,8 +514,6 @@ Qed.
344 of Lecture Notes in Mathematics, Springer-Verlag, 1973.
*)
-Notation Local "'inhabited' A" := A (at level 10, only parsing).
-
Definition IndependenceOfGeneralPremises :=
forall (A:Type) (P:A -> Prop) (Q:Prop),
inhabited A -> (Q -> exists x, P x) -> exists x, Q -> P x.
diff --git a/theories/Logic/ConstructiveEpsilon.v b/theories/Logic/ConstructiveEpsilon.v
index f1503d24..3753b97b 100644
--- a/theories/Logic/ConstructiveEpsilon.v
+++ b/theories/Logic/ConstructiveEpsilon.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: ConstructiveEpsilon.v 10739 2008-04-01 14:45:20Z herbelin $ i*)
+(*i $Id: ConstructiveEpsilon.v 11238 2008-07-19 09:34:03Z herbelin $ i*)
(** This module proves the constructive description schema, which
infers the sigma-existence (i.e., [Set]-existence) of a witness to a
@@ -53,7 +53,7 @@ of our searching algorithm. *)
Let R (x y : nat) : Prop := x = S y /\ ~ P y.
-Notation Local "'acc' x" := (Acc R x) (at level 10).
+Notation Local acc x := (Acc R x).
Lemma P_implies_acc : forall x : nat, P x -> acc x.
Proof.
diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v
index 5f139f35..880ef7e2 100644
--- a/theories/Logic/Diaconescu.v
+++ b/theories/Logic/Diaconescu.v
@@ -7,7 +7,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Diaconescu.v 9245 2006-10-17 12:53:34Z notin $ i*)
+(*i $Id: Diaconescu.v 11238 2008-07-19 09:34:03Z herbelin $ i*)
(** Diaconescu showed that the Axiom of Choice entails Excluded-Middle
in topoi [Diaconescu75]. Lacas and Werner adapted the proof to show
@@ -267,7 +267,7 @@ End ProofIrrel_RelChoice_imp_EqEM.
(** Proof sketch from Bell [Bell93] (with thanks to P. CastĂŠran) *)
-Notation Local "'inhabited' A" := A (at level 10, only parsing).
+Notation Local inhabited A := A.
Section ExtensionalEpsilon_imp_EM.
diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v
index 9669eacd..83ecd10d 100644
--- a/theories/Numbers/BigNumPrelude.v
+++ b/theories/Numbers/BigNumPrelude.v
@@ -8,7 +8,7 @@
(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
(************************************************************************)
-(*i $Id: BigNumPrelude.v 11013 2008-05-28 18:17:30Z letouzey $ i*)
+(*i $Id: BigNumPrelude.v 11207 2008-07-04 16:50:32Z letouzey $ i*)
(** * BigNumPrelude *)
@@ -277,7 +277,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
Qed.
- Lemma shift_unshift_mod_2 : forall n p a, (0<=p<=n)%Z ->
+ Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n ->
((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) =
a mod 2 ^ p.
Proof.
@@ -329,7 +329,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
Qed.
Theorem Zgcd_div_pos a b:
- (0 < b)%Z -> (0 < Zgcd a b)%Z -> (0 < b / Zgcd a b)%Z.
+ 0 < b -> 0 < Zgcd a b -> 0 < b / Zgcd a b.
Proof.
intros a b Ha Hg.
case (Zle_lt_or_eq 0 (b/Zgcd a b)); auto.
@@ -340,6 +340,72 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a.
assert (F := (Zgcd_is_gcd a b)); inversion F; auto.
Qed.
+ Theorem Zdiv_neg a b:
+ a < 0 -> 0 < b -> a / b < 0.
+ Proof.
+ intros a b Ha Hb.
+ assert (b > 0) by omega.
+ generalize (Z_mult_div_ge a _ H); intros.
+ assert (b * (a / b) < 0)%Z.
+ apply Zle_lt_trans with a; auto with zarith.
+ destruct b; try (compute in Hb; discriminate).
+ destruct (a/Zpos p)%Z.
+ compute in H1; discriminate.
+ compute in H1; discriminate.
+ compute; auto.
+ Qed.
+
+ Lemma Zgcd_Zabs : forall z z', Zgcd (Zabs z) z' = Zgcd z z'.
+ Proof.
+ destruct z; simpl; auto.
+ Qed.
+
+ Lemma Zgcd_sym : forall p q, Zgcd p q = Zgcd q p.
+ Proof.
+ intros.
+ apply Zis_gcd_gcd.
+ apply Zgcd_is_pos.
+ apply Zis_gcd_sym.
+ apply Zgcd_is_gcd.
+ Qed.
+
+ Lemma Zdiv_gcd_zero : forall a b, b / Zgcd a b = 0 -> b <> 0 ->
+ Zgcd a b = 0.
+ Proof.
+ intros.
+ generalize (Zgcd_is_gcd a b); destruct 1.
+ destruct H2 as (k,Hk).
+ generalize H; rewrite Hk at 1.
+ destruct (Z_eq_dec (Zgcd a b) 0) as [H'|H']; auto.
+ rewrite Z_div_mult_full; auto.
+ intros; subst k; simpl in *; subst b; elim H0; auto.
+ Qed.
+
+ Lemma Zgcd_1 : forall z, Zgcd z 1 = 1.
+ Proof.
+ intros; apply Zis_gcd_gcd; auto with zarith; apply Zis_gcd_1.
+ Qed.
+ Hint Resolve Zgcd_1.
+
+ Lemma Zgcd_mult_rel_prime : forall a b c,
+ Zgcd a c = 1 -> Zgcd b c = 1 -> Zgcd (a*b) c = 1.
+ Proof.
+ intros.
+ rewrite Zgcd_1_rel_prime in *.
+ apply rel_prime_sym; apply rel_prime_mult; apply rel_prime_sym; auto.
+ Qed.
+
+ Lemma Zcompare_gt : forall (A:Type)(a a':A)(p q:Z),
+ match (p?=q)%Z with Gt => a | _ => a' end =
+ if Z_le_gt_dec p q then a' else a.
+ Proof.
+ intros.
+ destruct Z_le_gt_dec as [H|H].
+ red in H.
+ destruct (p?=q)%Z; auto; elim H; auto.
+ rewrite H; auto.
+ Qed.
+
Theorem Zbounded_induction :
(forall Q : Z -> Prop, forall b : Z,
Q 0 ->
diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
index 22f6d95b..fb3f0cef 100644
--- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v
+++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v
@@ -8,7 +8,7 @@
(* Evgeny Makarov, INRIA, 2007 *)
(************************************************************************)
-(*i $Id: NZCyclic.v 11040 2008-06-03 00:04:16Z letouzey $ i*)
+(*i $Id: NZCyclic.v 11238 2008-07-19 09:34:03Z herbelin $ i*)
Require Export NZAxioms.
Require Import BigNumPrelude.
@@ -89,8 +89,8 @@ Open Local Scope IntScope.
Notation "x == y" := (NZeq x y) (at level 70) : IntScope.
Notation "x ~= y" := (~ NZeq x y) (at level 70) : IntScope.
Notation "0" := NZ0 : IntScope.
-Notation "'S'" := NZsucc : IntScope.
-Notation "'P'" := NZpred : IntScope.
+Notation S x := (NZsucc x).
+Notation P x := (NZpred x).
(*Notation "1" := (S 0) : IntScope.*)
Notation "x + y" := (NZadd x y) : IntScope.
Notation "x - y" := (NZsub x y) : IntScope.
diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v
index 09abf424..cb920124 100644
--- a/theories/Numbers/Integer/BigZ/BigZ.v
+++ b/theories/Numbers/Integer/BigZ/BigZ.v
@@ -8,7 +8,7 @@
(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
(************************************************************************)
-(*i $Id: BigZ.v 11040 2008-06-03 00:04:16Z letouzey $ i*)
+(*i $Id: BigZ.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
Require Export BigN.
Require Import ZMulOrder.
@@ -42,25 +42,27 @@ Infix "?=" := BigZ.compare : bigZ_scope.
Infix "==" := BigZ.eq (at level 70, no associativity) : bigZ_scope.
Infix "<" := BigZ.lt : bigZ_scope.
Infix "<=" := BigZ.le : bigZ_scope.
+Notation "x > y" := (BigZ.lt y x)(only parsing) : bigZ_scope.
+Notation "x >= y" := (BigZ.le y x)(only parsing) : bigZ_scope.
Notation "[ i ]" := (BigZ.to_Z i) : bigZ_scope.
Open Scope bigZ_scope.
(** Some additional results about [BigZ] *)
-Theorem spec_to_Z: forall n:bigZ,
+Theorem spec_to_Z: forall n:bigZ,
BigN.to_Z (BigZ.to_N n) = ((Zsgn [n]) * [n])%Z.
Proof.
-intros n; case n; simpl; intros p;
+intros n; case n; simpl; intros p;
generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
intros p1 H1; case H1; auto.
intros p1 H1; case H1; auto.
Qed.
-Theorem spec_to_N n:
+Theorem spec_to_N n:
([n] = Zsgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z.
Proof.
-intros n; case n; simpl; intros p;
+intros n; case n; simpl; intros p;
generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
intros p1 H1; case H1; auto.
intros p1 H1; case H1; auto.
@@ -69,7 +71,7 @@ Qed.
Theorem spec_to_Z_pos: forall n, (0 <= [n])%Z ->
BigN.to_Z (BigZ.to_N n) = [n].
Proof.
-intros n; case n; simpl; intros p;
+intros n; case n; simpl; intros p;
generalize (BigN.spec_pos p); case (BigN.to_Z p); auto.
intros p1 _ H1; case H1; auto.
intros p1 H1; case H1; auto.
@@ -87,7 +89,7 @@ Qed.
(** [BigZ] is a ring *)
-Lemma BigZring :
+Lemma BigZring :
ring_theory BigZ.zero BigZ.one BigZ.add BigZ.mul BigZ.sub BigZ.opp BigZ.eq.
Proof.
constructor.
@@ -102,6 +104,8 @@ exact sub_opp.
exact add_opp.
Qed.
+Typeclasses unfold NZadd NZmul NZsub NZeq.
+
Add Ring BigZr : BigZring.
(** Todo: tactic translating from [BigZ] to [Z] + omega *)
diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v
index 1f2b12bb..6305156b 100644
--- a/theories/Numbers/Integer/BigZ/ZMake.v
+++ b/theories/Numbers/Integer/BigZ/ZMake.v
@@ -8,7 +8,7 @@
(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
(************************************************************************)
-(*i $Id: ZMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*)
+(*i $Id: ZMake.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
Require Import ZArith.
Require Import BigNumPrelude.
@@ -30,6 +30,7 @@ Module Make (N:NType) <: ZType.
| Neg : N.t -> t_.
Definition t := t_.
+ Typeclasses unfold t.
Definition zero := Pos N.zero.
Definition one := Pos N.one.
diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
index d7c56267..aceb8984 100644
--- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
+++ b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: ZSigZAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*)
+(*i $Id: ZSigZAxioms.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
Require Import ZArith.
Require Import ZAxioms.
@@ -216,7 +216,7 @@ Qed.
Add Morphism Z.compare with signature Z.eq ==> Z.eq ==> (@eq comparison) as compare_wd.
Proof.
intros x x' Hx y y' Hy.
-rewrite 2 spec_compare_alt; rewrite Hx, Hy; intuition.
+rewrite 2 spec_compare_alt; unfold Z.eq in *; rewrite Hx, Hy; intuition.
Qed.
Add Morphism Z.lt with signature Z.eq ==> Z.eq ==> iff as NZlt_wd.
diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v
index 826ffa2c..15aed7ab 100644
--- a/theories/Numbers/Natural/Abstract/NOrder.v
+++ b/theories/Numbers/Natural/Abstract/NOrder.v
@@ -8,7 +8,7 @@
(* Evgeny Makarov, INRIA, 2007 *)
(************************************************************************)
-(*i $Id: NOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*)
+(*i $Id: NOrder.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
Require Export NMul.
@@ -309,13 +309,12 @@ Proof NZgt_wf.
Theorem lt_wf_0 : well_founded lt.
Proof.
-assert (H : relations_eq lt (fun n m : N => 0 <= n /\ n < m)).
+setoid_replace lt with (fun n m : N => 0 <= n /\ n < m)
+ using relation (@relations_eq N N).
+apply lt_wf.
intros x y; split.
intro H; split; [apply le_0_l | assumption]. now intros [_ H].
-rewrite H; apply lt_wf.
-(* does not work:
-setoid_replace lt with (fun n m : N => 0 <= n /\ n < m) using relation relations_eq.*)
-Qed.
+Defined.
(* Theorems that are true for natural numbers but not for integers *)
diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v
index 0574c09f..41c255b1 100644
--- a/theories/Numbers/Natural/BigN/BigN.v
+++ b/theories/Numbers/Natural/BigN/BigN.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: BigN.v 11040 2008-06-03 00:04:16Z letouzey $ i*)
+(*i $Id: BigN.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
(** * Natural numbers in base 2^31 *)
@@ -47,6 +47,8 @@ Infix "?=" := BigN.compare : bigN_scope.
Infix "==" := BigN.eq (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 "[ i ]" := (BigN.to_Z i) : bigN_scope.
Open Scope bigN_scope.
@@ -62,7 +64,7 @@ Qed.
(** [BigN] is a semi-ring *)
-Lemma BigNring :
+Lemma BigNring :
semi_ring_theory BigN.zero BigN.one BigN.add BigN.mul BigN.eq.
Proof.
constructor.
@@ -76,6 +78,8 @@ exact mul_assoc.
exact mul_add_distr_r.
Qed.
+Typeclasses unfold NZadd NZsub NZmul.
+
Add Ring BigNr : BigNring.
(** Todo: tactic translating from [BigN] to [Z] + omega *)
diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml
index bd0fb5b1..4d6b45c5 100644
--- a/theories/Numbers/Natural/BigN/NMake_gen.ml
+++ b/theories/Numbers/Natural/BigN/NMake_gen.ml
@@ -8,7 +8,7 @@
(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
(************************************************************************)
-(*i $Id: NMake_gen.ml 11136 2008-06-18 10:41:34Z herbelin $ i*)
+(*i $Id: NMake_gen.ml 11282 2008-07-28 11:51:53Z msozeau $ i*)
(*S NMake_gen.ml : this file generates NMake.v *)
@@ -139,7 +139,7 @@ let _ =
pr "";
pr " Definition %s := %s_." t t;
pr "";
-
+ pr " Typeclasses unfold %s." t;
pr " Definition w_0 := w0_op.(znz_0).";
pr "";
diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
index fe068437..84836268 100644
--- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
+++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: NSigNAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*)
+(*i $Id: NSigNAxioms.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
Require Import ZArith.
Require Import Nnat.
@@ -223,7 +223,7 @@ 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; rewrite Hx, Hy; intuition.
+rewrite 2 spec_compare_alt. unfold N.eq in *. rewrite Hx, Hy; intuition.
Qed.
Add Morphism N.lt with signature N.eq ==> N.eq ==> iff as NZlt_wd.
diff --git a/theories/Numbers/Rational/BigQ/BigQ.v b/theories/Numbers/Rational/BigQ/BigQ.v
index 39e120f7..21f2513f 100644
--- a/theories/Numbers/Rational/BigQ/BigQ.v
+++ b/theories/Numbers/Rational/BigQ/BigQ.v
@@ -8,19 +8,35 @@
(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
(************************************************************************)
-(*i $Id: BigQ.v 11028 2008-06-01 17:34:19Z letouzey $ i*)
+(*i $Id: BigQ.v 11208 2008-07-04 16:57:46Z letouzey $ i*)
-Require Export QMake_base.
-Require Import QpMake.
-Require Import QvMake.
-Require Import Q0Make.
-Require Import QifMake.
-Require Import QbiMake.
+Require Import Field Qfield BigN BigZ QSig QMake.
-(* We choose for Q the implemention with
- multiple representation of 0: 0, 1/0, 2/0 etc *)
+(** We choose for BigQ an implemention with
+ multiple representation of 0: 0, 1/0, 2/0 etc.
+ See [QMake.v] *)
-Module BigQ <: QSig.QType := Q0.
+(** First, we provide translations functions between [BigN] and [BigZ] *)
+
+Module BigN_BigZ <: NType_ZType BigN.BigN BigZ.
+ Definition Z_of_N := BigZ.Pos.
+ Lemma spec_Z_of_N : forall n, BigZ.to_Z (Z_of_N n) = BigN.to_Z n.
+ Proof.
+ reflexivity.
+ Qed.
+ Definition Zabs_N := BigZ.to_N.
+ Lemma spec_Zabs_N : forall z, BigN.to_Z (Zabs_N z) = Zabs (BigZ.to_Z z).
+ Proof.
+ unfold Zabs_N; intros.
+ rewrite BigZ.spec_to_Z, Zmult_comm; apply Zsgn_Zabs.
+ Qed.
+End BigN_BigZ.
+
+(** This allows to build [BigQ] out of [BigN] and [BigQ] via [QMake] *)
+
+Module BigQ <: QSig.QType := QMake.Make BigN BigZ BigN_BigZ.
+
+(** Notations about [BigQ] *)
Notation bigQ := BigQ.t.
@@ -28,8 +44,150 @@ Delimit Scope bigQ_scope with bigQ.
Bind Scope bigQ_scope with bigQ.
Bind Scope bigQ_scope with BigQ.t.
-Notation " i + j " := (BigQ.add i j) : bigQ_scope.
-Notation " i - j " := (BigQ.sub i j) : bigQ_scope.
-Notation " i * j " := (BigQ.mul i j) : bigQ_scope.
-Notation " i / j " := (BigQ.div i j) : bigQ_scope.
-Notation " i ?= j " := (BigQ.compare i j) : bigQ_scope.
+Infix "+" := BigQ.add : bigQ_scope.
+Infix "-" := BigQ.sub : bigQ_scope.
+Notation "- x" := (BigQ.opp x) : bigQ_scope.
+Infix "*" := BigQ.mul : bigQ_scope.
+Infix "/" := BigQ.div : bigQ_scope.
+Infix "^" := BigQ.power : bigQ_scope.
+Infix "?=" := BigQ.compare : bigQ_scope.
+Infix "==" := BigQ.eq : bigQ_scope.
+Infix "<" := BigQ.lt : bigQ_scope.
+Infix "<=" := BigQ.le : bigQ_scope.
+Notation "x > y" := (BigQ.lt y x)(only parsing) : bigQ_scope.
+Notation "x >= y" := (BigQ.le y x)(only parsing) : bigQ_scope.
+Notation "[ q ]" := (BigQ.to_Q q) : bigQ_scope.
+
+Open Scope bigQ_scope.
+
+(** [BigQ] is a setoid *)
+
+Add Relation BigQ.t BigQ.eq
+ reflexivity proved by (fun x => Qeq_refl [x])
+ symmetry proved by (fun x y => Qeq_sym [x] [y])
+ transitivity proved by (fun x y z => Qeq_trans [x] [y] [z])
+as BigQeq_rel.
+
+Add Morphism BigQ.add with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQadd_wd.
+Proof.
+ unfold BigQ.eq; intros; rewrite !BigQ.spec_add; rewrite H, H0; apply Qeq_refl.
+Qed.
+
+Add Morphism BigQ.opp with signature BigQ.eq ==> BigQ.eq as BigQopp_wd.
+Proof.
+ unfold BigQ.eq; intros; rewrite !BigQ.spec_opp; rewrite H; apply Qeq_refl.
+Qed.
+
+Add Morphism BigQ.sub with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQsub_wd.
+Proof.
+ unfold BigQ.eq; intros; rewrite !BigQ.spec_sub; rewrite H, H0; apply Qeq_refl.
+Qed.
+
+Add Morphism BigQ.mul with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQmul_wd.
+Proof.
+ unfold BigQ.eq; intros; rewrite !BigQ.spec_mul; rewrite H, H0; apply Qeq_refl.
+Qed.
+
+Add Morphism BigQ.inv with signature BigQ.eq ==> BigQ.eq as BigQinv_wd.
+Proof.
+ unfold BigQ.eq; intros; rewrite !BigQ.spec_inv; rewrite H; apply Qeq_refl.
+Qed.
+
+Add Morphism BigQ.div with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQdiv_wd.
+Proof.
+ unfold BigQ.eq; intros; rewrite !BigQ.spec_div; rewrite H, H0; apply Qeq_refl.
+Qed.
+
+(* TODO : fix this. For the moment it's useless (horribly slow)
+Hint Rewrite
+ BigQ.spec_0 BigQ.spec_1 BigQ.spec_m1 BigQ.spec_compare
+ BigQ.spec_red BigQ.spec_add BigQ.spec_sub BigQ.spec_opp
+ BigQ.spec_mul BigQ.spec_inv BigQ.spec_div BigQ.spec_power_pos
+ BigQ.spec_square : bigq. *)
+
+
+(** [BigQ] is a field *)
+
+Lemma BigQfieldth :
+ field_theory BigQ.zero BigQ.one BigQ.add BigQ.mul BigQ.sub BigQ.opp BigQ.div BigQ.inv BigQ.eq.
+Proof.
+constructor.
+constructor; intros; red.
+rewrite BigQ.spec_add, BigQ.spec_0; ring.
+rewrite ! BigQ.spec_add; ring.
+rewrite ! BigQ.spec_add; ring.
+rewrite BigQ.spec_mul, BigQ.spec_1; ring.
+rewrite ! BigQ.spec_mul; ring.
+rewrite ! BigQ.spec_mul; ring.
+rewrite BigQ.spec_add, ! BigQ.spec_mul, BigQ.spec_add; ring.
+unfold BigQ.sub; apply Qeq_refl.
+rewrite BigQ.spec_add, BigQ.spec_0, BigQ.spec_opp; ring.
+compute; discriminate.
+intros; red.
+unfold BigQ.div; apply Qeq_refl.
+intros; red.
+rewrite BigQ.spec_mul, BigQ.spec_inv, BigQ.spec_1; field.
+rewrite <- BigQ.spec_0; auto.
+Qed.
+
+Lemma BigQpowerth :
+ power_theory BigQ.one BigQ.mul BigQ.eq Z_of_N BigQ.power.
+Proof.
+constructor.
+intros; red.
+rewrite BigQ.spec_power.
+replace ([r] ^ Z_of_N n)%Q with (pow_N 1 Qmult [r] n)%Q.
+destruct n.
+simpl; compute; auto.
+induction p; simpl; auto; try rewrite !BigQ.spec_mul, !IHp; apply Qeq_refl.
+destruct n; reflexivity.
+Qed.
+
+Lemma BigQ_eq_bool_correct :
+ forall x y, BigQ.eq_bool x y = true -> x==y.
+Proof.
+intros; generalize (BigQ.spec_eq_bool x y); rewrite H; auto.
+Qed.
+
+Lemma BigQ_eq_bool_complete :
+ forall x y, x==y -> BigQ.eq_bool x y = true.
+Proof.
+intros; generalize (BigQ.spec_eq_bool x y).
+destruct BigQ.eq_bool; auto.
+Qed.
+
+(* TODO : improve later the detection of constants ... *)
+
+Ltac BigQcst t :=
+ match t with
+ | BigQ.zero => BigQ.zero
+ | BigQ.one => BigQ.one
+ | BigQ.minus_one => BigQ.minus_one
+ | _ => NotConstant
+ end.
+
+Add Field BigQfield : BigQfieldth
+ (decidable BigQ_eq_bool_correct,
+ completeness BigQ_eq_bool_complete,
+ constants [BigQcst],
+ power_tac BigQpowerth [Qpow_tac]).
+
+Section Examples.
+
+Let ex1 : forall x y z, (x+y)*z == (x*z)+(y*z).
+ intros.
+ ring.
+Qed.
+
+Let ex8 : forall x, x ^ 1 == x.
+ intro.
+ ring.
+Qed.
+
+Let ex10 : forall x y, ~(y==BigQ.zero) -> (x/y)*y == x.
+intros.
+field.
+auto.
+Qed.
+
+End Examples. \ No newline at end of file
diff --git a/theories/Numbers/Rational/BigQ/Q0Make.v b/theories/Numbers/Rational/BigQ/Q0Make.v
deleted file mode 100644
index 93f52c03..00000000
--- a/theories/Numbers/Rational/BigQ/Q0Make.v
+++ /dev/null
@@ -1,1412 +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 *)
-(************************************************************************)
-(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-(************************************************************************)
-
-(*i $Id: Q0Make.v 11028 2008-06-01 17:34:19Z letouzey $ i*)
-
-Require Import Bool.
-Require Import ZArith.
-Require Import Znumtheory.
-Require Import BigNumPrelude.
-Require Import Arith.
-Require Export BigN.
-Require Export BigZ.
-Require Import QArith.
-Require Import Qcanon.
-Require Import Qpower.
-Require Import QSig.
-Require Import QMake_base.
-
-Module Q0 <: QType.
-
- Import BinInt Zorder.
-
- (** The notation of a rational number is either an integer x,
- interpreted as itself or a pair (x,y) of an integer x and a natural
- number y interpreted as x/y. The pairs (x,0) and (0,y) are all
- interpreted as 0. *)
-
- Definition t := q_type.
-
- (** Specification with respect to [QArith] *)
-
- Open Local Scope Q_scope.
-
- Definition of_Z x: t := Qz (BigZ.of_Z x).
-
- Definition of_Q q: t :=
- match q with x # y =>
- Qq (BigZ.of_Z x) (BigN.of_N (Npos y))
- end.
-
- Definition to_Q (q: t) :=
- match q with
- Qz x => BigZ.to_Z x # 1
- |Qq x y => if BigN.eq_bool y BigN.zero then 0
- else BigZ.to_Z x # Z2P (BigN.to_Z y)
- end.
-
- Notation "[ x ]" := (to_Q x).
-
- Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q.
- Proof.
- intros (x,y); simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigN.spec_of_pos; intros HH; discriminate HH.
- rewrite BigZ.spec_of_Z; simpl.
- rewrite (BigN.spec_of_pos); auto.
- Qed.
-
- Theorem spec_of_Q: forall q: Q, [of_Q q] == q.
- Proof.
- intros; rewrite strong_spec_of_Q; red; auto.
- Qed.
-
- Definition eq x y := [x] == [y].
-
- Definition zero: t := Qz BigZ.zero.
- Definition one: t := Qz BigZ.one.
- Definition minus_one: t := Qz BigZ.minus_one.
-
- Lemma spec_0: [zero] == 0.
- Proof.
- reflexivity.
- Qed.
-
- Lemma spec_1: [one] == 1.
- Proof.
- reflexivity.
- Qed.
-
- Lemma spec_m1: [minus_one] == -(1).
- Proof.
- reflexivity.
- Qed.
-
- Definition opp (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.opp zx)
- | Qq nx dx => Qq (BigZ.opp nx) dx
- end.
-
- Theorem strong_spec_opp: forall q, [opp q] = -[q].
- Proof.
- intros [z | x y]; simpl.
- rewrite BigZ.spec_opp; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigZ.spec_opp; auto.
- Qed.
-
- Theorem spec_opp : forall q, [opp q] == -[q].
- Proof.
- intros; rewrite strong_spec_opp; red; auto.
- Qed.
-
- Definition compare (x y: t) :=
- match x, y with
- | Qz zx, Qz zy => BigZ.compare zx zy
- | Qz zx, Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero
- else BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny
- | Qq nx dx, Qz zy =>
- if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy
- else BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx))
- | Qq nx dx, Qq ny dy =>
- match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with
- | true, true => Eq
- | true, false => BigZ.compare BigZ.zero ny
- | false, true => BigZ.compare nx BigZ.zero
- | false, false => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx))
- end
- end.
-
- Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]).
- Proof.
- intros [z1 | x1 y1] [z2 | x2 y2];
- unfold Qcompare, compare, to_Q, Qnum, Qden.
- repeat rewrite Zmult_1_r.
- generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- rewrite Zmult_1_r.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare;
- rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare BigZ.zero z2);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- rewrite Zmult_1_r.
- generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare;
- rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- rewrite Zcompare_refl; auto.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare BigZ.zero x2);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare;
- auto; rewrite BigZ.spec_0.
- intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto.
- repeat rewrite Z2P_correct.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (x1 * BigZ.Pos y2)
- (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare;
- repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- Qed.
-
- 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.
-
-(* Je pense que cette fonction normalise bien ... *)
- Definition norm n d: t :=
- let gcd := BigN.gcd (BigZ.to_N n) d in
- match BigN.compare BigN.one gcd with
- | Lt =>
- let n := BigZ.div n (BigZ.Pos gcd) in
- let d := BigN.div d gcd in
- match BigN.compare d BigN.one with
- | Gt => Qq n d
- | Eq => Qz n
- | Lt => zero
- end
- | Eq => Qq n d
- | Gt => zero (* gcd = 0 => both numbers are 0 *)
- end.
-
- Theorem spec_norm: forall n q, [norm n q] == [Qq n q].
- Proof.
- intros p q; unfold norm.
- assert (Hp := BigN.spec_pos (BigZ.to_N p)).
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1.
- apply Qeq_refl.
- generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN).
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith; intros H2 HH.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H3; simpl;
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- auto with zarith.
- generalize H2; rewrite H3;
- rewrite Zdiv_0_l; auto with zarith.
- generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3.
- rewrite spec_to_N.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H3; simpl.
- case H3.
- generalize H1 H2 H3 HH; clear H1 H2 H3 HH.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 HH.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith.
- case (Zle_lt_or_eq _ _ HH); auto with zarith.
- intros HH1; rewrite <- HH1; ring.
- generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith; intros H3.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H4.
- case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith.
- simpl.
- assert (FF := BigN.spec_pos q).
- rewrite Z2P_correct; auto with zarith.
- rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith.
- simpl; rewrite BigZ.spec_div; simpl.
- rewrite BigN.spec_gcd; auto with zarith.
- generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 H4 HH FF.
- rewrite spec_to_N; fold a.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_gcd; auto with zarith.
- case (Zle_lt_or_eq _ _
- (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q)));
- rewrite BigN.spec_gcd; auto with zarith.
- intros; apply False_ind; auto with zarith.
- intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)).
- assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)).
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H2; simpl.
- rewrite spec_to_N.
- rewrite FF2; ring.
- Qed.
-
-
- Definition add (x y: t): t :=
- match x with
- | Qz zx =>
- match y with
- | Qz zy => Qz (BigZ.add zx zy)
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- end
- | Qq nx dx =>
- if BigN.eq_bool dx BigN.zero then y
- else match y with
- | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- Qq n d
- end
- end.
-
- Theorem spec_add : forall x y, [add x y] == [x] + [y].
- Proof.
- intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl.
- rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- assert (F1:= BigN.spec_pos dy).
- rewrite Zmult_1_r; red; simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH; simpl; try ring.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH1; simpl; try ring.
- case HH; auto.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH; simpl; try ring.
- rewrite Zmult_1_r; apply Qeq_refl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH1; simpl; try ring.
- case HH; auto.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto.
- rewrite Zmult_1_r; rewrite Pmult_1_r.
- apply Qeq_refl.
- assert (F1:= BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- apply Qeq_refl.
- case HH2; auto.
- simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- case HH2; auto.
- case HH1; auto.
- rewrite Zmult_1_r; apply Qeq_refl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- simpl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- case HH; auto.
- rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r.
- apply Qeq_refl.
- simpl.
- generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_mul;
- rewrite BigN.spec_0; intros HH2.
- (case (Zmult_integral _ _ HH2); intros HH3);
- [case HH| case HH1]; auto.
- rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl.
- assert (Fx: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (Fy: (0 < BigN.to_Z dy)%Z).
- generalize (BigN.spec_pos dy); auto with zarith.
- red; simpl; rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto with zarith.
- apply Zmult_lt_0_compat; auto.
- Qed.
-
- Definition add_norm (x y: t): t :=
- match x with
- | Qz zx =>
- match y with
- | Qz zy => Qz (BigZ.add zx zy)
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- end
- | Qq nx dx =>
- if BigN.eq_bool dx BigN.zero then y
- else match y with
- | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- norm n d
- end
- end.
-
- Theorem spec_add_norm : forall x y, [add_norm x y] == [x] + [y].
- Proof.
- intros x y; rewrite <- spec_add; auto.
- case x; case y; clear x y; unfold add_norm, add.
- intros; apply Qeq_refl.
- intros p1 n p2.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- simpl.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- apply Qeq_refl.
- apply Qeq_refl.
- intros p1 p2 n.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- apply Qeq_refl.
- intros p1 q1 p2 q2.
- generalize (BigN.spec_eq_bool q2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- apply Qeq_refl.
- generalize (BigN.spec_eq_bool q1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- apply Qeq_refl.
- Qed.
-
- Definition sub x y := add x (opp y).
-
- Theorem spec_sub : forall x y, [sub x y] == [x] - [y].
- Proof.
- intros x y; unfold sub; rewrite spec_add; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Definition sub_norm x y := add_norm x (opp y).
-
- Theorem spec_sub_norm : forall x y, [sub_norm x y] == [x] - [y].
- Proof.
- intros x y; unfold sub_norm; rewrite spec_add_norm; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Definition mul (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy
- | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx
- | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy)
- end.
-
- Theorem spec_mul : forall x y, [mul x y] == [x] * [y].
- Proof.
- intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl.
- rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH1.
- red; simpl; ring.
- rewrite BigZ.spec_mul; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH1.
- red; simpl; ring.
- rewrite BigZ.spec_mul; rewrite Pmult_1_r.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_mul;
- intros HH1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH2.
- red; simpl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH3.
- red; simpl; ring.
- case (Zmult_integral _ _ HH1); intros HH.
- case HH2; auto.
- case HH3; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH2.
- case HH1; rewrite HH2; ring.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH3.
- case HH1; rewrite HH3; ring.
- rewrite BigZ.spec_mul.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto.
- apply Qeq_refl.
- generalize (BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_pos dy); auto with zarith.
- Qed.
-
-Definition mul_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy =>
- if BigZ.eq_bool zx BigZ.zero then zero
- else
- let gcd := BigN.gcd (BigZ.to_N zx) dy in
- match BigN.compare gcd BigN.one with
- Gt =>
- let zx := BigZ.div zx (BigZ.Pos gcd) in
- let d := BigN.div dy gcd in
- if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny)
- else Qq (BigZ.mul zx ny) d
- | _ => Qq (BigZ.mul zx ny) dy
- end
- | Qq nx dx, Qz zy =>
- if BigZ.eq_bool zy BigZ.zero then zero
- else
- let gcd := BigN.gcd (BigZ.to_N zy) dx in
- match BigN.compare gcd BigN.one with
- Gt =>
- let zy := BigZ.div zy (BigZ.Pos gcd) in
- let d := BigN.div dx gcd in
- if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx)
- else Qq (BigZ.mul zy nx) d
- | _ => Qq (BigZ.mul zy nx) dx
- end
- | Qq nx dx, Qq ny dy =>
- let (nx, dy) :=
- let gcd := BigN.gcd (BigZ.to_N nx) dy in
- match BigN.compare gcd BigN.one with
- Gt => (BigZ.div nx (BigZ.Pos gcd), BigN.div dy gcd)
- | _ => (nx, dy)
- end in
- let (ny, dx) :=
- let gcd := BigN.gcd (BigZ.to_N ny) dx in
- match BigN.compare gcd BigN.one with
- Gt => (BigZ.div ny (BigZ.Pos gcd), BigN.div dx gcd)
- | _ => (ny, dx)
- end in
- let d := (BigN.mul dx dy) in
- if BigN.eq_bool d BigN.one then Qz (BigZ.mul ny nx)
- else Qq (BigZ.mul ny nx) d
- end.
-
- Theorem spec_mul_norm : forall x y, [mul_norm x y] == [x] * [y].
- Proof.
- intros x y; rewrite <- spec_mul; auto.
- unfold mul_norm, mul; case x; case y; clear x y.
- intros; apply Qeq_refl.
- intros p1 n p2.
- set (a := BigN.to_Z (BigZ.to_N p2)).
- set (b := BigN.to_Z n).
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H.
- case BigN.eq_bool; try apply Qeq_refl.
- rewrite BigZ.spec_mul; rewrite H.
- red; simpl; ring.
- assert (F: (0 < a)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto.
- intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; rewrite BigN.spec_gcd;
- fold a b; intros H1.
- apply Qeq_refl.
- apply Qeq_refl.
- assert (F0 : (0 < (Zgcd a b))%Z).
- apply Zlt_trans with 1%Z.
- red; auto.
- apply Zgt_lt; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith;
- fold a b; intros H2.
- assert (F1: b = Zgcd a b).
- pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b);
- auto with zarith.
- rewrite H2; ring.
- assert (FF := Zgcd_is_gcd a b); inversion FF; auto.
- assert (F2: (0 < b)%Z).
- rewrite F1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; fold b; intros H3.
- rewrite H3 in F2; discriminate F2.
- rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- rewrite BigZ.spec_mul.
- red; simpl; rewrite Z2P_correct; auto.
- rewrite Zmult_1_r; rewrite spec_to_N; fold a b.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p1)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; fold a b; auto; intros H3.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H4.
- apply Qeq_refl.
- case H4; fold b.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite H3; ring.
- assert (FF := Zgcd_is_gcd a b); inversion FF; auto.
- simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; fold b; intros H4.
- case H3; rewrite H4; rewrite Zdiv_0_l; auto.
- rewrite BigZ.spec_mul; rewrite BigZ.spec_div; simpl;
- rewrite BigN.spec_gcd; fold a b; auto with zarith.
- assert (F1: (0 < b)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos n)); fold b; auto with zarith.
- red; simpl.
- rewrite BigZ.spec_mul.
- repeat rewrite Z2P_correct; auto.
- rewrite spec_to_N; fold a.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p1)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- ring.
- apply Zgcd_div_pos; auto.
- intros p1 p2 n.
- set (a := BigN.to_Z (BigZ.to_N p1)).
- set (b := BigN.to_Z n).
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H.
- case BigN.eq_bool; try apply Qeq_refl.
- rewrite BigZ.spec_mul; rewrite H.
- red; simpl; ring.
- assert (F: (0 < a)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto.
- intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; rewrite BigN.spec_gcd;
- fold a b; intros H1.
- repeat rewrite BigZ.spec_mul; rewrite Zmult_comm.
- apply Qeq_refl.
- repeat rewrite BigZ.spec_mul; rewrite Zmult_comm.
- apply Qeq_refl.
- assert (F0 : (0 < (Zgcd a b))%Z).
- apply Zlt_trans with 1%Z.
- red; auto.
- apply Zgt_lt; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith;
- fold a b; intros H2.
- assert (F1: b = Zgcd a b).
- pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b);
- auto with zarith.
- rewrite H2; ring.
- assert (FF := Zgcd_is_gcd a b); inversion FF; auto.
- assert (F2: (0 < b)%Z).
- rewrite F1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; fold b; intros H3.
- rewrite H3 in F2; discriminate F2.
- rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- rewrite BigZ.spec_mul.
- red; simpl; rewrite Z2P_correct; auto.
- rewrite Zmult_1_r; rewrite spec_to_N; fold a b.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p2)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; fold a b; auto; intros H3.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H4.
- apply Qeq_refl.
- case H4; fold b.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite H3; ring.
- assert (FF := Zgcd_is_gcd a b); inversion FF; auto.
- simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; fold b; intros H4.
- case H3; rewrite H4; rewrite Zdiv_0_l; auto.
- rewrite BigZ.spec_mul; rewrite BigZ.spec_div; simpl;
- rewrite BigN.spec_gcd; fold a b; auto with zarith.
- assert (F1: (0 < b)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos n)); fold b; auto with zarith.
- red; simpl.
- rewrite BigZ.spec_mul.
- repeat rewrite Z2P_correct; auto.
- rewrite spec_to_N; fold a.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p2)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- ring.
- apply Zgcd_div_pos; auto.
- set (f := fun p t =>
- match (BigN.gcd (BigZ.to_N p) t ?= BigN.one)%bigN with
- | Eq => (p, t)
- | Lt => (p, t)
- | Gt =>
- ((p / BigZ.Pos (BigN.gcd (BigZ.to_N p) t))%bigZ,
- (t / BigN.gcd (BigZ.to_N p) t)%bigN)
- end).
- assert (F: forall p t,
- let (n, d) := f p t in [Qq p t] == [Qq n d]).
- intros p t1; unfold f.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1.
- apply Qeq_refl.
- apply Qeq_refl.
- set (a := BigN.to_Z (BigZ.to_N p)).
- set (b := BigN.to_Z t1).
- fold a b in H1.
- assert (F0 : (0 < (Zgcd a b))%Z).
- apply Zlt_trans with 1%Z.
- red; auto.
- apply Zgt_lt; auto.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; fold b; intros HH1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; fold b; intros HH2.
- simpl; ring.
- case HH2.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; auto.
- rewrite HH1; rewrite Zdiv_0_l; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0;
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; auto;
- intros HH2.
- case HH1.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite HH2; ring.
- assert (FF := Zgcd_is_gcd a b); inversion FF; auto.
- simpl.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; fold a b; auto with zarith.
- assert (F1: (0 < b)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos t1)); fold b; auto with zarith.
- intros HH; case HH1; auto.
- repeat rewrite Z2P_correct; auto.
- rewrite spec_to_N; fold a.
- rewrite Zgcd_div_swap; auto.
- apply Zgcd_div_pos; auto.
- intros HH; rewrite HH in F0; discriminate F0.
- intros p1 n1 p2 n2.
- change ([let (nx , dy) := f p2 n1 in
- let (ny, dx) := f p1 n2 in
- if BigN.eq_bool (dx * dy)%bigN BigN.one
- then Qz (ny * nx)
- else Qq (ny * nx) (dx * dy)] == [Qq (p2 * p1) (n2 * n1)]).
- generalize (F p2 n1) (F p1 n2).
- case f; case f.
- intros u1 u2 v1 v2 Hu1 Hv1.
- apply Qeq_trans with [mul (Qq p2 n1) (Qq p1 n2)].
- rewrite spec_mul; rewrite Hu1; rewrite Hv1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; rewrite BigN.spec_mul; intros HH1.
- assert (F1: BigN.to_Z u2 = 1%Z).
- case (Zmult_1_inversion_l _ _ HH1); auto.
- generalize (BigN.spec_pos u2); auto with zarith.
- assert (F2: BigN.to_Z v2 = 1%Z).
- rewrite Zmult_comm in HH1.
- case (Zmult_1_inversion_l _ _ HH1); auto.
- generalize (BigN.spec_pos v2); auto with zarith.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1.
- rewrite H1 in F2; discriminate F2.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2.
- rewrite H2 in F1; discriminate F1.
- simpl; rewrite BigZ.spec_mul.
- rewrite F1; rewrite F2; simpl; ring.
- rewrite Qmult_comm; rewrite <- spec_mul.
- apply Qeq_refl.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_mul;
- rewrite Zmult_comm; intros H1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_mul; intros H2; auto.
- case H2; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_mul; intros H2; auto.
- case H1; auto.
- Qed.
-
-
-Definition inv (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) => Qq BigZ.one n
- | Qz (BigZ.Neg n) => Qq BigZ.minus_one n
- | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n
- | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n
- end.
-
- Theorem spec_inv : forall x, [inv x] == /[x].
- Proof.
- intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- rewrite H1; apply Qeq_refl.
- generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto.
- intros HH; case HH; auto.
- intros; red; simpl; auto.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- rewrite H1; apply Qeq_refl.
- generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl; auto.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- apply Qeq_refl.
- rewrite H1; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- rewrite H2; red; simpl; auto.
- generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- apply Qeq_refl.
- rewrite H1; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- rewrite H2; red; simpl; auto.
- generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl.
- assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto.
- rewrite tmp.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- ring.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p _ HH; case HH; auto.
- Qed.
-
-Definition inv_norm (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) =>
- match BigN.compare n BigN.one with
- Gt => Qq BigZ.one n
- | _ => x
- end
- | Qz (BigZ.Neg n) =>
- match BigN.compare n BigN.one with
- Gt => Qq BigZ.minus_one n
- | _ => x
- end
- | Qq (BigZ.Pos n) d =>
- match BigN.compare n BigN.one with
- Gt => Qq (BigZ.Pos d) n
- | Eq => Qz (BigZ.Pos d)
- | Lt => Qz (BigZ.zero)
- end
- | Qq (BigZ.Neg n) d =>
- match BigN.compare n BigN.one with
- Gt => Qq (BigZ.Neg d) n
- | Eq => Qz (BigZ.Neg d)
- | Lt => Qz (BigZ.zero)
- end
- end.
-
- Theorem spec_inv_norm : forall x, [inv_norm x] == /[x].
- Proof.
- intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, Qinv.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H.
- simpl; rewrite H; apply Qeq_refl.
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl.
- generalize H; case BigN.to_Z.
- intros _ HH; discriminate HH.
- intros p; case p; auto.
- intros p1 HH; discriminate HH.
- intros p1 HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; discriminate HH.
- intros HH; rewrite <- HH.
- apply Qeq_refl.
- generalize H; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1.
- rewrite H1; intros HH; discriminate.
- generalize H; case BigN.to_Z.
- intros HH; discriminate HH.
- intros; red; simpl; auto.
- intros p HH; discriminate HH.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H.
- simpl; rewrite H; apply Qeq_refl.
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl.
- generalize H; case BigN.to_Z.
- intros _ HH; discriminate HH.
- intros p; case p; auto.
- intros p1 HH; discriminate HH.
- intros p1 HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; discriminate HH.
- intros HH; rewrite <- HH.
- apply Qeq_refl.
- generalize H; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1.
- rewrite H1; intros HH; discriminate.
- generalize H; case BigN.to_Z.
- intros HH; discriminate HH.
- intros; red; simpl; auto.
- intros p HH; discriminate HH.
- simpl Qnum.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; simpl.
- case BigN.compare; red; simpl; auto.
- rewrite H1; auto.
- case BigN.eq_bool; auto.
- simpl; rewrite H1; auto.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H2.
- rewrite H2.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- red; simpl.
- rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx).
- intros; apply Qeq_refl.
- intros p; case p; clear p.
- intros p HH; discriminate HH.
- intros p HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- simpl; generalize H2; case (BigN.to_Z nx).
- intros HH; discriminate HH.
- intros p Hp.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H4.
- rewrite H4 in H2; discriminate H2.
- red; simpl.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p HH; discriminate HH.
- simpl Qnum.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; simpl.
- case BigN.compare; red; simpl; auto.
- rewrite H1; auto.
- case BigN.eq_bool; auto.
- simpl; rewrite H1; auto.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H2.
- rewrite H2.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- red; simpl.
- assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto.
- rewrite tmp.
- rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx).
- intros; apply Qeq_refl.
- intros p; case p; clear p.
- intros p HH; discriminate HH.
- intros p HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- simpl; generalize H2; case (BigN.to_Z nx).
- intros HH; discriminate HH.
- intros p Hp.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H4.
- rewrite H4 in H2; discriminate H2.
- red; simpl.
- assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto.
- rewrite tmp.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- ring.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p HH; discriminate HH.
- Qed.
-
- Definition div x y := mul x (inv y).
-
- Theorem spec_div x y: [div x y] == [x] / [y].
- Proof.
- intros x y; unfold div; rewrite spec_mul; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Definition div_norm x y := mul_norm x (inv y).
-
- Theorem spec_div_norm x y: [div_norm x y] == [x] / [y].
- Proof.
- intros x y; unfold div_norm; rewrite spec_mul_norm; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Definition square (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.square zx)
- | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx)
- end.
-
- Theorem spec_square : forall x, [square x] == [x] ^ 2.
- Proof.
- intros [ x | nx dx]; unfold square.
- red; simpl; rewrite BigZ.spec_square; auto with zarith.
- simpl Qpower.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H.
- red; simpl.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square;
- intros H1.
- case H1; rewrite H; auto.
- red; simpl.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square;
- intros H1.
- case H; case (Zmult_integral _ _ H1); auto.
- simpl.
- rewrite BigZ.spec_square.
- rewrite Zpos_mult_morphism.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_pos dx); auto with zarith.
- Qed.
-
- Definition power_pos (x: t) p: t :=
- match x with
- | Qz zx => Qz (BigZ.power_pos zx p)
- | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p)
- end.
-
- Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p.
- Proof.
- intros [x | nx dx] p; unfold power_pos.
- unfold power_pos; red; simpl.
- generalize (Qpower_decomp p (BigZ.to_Z x) 1).
- unfold Qeq; simpl.
- rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Zmult_1_r.
- intros H; rewrite H.
- rewrite BigZ.spec_power_pos; simpl; ring.
- simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_power_pos; intros H1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H2.
- elim p; simpl.
- intros; red; simpl; auto.
- intros p1 Hp1; rewrite <- Hp1; red; simpl; auto.
- apply Qeq_refl.
- case H2; generalize H1.
- elim p; simpl.
- intros p1 Hrec.
- change (xI p1) with (1 + (xO p1))%positive.
- rewrite Zpower_pos_is_exp; rewrite Zpower_pos_1_r.
- intros HH; case (Zmult_integral _ _ HH); auto.
- rewrite <- Pplus_diag.
- rewrite Zpower_pos_is_exp.
- intros HH1; case (Zmult_integral _ _ HH1); auto.
- intros p1 Hrec.
- rewrite <- Pplus_diag.
- rewrite Zpower_pos_is_exp.
- intros HH1; case (Zmult_integral _ _ HH1); auto.
- rewrite Zpower_pos_1_r; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H2.
- case H1; rewrite H2; auto.
- simpl; rewrite Zpower_pos_0_l; auto.
- assert (F1: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z).
- unfold Zpower; apply Zpower_pos_pos; auto.
- unfold power_pos; red; simpl.
- generalize (Qpower_decomp p (BigZ.to_Z nx)
- (Z2P (BigN.to_Z dx))).
- unfold Qeq; simpl.
- repeat rewrite Z2P_correct; auto.
- unfold Qeq; simpl; intros HH.
- rewrite HH.
- rewrite BigZ.spec_power_pos; simpl; ring.
- Qed.
-
- (** Interaction with [Qcanon.Qc] *)
-
- Open Scope Qc_scope.
-
- Definition of_Qc q := of_Q (this q).
-
- Definition to_Qc q := !!(to_Q q).
-
- Notation "[[ x ]]" := (to_Qc x).
-
- Theorem spec_of_Qc: forall q, [[of_Qc q]] = q.
- Proof.
- intros (x, Hx); unfold of_Qc, to_Qc; simpl.
- apply Qc_decomp; simpl.
- intros.
- rewrite <- H0 at 2; apply Qred_complete.
- apply spec_of_Q.
- Qed.
-
- Theorem spec_oppc: forall q, [[opp q]] = -[[q]].
- Proof.
- intros q; unfold Qcopp, to_Qc, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- rewrite spec_opp.
- rewrite <- Qred_opp.
- rewrite Qred_correct; red; auto.
- Qed.
-
- Theorem spec_comparec: forall q1 q2,
- compare q1 q2 = ([[q1]] ?= [[q2]]).
- Proof.
- unfold Qccompare, to_Qc.
- intros q1 q2; rewrite spec_compare; simpl; auto.
- apply Qcompare_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_addc x y:
- [[add x y]] = [[x]] + [[y]].
- Proof.
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_add_normc x y:
- [[add_norm x y]] = [[x]] + [[y]].
- Proof.
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add_norm; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]].
- Proof.
- intros x y; unfold sub; rewrite spec_addc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Theorem spec_sub_normc x y:
- [[sub_norm x y]] = [[x]] - [[y]].
- intros x y; unfold sub_norm; rewrite spec_add_normc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Theorem spec_mulc x y:
- [[mul x y]] = [[x]] * [[y]].
- Proof.
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_mul_normc x y:
- [[mul_norm x y]] = [[x]] * [[y]].
- Proof.
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul_norm; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_invc x:
- [[inv x]] = /[[x]].
- Proof.
- intros x; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_inv_normc x:
- [[inv_norm x]] = /[[x]].
- Proof.
- intros x; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv_norm; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]].
- Proof.
- intros x y; unfold div; rewrite spec_mulc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
- Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]].
- Proof.
- intros x y; unfold div_norm; rewrite spec_mul_normc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
- Theorem spec_squarec x: [[square x]] = [[x]]^2.
- Proof.
- intros x; unfold to_Qc.
- apply trans_equal with (!! ([x]^2)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_square; auto.
- simpl Qcpower.
- replace (!! [x] * 1) with (!![x]); try ring.
- simpl.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Theorem spec_power_posc x p:
- [[power_pos x p]] = [[x]] ^ nat_of_P p.
- Proof.
- intros x p; unfold to_Qc.
- apply trans_equal with (!! ([x]^Zpos p)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_power_pos; auto.
- pattern p; apply Pind; clear p.
- simpl; ring.
- intros p Hrec.
- rewrite nat_of_P_succ_morphism; simpl Qcpower.
- rewrite <- Hrec.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _;
- unfold this.
- apply Qred_complete.
- assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p).
- simpl; case x; simpl; clear x Hrec.
- intros x; simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- intros nx dx.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- unfold Qpower_positive.
- assert (tmp: forall p, pow_pos Qmult 0%Q p = 0%Q).
- intros p1; elim p1; simpl; auto; clear p1.
- intros p1 Hp1; rewrite Hp1; auto.
- intros p1 Hp1; rewrite Hp1; auto.
- repeat rewrite tmp; intros; red; simpl; auto.
- intros H1.
- assert (F1: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- repeat rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto.
- 2: apply Zpower_pos_pos; auto.
- 2: apply Zpower_pos_pos; auto.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- rewrite F.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
-End Q0.
diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v
new file mode 100644
index 00000000..494420bd
--- /dev/null
+++ b/theories/Numbers/Rational/BigQ/QMake.v
@@ -0,0 +1,1345 @@
+(************************************************************************)
+(* 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 *)
+(************************************************************************)
+
+(*i $Id: QMake.v 11208 2008-07-04 16:57:46Z letouzey $ i*)
+
+Require Import BigNumPrelude ROmega.
+Require Import QArith Qcanon Qpower.
+Require Import NSig ZSig QSig.
+
+Module Type NType_ZType (N:NType)(Z:ZType).
+ Parameter Z_of_N : N.t -> Z.t.
+ Parameter spec_Z_of_N : forall n, Z.to_Z (Z_of_N n) = N.to_Z n.
+ Parameter Zabs_N : Z.t -> N.t.
+ Parameter spec_Zabs_N : forall z, N.to_Z (Zabs_N z) = Zabs (Z.to_Z z).
+End NType_ZType.
+
+Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType.
+
+ (** The notation of a rational number is either an integer x,
+ interpreted as itself or a pair (x,y) of an integer x and a natural
+ number y interpreted as x/y. The pairs (x,0) and (0,y) are all
+ interpreted as 0. *)
+
+ Inductive t_ :=
+ | Qz : Z.t -> t_
+ | Qq : Z.t -> N.t -> t_.
+
+ Definition t := t_.
+
+ (** Specification with respect to [QArith] *)
+
+ Open Local Scope Q_scope.
+
+ Definition of_Z x: t := Qz (Z.of_Z x).
+
+ Definition of_Q (q:Q) : t :=
+ let (x,y) := q in
+ match y with
+ | 1%positive => Qz (Z.of_Z x)
+ | _ => Qq (Z.of_Z x) (N.of_N (Npos y))
+ end.
+
+ Definition to_Q (q: t) :=
+ match q with
+ | Qz x => Z.to_Z x # 1
+ | Qq x y => if N.eq_bool y N.zero then 0
+ else Z.to_Z x # Z2P (N.to_Z y)
+ end.
+
+ Notation "[ x ]" := (to_Q x).
+
+ Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q.
+ Proof.
+ intros(x,y); destruct y; simpl; rewrite Z.spec_of_Z; auto.
+ generalize (N.spec_eq_bool (N.of_N (Npos y~1)) N.zero);
+ case N.eq_bool; auto; rewrite N.spec_0.
+ rewrite N.spec_of_N; intros; discriminate.
+ rewrite N.spec_of_N; auto.
+ generalize (N.spec_eq_bool (N.of_N (Npos y~0)) N.zero);
+ case N.eq_bool; auto; rewrite N.spec_0.
+ rewrite N.spec_of_N; intros; discriminate.
+ rewrite N.spec_of_N; auto.
+ Qed.
+
+ Theorem spec_of_Q: forall q: Q, [of_Q q] == q.
+ Proof.
+ intros; rewrite strong_spec_of_Q; red; auto.
+ Qed.
+
+ Definition eq x y := [x] == [y].
+
+ Definition zero: t := Qz Z.zero.
+ Definition one: t := Qz Z.one.
+ Definition minus_one: t := Qz Z.minus_one.
+
+ Lemma spec_0: [zero] == 0.
+ Proof.
+ simpl; rewrite Z.spec_0; reflexivity.
+ Qed.
+
+ Lemma spec_1: [one] == 1.
+ Proof.
+ simpl; rewrite Z.spec_1; reflexivity.
+ Qed.
+
+ Lemma spec_m1: [minus_one] == -(1).
+ Proof.
+ simpl; rewrite Z.spec_m1; reflexivity.
+ Qed.
+
+ Definition compare (x y: t) :=
+ match x, y with
+ | Qz zx, Qz zy => Z.compare zx zy
+ | Qz zx, Qq ny dy =>
+ if N.eq_bool dy N.zero then Z.compare zx Z.zero
+ else Z.compare (Z.mul zx (Z_of_N dy)) ny
+ | Qq nx dx, Qz zy =>
+ if N.eq_bool dx N.zero then Z.compare Z.zero zy
+ else Z.compare nx (Z.mul zy (Z_of_N dx))
+ | Qq nx dx, Qq ny dy =>
+ match N.eq_bool dx N.zero, N.eq_bool dy N.zero with
+ | true, true => Eq
+ | true, false => Z.compare Z.zero ny
+ | false, true => Z.compare nx Z.zero
+ | false, false => Z.compare (Z.mul nx (Z_of_N dy))
+ (Z.mul ny (Z_of_N dx))
+ end
+ end.
+
+ Lemma Zcompare_spec_alt :
+ forall z z', Z.compare z z' = (Z.to_Z z ?= Z.to_Z z')%Z.
+ Proof.
+ intros; generalize (Z.spec_compare z z'); destruct Z.compare; auto.
+ intro H; rewrite H; symmetry; apply Zcompare_refl.
+ Qed.
+
+ Lemma Ncompare_spec_alt :
+ forall n n', N.compare n n' = (N.to_Z n ?= N.to_Z n')%Z.
+ Proof.
+ intros; generalize (N.spec_compare n n'); destruct N.compare; auto.
+ intro H; rewrite H; symmetry; apply Zcompare_refl.
+ Qed.
+
+ Lemma N_to_Z2P : forall n, N.to_Z n <> 0%Z ->
+ Zpos (Z2P (N.to_Z n)) = N.to_Z n.
+ Proof.
+ intros; apply Z2P_correct.
+ generalize (N.spec_pos n); romega.
+ Qed.
+
+ Hint Rewrite
+ Zplus_0_r Zplus_0_l Zmult_0_r Zmult_0_l Zmult_1_r Zmult_1_l
+ Z.spec_0 N.spec_0 Z.spec_1 N.spec_1 Z.spec_m1 Z.spec_opp
+ Zcompare_spec_alt Ncompare_spec_alt
+ Z.spec_add N.spec_add Z.spec_mul N.spec_mul
+ Z.spec_gcd N.spec_gcd Zgcd_Zabs
+ spec_Z_of_N spec_Zabs_N
+ : nz.
+ Ltac nzsimpl := autorewrite with nz in *.
+
+ Ltac destr_neq_bool := repeat
+ (match goal with |- context [N.eq_bool ?x ?y] =>
+ generalize (N.spec_eq_bool x y); case N.eq_bool
+ end).
+
+ Ltac destr_zeq_bool := repeat
+ (match goal with |- context [Z.eq_bool ?x ?y] =>
+ generalize (Z.spec_eq_bool x y); case Z.eq_bool
+ end).
+
+ Ltac simpl_ndiv := rewrite N.spec_div by (nzsimpl; romega).
+ Tactic Notation "simpl_ndiv" "in" "*" :=
+ rewrite N.spec_div in * by (nzsimpl; romega).
+
+ Ltac simpl_zdiv := rewrite Z.spec_div by (nzsimpl; romega).
+ Tactic Notation "simpl_zdiv" "in" "*" :=
+ rewrite Z.spec_div in * by (nzsimpl; romega).
+
+ Ltac qsimpl := try red; unfold to_Q; simpl; intros;
+ destr_neq_bool; destr_zeq_bool; simpl; nzsimpl; auto; intros.
+
+ Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]).
+ Proof.
+ intros [z1 | x1 y1] [z2 | x2 y2];
+ unfold Qcompare, compare; qsimpl; rewrite ! N_to_Z2P; auto.
+ Qed.
+
+ 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.
+
+ Definition eq_bool n m :=
+ match compare n m with Eq => true | _ => false end.
+
+ Theorem spec_eq_bool: forall x y,
+ if eq_bool x y then [x] == [y] else ~([x] == [y]).
+ Proof.
+ intros.
+ unfold eq_bool.
+ rewrite spec_compare.
+ generalize (Qeq_alt [x] [y]).
+ destruct Qcompare.
+ intros H; rewrite H; auto.
+ intros H H'; rewrite H in H'; discriminate.
+ intros H H'; rewrite H in H'; discriminate.
+ Qed.
+
+ (** Normalisation function *)
+
+ Definition norm n d : t :=
+ let gcd := N.gcd (Zabs_N n) d in
+ match N.compare N.one gcd with
+ | Lt =>
+ let n := Z.div n (Z_of_N gcd) in
+ let d := N.div d gcd in
+ match N.compare d N.one with
+ | Gt => Qq n d
+ | Eq => Qz n
+ | Lt => zero
+ end
+ | Eq => Qq n d
+ | Gt => zero (* gcd = 0 => both numbers are 0 *)
+ end.
+
+ Theorem spec_norm: forall n q, [norm n q] == [Qq n q].
+ Proof.
+ intros p q; unfold norm.
+ assert (Hp := N.spec_pos (Zabs_N p)).
+ assert (Hq := N.spec_pos q).
+ nzsimpl.
+ destr_zcompare.
+ qsimpl.
+
+ simpl_ndiv.
+ destr_zcompare.
+ qsimpl.
+ rewrite H1 in *; rewrite Zdiv_0_l in H0; discriminate.
+ rewrite N_to_Z2P; auto.
+ simpl_zdiv; nzsimpl.
+ rewrite Zgcd_div_swap0, H0; romega.
+
+ qsimpl.
+ assert (0 < N.to_Z q / Zgcd (Z.to_Z p) (N.to_Z q))%Z.
+ apply Zgcd_div_pos; romega.
+ romega.
+
+ qsimpl.
+ simpl_ndiv in *; nzsimpl; romega.
+ simpl_ndiv in *.
+ rewrite H1, Zdiv_0_l in H2; elim H2; auto.
+ rewrite 2 N_to_Z2P; auto.
+ simpl_ndiv; simpl_zdiv; nzsimpl.
+ apply Zgcd_div_swap0; romega.
+
+ qsimpl.
+ assert (H' : Zgcd (Z.to_Z p) (N.to_Z q) = 0%Z).
+ generalize (Zgcd_is_pos (Z.to_Z p) (N.to_Z q)); romega.
+ symmetry; apply (Zgcd_inv_0_l _ _ H'); auto.
+ Qed.
+
+ Theorem strong_spec_norm : forall p q, [norm p q] = Qred [Qq p q].
+ Proof.
+ intros.
+ replace (Qred [Qq p q]) with (Qred [norm p q]) by
+ (apply Qred_complete; apply spec_norm).
+ symmetry; apply Qred_identity.
+ unfold norm.
+ assert (Hp := N.spec_pos (Zabs_N p)).
+ assert (Hq := N.spec_pos q).
+ nzsimpl.
+ destr_zcompare.
+ (* Eq *)
+ simpl.
+ destr_neq_bool; nzsimpl; simpl; auto.
+ intros.
+ rewrite N_to_Z2P; auto.
+ (* Lt *)
+ simpl_ndiv.
+ destr_zcompare.
+ qsimpl; auto.
+ qsimpl.
+ qsimpl.
+ simpl_zdiv; nzsimpl.
+ rewrite N_to_Z2P; auto.
+ clear H1.
+ simpl_ndiv; nzsimpl.
+ rewrite Zgcd_1_rel_prime.
+ destruct (Z_lt_le_dec 0 (N.to_Z q)).
+ apply Zis_gcd_rel_prime; auto with zarith.
+ apply Zgcd_is_gcd.
+ replace (N.to_Z q) with 0%Z in * by romega.
+ rewrite Zdiv_0_l in H0; discriminate.
+ (* Gt *)
+ simpl; auto.
+ Qed.
+
+ (** Reduction function : producing irreducible fractions *)
+
+ Definition red (x : t) : t :=
+ match x with
+ | Qz z => x
+ | Qq n d => norm n d
+ end.
+
+ Definition Reduced x := [red x] = [x].
+
+ Theorem spec_red : forall x, [red x] == [x].
+ Proof.
+ intros [ z | n d ].
+ auto with qarith.
+ unfold red.
+ apply spec_norm.
+ Qed.
+
+ Theorem strong_spec_red : forall x, [red x] = Qred [x].
+ Proof.
+ intros [ z | n d ].
+ unfold red.
+ symmetry; apply Qred_identity; simpl; auto.
+ unfold red; apply strong_spec_norm.
+ Qed.
+
+ Definition add (x y: t): t :=
+ match x with
+ | Qz zx =>
+ match y with
+ | Qz zy => Qz (Z.add zx zy)
+ | Qq ny dy =>
+ if N.eq_bool dy N.zero then x
+ else Qq (Z.add (Z.mul zx (Z_of_N dy)) ny) dy
+ end
+ | Qq nx dx =>
+ if N.eq_bool dx N.zero then y
+ else match y with
+ | Qz zy => Qq (Z.add nx (Z.mul zy (Z_of_N dx))) dx
+ | Qq ny dy =>
+ if N.eq_bool dy N.zero then x
+ else
+ let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in
+ let d := N.mul dx dy in
+ Qq n d
+ end
+ end.
+
+ Theorem spec_add : forall x y, [add x y] == [x] + [y].
+ Proof.
+ intros [x | nx dx] [y | ny dy]; unfold Qplus; qsimpl.
+ intuition.
+ rewrite N_to_Z2P; auto.
+ intuition.
+ rewrite Pmult_1_r, N_to_Z2P; auto.
+ intuition.
+ rewrite Pmult_1_r, N_to_Z2P; auto.
+ destruct (Zmult_integral _ _ H); intuition.
+ rewrite Zpos_mult_morphism, 2 N_to_Z2P; auto.
+ rewrite (Z2P_correct (N.to_Z dx * N.to_Z dy)); auto.
+ apply Zmult_lt_0_compat.
+ generalize (N.spec_pos dx); romega.
+ generalize (N.spec_pos dy); romega.
+ Qed.
+
+ Definition add_norm (x y: t): t :=
+ match x with
+ | Qz zx =>
+ match y with
+ | Qz zy => Qz (Z.add zx zy)
+ | Qq ny dy =>
+ if N.eq_bool dy N.zero then x
+ else norm (Z.add (Z.mul zx (Z_of_N dy)) ny) dy
+ end
+ | Qq nx dx =>
+ if N.eq_bool dx N.zero then y
+ else match y with
+ | Qz zy => norm (Z.add nx (Z.mul zy (Z_of_N dx))) dx
+ | Qq ny dy =>
+ if N.eq_bool dy N.zero then x
+ else
+ let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in
+ let d := N.mul dx dy in
+ norm n d
+ end
+ end.
+
+ Theorem spec_add_norm : forall x y, [add_norm x y] == [x] + [y].
+ Proof.
+ intros x y; rewrite <- spec_add.
+ destruct x; destruct y; unfold add_norm, add;
+ destr_neq_bool; auto using Qeq_refl, spec_norm.
+ Qed.
+
+ Theorem strong_spec_add_norm : forall x y : t,
+ Reduced x -> Reduced y -> Reduced (add_norm x y).
+ Proof.
+ unfold Reduced; intros.
+ rewrite strong_spec_red.
+ rewrite <- (Qred_complete [add x y]);
+ [ | rewrite spec_add, spec_add_norm; apply Qeq_refl ].
+ rewrite <- strong_spec_red.
+ destruct x as [zx|nx dx]; destruct y as [zy|ny dy].
+ simpl in *; auto.
+ simpl; intros.
+ destr_neq_bool; nzsimpl; simpl; auto.
+ simpl; intros.
+ destr_neq_bool; nzsimpl; simpl; auto.
+ simpl; intros.
+ destr_neq_bool; nzsimpl; simpl; auto.
+ Qed.
+
+ Definition opp (x: t): t :=
+ match x with
+ | Qz zx => Qz (Z.opp zx)
+ | Qq nx dx => Qq (Z.opp nx) dx
+ end.
+
+ Theorem strong_spec_opp: forall q, [opp q] = -[q].
+ Proof.
+ intros [z | x y]; simpl.
+ rewrite Z.spec_opp; auto.
+ match goal with |- context[N.eq_bool ?X ?Y] =>
+ generalize (N.spec_eq_bool X Y); case N.eq_bool
+ end; auto; rewrite N.spec_0.
+ rewrite Z.spec_opp; auto.
+ Qed.
+
+ Theorem spec_opp : forall q, [opp q] == -[q].
+ Proof.
+ intros; rewrite strong_spec_opp; red; auto.
+ Qed.
+
+ Theorem strong_spec_opp_norm : forall q, Reduced q -> Reduced (opp q).
+ Proof.
+ unfold Reduced; intros.
+ rewrite strong_spec_opp, <- H, !strong_spec_red, <- Qred_opp.
+ apply Qred_complete; apply spec_opp.
+ Qed.
+
+ Definition sub x y := add x (opp y).
+
+ Theorem spec_sub : forall x y, [sub x y] == [x] - [y].
+ Proof.
+ intros x y; unfold sub; rewrite spec_add; auto.
+ rewrite spec_opp; ring.
+ Qed.
+
+ Definition sub_norm x y := add_norm x (opp y).
+
+ Theorem spec_sub_norm : forall x y, [sub_norm x y] == [x] - [y].
+ Proof.
+ intros x y; unfold sub_norm; rewrite spec_add_norm; auto.
+ rewrite spec_opp; ring.
+ Qed.
+
+ Theorem strong_spec_sub_norm : forall x y,
+ Reduced x -> Reduced y -> Reduced (sub_norm x y).
+ Proof.
+ intros.
+ unfold sub_norm.
+ apply strong_spec_add_norm; auto.
+ apply strong_spec_opp_norm; auto.
+ Qed.
+
+ Definition mul (x y: t): t :=
+ match x, y with
+ | Qz zx, Qz zy => Qz (Z.mul zx zy)
+ | Qz zx, Qq ny dy => Qq (Z.mul zx ny) dy
+ | Qq nx dx, Qz zy => Qq (Z.mul nx zy) dx
+ | Qq nx dx, Qq ny dy => Qq (Z.mul nx ny) (N.mul dx dy)
+ end.
+
+ Theorem spec_mul : forall x y, [mul x y] == [x] * [y].
+ Proof.
+ intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl; qsimpl.
+ rewrite Pmult_1_r, N_to_Z2P; auto.
+ destruct (Zmult_integral _ _ H1); intuition.
+ rewrite H0 in H1; elim H1; auto.
+ rewrite H0 in H1; elim H1; auto.
+ rewrite H in H1; nzsimpl; elim H1; auto.
+ rewrite Zpos_mult_morphism, 2 N_to_Z2P; auto.
+ rewrite (Z2P_correct (N.to_Z dx * N.to_Z dy)); auto.
+ apply Zmult_lt_0_compat.
+ generalize (N.spec_pos dx); omega.
+ generalize (N.spec_pos dy); omega.
+ Qed.
+
+ Lemma norm_denum : forall n d,
+ [if N.eq_bool d N.one then Qz n else Qq n d] == [Qq n d].
+ Proof.
+ intros; simpl; qsimpl.
+ rewrite H0 in H; discriminate.
+ rewrite N_to_Z2P, H0; auto with zarith.
+ Qed.
+
+ Definition irred n d :=
+ let gcd := N.gcd (Zabs_N n) d in
+ match N.compare gcd N.one with
+ | Gt => (Z.div n (Z_of_N gcd), N.div d gcd)
+ | _ => (n, d)
+ end.
+
+ Lemma spec_irred : forall n d, exists g,
+ let (n',d') := irred n d in
+ (Z.to_Z n' * g = Z.to_Z n)%Z /\ (N.to_Z d' * g = N.to_Z d)%Z.
+ Proof.
+ intros.
+ unfold irred; nzsimpl; simpl.
+ destr_zcompare.
+ exists 1%Z; nzsimpl; auto.
+ exists 0%Z; nzsimpl.
+ assert (Zgcd (Z.to_Z n) (N.to_Z d) = 0%Z).
+ generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega.
+ clear H.
+ split.
+ symmetry; apply (Zgcd_inv_0_l _ _ H0).
+ symmetry; apply (Zgcd_inv_0_r _ _ H0).
+ exists (Zgcd (Z.to_Z n) (N.to_Z d)).
+ simpl.
+ split.
+ simpl_zdiv; nzsimpl.
+ destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)).
+ rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
+ simpl_ndiv; nzsimpl.
+ destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)).
+ rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith.
+ Qed.
+
+ Lemma spec_irred_zero : forall n d,
+ (N.to_Z d = 0)%Z <-> (N.to_Z (snd (irred n d)) = 0)%Z.
+ Proof.
+ intros.
+ unfold irred.
+ split.
+ nzsimpl; intros.
+ destr_zcompare; auto.
+ simpl.
+ simpl_ndiv; nzsimpl.
+ rewrite H, Zdiv_0_l; auto.
+ nzsimpl; destr_zcompare; simpl; auto.
+ simpl_ndiv; nzsimpl.
+ intros.
+ generalize (N.spec_pos d); intros.
+ destruct (N.to_Z d); auto.
+ assert (0 < 0)%Z.
+ rewrite <- H0 at 2.
+ apply Zgcd_div_pos; auto with zarith.
+ compute; auto.
+ discriminate.
+ compute in H1; elim H1; auto.
+ Qed.
+
+ Lemma strong_spec_irred : forall n d,
+ (N.to_Z d <> 0%Z) ->
+ let (n',d') := irred n d in Zgcd (Z.to_Z n') (N.to_Z d') = 1%Z.
+ Proof.
+ unfold irred; intros.
+ nzsimpl.
+ destr_zcompare; simpl; auto.
+ elim H.
+ apply (Zgcd_inv_0_r (Z.to_Z n)).
+ generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega.
+
+ simpl_ndiv; simpl_zdiv; nzsimpl.
+ rewrite Zgcd_1_rel_prime.
+ apply Zis_gcd_rel_prime.
+ generalize (N.spec_pos d); romega.
+ generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega.
+ apply Zgcd_is_gcd; auto.
+ Qed.
+
+ Definition mul_norm_Qz_Qq z n d :=
+ if Z.eq_bool z Z.zero then zero
+ else
+ let gcd := N.gcd (Zabs_N z) d in
+ match N.compare gcd N.one with
+ | Gt =>
+ let z := Z.div z (Z_of_N gcd) in
+ let d := N.div d gcd in
+ if N.eq_bool d N.one then Qz (Z.mul z n) else Qq (Z.mul z n) d
+ | _ => Qq (Z.mul z n) d
+ end.
+
+ Definition mul_norm (x y: t): t :=
+ match x, y with
+ | Qz zx, Qz zy => Qz (Z.mul zx zy)
+ | Qz zx, Qq ny dy => mul_norm_Qz_Qq zx ny dy
+ | Qq nx dx, Qz zy => mul_norm_Qz_Qq zy nx dx
+ | Qq nx dx, Qq ny dy =>
+ let (nx, dy) := irred nx dy in
+ let (ny, dx) := irred ny dx in
+ let d := N.mul dx dy in
+ if N.eq_bool d N.one then Qz (Z.mul ny nx) else Qq (Z.mul ny nx) d
+ end.
+
+ Lemma spec_mul_norm_Qz_Qq : forall z n d,
+ [mul_norm_Qz_Qq z n d] == [Qq (Z.mul z n) d].
+ Proof.
+ intros z n d; unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
+ destr_zeq_bool; intros Hz; nzsimpl.
+ qsimpl; rewrite Hz; auto.
+ assert (Hd := N.spec_pos d).
+ destruct Z_le_gt_dec.
+ qsimpl.
+ rewrite norm_denum.
+ qsimpl.
+ simpl_ndiv in *; nzsimpl.
+ rewrite (Zdiv_gcd_zero _ _ H0 H) in z0; discriminate.
+ simpl_ndiv in *; nzsimpl.
+ rewrite H, Zdiv_0_l in H0; elim H0; auto.
+ rewrite 2 N_to_Z2P; auto.
+ simpl_ndiv; simpl_zdiv; nzsimpl.
+ rewrite (Zmult_comm (Z.to_Z z)), <- 2 Zmult_assoc.
+ rewrite <- Zgcd_div_swap0; auto with zarith; ring.
+ Qed.
+
+ Lemma strong_spec_mul_norm_Qz_Qq : forall z n d,
+ Reduced (Qq n d) -> Reduced (mul_norm_Qz_Qq z n d).
+ Proof.
+ unfold Reduced; intros z n d.
+ rewrite 2 strong_spec_red, 2 Qred_iff.
+ simpl; nzsimpl.
+ destr_neq_bool; intros Hd H; simpl in *; nzsimpl.
+
+ unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
+ destr_zeq_bool; intros Hz; simpl; nzsimpl; simpl; auto.
+ destruct Z_le_gt_dec.
+ simpl; nzsimpl.
+ destr_neq_bool; simpl; nzsimpl; auto.
+ intros H'; elim H'; auto.
+ destr_neq_bool; simpl; nzsimpl.
+ simpl_ndiv; nzsimpl; rewrite Hd, Zdiv_0_l; intros; discriminate.
+ intros _.
+ destr_neq_bool; simpl; nzsimpl; auto.
+ simpl_ndiv; nzsimpl; rewrite Hd, Zdiv_0_l; intro H'; elim H'; auto.
+
+ rewrite N_to_Z2P in H; auto.
+ unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt.
+ destr_zeq_bool; intros Hz; simpl; nzsimpl; simpl; auto.
+ destruct Z_le_gt_dec as [H'|H'].
+ simpl; nzsimpl.
+ destr_neq_bool; simpl; nzsimpl; auto.
+ intros.
+ rewrite N_to_Z2P; auto.
+ apply Zgcd_mult_rel_prime; auto.
+ generalize (Zgcd_inv_0_l (Z.to_Z z) (N.to_Z d))
+ (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega.
+ destr_neq_bool; simpl; nzsimpl; auto.
+ simpl_ndiv; simpl_zdiv; nzsimpl.
+ intros.
+ destr_neq_bool; simpl; nzsimpl; auto.
+ simpl_ndiv in *; nzsimpl.
+ intros.
+ rewrite Z2P_correct.
+ apply Zgcd_mult_rel_prime.
+ rewrite Zgcd_1_rel_prime.
+ apply Zis_gcd_rel_prime.
+ generalize (N.spec_pos d); romega.
+ generalize (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega.
+ apply Zgcd_is_gcd.
+ destruct (Zgcd_is_gcd (Z.to_Z z) (N.to_Z d)) as [ (z0,Hz0) (d0,Hd0) Hzd].
+ replace (N.to_Z d / Zgcd (Z.to_Z z) (N.to_Z d))%Z with d0.
+ rewrite Zgcd_1_rel_prime in *.
+ apply bezout_rel_prime.
+ destruct (rel_prime_bezout _ _ H) as [u v Huv].
+ apply Bezout_intro with u (v*(Zgcd (Z.to_Z z) (N.to_Z d)))%Z.
+ rewrite <- Huv; rewrite Hd0 at 2; ring.
+ rewrite Hd0 at 1.
+ symmetry; apply Z_div_mult_full; auto with zarith.
+ apply Zgcd_div_pos.
+ generalize (N.spec_pos d); romega.
+ generalize (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega.
+ Qed.
+
+ Theorem spec_mul_norm : forall x y, [mul_norm x y] == [x] * [y].
+ Proof.
+ intros x y; rewrite <- spec_mul; auto.
+ unfold mul_norm, mul; destruct x; destruct y.
+ apply Qeq_refl.
+ apply spec_mul_norm_Qz_Qq.
+ rewrite spec_mul_norm_Qz_Qq; qsimpl; ring.
+
+ rename t0 into nx, t3 into dy, t2 into ny, t1 into dx.
+ destruct (spec_irred nx dy) as (g & Hg).
+ destruct (spec_irred ny dx) as (g' & Hg').
+ assert (Hz := spec_irred_zero nx dy).
+ assert (Hz':= spec_irred_zero ny dx).
+ destruct irred as (n1,d1); destruct irred as (n2,d2).
+ simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
+ rewrite norm_denum.
+ qsimpl.
+
+ elim H; destruct (Zmult_integral _ _ H0) as [Eq|Eq].
+ rewrite <- Hz' in Eq; rewrite Eq; simpl; auto.
+ rewrite <- Hz in Eq; rewrite Eq; nzsimpl; auto.
+
+ elim H0; destruct (Zmult_integral _ _ H) as [Eq|Eq].
+ rewrite Hz' in Eq; rewrite Eq; simpl; auto.
+ rewrite Hz in Eq; rewrite Eq; nzsimpl; auto.
+
+ rewrite 2 Z2P_correct.
+ rewrite <- Hg1, <- Hg2, <- Hg1', <- Hg2'; ring.
+
+ assert (0 <= N.to_Z d2 * N.to_Z d1)%Z
+ by (apply Zmult_le_0_compat; apply N.spec_pos).
+ romega.
+ assert (0 <= N.to_Z dx * N.to_Z dy)%Z
+ by (apply Zmult_le_0_compat; apply N.spec_pos).
+ romega.
+ Qed.
+
+ Theorem strong_spec_mul_norm : forall x y,
+ Reduced x -> Reduced y -> Reduced (mul_norm x y).
+ Proof.
+ unfold Reduced; intros.
+ rewrite strong_spec_red, Qred_iff.
+ destruct x as [zx|nx dx]; destruct y as [zy|ny dy].
+ simpl in *; auto.
+ simpl.
+ rewrite <- Qred_iff, <- strong_spec_red, strong_spec_mul_norm_Qz_Qq; auto.
+ simpl.
+ rewrite <- Qred_iff, <- strong_spec_red, strong_spec_mul_norm_Qz_Qq; auto.
+ simpl.
+ destruct (spec_irred nx dy) as [g Hg].
+ destruct (spec_irred ny dx) as [g' Hg'].
+ assert (Hz := spec_irred_zero nx dy).
+ assert (Hz':= spec_irred_zero ny dx).
+ assert (Hgc := strong_spec_irred nx dy).
+ assert (Hgc' := strong_spec_irred ny dx).
+ destruct irred as (n1,d1); destruct irred as (n2,d2).
+ simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2'].
+ destr_neq_bool; simpl; nzsimpl; intros.
+ apply Zis_gcd_gcd; auto with zarith; apply Zis_gcd_1.
+ destr_neq_bool; simpl; nzsimpl; intros.
+ auto.
+
+ revert H H0.
+ rewrite 2 strong_spec_red, 2 Qred_iff; simpl.
+ destr_neq_bool; simpl; nzsimpl; intros.
+ rewrite Hz in H; rewrite H in H2; nzsimpl; elim H2; auto.
+ rewrite Hz' in H0; rewrite H0 in H2; nzsimpl; elim H2; auto.
+ rewrite Hz in H; rewrite H in H2; nzsimpl; elim H2; auto.
+
+ rewrite N_to_Z2P in *; auto.
+ rewrite Z2P_correct.
+
+ apply Zgcd_mult_rel_prime; rewrite Zgcd_sym;
+ apply Zgcd_mult_rel_prime; rewrite Zgcd_sym; auto.
+
+ rewrite Zgcd_1_rel_prime in *.
+ apply bezout_rel_prime.
+ destruct (rel_prime_bezout _ _ H4) as [u v Huv].
+ apply Bezout_intro with (u*g')%Z (v*g)%Z.
+ rewrite <- Huv, <- Hg1', <- Hg2. ring.
+
+ rewrite Zgcd_1_rel_prime in *.
+ apply bezout_rel_prime.
+ destruct (rel_prime_bezout _ _ H3) as [u v Huv].
+ apply Bezout_intro with (u*g)%Z (v*g')%Z.
+ rewrite <- Huv, <- Hg2', <- Hg1. ring.
+
+ assert (0 <= N.to_Z d2 * N.to_Z d1)%Z.
+ apply Zmult_le_0_compat; apply N.spec_pos.
+ romega.
+ Qed.
+
+ Definition inv (x: t): t :=
+ match x with
+ | Qz z =>
+ match Z.compare Z.zero z with
+ | Eq => zero
+ | Lt => Qq Z.one (Zabs_N z)
+ | Gt => Qq Z.minus_one (Zabs_N z)
+ end
+ | Qq n d =>
+ match Z.compare Z.zero n with
+ | Eq => zero
+ | Lt => Qq (Z_of_N d) (Zabs_N n)
+ | Gt => Qq (Z.opp (Z_of_N d)) (Zabs_N n)
+ end
+ end.
+
+ Theorem spec_inv : forall x, [inv x] == /[x].
+ Proof.
+ destruct x as [ z | n d ].
+ (* Qz z *)
+ simpl.
+ rewrite Zcompare_spec_alt; destr_zcompare.
+ (* 0 = z *)
+ rewrite <- H.
+ simpl; nzsimpl; compute; auto.
+ (* 0 < z *)
+ simpl.
+ destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ].
+ set (z':=Z.to_Z z) in *; clearbody z'.
+ red; simpl.
+ rewrite Zabs_eq by romega.
+ rewrite Z2P_correct by auto.
+ unfold Qinv; simpl; destruct z'; simpl; auto; discriminate.
+ (* 0 > z *)
+ simpl.
+ destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ].
+ set (z':=Z.to_Z z) in *; clearbody z'.
+ red; simpl.
+ rewrite Zabs_non_eq by romega.
+ rewrite Z2P_correct by romega.
+ unfold Qinv; simpl; destruct z'; simpl; auto; discriminate.
+ (* Qq n d *)
+ simpl.
+ rewrite Zcompare_spec_alt; destr_zcompare.
+ (* 0 = n *)
+ rewrite <- H.
+ simpl; nzsimpl.
+ destr_neq_bool; intros; compute; auto.
+ (* 0 < n *)
+ simpl.
+ destr_neq_bool; nzsimpl; intros.
+ intros; rewrite Zabs_eq in *; romega.
+ intros; rewrite Zabs_eq in *; romega.
+ clear H1.
+ rewrite H0.
+ compute; auto.
+ clear H1.
+ set (n':=Z.to_Z n) in *; clearbody n'.
+ rewrite Zabs_eq by romega.
+ red; simpl.
+ rewrite Z2P_correct by auto.
+ unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate.
+ rewrite Zpos_mult_morphism, N_to_Z2P; auto.
+ (* 0 > n *)
+ simpl.
+ destr_neq_bool; nzsimpl; intros.
+ intros; rewrite Zabs_non_eq in *; romega.
+ intros; rewrite Zabs_non_eq in *; romega.
+ clear H1.
+ red; nzsimpl; rewrite H0; compute; auto.
+ clear H1.
+ set (n':=Z.to_Z n) in *; clearbody n'.
+ red; simpl; nzsimpl.
+ rewrite Zabs_non_eq by romega.
+ rewrite Z2P_correct by romega.
+ unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate.
+ assert (T : forall x, Zneg x = Zopp (Zpos x)) by auto.
+ rewrite T, Zpos_mult_morphism, N_to_Z2P; auto; ring.
+ Qed.
+
+ Definition inv_norm (x: t): t :=
+ match x with
+ | Qz z =>
+ match Z.compare Z.zero z with
+ | Eq => zero
+ | Lt => Qq Z.one (Zabs_N z)
+ | Gt => Qq Z.minus_one (Zabs_N z)
+ end
+ | Qq n d =>
+ if N.eq_bool d N.zero then zero else
+ match Z.compare Z.zero n with
+ | Eq => zero
+ | Lt =>
+ match Z.compare n Z.one with
+ | Gt => Qq (Z_of_N d) (Zabs_N n)
+ | _ => Qz (Z_of_N d)
+ end
+ | Gt =>
+ match Z.compare n Z.minus_one with
+ | Lt => Qq (Z.opp (Z_of_N d)) (Zabs_N n)
+ | _ => Qz (Z.opp (Z_of_N d))
+ end
+ end
+ end.
+
+ Theorem spec_inv_norm : forall x, [inv_norm x] == /[x].
+ Proof.
+ intros.
+ rewrite <- spec_inv.
+ destruct x as [ z | n d ].
+ (* Qz z *)
+ simpl.
+ rewrite Zcompare_spec_alt; destr_zcompare; auto with qarith.
+ (* Qq n d *)
+ simpl; nzsimpl; destr_neq_bool.
+ destr_zcompare; simpl; auto with qarith.
+ destr_neq_bool; nzsimpl; auto with qarith.
+ intros _ Hd; rewrite Hd; auto with qarith.
+ destr_neq_bool; nzsimpl; auto with qarith.
+ intros _ Hd; rewrite Hd; auto with qarith.
+ (* 0 < n *)
+ destr_zcompare; auto with qarith.
+ destr_zcompare; nzsimpl; simpl; auto with qarith; intros.
+ destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ].
+ rewrite H0; auto with qarith.
+ romega.
+ (* 0 > n *)
+ destr_zcompare; nzsimpl; simpl; auto with qarith.
+ destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ].
+ rewrite H0; auto with qarith.
+ romega.
+ Qed.
+
+ Theorem strong_spec_inv_norm : forall x, Reduced x -> Reduced (inv_norm x).
+ Proof.
+ unfold Reduced.
+ intros.
+ destruct x as [ z | n d ].
+ (* Qz *)
+ simpl; nzsimpl.
+ rewrite strong_spec_red, Qred_iff.
+ destr_zcompare; simpl; nzsimpl; auto.
+ destr_neq_bool; nzsimpl; simpl; auto.
+ destr_neq_bool; nzsimpl; simpl; auto.
+ (* Qq n d *)
+ rewrite strong_spec_red, Qred_iff in H; revert H.
+ simpl; nzsimpl.
+ destr_neq_bool; nzsimpl; auto with qarith.
+ destr_zcompare; simpl; nzsimpl; auto; intros.
+ (* 0 < n *)
+ destr_zcompare; simpl; nzsimpl; auto.
+ destr_neq_bool; nzsimpl; simpl; auto.
+ rewrite Zabs_eq; romega.
+ intros _.
+ rewrite strong_spec_norm; simpl; nzsimpl.
+ destr_neq_bool; nzsimpl.
+ rewrite Zabs_eq; romega.
+ intros _.
+ rewrite Qred_iff.
+ simpl.
+ rewrite Zabs_eq; auto with zarith.
+ rewrite N_to_Z2P in *; auto.
+ rewrite Z2P_correct; auto with zarith.
+ rewrite Zgcd_sym; auto.
+ (* 0 > n *)
+ destr_neq_bool; nzsimpl; simpl; auto; intros.
+ destr_zcompare; simpl; nzsimpl; auto.
+ destr_neq_bool; nzsimpl.
+ rewrite Zabs_non_eq; romega.
+ intros _.
+ rewrite strong_spec_norm; simpl; nzsimpl.
+ destr_neq_bool; nzsimpl.
+ rewrite Zabs_non_eq; romega.
+ intros _.
+ rewrite Qred_iff.
+ simpl.
+ rewrite N_to_Z2P in *; auto.
+ rewrite Z2P_correct; auto with zarith.
+ intros.
+ rewrite Zgcd_sym, Zgcd_Zabs, Zgcd_sym.
+ apply Zis_gcd_gcd; auto with zarith.
+ apply Zis_gcd_minus.
+ rewrite Zopp_involutive, <- H1; apply Zgcd_is_gcd.
+ rewrite Zabs_non_eq; romega.
+ Qed.
+
+ Definition div x y := mul x (inv y).
+
+ Theorem spec_div x y: [div x y] == [x] / [y].
+ Proof.
+ intros x y; unfold div; rewrite spec_mul; auto.
+ unfold Qdiv; apply Qmult_comp.
+ apply Qeq_refl.
+ apply spec_inv; auto.
+ Qed.
+
+ Definition div_norm x y := mul_norm x (inv_norm y).
+
+ Theorem spec_div_norm x y: [div_norm x y] == [x] / [y].
+ Proof.
+ intros x y; unfold div_norm; rewrite spec_mul_norm; auto.
+ unfold Qdiv; apply Qmult_comp.
+ apply Qeq_refl.
+ apply spec_inv_norm; auto.
+ Qed.
+
+ Theorem strong_spec_div_norm : forall x y,
+ Reduced x -> Reduced y -> Reduced (div_norm x y).
+ Proof.
+ intros; unfold div_norm.
+ apply strong_spec_mul_norm; auto.
+ apply strong_spec_inv_norm; auto.
+ Qed.
+
+ Definition square (x: t): t :=
+ match x with
+ | Qz zx => Qz (Z.square zx)
+ | Qq nx dx => Qq (Z.square nx) (N.square dx)
+ end.
+
+ Theorem spec_square : forall x, [square x] == [x] ^ 2.
+ Proof.
+ destruct x as [ z | n d ].
+ simpl; rewrite Z.spec_square; red; auto.
+ simpl.
+ destr_neq_bool; nzsimpl; intros.
+ apply Qeq_refl.
+ rewrite N.spec_square in *; nzsimpl.
+ contradict H; elim (Zmult_integral _ _ H0); auto.
+ rewrite N.spec_square in *; nzsimpl.
+ rewrite H in H0; simpl in H0; elim H0; auto.
+ assert (0 < N.to_Z d)%Z by (generalize (N.spec_pos d); romega).
+ clear H H0.
+ rewrite Z.spec_square, N.spec_square.
+ red; simpl.
+ rewrite Zpos_mult_morphism; rewrite !Z2P_correct; auto.
+ apply Zmult_lt_0_compat; auto.
+ Qed.
+
+ Definition power_pos (x : t) p : t :=
+ match x with
+ | Qz zx => Qz (Z.power_pos zx p)
+ | Qq nx dx => Qq (Z.power_pos nx p) (N.power_pos dx p)
+ end.
+
+ Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p.
+ Proof.
+ intros [ z | n d ] p; unfold power_pos.
+ (* Qz *)
+ simpl.
+ rewrite Z.spec_power_pos.
+ rewrite Qpower_decomp.
+ red; simpl; f_equal.
+ rewrite Zpower_pos_1_l; auto.
+ (* Qq *)
+ simpl.
+ rewrite Z.spec_power_pos.
+ destr_neq_bool; nzsimpl; intros.
+ apply Qeq_sym; apply Qpower_positive_0.
+ rewrite N.spec_power_pos in *.
+ assert (0 < N.to_Z d ^ ' p)%Z.
+ apply Zpower_gt_0; auto with zarith.
+ generalize (N.spec_pos d); romega.
+ romega.
+ rewrite N.spec_power_pos, H in *.
+ rewrite Zpower_0_l in H0; [ elim H0; auto | discriminate ].
+ rewrite Qpower_decomp.
+ red; simpl; do 3 f_equal.
+ rewrite Z2P_correct by (generalize (N.spec_pos d); romega).
+ rewrite N.spec_power_pos. auto.
+ Qed.
+
+ Theorem strong_spec_power_pos : forall x p,
+ Reduced x -> Reduced (power_pos x p).
+ Proof.
+ destruct x as [z | n d]; simpl; intros.
+ red; simpl; auto.
+ red; simpl; intros.
+ rewrite strong_spec_norm; simpl.
+ destr_neq_bool; nzsimpl; intros.
+ simpl; auto.
+ rewrite Qred_iff.
+ revert H.
+ unfold Reduced; rewrite strong_spec_red, Qred_iff; simpl.
+ destr_neq_bool; nzsimpl; simpl; intros.
+ rewrite N.spec_power_pos in H0.
+ elim H0; rewrite H; rewrite Zpower_0_l; auto; discriminate.
+ rewrite N_to_Z2P in *; auto.
+ rewrite N.spec_power_pos, Z.spec_power_pos; auto.
+ rewrite Zgcd_1_rel_prime in *.
+ apply rel_prime_Zpower; auto with zarith.
+ Qed.
+
+ Definition power (x : t) (z : Z) : t :=
+ match z with
+ | Z0 => one
+ | Zpos p => power_pos x p
+ | Zneg p => inv (power_pos x p)
+ end.
+
+ Theorem spec_power : forall x z, [power x z] == [x]^z.
+ Proof.
+ destruct z.
+ simpl; nzsimpl; red; auto.
+ apply spec_power_pos.
+ simpl.
+ rewrite spec_inv, spec_power_pos; apply Qeq_refl.
+ Qed.
+
+ Definition power_norm (x : t) (z : Z) : t :=
+ match z with
+ | Z0 => one
+ | Zpos p => power_pos x p
+ | Zneg p => inv_norm (power_pos x p)
+ end.
+
+ Theorem spec_power_norm : forall x z, [power_norm x z] == [x]^z.
+ Proof.
+ destruct z.
+ simpl; nzsimpl; red; auto.
+ apply spec_power_pos.
+ simpl.
+ rewrite spec_inv_norm, spec_power_pos; apply Qeq_refl.
+ Qed.
+
+ Theorem strong_spec_power_norm : forall x z,
+ Reduced x -> Reduced (power_norm x z).
+ Proof.
+ destruct z; simpl.
+ intros _; unfold Reduced; rewrite strong_spec_red.
+ unfold one.
+ simpl to_Q; nzsimpl; auto.
+ intros; apply strong_spec_power_pos; auto.
+ intros; apply strong_spec_inv_norm; apply strong_spec_power_pos; auto.
+ Qed.
+
+
+ (** Interaction with [Qcanon.Qc] *)
+
+ Open Scope Qc_scope.
+
+ Definition of_Qc q := of_Q (this q).
+
+ Definition to_Qc q := !! [q].
+
+ Notation "[[ x ]]" := (to_Qc x).
+
+ Theorem strong_spec_of_Qc : forall q, [of_Qc q] = q.
+ Proof.
+ intros (q,Hq); intros.
+ unfold of_Qc; rewrite strong_spec_of_Q; auto.
+ Qed.
+
+ Lemma strong_spec_of_Qc_bis : forall q, Reduced (of_Qc q).
+ Proof.
+ intros; red; rewrite strong_spec_red, strong_spec_of_Qc.
+ destruct q; simpl; auto.
+ Qed.
+
+ Theorem spec_of_Qc: forall q, [[of_Qc q]] = q.
+ Proof.
+ intros; apply Qc_decomp; simpl; intros.
+ rewrite strong_spec_of_Qc; auto.
+ Qed.
+
+ Theorem spec_oppc: forall q, [[opp q]] = -[[q]].
+ Proof.
+ intros q; unfold Qcopp, to_Qc, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ rewrite spec_opp, <- Qred_opp, Qred_correct.
+ apply Qeq_refl.
+ Qed.
+
+ Theorem spec_oppc_bis : forall q : Qc, [opp (of_Qc q)] = - q.
+ Proof.
+ intros.
+ rewrite <- strong_spec_opp_norm by apply strong_spec_of_Qc_bis.
+ rewrite strong_spec_red.
+ symmetry; apply (Qred_complete (-q)%Q).
+ rewrite spec_opp, strong_spec_of_Qc; auto with qarith.
+ Qed.
+
+ Theorem spec_comparec: forall q1 q2,
+ compare q1 q2 = ([[q1]] ?= [[q2]]).
+ Proof.
+ unfold Qccompare, to_Qc.
+ intros q1 q2; rewrite spec_compare; simpl; auto.
+ apply Qcompare_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_addc x y:
+ [[add x y]] = [[x]] + [[y]].
+ Proof.
+ intros x y; unfold to_Qc.
+ apply trans_equal with (!! ([x] + [y])).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_add; auto.
+ unfold Qcplus, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_add_normc x y:
+ [[add_norm x y]] = [[x]] + [[y]].
+ Proof.
+ intros x y; unfold to_Qc.
+ apply trans_equal with (!! ([x] + [y])).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_add_norm; auto.
+ unfold Qcplus, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_add_normc_bis : forall x y : Qc,
+ [add_norm (of_Qc x) (of_Qc y)] = x+y.
+ Proof.
+ intros.
+ rewrite <- strong_spec_add_norm by apply strong_spec_of_Qc_bis.
+ rewrite strong_spec_red.
+ symmetry; apply (Qred_complete (x+y)%Q).
+ rewrite spec_add_norm, ! strong_spec_of_Qc; auto with qarith.
+ Qed.
+
+ Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]].
+ Proof.
+ intros x y; unfold sub; rewrite spec_addc; auto.
+ rewrite spec_oppc; ring.
+ Qed.
+
+ Theorem spec_sub_normc x y:
+ [[sub_norm x y]] = [[x]] - [[y]].
+ Proof.
+ intros x y; unfold sub_norm; rewrite spec_add_normc; auto.
+ rewrite spec_oppc; ring.
+ Qed.
+
+ Theorem spec_sub_normc_bis : forall x y : Qc,
+ [sub_norm (of_Qc x) (of_Qc y)] = x-y.
+ Proof.
+ intros.
+ rewrite <- strong_spec_sub_norm by apply strong_spec_of_Qc_bis.
+ rewrite strong_spec_red.
+ symmetry; apply (Qred_complete (x+(-y)%Qc)%Q).
+ rewrite spec_sub_norm, ! strong_spec_of_Qc.
+ unfold Qcopp, Q2Qc; rewrite Qred_correct; auto with qarith.
+ Qed.
+
+ Theorem spec_mulc x y:
+ [[mul x y]] = [[x]] * [[y]].
+ Proof.
+ intros x y; unfold to_Qc.
+ apply trans_equal with (!! ([x] * [y])).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_mul; auto.
+ unfold Qcmult, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_mul_normc x y:
+ [[mul_norm x y]] = [[x]] * [[y]].
+ Proof.
+ intros x y; unfold to_Qc.
+ apply trans_equal with (!! ([x] * [y])).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_mul_norm; auto.
+ unfold Qcmult, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_mul_normc_bis : forall x y : Qc,
+ [mul_norm (of_Qc x) (of_Qc y)] = x*y.
+ Proof.
+ intros.
+ rewrite <- strong_spec_mul_norm by apply strong_spec_of_Qc_bis.
+ rewrite strong_spec_red.
+ symmetry; apply (Qred_complete (x*y)%Q).
+ rewrite spec_mul_norm, ! strong_spec_of_Qc; auto with qarith.
+ Qed.
+
+ Theorem spec_invc x:
+ [[inv x]] = /[[x]].
+ Proof.
+ intros x; unfold to_Qc.
+ apply trans_equal with (!! (/[x])).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_inv; auto.
+ unfold Qcinv, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_inv_normc x:
+ [[inv_norm x]] = /[[x]].
+ Proof.
+ intros x; unfold to_Qc.
+ apply trans_equal with (!! (/[x])).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_inv_norm; auto.
+ unfold Qcinv, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_inv_normc_bis : forall x : Qc,
+ [inv_norm (of_Qc x)] = /x.
+ Proof.
+ intros.
+ rewrite <- strong_spec_inv_norm by apply strong_spec_of_Qc_bis.
+ rewrite strong_spec_red.
+ symmetry; apply (Qred_complete (/x)%Q).
+ rewrite spec_inv_norm, ! strong_spec_of_Qc; auto with qarith.
+ Qed.
+
+ Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]].
+ Proof.
+ intros x y; unfold div; rewrite spec_mulc; auto.
+ unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
+ apply spec_invc; auto.
+ Qed.
+
+ Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]].
+ Proof.
+ intros x y; unfold div_norm; rewrite spec_mul_normc; auto.
+ unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
+ apply spec_inv_normc; auto.
+ Qed.
+
+ Theorem spec_div_normc_bis : forall x y : Qc,
+ [div_norm (of_Qc x) (of_Qc y)] = x/y.
+ Proof.
+ intros.
+ rewrite <- strong_spec_div_norm by apply strong_spec_of_Qc_bis.
+ rewrite strong_spec_red.
+ symmetry; apply (Qred_complete (x*(/y)%Qc)%Q).
+ rewrite spec_div_norm, ! strong_spec_of_Qc.
+ unfold Qcinv, Q2Qc; rewrite Qred_correct; auto with qarith.
+ Qed.
+
+ Theorem spec_squarec x: [[square x]] = [[x]]^2.
+ Proof.
+ intros x; unfold to_Qc.
+ apply trans_equal with (!! ([x]^2)).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_square; auto.
+ simpl Qcpower.
+ replace (!! [x] * 1) with (!![x]); try ring.
+ simpl.
+ unfold Qcmult, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
+ Qed.
+
+ Theorem spec_power_posc x p:
+ [[power_pos x p]] = [[x]] ^ nat_of_P p.
+ Proof.
+ intros x p; unfold to_Qc.
+ apply trans_equal with (!! ([x]^Zpos p)).
+ unfold Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete; apply spec_power_pos; auto.
+ induction p using Pind.
+ simpl; ring.
+ rewrite nat_of_P_succ_morphism; simpl Qcpower.
+ rewrite <- IHp; clear IHp.
+ unfold Qcmult, Q2Qc.
+ apply Qc_decomp; intros _ _; unfold this.
+ apply Qred_complete.
+ setoid_replace ([x] ^ ' Psucc p)%Q with ([x] * [x] ^ ' p)%Q.
+ apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
+ simpl.
+ rewrite Pplus_one_succ_l.
+ rewrite Qpower_plus_positive; simpl; apply Qeq_refl.
+ Qed.
+
+End Make.
+
diff --git a/theories/Numbers/Rational/BigQ/QMake_base.v b/theories/Numbers/Rational/BigQ/QMake_base.v
deleted file mode 100644
index 547e74b7..00000000
--- a/theories/Numbers/Rational/BigQ/QMake_base.v
+++ /dev/null
@@ -1,34 +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 *)
-(************************************************************************)
-(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-(************************************************************************)
-
-(* $Id: QMake_base.v 10964 2008-05-22 11:08:13Z letouzey $ *)
-
-(** * An implementation of rational numbers based on big integers *)
-
-Require Export BigN.
-Require Export BigZ.
-
-(* Basic type for Q: a Z or a pair of a Z and an N *)
-
-Inductive q_type :=
- | Qz : BigZ.t -> q_type
- | Qq : BigZ.t -> BigN.t -> q_type.
-
-Definition print_type x :=
- match x with
- | Qz _ => Z
- | _ => (Z*Z)%type
- end.
-
-Definition print x :=
- match x return print_type x with
- | Qz zx => BigZ.to_Z zx
- | Qq nx dx => (BigZ.to_Z nx, BigN.to_Z dx)
- end.
diff --git a/theories/Numbers/Rational/BigQ/QbiMake.v b/theories/Numbers/Rational/BigQ/QbiMake.v
deleted file mode 100644
index 699f383e..00000000
--- a/theories/Numbers/Rational/BigQ/QbiMake.v
+++ /dev/null
@@ -1,1066 +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 *)
-(************************************************************************)
-(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-(************************************************************************)
-
-(*i $Id: QbiMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*)
-
-Require Import Bool.
-Require Import ZArith.
-Require Import Znumtheory.
-Require Import BigNumPrelude.
-Require Import Arith.
-Require Export BigN.
-Require Export BigZ.
-Require Import QArith.
-Require Import Qcanon.
-Require Import Qpower.
-Require Import QMake_base.
-
-Module Qbi.
-
- Import BinInt Zorder.
- Open Local Scope Q_scope.
- Open Local Scope Qc_scope.
-
- (** The notation of a rational number is either an integer x,
- interpreted as itself or a pair (x,y) of an integer x and a naturel
- number y interpreted as x/y. The pairs (x,0) and (0,y) are all
- interpreted as 0. *)
-
- Definition t := q_type.
-
- Definition zero: t := Qz BigZ.zero.
- Definition one: t := Qz BigZ.one.
- Definition minus_one: t := Qz BigZ.minus_one.
-
- Definition of_Z x: t := Qz (BigZ.of_Z x).
-
-
- Definition of_Q q: t :=
- match q with x # y =>
- Qq (BigZ.of_Z x) (BigN.of_N (Npos y))
- end.
-
- Definition of_Qc q := of_Q (this q).
-
- Definition to_Q (q: t) :=
- match q with
- Qz x => BigZ.to_Z x # 1
- |Qq x y => if BigN.eq_bool y BigN.zero then 0%Q
- else BigZ.to_Z x # Z2P (BigN.to_Z y)
- end.
-
- Definition to_Qc q := !!(to_Q q).
-
- Notation "[[ x ]]" := (to_Qc x).
-
- Notation "[ x ]" := (to_Q x).
-
- Theorem spec_to_Q: forall q: Q, [of_Q q] = q.
- intros (x,y); simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigN.spec_of_pos; intros HH; discriminate HH.
- rewrite BigZ.spec_of_Z; simpl.
- rewrite (BigN.spec_of_pos); auto.
- Qed.
-
- Theorem spec_to_Qc: forall q, [[of_Qc q]] = q.
- intros (x, Hx); unfold of_Qc, to_Qc; simpl.
- apply Qc_decomp; simpl.
- intros; rewrite spec_to_Q; auto.
- Qed.
-
- Definition opp (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.opp zx)
- | Qq nx dx => Qq (BigZ.opp nx) dx
- end.
-
- Theorem spec_opp: forall q, ([opp q] = -[q])%Q.
- intros [z | x y]; simpl.
- rewrite BigZ.spec_opp; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigZ.spec_opp; auto.
- Qed.
-
- Theorem spec_oppc: forall q, [[opp q]] = -[[q]].
- intros q; unfold Qcopp, to_Qc, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- rewrite spec_opp.
- rewrite <- Qred_opp.
- rewrite Qred_involutive; auto.
- Qed.
-
-
- Definition compare (x y: t) :=
- match x, y with
- | Qz zx, Qz zy => BigZ.compare zx zy
- | Qz zx, Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero
- else
- match BigZ.cmp_sign zx ny with
- | Lt => Lt
- | Gt => Gt
- | Eq => BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny
- end
- | Qq nx dx, Qz zy =>
- if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy
- else
- match BigZ.cmp_sign nx zy with
- | Lt => Lt
- | Gt => Gt
- | Eq => BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx))
- end
- | Qq nx dx, Qq ny dy =>
- match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with
- | true, true => Eq
- | true, false => BigZ.compare BigZ.zero ny
- | false, true => BigZ.compare nx BigZ.zero
- | false, false =>
- match BigZ.cmp_sign nx ny with
- | Lt => Lt
- | Gt => Gt
- | Eq => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx))
- end
- end
- end.
-
- Theorem spec_compare: forall q1 q2,
- compare q1 q2 = ([q1] ?= [q2])%Q.
- intros [z1 | x1 y1] [z2 | x2 y2];
- unfold Qcompare, compare, to_Q, Qnum, Qden.
- repeat rewrite Zmult_1_r.
- generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- rewrite Zmult_1_r.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto.
- set (a := BigZ.to_Z z1); set (b := BigZ.to_Z x2);
- set (c := BigN.to_Z y2); fold c in HH.
- assert (F: (0 < c)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos y2)); fold c; auto.
- intros H1; case HH; rewrite <- H1; auto.
- rewrite Z2P_correct; auto with zarith.
- generalize (BigZ.spec_cmp_sign z1 x2); case BigZ.cmp_sign; fold a b c.
- intros _; generalize (BigZ.spec_compare (z1 * BigZ.Pos y2)%bigZ x2);
- case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c; auto.
- intros H1; rewrite H1; rewrite Zcompare_refl; auto.
- intros (H1, H2); apply sym_equal; change (a * c < b)%Z.
- apply Zlt_le_trans with (2 := H2).
- change 0%Z with (0 * c)%Z.
- apply Zmult_lt_compat_r; auto with zarith.
- intros (H1, H2); apply sym_equal; change (a * c > b)%Z.
- apply Zlt_gt.
- apply Zlt_le_trans with (1 := H2).
- change 0%Z with (0 * c)%Z.
- apply Zmult_le_compat_r; auto with zarith.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare BigZ.zero z2);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto.
- set (a := BigZ.to_Z z2); set (b := BigZ.to_Z x1);
- set (c := BigN.to_Z y1); fold c in HH.
- assert (F: (0 < c)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos y1)); fold c; auto.
- intros H1; case HH; rewrite <- H1; auto.
- rewrite Zmult_1_r; rewrite Z2P_correct; auto with zarith.
- generalize (BigZ.spec_cmp_sign x1 z2); case BigZ.cmp_sign; fold a b c.
- intros _; generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1)%bigZ);
- case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c; auto.
- intros H1; rewrite H1; rewrite Zcompare_refl; auto.
- intros (H1, H2); apply sym_equal; change (b < a * c)%Z.
- apply Zlt_le_trans with (1 := H1).
- change 0%Z with (0 * c)%Z.
- apply Zmult_le_compat_r; auto with zarith.
- intros (H1, H2); apply sym_equal; change (b > a * c)%Z.
- apply Zlt_gt.
- apply Zlt_le_trans with (2 := H1).
- change 0%Z with (0 * c)%Z.
- apply Zmult_lt_compat_r; auto with zarith.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- rewrite Zcompare_refl; auto.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare BigZ.zero x2);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare;
- auto; rewrite BigZ.spec_0.
- intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto.
- set (a := BigZ.to_Z x1); set (b := BigZ.to_Z x2);
- set (c1 := BigN.to_Z y1); set (c2 := BigN.to_Z y2).
- fold c1 in HH; fold c2 in HH1.
- assert (F1: (0 < c1)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos y1)); fold c1; auto.
- intros H1; case HH; rewrite <- H1; auto.
- assert (F2: (0 < c2)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos y2)); fold c2; auto.
- intros H1; case HH1; rewrite <- H1; auto.
- repeat rewrite Z2P_correct; auto.
- generalize (BigZ.spec_cmp_sign x1 x2); case BigZ.cmp_sign.
- intros _; generalize (BigZ.spec_compare (x1 * BigZ.Pos y2)%bigZ
- (x2 * BigZ.Pos y1)%bigZ);
- case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c1 c2; auto.
- rewrite BigZ.spec_mul; simpl; fold a b c1; intros HH2; rewrite HH2;
- rewrite Zcompare_refl; auto.
- rewrite BigZ.spec_mul; simpl; auto.
- rewrite BigZ.spec_mul; simpl; auto.
- fold a b; intros (H1, H2); apply sym_equal; change (a * c2 < b * c1)%Z.
- apply Zlt_le_trans with 0%Z.
- change 0%Z with (0 * c2)%Z.
- apply Zmult_lt_compat_r; auto with zarith.
- apply Zmult_le_0_compat; auto with zarith.
- fold a b; intros (H1, H2); apply sym_equal; change (a * c2 > b * c1)%Z.
- apply Zlt_gt; apply Zlt_le_trans with 0%Z.
- change 0%Z with (0 * c1)%Z.
- apply Zmult_lt_compat_r; auto with zarith.
- apply Zmult_le_0_compat; auto with zarith.
- Qed.
-
-
- Definition do_norm_n n :=
- match n with
- | BigN.N0 _ => false
- | BigN.N1 _ => false
- | BigN.N2 _ => false
- | BigN.N3 _ => false
- | BigN.N4 _ => false
- | BigN.N5 _ => false
- | BigN.N6 _ => false
- | _ => true
- end.
-
- Definition do_norm_z z :=
- match z with
- | BigZ.Pos n => do_norm_n n
- | BigZ.Neg n => do_norm_n n
- end.
-
-(* Je pense que cette fonction normalise bien ... *)
- Definition norm n d: t :=
- if andb (do_norm_z n) (do_norm_n d) then
- let gcd := BigN.gcd (BigZ.to_N n) d in
- match BigN.compare BigN.one gcd with
- | Lt =>
- let n := BigZ.div n (BigZ.Pos gcd) in
- let d := BigN.div d gcd in
- match BigN.compare d BigN.one with
- | Gt => Qq n d
- | Eq => Qz n
- | Lt => zero
- end
- | Eq => Qq n d
- | Gt => zero (* gcd = 0 => both numbers are 0 *)
- end
- else Qq n d.
-
- Theorem spec_norm: forall n q,
- ([norm n q] == [Qq n q])%Q.
- intros p q; unfold norm.
- case do_norm_z; simpl andb.
- 2: apply Qeq_refl.
- case do_norm_n.
- 2: apply Qeq_refl.
- assert (Hp := BigN.spec_pos (BigZ.to_N p)).
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1.
- apply Qeq_refl.
- generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN).
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith; intros H2 HH.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H3; simpl;
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- auto with zarith.
- generalize H2; rewrite H3;
- rewrite Zdiv_0_l; auto with zarith.
- generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3.
- rewrite spec_to_N.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H3; simpl.
- case H3.
- generalize H1 H2 H3 HH; clear H1 H2 H3 HH.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 HH.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith.
- case (Zle_lt_or_eq _ _ HH); auto with zarith.
- intros HH1; rewrite <- HH1; ring.
- generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith; intros H3.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H4.
- case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith.
- simpl.
- assert (FF := BigN.spec_pos q).
- rewrite Z2P_correct; auto with zarith.
- rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith.
- simpl; rewrite BigZ.spec_div; simpl.
- rewrite BigN.spec_gcd; auto with zarith.
- generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 H4 HH FF.
- rewrite spec_to_N; fold a.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_gcd; auto with zarith.
- case (Zle_lt_or_eq _ _
- (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q)));
- rewrite BigN.spec_gcd; auto with zarith.
- intros; apply False_ind; auto with zarith.
- intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)).
- assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)).
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H2; simpl.
- rewrite spec_to_N.
- rewrite FF2; ring.
- Qed.
-
- Definition add (x y: t): t :=
- match x with
- | Qz zx =>
- match y with
- | Qz zy => Qz (BigZ.add zx zy)
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- end
- | Qq nx dx =>
- if BigN.eq_bool dx BigN.zero then y
- else match y with
- | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else
- if BigN.eq_bool dx dy then
- let n := BigZ.add nx ny in
- Qq n dx
- else
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- Qq n d
- end
- end.
-
-
-
- Theorem spec_add x y:
- ([add x y] == [x] + [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl.
- rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- assert (F1:= BigN.spec_pos dy).
- rewrite Zmult_1_r; red; simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH; simpl; try ring.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH1; simpl; try ring.
- case HH; auto.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH; simpl; try ring.
- rewrite Zmult_1_r; apply Qeq_refl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH1; simpl; try ring.
- case HH; auto.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto.
- rewrite Zmult_1_r; rewrite Pmult_1_r.
- apply Qeq_refl.
- assert (F1:= BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- apply Qeq_refl.
- case HH2; auto.
- simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- case HH2; auto.
- case HH1; auto.
- rewrite Zmult_1_r; apply Qeq_refl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- simpl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- case HH; auto.
- rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r.
- apply Qeq_refl.
- simpl.
- generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_mul;
- rewrite BigN.spec_0; intros HH2.
- (case (Zmult_integral _ _ HH2); intros HH3);
- [case HH| case HH1]; auto.
- generalize (BigN.spec_eq_bool dx dy);
- case BigN.eq_bool; intros HH3.
- rewrite <- HH3.
- assert (Fx: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- red; simpl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH4.
- case HH; auto.
- simpl; rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl.
- ring.
- assert (Fx: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (Fy: (0 < BigN.to_Z dy)%Z).
- generalize (BigN.spec_pos dy); auto with zarith.
- red; simpl; rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_mul;
- rewrite BigN.spec_0; intros H3; simpl.
- absurd (0 < 0)%Z; auto with zarith.
- rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl.
- repeat rewrite Z2P_correct; auto with zarith.
- apply Zmult_lt_0_compat; auto.
- Qed.
-
- Theorem spec_addc x y:
- [[add x y]] = [[x]] + [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition add_norm (x y: t): t :=
- match x with
- | Qz zx =>
- match y with
- | Qz zy => Qz (BigZ.add zx zy)
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else
- norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- end
- | Qq nx dx =>
- if BigN.eq_bool dx BigN.zero then y
- else match y with
- | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else
- if BigN.eq_bool dx dy then
- let n := BigZ.add nx ny in
- norm n dx
- else
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- norm n d
- end
- end.
-
- Theorem spec_add_norm x y:
- ([add_norm x y] == [x] + [y])%Q.
- intros x y; rewrite <- spec_add; auto.
- case x; case y; clear x y; unfold add_norm, add.
- intros; apply Qeq_refl.
- intros p1 n p2.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- simpl.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- apply Qeq_refl.
- apply Qeq_refl.
- intros p1 p2 n.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- apply Qeq_refl.
- intros p1 q1 p2 q2.
- generalize (BigN.spec_eq_bool q2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- apply Qeq_refl.
- generalize (BigN.spec_eq_bool q1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; intros HH3;
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end; apply Qeq_refl.
- Qed.
-
- Theorem spec_add_normc x y:
- [[add_norm x y]] = [[x]] + [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add_norm; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition sub x y := add x (opp y).
-
- Theorem spec_sub x y:
- ([sub x y] == [x] - [y])%Q.
- intros x y; unfold sub; rewrite spec_add; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]].
- intros x y; unfold sub; rewrite spec_addc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Definition sub_norm x y := add_norm x (opp y).
-
- Theorem spec_sub_norm x y:
- ([sub_norm x y] == [x] - [y])%Q.
- intros x y; unfold sub_norm; rewrite spec_add_norm; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Theorem spec_sub_normc x y:
- [[sub_norm x y]] = [[x]] - [[y]].
- intros x y; unfold sub_norm; rewrite spec_add_normc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Definition mul (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy
- | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx
- | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy)
- end.
-
- Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl.
- rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH1.
- red; simpl; ring.
- rewrite BigZ.spec_mul; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH1.
- red; simpl; ring.
- rewrite BigZ.spec_mul; rewrite Pmult_1_r.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_mul;
- intros HH1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH2.
- red; simpl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH3.
- red; simpl; ring.
- case (Zmult_integral _ _ HH1); intros HH.
- case HH2; auto.
- case HH3; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH2.
- case HH1; rewrite HH2; ring.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH3.
- case HH1; rewrite HH3; ring.
- rewrite BigZ.spec_mul.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto.
- apply Qeq_refl.
- generalize (BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_pos dy); auto with zarith.
- Qed.
-
- Theorem spec_mulc x y:
- [[mul x y]] = [[x]] * [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition mul_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy => mul (Qz ny) (norm zx dy)
- | Qq nx dx, Qz zy => mul (Qz nx) (norm zy dx)
- | Qq nx dx, Qq ny dy => mul (norm nx dy) (norm ny dx)
- end.
-
- Theorem spec_mul_norm x y:
- ([mul_norm x y] == [x] * [y])%Q.
- intros x y; rewrite <- spec_mul; auto.
- unfold mul_norm; case x; case y; clear x y.
- intros; apply Qeq_refl.
- intros p1 n p2.
- repeat rewrite spec_mul.
- match goal with |- ?Z == _ =>
- match Z with context id [norm ?X ?Y] =>
- let y := context id [Qq X Y] in
- apply Qeq_trans with y; [repeat apply Qmult_comp;
- repeat apply Qplus_comp; repeat apply Qeq_refl;
- apply spec_norm | idtac]
- end
- end.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH; simpl; ring.
- intros p1 p2 n.
- repeat rewrite spec_mul.
- match goal with |- ?Z == _ =>
- match Z with context id [norm ?X ?Y] =>
- let y := context id [Qq X Y] in
- apply Qeq_trans with y; [repeat apply Qmult_comp;
- repeat apply Qplus_comp; repeat apply Qeq_refl;
- apply spec_norm | idtac]
- end
- end.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH; simpl; try ring.
- rewrite Pmult_1_r; auto.
- intros p1 n1 p2 n2.
- repeat rewrite spec_mul.
- repeat match goal with |- ?Z == _ =>
- match Z with context id [norm ?X ?Y] =>
- let y := context id [Qq X Y] in
- apply Qeq_trans with y; [repeat apply Qmult_comp;
- repeat apply Qplus_comp; repeat apply Qeq_refl;
- apply spec_norm | idtac]
- end
- end.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1;
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; try ring.
- repeat rewrite Zpos_mult_morphism; ring.
- Qed.
-
- Theorem spec_mul_normc x y:
- [[mul_norm x y]] = [[x]] * [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul_norm; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition inv (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) => Qq BigZ.one n
- | Qz (BigZ.Neg n) => Qq BigZ.minus_one n
- | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n
- | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n
- end.
-
-
- Theorem spec_inv x:
- ([inv x] == /[x])%Q.
- intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- rewrite H1; apply Qeq_refl.
- generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto.
- intros HH; case HH; auto.
- intros; red; simpl; auto.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- rewrite H1; apply Qeq_refl.
- generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl; auto.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- apply Qeq_refl.
- rewrite H1; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- rewrite H2; red; simpl; auto.
- generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- apply Qeq_refl.
- rewrite H1; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- rewrite H2; red; simpl; auto.
- generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl.
- assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto.
- rewrite tmp.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- ring.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p _ HH; case HH; auto.
- Qed.
-
- Theorem spec_invc x:
- [[inv x]] = /[[x]].
- intros x; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition inv_norm (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) =>
- if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one n
- | Qz (BigZ.Neg n) =>
- if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one n
- | Qq (BigZ.Pos n) d =>
- if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos d) n
- | Qq (BigZ.Neg n) d =>
- if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg d) n
- end.
-
- Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q.
- intros x; rewrite <- spec_inv; generalize x; clear x.
- intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, inv;
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; try apply Qeq_refl;
- red; simpl;
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; auto;
- case H2; auto.
- Qed.
-
- Theorem spec_inv_normc x:
- [[inv_norm x]] = /[[x]].
- intros x; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv_norm; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
- Definition div x y := mul x (inv y).
-
- Theorem spec_div x y: ([div x y] == [x] / [y])%Q.
- intros x y; unfold div; rewrite spec_mul; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]].
- intros x y; unfold div; rewrite spec_mulc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
- Definition div_norm x y := mul_norm x (inv y).
-
- Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q.
- intros x y; unfold div_norm; rewrite spec_mul_norm; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]].
- intros x y; unfold div_norm; rewrite spec_mul_normc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
-
- Definition square (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.square zx)
- | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx)
- end.
-
-
- Theorem spec_square x: ([square x] == [x] ^ 2)%Q.
- intros [ x | nx dx]; unfold square.
- red; simpl; rewrite BigZ.spec_square; auto with zarith.
- simpl Qpower.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H.
- red; simpl.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square;
- intros H1.
- case H1; rewrite H; auto.
- red; simpl.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square;
- intros H1.
- case H; case (Zmult_integral _ _ H1); auto.
- simpl.
- rewrite BigZ.spec_square.
- rewrite Zpos_mult_morphism.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_pos dx); auto with zarith.
- Qed.
-
- Theorem spec_squarec x: [[square x]] = [[x]]^2.
- intros x; unfold to_Qc.
- apply trans_equal with (!! ([x]^2)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_square; auto.
- simpl Qcpower.
- replace (!! [x] * 1) with (!![x]); try ring.
- simpl.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition power_pos (x: t) p: t :=
- match x with
- | Qz zx => Qz (BigZ.power_pos zx p)
- | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p)
- end.
-
- Theorem spec_power_pos x p: ([power_pos x p] == [x] ^ Zpos p)%Q.
- Proof.
- intros [x | nx dx] p; unfold power_pos.
- unfold power_pos; red; simpl.
- generalize (Qpower_decomp p (BigZ.to_Z x) 1).
- unfold Qeq; simpl.
- rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Zmult_1_r.
- intros H; rewrite H.
- rewrite BigZ.spec_power_pos; simpl; ring.
- simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_power_pos; intros H1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H2.
- elim p; simpl.
- intros; red; simpl; auto.
- intros p1 Hp1; rewrite <- Hp1; red; simpl; auto.
- apply Qeq_refl.
- case H2; generalize H1.
- elim p; simpl.
- intros p1 Hrec.
- change (xI p1) with (1 + (xO p1))%positive.
- rewrite Zpower_pos_is_exp; rewrite Zpower_pos_1_r.
- intros HH; case (Zmult_integral _ _ HH); auto.
- rewrite <- Pplus_diag.
- rewrite Zpower_pos_is_exp.
- intros HH1; case (Zmult_integral _ _ HH1); auto.
- intros p1 Hrec.
- rewrite <- Pplus_diag.
- rewrite Zpower_pos_is_exp.
- intros HH1; case (Zmult_integral _ _ HH1); auto.
- rewrite Zpower_pos_1_r; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H2.
- case H1; rewrite H2; auto.
- simpl; rewrite Zpower_pos_0_l; auto.
- assert (F1: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z).
- unfold Zpower; apply Zpower_pos_pos; auto.
- unfold power_pos; red; simpl.
- generalize (Qpower_decomp p (BigZ.to_Z nx)
- (Z2P (BigN.to_Z dx))).
- unfold Qeq; simpl.
- repeat rewrite Z2P_correct; auto.
- unfold Qeq; simpl; intros HH.
- rewrite HH.
- rewrite BigZ.spec_power_pos; simpl; ring.
- Qed.
-
- Theorem spec_power_posc x p:
- [[power_pos x p]] = [[x]] ^ nat_of_P p.
- intros x p; unfold to_Qc.
- apply trans_equal with (!! ([x]^Zpos p)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_power_pos; auto.
- pattern p; apply Pind; clear p.
- simpl; ring.
- intros p Hrec.
- rewrite nat_of_P_succ_morphism; simpl Qcpower.
- rewrite <- Hrec.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _;
- unfold this.
- apply Qred_complete.
- assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p).
- simpl; case x; simpl; clear x Hrec.
- intros x; simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- intros nx dx.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- unfold Qpower_positive.
- assert (tmp: forall p, pow_pos Qmult 0%Q p = 0%Q).
- intros p1; elim p1; simpl; auto; clear p1.
- intros p1 Hp1; rewrite Hp1; auto.
- intros p1 Hp1; rewrite Hp1; auto.
- repeat rewrite tmp; intros; red; simpl; auto.
- intros H1.
- assert (F1: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- repeat rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto.
- 2: apply Zpower_pos_pos; auto.
- 2: apply Zpower_pos_pos; auto.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- rewrite F.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
-End Qbi.
diff --git a/theories/Numbers/Rational/BigQ/QifMake.v b/theories/Numbers/Rational/BigQ/QifMake.v
deleted file mode 100644
index 1d8ecc94..00000000
--- a/theories/Numbers/Rational/BigQ/QifMake.v
+++ /dev/null
@@ -1,979 +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 *)
-(************************************************************************)
-(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-(************************************************************************)
-
-(*i $Id: QifMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*)
-
-Require Import Bool.
-Require Import ZArith.
-Require Import Znumtheory.
-Require Import BigNumPrelude.
-Require Import Arith.
-Require Export BigN.
-Require Export BigZ.
-Require Import QArith.
-Require Import Qcanon.
-Require Import Qpower.
-Require Import QMake_base.
-
-Module Qif.
-
- Import BinInt.
- Open Local Scope Q_scope.
- Open Local Scope Qc_scope.
-
- (** The notation of a rational number is either an integer x,
- interpreted as itself or a pair (x,y) of an integer x and a naturel
- number y interpreted as x/y. The pairs (x,0) and (0,y) are all
- interpreted as 0. *)
-
- Definition t := q_type.
-
- Definition zero: t := Qz BigZ.zero.
- Definition one: t := Qz BigZ.one.
- Definition minus_one: t := Qz BigZ.minus_one.
-
- Definition of_Z x: t := Qz (BigZ.of_Z x).
-
- Definition of_Q q: t :=
- match q with x # y =>
- Qq (BigZ.of_Z x) (BigN.of_N (Npos y))
- end.
-
- Definition of_Qc q := of_Q (this q).
-
- Definition to_Q (q: t) :=
- match q with
- Qz x => BigZ.to_Z x # 1
- |Qq x y => if BigN.eq_bool y BigN.zero then 0%Q
- else BigZ.to_Z x # Z2P (BigN.to_Z y)
- end.
-
- Definition to_Qc q := !!(to_Q q).
-
- Notation "[[ x ]]" := (to_Qc x).
-
- Notation "[ x ]" := (to_Q x).
-
- Theorem spec_to_Q: forall q: Q, [of_Q q] = q.
- intros (x,y); simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigN.spec_of_pos; intros HH; discriminate HH.
- rewrite BigZ.spec_of_Z; simpl.
- rewrite (BigN.spec_of_pos); auto.
- Qed.
-
- Theorem spec_to_Qc: forall q, [[of_Qc q]] = q.
- intros (x, Hx); unfold of_Qc, to_Qc; simpl.
- apply Qc_decomp; simpl.
- intros; rewrite spec_to_Q; auto.
- Qed.
-
- Definition opp (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.opp zx)
- | Qq nx dx => Qq (BigZ.opp nx) dx
- end.
-
- Theorem spec_opp: forall q, ([opp q] = -[q])%Q.
- intros [z | x y]; simpl.
- rewrite BigZ.spec_opp; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigZ.spec_opp; auto.
- Qed.
-
- Theorem spec_oppc: forall q, [[opp q]] = -[[q]].
- intros q; unfold Qcopp, to_Qc, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- rewrite spec_opp.
- rewrite <- Qred_opp.
- rewrite Qred_involutive; auto.
- Qed.
-
- Definition compare (x y: t) :=
- match x, y with
- | Qz zx, Qz zy => BigZ.compare zx zy
- | Qz zx, Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero
- else BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny
- | Qq nx dx, Qz zy =>
- if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy
- else BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx))
- | Qq nx dx, Qq ny dy =>
- match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with
- | true, true => Eq
- | true, false => BigZ.compare BigZ.zero ny
- | false, true => BigZ.compare nx BigZ.zero
- | false, false => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx))
- end
- end.
-
- Theorem spec_compare: forall q1 q2,
- compare q1 q2 = ([q1] ?= [q2])%Q.
- intros [z1 | x1 y1] [z2 | x2 y2];
- unfold Qcompare, compare, to_Q, Qnum, Qden.
- repeat rewrite Zmult_1_r.
- generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- rewrite Zmult_1_r.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare;
- rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare BigZ.zero z2);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- rewrite Zmult_1_r.
- generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare;
- rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- rewrite Zcompare_refl; auto.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare BigZ.zero x2);
- case BigZ.compare; auto.
- rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- rewrite Zmult_0_l; rewrite Zmult_1_r.
- generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare;
- auto; rewrite BigZ.spec_0.
- intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto.
- repeat rewrite Z2P_correct.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (x1 * BigZ.Pos y2)
- (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare;
- repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- Qed.
-
- Definition do_norm_n n :=
- match n with
- | BigN.N0 _ => false
- | BigN.N1 _ => false
- | BigN.N2 _ => false
- | BigN.N3 _ => false
- | BigN.N4 _ => false
- | BigN.N5 _ => false
- | BigN.N6 _ => false
- | _ => true
- end.
-
- Definition do_norm_z z :=
- match z with
- | BigZ.Pos n => do_norm_n n
- | BigZ.Neg n => do_norm_n n
- end.
-
-(* Je pense que cette fonction normalise bien ... *)
- Definition norm n d: t :=
- if andb (do_norm_z n) (do_norm_n d) then
- let gcd := BigN.gcd (BigZ.to_N n) d in
- match BigN.compare BigN.one gcd with
- | Lt =>
- let n := BigZ.div n (BigZ.Pos gcd) in
- let d := BigN.div d gcd in
- match BigN.compare d BigN.one with
- | Gt => Qq n d
- | Eq => Qz n
- | Lt => zero
- end
- | Eq => Qq n d
- | Gt => zero (* gcd = 0 => both numbers are 0 *)
- end
- else Qq n d.
-
- Theorem spec_norm: forall n q,
- ([norm n q] == [Qq n q])%Q.
- intros p q; unfold norm.
- case do_norm_z; simpl andb.
- 2: apply Qeq_refl.
- case do_norm_n.
- 2: apply Qeq_refl.
- assert (Hp := BigN.spec_pos (BigZ.to_N p)).
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1.
- apply Qeq_refl.
- generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN).
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith; intros H2 HH.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H3; simpl;
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- auto with zarith.
- generalize H2; rewrite H3;
- rewrite Zdiv_0_l; auto with zarith.
- generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3.
- rewrite spec_to_N.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H3; simpl.
- case H3.
- generalize H1 H2 H3 HH; clear H1 H2 H3 HH.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 HH.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith.
- case (Zle_lt_or_eq _ _ HH); auto with zarith.
- intros HH1; rewrite <- HH1; ring.
- generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto.
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith; intros H3.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H4.
- case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith.
- simpl.
- assert (FF := BigN.spec_pos q).
- rewrite Z2P_correct; auto with zarith.
- rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith.
- simpl; rewrite BigZ.spec_div; simpl.
- rewrite BigN.spec_gcd; auto with zarith.
- generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF.
- set (a := (BigN.to_Z (BigZ.to_N p))).
- set (b := (BigN.to_Z q)).
- intros H1 H2 H3 H4 HH FF.
- rewrite spec_to_N; fold a.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_div;
- rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_gcd; auto with zarith.
- case (Zle_lt_or_eq _ _
- (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q)));
- rewrite BigN.spec_gcd; auto with zarith.
- intros; apply False_ind; auto with zarith.
- intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)).
- assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)).
- red; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H2; simpl.
- rewrite spec_to_N.
- rewrite FF2; ring.
- Qed.
-
-
- Definition add (x y: t): t :=
- match x with
- | Qz zx =>
- match y with
- | Qz zy => Qz (BigZ.add zx zy)
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- end
- | Qq nx dx =>
- if BigN.eq_bool dx BigN.zero then y
- else match y with
- | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- Qq n d
- end
- end.
-
-
- Theorem spec_add x y:
- ([add x y] == [x] + [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl.
- rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- assert (F1:= BigN.spec_pos dy).
- rewrite Zmult_1_r; red; simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH; simpl; try ring.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH1; simpl; try ring.
- case HH; auto.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH; simpl; try ring.
- rewrite Zmult_1_r; apply Qeq_refl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool;
- rewrite BigN.spec_0; intros HH1; simpl; try ring.
- case HH; auto.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto.
- rewrite Zmult_1_r; rewrite Pmult_1_r.
- apply Qeq_refl.
- assert (F1:= BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- apply Qeq_refl.
- case HH2; auto.
- simpl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- case HH2; auto.
- case HH1; auto.
- rewrite Zmult_1_r; apply Qeq_refl.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- simpl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- case HH; auto.
- rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r.
- apply Qeq_refl.
- simpl.
- generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_mul;
- rewrite BigN.spec_0; intros HH2.
- (case (Zmult_integral _ _ HH2); intros HH3);
- [case HH| case HH1]; auto.
- rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl.
- assert (Fx: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (Fy: (0 < BigN.to_Z dy)%Z).
- generalize (BigN.spec_pos dy); auto with zarith.
- red; simpl; rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto with zarith.
- apply Zmult_lt_0_compat; auto.
- Qed.
-
- Theorem spec_addc x y:
- [[add x y]] = [[x]] + [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition add_norm (x y: t): t :=
- match x with
- | Qz zx =>
- match y with
- | Qz zy => Qz (BigZ.add zx zy)
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- end
- | Qq nx dx =>
- if BigN.eq_bool dx BigN.zero then y
- else match y with
- | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx
- | Qq ny dy =>
- if BigN.eq_bool dy BigN.zero then x
- else
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- norm n d
- end
- end.
-
- Theorem spec_add_norm x y:
- ([add_norm x y] == [x] + [y])%Q.
- intros x y; rewrite <- spec_add; auto.
- case x; case y; clear x y; unfold add_norm, add.
- intros; apply Qeq_refl.
- intros p1 n p2.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- simpl.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- apply Qeq_refl.
- apply Qeq_refl.
- intros p1 p2 n.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- apply Qeq_refl.
- intros p1 q1 p2 q2.
- generalize (BigN.spec_eq_bool q2 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH1.
- apply Qeq_refl.
- generalize (BigN.spec_eq_bool q1 BigN.zero);
- case BigN.eq_bool; rewrite BigN.spec_0; intros HH2.
- apply Qeq_refl.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- apply Qeq_refl.
- Qed.
-
- Theorem spec_add_normc x y:
- [[add_norm x y]] = [[x]] + [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add_norm; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition sub x y := add x (opp y).
-
-
- Theorem spec_sub x y:
- ([sub x y] == [x] - [y])%Q.
- intros x y; unfold sub; rewrite spec_add; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]].
- intros x y; unfold sub; rewrite spec_addc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Definition sub_norm x y := add_norm x (opp y).
-
- Theorem spec_sub_norm x y:
- ([sub_norm x y] == [x] - [y])%Q.
- intros x y; unfold sub_norm; rewrite spec_add_norm; auto.
- rewrite spec_opp; ring.
- Qed.
-
- Theorem spec_sub_normc x y:
- [[sub_norm x y]] = [[x]] - [[y]].
- intros x y; unfold sub_norm; rewrite spec_add_normc; auto.
- rewrite spec_oppc; ring.
- Qed.
-
- Definition mul (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy
- | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx
- | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy)
- end.
-
-
- Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl.
- rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH1.
- red; simpl; ring.
- rewrite BigZ.spec_mul; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH1.
- red; simpl; ring.
- rewrite BigZ.spec_mul; rewrite Pmult_1_r.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; rewrite BigN.spec_mul;
- intros HH1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH2.
- red; simpl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH3.
- red; simpl; ring.
- case (Zmult_integral _ _ HH1); intros HH.
- case HH2; auto.
- case HH3; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH2.
- case HH1; rewrite HH2; ring.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros HH3.
- case HH1; rewrite HH3; ring.
- rewrite BigZ.spec_mul.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto.
- apply Qeq_refl.
- generalize (BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_pos dy); auto with zarith.
- Qed.
-
- Theorem spec_mulc x y:
- [[mul x y]] = [[x]] * [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
- Definition mul_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy => norm (BigZ.mul zx ny) dy
- | Qq nx dx, Qz zy => norm (BigZ.mul nx zy) dx
- | Qq nx dx, Qq ny dy => norm (BigZ.mul nx ny) (BigN.mul dx dy)
- end.
-
- Theorem spec_mul_norm x y:
- ([mul_norm x y] == [x] * [y])%Q.
- intros x y; rewrite <- spec_mul; auto.
- unfold mul_norm, mul; case x; case y; clear x y.
- intros; apply Qeq_refl.
- intros p1 n p2.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end; apply Qeq_refl.
- intros p1 p2 n.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end; apply Qeq_refl.
- intros p1 n1 p2 n2.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end; apply Qeq_refl.
- Qed.
-
- Theorem spec_mul_normc x y:
- [[mul_norm x y]] = [[x]] * [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul_norm; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
-
- Definition inv (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) => Qq BigZ.one n
- | Qz (BigZ.Neg n) => Qq BigZ.minus_one n
- | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n
- | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n
- end.
-
- Theorem spec_inv x:
- ([inv x] == /[x])%Q.
- intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- rewrite H1; apply Qeq_refl.
- generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto.
- intros HH; case HH; auto.
- intros; red; simpl; auto.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- rewrite H1; apply Qeq_refl.
- generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl; auto.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- apply Qeq_refl.
- rewrite H1; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- rewrite H2; red; simpl; auto.
- generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- apply Qeq_refl.
- rewrite H1; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H2; simpl; auto.
- rewrite H2; red; simpl; auto.
- generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl;
- auto.
- intros HH; case HH; auto.
- intros; red; simpl.
- assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto.
- rewrite tmp.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- ring.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p _ HH; case HH; auto.
- Qed.
-
- Theorem spec_invc x:
- [[inv x]] = /[[x]].
- intros x; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
-Definition inv_norm (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) =>
- match BigN.compare n BigN.one with
- Gt => Qq BigZ.one n
- | _ => x
- end
- | Qz (BigZ.Neg n) =>
- match BigN.compare n BigN.one with
- Gt => Qq BigZ.minus_one n
- | _ => x
- end
- | Qq (BigZ.Pos n) d =>
- match BigN.compare n BigN.one with
- Gt => Qq (BigZ.Pos d) n
- | Eq => Qz (BigZ.Pos d)
- | Lt => Qz (BigZ.zero)
- end
- | Qq (BigZ.Neg n) d =>
- match BigN.compare n BigN.one with
- Gt => Qq (BigZ.Neg d) n
- | Eq => Qz (BigZ.Neg d)
- | Lt => Qz (BigZ.zero)
- end
- end.
-
- Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q.
- intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, Qinv.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H.
- simpl; rewrite H; apply Qeq_refl.
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl.
- generalize H; case BigN.to_Z.
- intros _ HH; discriminate HH.
- intros p; case p; auto.
- intros p1 HH; discriminate HH.
- intros p1 HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; discriminate HH.
- intros HH; rewrite <- HH.
- apply Qeq_refl.
- generalize H; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1.
- rewrite H1; intros HH; discriminate.
- generalize H; case BigN.to_Z.
- intros HH; discriminate HH.
- intros; red; simpl; auto.
- intros p HH; discriminate HH.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H.
- simpl; rewrite H; apply Qeq_refl.
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl.
- generalize H; case BigN.to_Z.
- intros _ HH; discriminate HH.
- intros p; case p; auto.
- intros p1 HH; discriminate HH.
- intros p1 HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; discriminate HH.
- intros HH; rewrite <- HH.
- apply Qeq_refl.
- generalize H; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1.
- rewrite H1; intros HH; discriminate.
- generalize H; case BigN.to_Z.
- intros HH; discriminate HH.
- intros; red; simpl; auto.
- intros p HH; discriminate HH.
- simpl Qnum.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; simpl.
- case BigN.compare; red; simpl; auto.
- rewrite H1; auto.
- case BigN.eq_bool; auto.
- simpl; rewrite H1; auto.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H2.
- rewrite H2.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- red; simpl.
- rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx).
- intros; apply Qeq_refl.
- intros p; case p; clear p.
- intros p HH; discriminate HH.
- intros p HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- simpl; generalize H2; case (BigN.to_Z nx).
- intros HH; discriminate HH.
- intros p Hp.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H4.
- rewrite H4 in H2; discriminate H2.
- red; simpl.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p HH; discriminate HH.
- simpl Qnum.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1; simpl.
- case BigN.compare; red; simpl; auto.
- rewrite H1; auto.
- case BigN.eq_bool; auto.
- simpl; rewrite H1; auto.
- match goal with |- context[BigN.compare ?X ?Y] =>
- generalize (BigN.spec_compare X Y); case BigN.compare
- end; rewrite BigN.spec_1; intros H2.
- rewrite H2.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- red; simpl.
- assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto.
- rewrite tmp.
- rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx).
- intros; apply Qeq_refl.
- intros p; case p; clear p.
- intros p HH; discriminate HH.
- intros p HH; discriminate HH.
- intros HH; discriminate HH.
- intros p _ HH; case HH; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H3.
- case H1; auto.
- simpl; generalize H2; case (BigN.to_Z nx).
- intros HH; discriminate HH.
- intros p Hp.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H4.
- rewrite H4 in H2; discriminate H2.
- red; simpl.
- assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto.
- rewrite tmp.
- rewrite Zpos_mult_morphism.
- rewrite Z2P_correct; auto.
- ring.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p HH; discriminate HH.
- Qed.
-
- Theorem spec_inv_normc x:
- [[inv_norm x]] = /[[x]].
- intros x; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv_norm; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
- Definition div x y := mul x (inv y).
-
- Theorem spec_div x y: ([div x y] == [x] / [y])%Q.
- intros x y; unfold div; rewrite spec_mul; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]].
- intros x y; unfold div; rewrite spec_mulc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
- Definition div_norm x y := mul_norm x (inv y).
-
- Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q.
- intros x y; unfold div_norm; rewrite spec_mul_norm; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]].
- intros x y; unfold div_norm; rewrite spec_mul_normc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
-
- Definition square (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.square zx)
- | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx)
- end.
-
- Theorem spec_square x: ([square x] == [x] ^ 2)%Q.
- intros [ x | nx dx]; unfold square.
- red; simpl; rewrite BigZ.spec_square; auto with zarith.
- simpl Qpower.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; intros H.
- red; simpl.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square;
- intros H1.
- case H1; rewrite H; auto.
- red; simpl.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square;
- intros H1.
- case H; case (Zmult_integral _ _ H1); auto.
- simpl.
- rewrite BigZ.spec_square.
- rewrite Zpos_mult_morphism.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto.
- generalize (BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_pos dx); auto with zarith.
- Qed.
-
- Theorem spec_squarec x: [[square x]] = [[x]]^2.
- intros x; unfold to_Qc.
- apply trans_equal with (!! ([x]^2)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_square; auto.
- simpl Qcpower.
- replace (!! [x] * 1) with (!![x]); try ring.
- simpl.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
-End Qif.
diff --git a/theories/Numbers/Rational/BigQ/QpMake.v b/theories/Numbers/Rational/BigQ/QpMake.v
deleted file mode 100644
index ac3ca47a..00000000
--- a/theories/Numbers/Rational/BigQ/QpMake.v
+++ /dev/null
@@ -1,901 +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 *)
-(************************************************************************)
-(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-(************************************************************************)
-
-(*i $Id: QpMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*)
-
-Require Import Bool.
-Require Import ZArith.
-Require Import Znumtheory.
-Require Import BigNumPrelude.
-Require Import Arith.
-Require Export BigN.
-Require Export BigZ.
-Require Import QArith.
-Require Import Qcanon.
-Require Import Qpower.
-Require Import QMake_base.
-
-Notation Nspec_lt := BigNAxiomsMod.NZOrdAxiomsMod.spec_lt.
-Notation Nspec_le := BigNAxiomsMod.NZOrdAxiomsMod.spec_le.
-
-Module Qp.
-
- (** The notation of a rational number is either an integer x,
- interpreted as itself or a pair (x,y) of an integer x and a naturel
- number y interpreted as x/(y+1). *)
-
- Definition t := q_type.
-
- Definition zero: t := Qz BigZ.zero.
- Definition one: t := Qz BigZ.one.
- Definition minus_one: t := Qz BigZ.minus_one.
-
- Definition of_Z x: t := Qz (BigZ.of_Z x).
-
- Definition d_to_Z d := BigZ.Pos (BigN.succ d).
-
- Definition of_Q q: t :=
- match q with x # y =>
- Qq (BigZ.of_Z x) (BigN.pred (BigN.of_N (Npos y)))
- end.
-
- Definition of_Qc q := of_Q (this q).
-
- Definition to_Q (q: t) :=
- match q with
- Qz x => BigZ.to_Z x # 1
- |Qq x y => BigZ.to_Z x # Z2P (BigN.to_Z (BigN.succ y))
- end.
-
- Definition to_Qc q := !!(to_Q q).
-
- Notation "[[ x ]]" := (to_Qc x).
-
- Notation "[ x ]" := (to_Q x).
-
- Theorem spec_to_Q: forall q: Q, [of_Q q] = q.
- intros (x,y); simpl.
- rewrite BigZ.spec_of_Z; auto.
- rewrite BigN.spec_succ; simpl. simpl.
- rewrite BigN.spec_pred; rewrite (BigN.spec_of_pos).
- replace (Zpos y - 1 + 1)%Z with (Zpos y); auto; ring.
- red; auto.
- Qed.
-
- Theorem spec_to_Qc: forall q, [[of_Qc q]] = q.
- intros (x, Hx); unfold of_Qc, to_Qc; simpl.
- apply Qc_decomp; simpl.
- intros; rewrite spec_to_Q; auto.
- Qed.
-
- Definition opp (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.opp zx)
- | Qq nx dx => Qq (BigZ.opp nx) dx
- end.
-
-
- Theorem spec_opp: forall q, ([opp q] = -[q])%Q.
- intros [z | x y]; simpl.
- rewrite BigZ.spec_opp; auto.
- rewrite BigZ.spec_opp; auto.
- Qed.
-
-
- Theorem spec_oppc: forall q, [[opp q]] = -[[q]].
- intros q; unfold Qcopp, to_Qc, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- rewrite spec_opp.
- rewrite <- Qred_opp.
- rewrite Qred_involutive; auto.
- Qed.
-
- Definition compare (x y: t) :=
- match x, y with
- | Qz zx, Qz zy => BigZ.compare zx zy
- | Qz zx, Qq ny dy => BigZ.compare (BigZ.mul zx (d_to_Z dy)) ny
- | Qq nx dy, Qz zy => BigZ.compare nx (BigZ.mul zy (d_to_Z dy))
- | Qq nx dx, Qq ny dy =>
- BigZ.compare (BigZ.mul nx (d_to_Z dy)) (BigZ.mul ny (d_to_Z dx))
- end.
-
- Theorem spec_compare: forall q1 q2,
- compare q1 q2 = ([q1] ?= [q2])%Q.
- intros [z1 | x1 y1] [z2 | x2 y2]; unfold Qcompare; simpl.
- repeat rewrite Zmult_1_r.
- generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- rewrite Zmult_1_r.
- rewrite BigN.spec_succ.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (z1 * d_to_Z y2) x2)%bigZ; case BigZ.compare;
- intros H; rewrite <- H.
- rewrite BigZ.spec_mul; unfold d_to_Z; simpl.
- rewrite BigN.spec_succ.
- rewrite Zcompare_refl; auto.
- rewrite BigZ.spec_mul; unfold d_to_Z; simpl.
- rewrite BigN.spec_succ; auto.
- rewrite BigZ.spec_mul; unfold d_to_Z; simpl.
- rewrite BigN.spec_succ; auto.
- rewrite Zmult_1_r.
- rewrite BigN.spec_succ.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- generalize (BigZ.spec_compare x1 (z2 * d_to_Z y1))%bigZ; case BigZ.compare;
- rewrite BigZ.spec_mul; unfold d_to_Z; simpl;
- rewrite BigN.spec_succ; intros H; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- repeat rewrite BigN.spec_succ; auto.
- repeat rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (x1 * d_to_Z y2)
- (x2 * d_to_Z y1))%bigZ; case BigZ.compare;
- repeat rewrite BigZ.spec_mul; unfold d_to_Z; simpl;
- repeat rewrite BigN.spec_succ; intros H; auto.
- rewrite H; auto.
- rewrite Zcompare_refl; auto.
- Qed.
-
-
- Theorem spec_comparec: forall q1 q2,
- compare q1 q2 = ([[q1]] ?= [[q2]]).
- unfold Qccompare, to_Qc.
- intros q1 q2; rewrite spec_compare; simpl.
- apply Qcompare_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-(* Inv d > 0, Pour la forme normal unique on veut d > 1 *)
- Definition norm n d: t :=
- if BigZ.eq_bool n BigZ.zero then zero
- else
- let gcd := BigN.gcd (BigZ.to_N n) d in
- if BigN.eq_bool gcd BigN.one then Qq n (BigN.pred d)
- else
- let n := BigZ.div n (BigZ.Pos gcd) in
- let d := BigN.div d gcd in
- if BigN.eq_bool d BigN.one then Qz n
- else Qq n (BigN.pred d).
-
- Theorem spec_norm: forall n q,
- ((0 < BigN.to_Z q)%Z -> [norm n q] == [Qq n (BigN.pred q)])%Q.
- intros p q; unfold norm; intros Hq.
- assert (Hp := BigN.spec_pos (BigZ.to_N p)).
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; auto; rewrite BigZ.spec_0; intros H1.
- red; simpl; rewrite H1; ring.
- case (Zle_lt_or_eq _ _ Hp); clear Hp; intros Hp.
- case (Zle_lt_or_eq _ _
- (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p)) (BigN.to_Z q))); intros H4.
- 2: generalize Hq; rewrite (Zgcd_inv_0_r _ _ (sym_equal H4)); auto with zarith.
- 2: red; simpl; auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_1; intros H2.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_1.
- red; simpl.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite Zmult_1_r.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- rewrite Z2P_correct; auto with zarith.
- rewrite spec_to_N; intros; rewrite Zgcd_div_swap; auto.
- rewrite H; ring.
- intros H3.
- red; simpl.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- assert (F: (0 < BigN.to_Z (q / BigN.gcd (BigZ.to_N p) q)%bigN)%Z).
- rewrite BigN.spec_div; auto with zarith.
- rewrite BigN.spec_gcd.
- apply Zgcd_div_pos; auto.
- rewrite BigN.spec_gcd; auto.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- rewrite Z2P_correct; auto.
- rewrite Z2P_correct; auto.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite spec_to_N; apply Zgcd_div_swap; auto.
- case H1; rewrite spec_to_N; rewrite <- Hp; ring.
- Qed.
-
- Theorem spec_normc: forall n q,
- (0 < BigN.to_Z q)%Z -> [[norm n q]] = [[Qq n (BigN.pred q)]].
- intros n q H; unfold to_Qc, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_norm; auto.
- Qed.
-
- Definition add (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.add zx zy)
- | Qz zx, Qq ny dy => Qq (BigZ.add (BigZ.mul zx (d_to_Z dy)) ny) dy
- | Qq nx dx, Qz zy => Qq (BigZ.add nx (BigZ.mul zy (d_to_Z dx))) dx
- | Qq nx dx, Qq ny dy =>
- let dx' := BigN.succ dx in
- let dy' := BigN.succ dy in
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy')) (BigZ.mul ny (BigZ.Pos dx')) in
- let d := BigN.pred (BigN.mul dx' dy') in
- Qq n d
- end.
-
- Theorem spec_d_to_Z: forall dy,
- (BigZ.to_Z (d_to_Z dy) = BigN.to_Z dy + 1)%Z.
- intros dy; unfold d_to_Z; simpl.
- rewrite BigN.spec_succ; auto.
- Qed.
-
- Theorem spec_succ_pos: forall p,
- (0 < BigN.to_Z (BigN.succ p))%Z.
- intros p; rewrite BigN.spec_succ;
- generalize (BigN.spec_pos p); auto with zarith.
- Qed.
-
- Theorem spec_add x y: ([add x y] == [x] + [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl.
- rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto.
- apply Qeq_refl; auto.
- assert (F1:= BigN.spec_pos dy).
- rewrite Zmult_1_r.
- simpl; rewrite Z2P_correct; rewrite BigN.spec_succ; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul.
- rewrite spec_d_to_Z; apply Qeq_refl.
- assert (F1:= BigN.spec_pos dx).
- rewrite Zmult_1_r; rewrite Pmult_1_r.
- simpl; rewrite Z2P_correct; rewrite BigN.spec_succ; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul.
- rewrite spec_d_to_Z; apply Qeq_refl.
- repeat rewrite BigN.spec_succ.
- assert (Fx: (0 < BigN.to_Z dx + 1)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (Fy: (0 < BigN.to_Z dy + 1)%Z).
- generalize (BigN.spec_pos dy); auto with zarith.
- repeat rewrite BigN.spec_pred.
- rewrite BigZ.spec_add; repeat rewrite BigN.spec_mul;
- repeat rewrite BigN.spec_succ.
- assert (tmp: forall x, (x-1+1 = x)%Z); [intros; ring | rewrite tmp; clear tmp].
- repeat rewrite Z2P_correct; auto.
- repeat rewrite BigZ.spec_mul; simpl.
- repeat rewrite BigN.spec_succ.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto; apply Qeq_refl.
- rewrite BigN.spec_mul; repeat rewrite BigN.spec_succ; auto with zarith.
- apply Zmult_lt_0_compat; auto.
- Qed.
-
- Theorem spec_addc x y: [[add x y]] = [[x]] + [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition add_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.add zx zy)
- | Qz zx, Qq ny dy =>
- let d := BigN.succ dy in
- norm (BigZ.add (BigZ.mul zx (BigZ.Pos d)) ny) d
- | Qq nx dx, Qz zy =>
- let d := BigN.succ dx in
- norm (BigZ.add (BigZ.mul zy (BigZ.Pos d)) nx) d
- | Qq nx dx, Qq ny dy =>
- let dx' := BigN.succ dx in
- let dy' := BigN.succ dy in
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy')) (BigZ.mul ny (BigZ.Pos dx')) in
- let d := BigN.mul dx' dy' in
- norm n d
- end.
-
- Theorem spec_add_norm x y: ([add_norm x y] == [x] + [y])%Q.
- intros x y; rewrite <- spec_add.
- unfold add_norm, add; case x; case y.
- intros; apply Qeq_refl.
- intros p1 n p2.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X (BigN.pred Y)]);
- [apply spec_norm | idtac]
- end.
- rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith.
- simpl.
- repeat rewrite BigZ.spec_add.
- repeat rewrite BigZ.spec_mul; simpl.
- rewrite BigN.succ_pred; try apply Qeq_refl; apply lt_0_succ.
- intros p1 n p2.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X (BigN.pred Y)]);
- [apply spec_norm | idtac]
- end.
- rewrite BigN.spec_succ; generalize (BigN.spec_pos p2); auto with zarith.
- simpl.
- repeat rewrite BigZ.spec_add.
- repeat rewrite BigZ.spec_mul; simpl.
- rewrite BinInt.Zplus_comm.
- rewrite BigN.succ_pred; try apply Qeq_refl; apply lt_0_succ.
- intros p1 q1 p2 q2.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X (BigN.pred Y)]);
- [apply spec_norm | idtac]
- end; try apply Qeq_refl.
- rewrite BigN.spec_mul.
- apply Zmult_lt_0_compat; apply spec_succ_pos.
- Qed.
-
- Theorem spec_add_normc x y: [[add_norm x y]] = [[x]] + [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add_norm.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition sub (x y: t): t := add x (opp y).
-
- Theorem spec_sub x y: ([sub x y] == [x] - [y])%Q.
- intros x y; unfold sub; rewrite spec_add.
- rewrite spec_opp; ring.
- Qed.
-
- Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]].
- intros x y; unfold sub; rewrite spec_addc.
- rewrite spec_oppc; ring.
- Qed.
-
- Definition sub_norm x y := add_norm x (opp y).
-
- Theorem spec_sub_norm x y: ([sub_norm x y] == [x] - [y])%Q.
- intros x y; unfold sub_norm; rewrite spec_add_norm.
- rewrite spec_opp; ring.
- Qed.
-
- Theorem spec_sub_normc x y: [[sub_norm x y]] = [[x]] - [[y]].
- intros x y; unfold sub_norm; rewrite spec_add_normc.
- rewrite spec_oppc; ring.
- Qed.
-
-
- Definition mul (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy
- | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx
- | Qq nx dx, Qq ny dy =>
- Qq (BigZ.mul nx ny) (BigN.pred (BigN.mul (BigN.succ dx) (BigN.succ dy)))
- end.
-
- Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl.
- rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto.
- apply Qeq_refl; auto.
- rewrite BigZ.spec_mul; apply Qeq_refl.
- rewrite BigZ.spec_mul; rewrite Pmult_1_r; auto.
- apply Qeq_refl; auto.
- assert (F1:= spec_succ_pos dx).
- assert (F2:= spec_succ_pos dy).
- rewrite BigN.succ_pred.
- rewrite BigN.spec_mul; rewrite BigZ.spec_mul.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto; apply Qeq_refl.
- rewrite Nspec_lt, BigN.spec_0, BigN.spec_mul; auto.
- apply Zmult_lt_0_compat; apply spec_succ_pos.
- Qed.
-
- Theorem spec_mulc x y: [[mul x y]] = [[x]] * [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition mul_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy =>
- if BigZ.eq_bool zx BigZ.zero then zero
- else
- let d := BigN.succ dy in
- let gcd := BigN.gcd (BigZ.to_N zx) d in
- if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zx ny) dy
- else
- let zx := BigZ.div zx (BigZ.Pos gcd) in
- let d := BigN.div d gcd in
- if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny)
- else Qq (BigZ.mul zx ny) (BigN.pred d)
- | Qq nx dx, Qz zy =>
- if BigZ.eq_bool zy BigZ.zero then zero
- else
- let d := BigN.succ dx in
- let gcd := BigN.gcd (BigZ.to_N zy) d in
- if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zy nx) dx
- else
- let zy := BigZ.div zy (BigZ.Pos gcd) in
- let d := BigN.div d gcd in
- if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx)
- else Qq (BigZ.mul zy nx) (BigN.pred d)
- | Qq nx dx, Qq ny dy =>
- norm (BigZ.mul nx ny) (BigN.mul (BigN.succ dx) (BigN.succ dy))
- end.
-
- Theorem spec_mul_norm x y: ([mul_norm x y] == [x] * [y])%Q.
- intros x y; rewrite <- spec_mul.
- unfold mul_norm, mul; case x; case y.
- intros; apply Qeq_refl.
- intros p1 n p2.
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H.
- rewrite BigZ.spec_mul; rewrite H; red; auto.
- assert (F: (0 < BigN.to_Z (BigZ.to_N p2))%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto.
- intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring.
- assert (F1: (0 < BigN.to_Z (BigN.succ n))%Z).
- rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith.
- assert (F2: (0 < Zgcd (BigN.to_Z (BigZ.to_N p2)) (BigN.to_Z (BigN.succ n)))%Z).
- case (Zle_lt_or_eq _ _ (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p2))
- (BigN.to_Z (BigN.succ n)))); intros H3; auto.
- generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; intros H1.
- intros; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd;
- auto with zarith.
- intros H2.
- red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite spec_to_N.
- rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p1)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- intros H2.
- red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite (spec_to_N p2).
- case (Zle_lt_or_eq _ _
- (BigN.spec_pos (BigN.succ n /
- BigN.gcd (BigZ.to_N p2)
- (BigN.succ n)))%bigN); intros F3.
- rewrite BigN.succ_pred; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p1)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto; try ring.
- rewrite Nspec_lt, BigN.spec_0; auto.
- apply False_ind; generalize F1.
- rewrite (Zdivide_Zdiv_eq
- (Zgcd (BigN.to_Z (BigZ.to_N p2)) (BigN.to_Z (BigN.succ n)))
- (BigN.to_Z (BigN.succ n))); auto.
- generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd;
- auto with zarith.
- intros HH; rewrite <- HH; auto with zarith.
- assert (FF:= Zgcd_is_gcd (BigN.to_Z (BigZ.to_N p2))
- (BigN.to_Z (BigN.succ n))); inversion FF; auto.
- intros p1 p2 n.
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H.
- rewrite BigZ.spec_mul; rewrite H; red; simpl; ring.
- assert (F: (0 < BigN.to_Z (BigZ.to_N p1))%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto.
- intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring.
- assert (F1: (0 < BigN.to_Z (BigN.succ n))%Z).
- rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith.
- assert (F2: (0 < Zgcd (BigN.to_Z (BigZ.to_N p1)) (BigN.to_Z (BigN.succ n)))%Z).
- case (Zle_lt_or_eq _ _ (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p1))
- (BigN.to_Z (BigN.succ n)))); intros H3; auto.
- generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; intros H1.
- intros; repeat rewrite BigZ.spec_mul; rewrite Zmult_comm; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd;
- auto with zarith.
- intros H2.
- red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite spec_to_N.
- rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p2)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- intros H2.
- red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite (spec_to_N p1).
- case (Zle_lt_or_eq _ _
- (BigN.spec_pos (BigN.succ n /
- BigN.gcd (BigZ.to_N p1)
- (BigN.succ n)))%bigN); intros F3.
- rewrite BigN.succ_pred; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p2)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto; try ring.
- rewrite Nspec_lt, BigN.spec_0; auto.
- apply False_ind; generalize F1.
- rewrite (Zdivide_Zdiv_eq
- (Zgcd (BigN.to_Z (BigZ.to_N p1)) (BigN.to_Z (BigN.succ n)))
- (BigN.to_Z (BigN.succ n))); auto.
- generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd;
- auto with zarith.
- intros HH; rewrite <- HH; auto with zarith.
- assert (FF:= Zgcd_is_gcd (BigN.to_Z (BigZ.to_N p1))
- (BigN.to_Z (BigN.succ n))); inversion FF; auto.
- intros p1 n1 p2 n2.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X (BigN.pred Y)]);
- [apply spec_norm | idtac]
- end; try apply Qeq_refl.
- rewrite BigN.spec_mul.
- apply Zmult_lt_0_compat; rewrite BigN.spec_succ;
- generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith.
- Qed.
-
- Theorem spec_mul_normc x y: [[mul_norm x y]] = [[x]] * [[y]].
- intros x y; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul_norm.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition inv (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) =>
- if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one (BigN.pred n)
- | Qz (BigZ.Neg n) =>
- if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one (BigN.pred n)
- | Qq (BigZ.Pos n) d =>
- if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos (BigN.succ d)) (BigN.pred n)
- | Qq (BigZ.Neg n) d =>
- if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg (BigN.succ d)) (BigN.pred n)
- end.
-
- Theorem spec_inv x: ([inv x] == /[x])%Q.
- intros [ [x | x] | [nx | nx] dx]; unfold inv.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z x)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith.
- unfold to_Q; rewrite BigZ.spec_1.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- red; unfold Qinv; simpl.
- generalize F; case BigN.to_Z; auto with zarith.
- intros p Hp; discriminate Hp.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z x)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith.
- red; unfold Qinv; simpl.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- generalize F; case BigN.to_Z; simpl; auto with zarith.
- intros p Hp; discriminate Hp.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z nx)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith.
- red; unfold Qinv; simpl.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- rewrite BigN.spec_succ; rewrite Z2P_correct; auto with zarith.
- generalize F; case BigN.to_Z; auto with zarith.
- intros p Hp; discriminate Hp.
- generalize (BigN.spec_pos dx); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z nx)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith.
- red; unfold Qinv; simpl.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- rewrite BigN.spec_succ; rewrite Z2P_correct; auto with zarith.
- generalize F; case BigN.to_Z; auto with zarith.
- simpl; intros.
- match goal with |- (?X = Zneg ?Y)%Z =>
- replace (Zneg Y) with (-(Zpos Y))%Z;
- try rewrite Z2P_correct; auto with zarith
- end.
- rewrite Zpos_mult_morphism;
- rewrite Z2P_correct; auto with zarith; try ring.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p Hp; discriminate Hp.
- generalize (BigN.spec_pos dx); auto with zarith.
- Qed.
-
- Theorem spec_invc x: [[inv x]] = /[[x]].
- intros x; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-Definition inv_norm x :=
- match x with
- | Qz (BigZ.Pos n) =>
- if BigN.eq_bool n BigN.zero then zero else
- if BigN.eq_bool n BigN.one then x else Qq BigZ.one (BigN.pred n)
- | Qz (BigZ.Neg n) =>
- if BigN.eq_bool n BigN.zero then zero else
- if BigN.eq_bool n BigN.one then x else Qq BigZ.minus_one (BigN.pred n)
- | Qq (BigZ.Pos n) d => let d := BigN.succ d in
- if BigN.eq_bool n BigN.zero then zero else
- if BigN.eq_bool n BigN.one then Qz (BigZ.Pos d)
- else Qq (BigZ.Pos d) (BigN.pred n)
- | Qq (BigZ.Neg n) d => let d := BigN.succ d in
- if BigN.eq_bool n BigN.zero then zero else
- if BigN.eq_bool n BigN.one then Qz (BigZ.Neg d)
- else Qq (BigZ.Neg d) (BigN.pred n)
- end.
-
- Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q.
- intros x; rewrite <- spec_inv.
- (case x; clear x); [intros [x | x] | intros nx dx];
- unfold inv_norm, inv.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- apply Qeq_refl.
- assert (F: (0 < BigN.to_Z x)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; intros H1.
- red; simpl.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- rewrite Z2P_correct; try rewrite H1; auto with zarith.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- apply Qeq_refl.
- assert (F: (0 < BigN.to_Z x)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; intros H1.
- red; simpl.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- rewrite Z2P_correct; try rewrite H1; auto with zarith.
- apply Qeq_refl.
- case nx; clear nx; intros nx.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; intros H1.
- red; simpl.
- rewrite BigN.succ_pred; try rewrite H1; auto with zarith.
- rewrite Nspec_lt, BigN.spec_0, H1; auto with zarith.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; intros H1.
- red; simpl.
- rewrite BigN.succ_pred; try rewrite H1; auto with zarith.
- rewrite Nspec_lt, BigN.spec_0, H1; auto with zarith.
- apply Qeq_refl.
- Qed.
-
-
- Definition div x y := mul x (inv y).
-
- Theorem spec_div x y: ([div x y] == [x] / [y])%Q.
- intros x y; unfold div; rewrite spec_mul; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]].
- intros x y; unfold div; rewrite spec_mulc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
- Definition div_norm x y := mul_norm x (inv y).
-
- Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q.
- intros x y; unfold div_norm; rewrite spec_mul_norm; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- Qed.
-
- Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]].
- intros x y; unfold div_norm; rewrite spec_mul_normc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- Qed.
-
-
- Definition square (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.square zx)
- | Qq nx dx => Qq (BigZ.square nx) (BigN.pred (BigN.square (BigN.succ dx)))
- end.
-
- Theorem spec_square x: ([square x] == [x] ^ 2)%Q.
- intros [ x | nx dx]; unfold square.
- red; simpl; rewrite BigZ.spec_square; auto with zarith.
- red; simpl; rewrite BigZ.spec_square; auto with zarith.
- assert (F: (0 < BigN.to_Z (BigN.succ dx))%Z).
- rewrite BigN.spec_succ;
- case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith.
- assert (F1 : (0 < BigN.to_Z (BigN.square (BigN.succ dx)))%Z).
- rewrite BigN.spec_square; apply Zmult_lt_0_compat;
- auto with zarith.
- rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto).
- rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto with zarith.
- repeat rewrite BigN.spec_succ; auto with zarith.
- rewrite BigN.spec_square; auto with zarith.
- repeat rewrite BigN.spec_succ; auto with zarith.
- Qed.
-
- Theorem spec_squarec x: [[square x]] = [[x]]^2.
- intros x; unfold to_Qc.
- apply trans_equal with (!! ([x]^2)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_square.
- simpl Qcpower.
- replace (!! [x] * 1) with (!![x]); try ring.
- simpl.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition power_pos (x: t) p: t :=
- match x with
- | Qz zx => Qz (BigZ.power_pos zx p)
- | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.pred (BigN.power_pos (BigN.succ dx) p))
- end.
-
-
- Theorem spec_power_pos x p: ([power_pos x p] == [x] ^ Zpos p)%Q.
- Proof.
- intros [x | nx dx] p; unfold power_pos.
- unfold power_pos; red; simpl.
- generalize (Qpower_decomp p (BigZ.to_Z x) 1).
- unfold Qeq; simpl.
- rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Zmult_1_r.
- intros H; rewrite H.
- rewrite BigZ.spec_power_pos; simpl; ring.
- assert (F1: (0 < BigN.to_Z (BigN.succ dx))%Z).
- rewrite BigN.spec_succ;
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (F2: (0 < BigN.to_Z (BigN.succ dx) ^ ' p)%Z).
- unfold Zpower; apply Zpower_pos_pos; auto.
- unfold power_pos; red; simpl.
- rewrite BigN.succ_pred, BigN.spec_power_pos.
- rewrite Z2P_correct; auto.
- generalize (Qpower_decomp p (BigZ.to_Z nx)
- (Z2P (BigN.to_Z (BigN.succ dx)))).
- unfold Qeq; simpl.
- repeat rewrite Z2P_correct; auto.
- unfold Qeq; simpl; intros HH.
- rewrite HH.
- rewrite BigZ.spec_power_pos; simpl; ring.
- rewrite Nspec_lt, BigN.spec_0, BigN.spec_power_pos; auto.
- Qed.
-
- Theorem spec_power_posc x p: [[power_pos x p]] = [[x]] ^ nat_of_P p.
- intros x p; unfold to_Qc.
- apply trans_equal with (!! ([x]^Zpos p)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_power_pos.
- pattern p; apply Pind; clear p.
- simpl; ring.
- intros p Hrec.
- rewrite nat_of_P_succ_morphism; simpl Qcpower.
- rewrite <- Hrec.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _;
- unfold this.
- apply Qred_complete.
- assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p).
- simpl; case x; simpl; clear x Hrec.
- intros x; simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- intros nx dx; simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- assert (F1: (0 < BigN.to_Z (BigN.succ dx))%Z).
- rewrite BigN.spec_succ; generalize (BigN.spec_pos dx);
- auto with zarith.
- repeat rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto.
- 2: apply Zpower_pos_pos; auto.
- 2: apply Zpower_pos_pos; auto.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- rewrite F.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
-End Qp.
diff --git a/theories/Numbers/Rational/BigQ/QvMake.v b/theories/Numbers/Rational/BigQ/QvMake.v
deleted file mode 100644
index 4523e241..00000000
--- a/theories/Numbers/Rational/BigQ/QvMake.v
+++ /dev/null
@@ -1,1151 +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 *)
-(************************************************************************)
-(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *)
-(************************************************************************)
-
-(*i $Id: QvMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*)
-
-Require Import Bool.
-Require Import ZArith.
-Require Import Znumtheory.
-Require Import BigNumPrelude.
-Require Import Arith.
-Require Export BigN.
-Require Export BigZ.
-Require Import QArith.
-Require Import Qcanon.
-Require Import Qpower.
-Require Import QMake_base.
-
-Module Qv.
-
- Import BinInt Zorder.
- Open Local Scope Q_scope.
- Open Local Scope Qc_scope.
-
- (** The notation of a rational number is either an integer x,
- interpreted as itself or a pair (x,y) of an integer x and a naturel
- number y interpreted as x/y. All functions maintain the invariant
- that y is never zero. *)
-
- Definition t := q_type.
-
- Definition zero: t := Qz BigZ.zero.
- Definition one: t := Qz BigZ.one.
- Definition minus_one: t := Qz BigZ.minus_one.
-
- Definition of_Z x: t := Qz (BigZ.of_Z x).
-
- Definition wf x :=
- match x with
- | Qz _ => True
- | Qq n d => if BigN.eq_bool d BigN.zero then False else True
- end.
-
- Definition of_Q q: t :=
- match q with x # y =>
- Qq (BigZ.of_Z x) (BigN.of_N (Npos y))
- end.
-
- Definition of_Qc q := of_Q (this q).
-
- Definition to_Q (q: t) :=
- match q with
- Qz x => BigZ.to_Z x # 1
- |Qq x y => BigZ.to_Z x # Z2P (BigN.to_Z y)
- end.
-
- Definition to_Qc q := !!(to_Q q).
-
- Notation "[[ x ]]" := (to_Qc x).
-
- Notation "[ x ]" := (to_Q x).
-
- Theorem spec_to_Q: forall q: Q, [of_Q q] = q.
- intros (x,y); simpl.
- rewrite BigZ.spec_of_Z; simpl.
- rewrite (BigN.spec_of_pos); auto.
- Qed.
-
- Theorem spec_to_Qc: forall q, [[of_Qc q]] = q.
- intros (x, Hx); unfold of_Qc, to_Qc; simpl.
- apply Qc_decomp; simpl.
- intros; rewrite spec_to_Q; auto.
- Qed.
-
- Definition opp (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.opp zx)
- | Qq nx dx => Qq (BigZ.opp nx) dx
- end.
-
- Theorem wf_opp: forall x, wf x -> wf (opp x).
- intros [zx | nx dx]; unfold opp, wf; auto.
- Qed.
-
- Theorem spec_opp: forall q, ([opp q] = -[q])%Q.
- intros [z | x y]; simpl.
- rewrite BigZ.spec_opp; auto.
- rewrite BigZ.spec_opp; auto.
- Qed.
-
- Theorem spec_oppc: forall q, [[opp q]] = -[[q]].
- intros q; unfold Qcopp, to_Qc, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- rewrite spec_opp.
- rewrite <- Qred_opp.
- rewrite Qred_involutive; auto.
- Qed.
-
- (* Les fonctions doivent assurer que si leur arguments sont valides alors
- le resultat est correct et valide (si c'est un Q)
- *)
-
- Definition compare (x y: t) :=
- match x, y with
- | Qz zx, Qz zy => BigZ.compare zx zy
- | Qz zx, Qq ny dy => BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny
- | Qq nx dx, Qz zy => BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx))
- | Qq nx dx, Qq ny dy => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx))
- end.
-
- Theorem spec_compare: forall q1 q2, wf q1 -> wf q2 ->
- compare q1 q2 = ([q1] ?= [q2])%Q.
- intros [z1 | x1 y1] [z2 | x2 y2];
- unfold Qcompare, compare, to_Q, Qnum, Qden, wf.
- repeat rewrite Zmult_1_r.
- generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- rewrite Zmult_1_r.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool.
- intros _ _ HH; case HH.
- rewrite BigN.spec_0; intros HH _ _.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare;
- rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH _ _.
- rewrite Z2P_correct; auto with zarith.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- rewrite Zmult_1_r.
- generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare;
- rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- generalize (BigN.spec_eq_bool y1 BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH1.
- generalize (BigN.spec_eq_bool y2 BigN.zero);
- case BigN.eq_bool.
- intros _ _ HH; case HH.
- rewrite BigN.spec_0; intros HH2 _ _.
- repeat rewrite Z2P_correct.
- 2: generalize (BigN.spec_pos y1); auto with zarith.
- 2: generalize (BigN.spec_pos y2); auto with zarith.
- generalize (BigZ.spec_compare (x1 * BigZ.Pos y2)
- (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare;
- repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto.
- rewrite H; rewrite Zcompare_refl; auto.
- Qed.
-
- Theorem spec_comparec: forall q1 q2, wf q1 -> wf q2 ->
- compare q1 q2 = ([[q1]] ?= [[q2]]).
- unfold Qccompare, to_Qc.
- intros q1 q2 Hq1 Hq2; rewrite spec_compare; simpl; auto.
- apply Qcompare_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition norm n d: t :=
- if BigZ.eq_bool n BigZ.zero then zero
- else
- let gcd := BigN.gcd (BigZ.to_N n) d in
- if BigN.eq_bool gcd BigN.one then Qq n d
- else
- let n := BigZ.div n (BigZ.Pos gcd) in
- let d := BigN.div d gcd in
- if BigN.eq_bool d BigN.one then Qz n
- else Qq n d.
-
- Theorem wf_norm: forall n q,
- (BigN.to_Z q <> 0)%Z -> wf (norm n q).
- intros p q; unfold norm, wf; intros Hq.
- assert (Hp := BigN.spec_pos (BigZ.to_N p)).
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; auto; rewrite BigZ.spec_0; intros H1.
- simpl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_1.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- set (a := BigN.to_Z (BigZ.to_N p)).
- set (b := (BigN.to_Z q)).
- assert (F: (0 < Zgcd a b)%Z).
- case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto.
- intros HH1; case Hq; apply (Zgcd_inv_0_r _ _ (sym_equal HH1)).
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto; fold a; fold b.
- intros H; case Hq; fold b.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite H; auto with zarith.
- assert (F1:= Zgcd_is_gcd a b); inversion F1; auto.
- Qed.
-
- Theorem spec_norm: forall n q,
- ((0 < BigN.to_Z q)%Z -> [norm n q] == [Qq n q])%Q.
- intros p q; unfold norm; intros Hq.
- assert (Hp := BigN.spec_pos (BigZ.to_N p)).
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; auto; rewrite BigZ.spec_0; intros H1.
- red; simpl; rewrite H1; ring.
- case (Zle_lt_or_eq _ _ Hp); clear Hp; intros Hp.
- case (Zle_lt_or_eq _ _
- (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p)) (BigN.to_Z q))); intros H4.
- 2: generalize Hq; rewrite (Zgcd_inv_0_r _ _ (sym_equal H4)); auto with zarith.
- 2: red; simpl; auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_1; intros H2.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_1.
- red; simpl.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite Zmult_1_r.
- rewrite Z2P_correct; auto with zarith.
- rewrite spec_to_N; intros; rewrite Zgcd_div_swap; auto.
- rewrite H; ring.
- intros H3.
- red; simpl.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- assert (F: (0 < BigN.to_Z (q / BigN.gcd (BigZ.to_N p) q)%bigN)%Z).
- rewrite BigN.spec_div; auto with zarith.
- rewrite BigN.spec_gcd.
- apply Zgcd_div_pos; auto.
- rewrite BigN.spec_gcd; auto.
- rewrite Z2P_correct; auto.
- rewrite Z2P_correct; auto.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith.
- rewrite spec_to_N; apply Zgcd_div_swap; auto.
- case H1; rewrite spec_to_N; rewrite <- Hp; ring.
- Qed.
-
- Theorem spec_normc: forall n q,
- (0 < BigN.to_Z q)%Z -> [[norm n q]] = [[Qq n q]].
- intros n q H; unfold to_Qc, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_norm; auto.
- Qed.
-
- Definition add (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.add zx zy)
- | Qz zx, Qq ny dy => Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- | Qq nx dx, Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx
- | Qq nx dx, Qq ny dy =>
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- Qq n d
- end.
-
- Theorem wf_add: forall x y, wf x -> wf y -> wf (add x y).
- intros [zx | nx dx] [zy | ny dy]; unfold add, wf; auto.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul.
- intros H1 H2 H3.
- case (Zmult_integral _ _ H1); auto with zarith.
- Qed.
-
- Theorem spec_add x y: wf x -> wf y ->
- ([add x y] == [x] + [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl.
- rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- assert (F1:= BigN.spec_pos dy).
- rewrite Zmult_1_r.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool.
- intros _ _ HH; case HH.
- rewrite BigN.spec_0; intros HH _ _.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul.
- simpl; apply Qeq_refl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH _ _.
- assert (F1:= BigN.spec_pos dx).
- rewrite Zmult_1_r; rewrite Pmult_1_r.
- simpl; rewrite Z2P_correct; auto with zarith.
- rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl.
- apply Qeq_refl.
- generalize (BigN.spec_eq_bool dx BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH1.
- generalize (BigN.spec_eq_bool dy BigN.zero);
- case BigN.eq_bool.
- intros _ _ HH; case HH.
- rewrite BigN.spec_0; intros HH2 _ _.
- assert (Fx: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (Fy: (0 < BigN.to_Z dy)%Z).
- generalize (BigN.spec_pos dy); auto with zarith.
- rewrite BigZ.spec_add; repeat rewrite BigN.spec_mul.
- red; simpl.
- rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto.
- repeat rewrite BigZ.spec_mul; simpl; auto.
- apply Zmult_lt_0_compat; auto.
- Qed.
-
- Theorem spec_addc x y: wf x -> wf y ->
- [[add x y]] = [[x]] + [[y]].
- intros x y H1 H2; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition add_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.add zx zy)
- | Qz zx, Qq ny dy =>
- norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy
- | Qq nx dx, Qz zy =>
- norm (BigZ.add (BigZ.mul zy (BigZ.Pos dx)) nx) dx
- | Qq nx dx, Qq ny dy =>
- let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in
- let d := BigN.mul dx dy in
- norm n d
- end.
-
- Theorem wf_add_norm: forall x y, wf x -> wf y -> wf (add_norm x y).
- intros [zx | nx dx] [zy | ny dy]; unfold add_norm; auto.
- intros HH1 HH2; apply wf_norm.
- generalize HH2; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- intros HH1 HH2; apply wf_norm.
- generalize HH1; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- intros HH1 HH2; apply wf_norm.
- rewrite BigN.spec_mul; intros HH3.
- case (Zmult_integral _ _ HH3).
- generalize HH1; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- generalize HH2; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- Qed.
-
- Theorem spec_add_norm x y: wf x -> wf y ->
- ([add_norm x y] == [x] + [y])%Q.
- intros x y H1 H2; rewrite <- spec_add; auto.
- generalize H1 H2; unfold add_norm, add, wf; case x; case y; clear H1 H2.
- intros; apply Qeq_refl.
- intros p1 n p2 _.
- generalize (BigN.spec_eq_bool n BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH _.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- generalize (BigN.spec_pos n); auto with zarith.
- simpl.
- repeat rewrite BigZ.spec_add.
- repeat rewrite BigZ.spec_mul; simpl.
- apply Qeq_refl.
- intros p1 n p2.
- generalize (BigN.spec_eq_bool p2 BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH _ _.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end.
- generalize (BigN.spec_pos p2); auto with zarith.
- simpl.
- repeat rewrite BigZ.spec_add.
- repeat rewrite BigZ.spec_mul; simpl.
- rewrite Zplus_comm.
- apply Qeq_refl.
- intros p1 q1 p2 q2.
- generalize (BigN.spec_eq_bool q2 BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH1 _.
- generalize (BigN.spec_eq_bool q1 BigN.zero);
- case BigN.eq_bool.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH2 _.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end; try apply Qeq_refl.
- rewrite BigN.spec_mul.
- apply Zmult_lt_0_compat.
- generalize (BigN.spec_pos q2); auto with zarith.
- generalize (BigN.spec_pos q1); auto with zarith.
- Qed.
-
- Theorem spec_add_normc x y: wf x -> wf y ->
- [[add_norm x y]] = [[x]] + [[y]].
- intros x y Hx Hy; unfold to_Qc.
- apply trans_equal with (!! ([x] + [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_add_norm; auto.
- unfold Qcplus, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qplus_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition sub x y := add x (opp y).
-
- Theorem wf_sub x y: wf x -> wf y -> wf (sub x y).
- intros x y Hx Hy; unfold sub; apply wf_add; auto.
- apply wf_opp; auto.
- Qed.
-
- Theorem spec_sub x y: wf x -> wf y ->
- ([sub x y] == [x] - [y])%Q.
- intros x y Hx Hy; unfold sub; rewrite spec_add; auto.
- rewrite spec_opp; ring.
- apply wf_opp; auto.
- Qed.
-
- Theorem spec_subc x y: wf x -> wf y ->
- [[sub x y]] = [[x]] - [[y]].
- intros x y Hx Hy; unfold sub; rewrite spec_addc; auto.
- rewrite spec_oppc; ring.
- apply wf_opp; auto.
- Qed.
-
- Definition sub_norm x y := add_norm x (opp y).
-
- Theorem wf_sub_norm x y: wf x -> wf y -> wf (sub_norm x y).
- intros x y Hx Hy; unfold sub_norm; apply wf_add_norm; auto.
- apply wf_opp; auto.
- Qed.
-
- Theorem spec_sub_norm x y: wf x -> wf y ->
- ([sub_norm x y] == [x] - [y])%Q.
- intros x y Hx Hy; unfold sub_norm; rewrite spec_add_norm; auto.
- rewrite spec_opp; ring.
- apply wf_opp; auto.
- Qed.
-
- Theorem spec_sub_normc x y: wf x -> wf y ->
- [[sub_norm x y]] = [[x]] - [[y]].
- intros x y Hx Hy; unfold sub_norm; rewrite spec_add_normc; auto.
- rewrite spec_oppc; ring.
- apply wf_opp; auto.
- Qed.
-
- Definition mul (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy
- | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx
- | Qq nx dx, Qq ny dy =>
- Qq (BigZ.mul nx ny) (BigN.mul dx dy)
- end.
-
- Theorem wf_mul: forall x y, wf x -> wf y -> wf (mul x y).
- intros [zx | nx dx] [zy | ny dy]; unfold mul, wf; auto.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul.
- intros H1 H2 H3.
- case (Zmult_integral _ _ H1); auto with zarith.
- Qed.
-
- Theorem spec_mul x y: wf x -> wf y -> ([mul x y] == [x] * [y])%Q.
- intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl.
- rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto.
- intros; apply Qeq_refl; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- intros _ _ HH; case HH.
- rewrite BigN.spec_0; intros HH1 _ _.
- rewrite BigZ.spec_mul; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- intros _ HH; case HH.
- rewrite BigN.spec_0; intros HH1 _ _.
- rewrite BigZ.spec_mul; rewrite Pmult_1_r.
- apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- intros _ HH; case HH.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- intros _ _ _ HH; case HH.
- rewrite BigN.spec_0; intros H1 H2 _ _.
- rewrite BigZ.spec_mul; rewrite BigN.spec_mul.
- assert (tmp:
- (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z).
- intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith.
- rewrite tmp; auto.
- apply Qeq_refl.
- generalize (BigN.spec_pos dx); auto with zarith.
- generalize (BigN.spec_pos dy); auto with zarith.
- Qed.
-
- Theorem spec_mulc x y: wf x -> wf y ->
- [[mul x y]] = [[x]] * [[y]].
- intros x y Hx Hy; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition mul_norm (x y: t): t :=
- match x, y with
- | Qz zx, Qz zy => Qz (BigZ.mul zx zy)
- | Qz zx, Qq ny dy =>
- if BigZ.eq_bool zx BigZ.zero then zero
- else
- let gcd := BigN.gcd (BigZ.to_N zx) dy in
- if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zx ny) dy
- else
- let zx := BigZ.div zx (BigZ.Pos gcd) in
- let d := BigN.div dy gcd in
- if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny)
- else Qq (BigZ.mul zx ny) d
- | Qq nx dx, Qz zy =>
- if BigZ.eq_bool zy BigZ.zero then zero
- else
- let gcd := BigN.gcd (BigZ.to_N zy) dx in
- if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zy nx) dx
- else
- let zy := BigZ.div zy (BigZ.Pos gcd) in
- let d := BigN.div dx gcd in
- if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx)
- else Qq (BigZ.mul zy nx) d
- | Qq nx dx, Qq ny dy => norm (BigZ.mul nx ny) (BigN.mul dx dy)
- end.
-
- Theorem wf_mul_norm: forall x y, wf x -> wf y -> wf (mul_norm x y).
- intros [zx | nx dx] [zy | ny dy]; unfold mul_norm; auto.
- intros HH1 HH2.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto;
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- rewrite BigN.spec_1; rewrite BigZ.spec_0.
- intros H1 H2; unfold wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- rewrite BigN.spec_0.
- set (a := BigN.to_Z (BigZ.to_N zx)).
- set (b := (BigN.to_Z dy)).
- assert (F: (0 < Zgcd a b)%Z).
- case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto.
- intros HH3; case H2; rewrite spec_to_N; fold a.
- rewrite (Zgcd_inv_0_l _ _ (sym_equal HH3)); try ring.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto.
- intros H.
- generalize HH2; simpl wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- rewrite BigN.spec_0; intros HH; case HH; fold b.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite H; auto with zarith.
- assert (F1:= Zgcd_is_gcd a b); inversion F1; auto.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- rewrite BigN.spec_1; rewrite BigN.spec_gcd.
- intros HH1 H1 H2.
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; auto.
- rewrite BigN.spec_1; rewrite BigN.spec_gcd.
- intros HH1 H1 H2.
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; auto.
- rewrite BigZ.spec_0.
- intros HH2.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- set (a := BigN.to_Z (BigZ.to_N zy)).
- set (b := (BigN.to_Z dx)).
- assert (F: (0 < Zgcd a b)%Z).
- case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto.
- intros HH3; case HH2; rewrite spec_to_N; fold a.
- rewrite (Zgcd_inv_0_l _ _ (sym_equal HH3)); try ring.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto.
- intros H; unfold wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- rewrite BigN.spec_0.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto.
- intros HH; generalize H1; simpl wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- rewrite BigN.spec_0.
- intros HH3; case HH3; fold b.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite HH; auto with zarith.
- assert (F1:= Zgcd_is_gcd a b); inversion F1; auto.
- intros HH1 HH2; apply wf_norm.
- rewrite BigN.spec_mul; intros HH3.
- case (Zmult_integral _ _ HH3).
- generalize HH1; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- generalize HH2; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- Qed.
-
- Theorem spec_mul_norm x y: wf x -> wf y ->
- ([mul_norm x y] == [x] * [y])%Q.
- intros x y Hx Hy; rewrite <- spec_mul; auto.
- unfold mul_norm, mul; generalize Hx Hy; case x; case y; clear Hx Hy.
- intros; apply Qeq_refl.
- intros p1 n p2 Hx Hy.
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H.
- rewrite BigZ.spec_mul; rewrite H; red; auto.
- assert (F: (0 < BigN.to_Z (BigZ.to_N p2))%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto.
- intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring.
- assert (F1: (0 < BigN.to_Z n)%Z).
- generalize Hy; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto.
- intros _ HH; case HH.
- rewrite BigN.spec_0; generalize (BigN.spec_pos n); auto with zarith.
- set (a := BigN.to_Z (BigZ.to_N p2)).
- set (b := BigN.to_Z n).
- assert (F2: (0 < Zgcd a b )%Z).
- case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); intros H3; auto.
- generalize F; fold a; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; try rewrite BigN.spec_gcd;
- fold a b; intros H1.
- intros; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd;
- auto with zarith; fold a b; intros H2.
- red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite spec_to_N; fold a; fold b.
- rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p1)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- intros H2; red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite Z2P_correct; auto with zarith.
- rewrite (spec_to_N p2); fold a b.
- rewrite Z2P_correct; auto with zarith.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p1)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto; try ring.
- case (Zle_lt_or_eq _ _
- (BigN.spec_pos (n /
- BigN.gcd (BigZ.to_N p2)
- n))%bigN);
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- intros H3.
- apply False_ind; generalize F1.
- generalize Hy; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; auto with zarith.
- intros HH; case HH; fold b.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- rewrite <- H3; ring.
- assert (FF:= Zgcd_is_gcd a b); inversion FF; auto.
- intros p1 p2 n Hx Hy.
- match goal with |- context[BigZ.eq_bool ?X ?Y] =>
- generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool
- end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H.
- rewrite BigZ.spec_mul; rewrite H; red; simpl; ring.
- set (a := BigN.to_Z (BigZ.to_N p1)).
- set (b := BigN.to_Z n).
- assert (F: (0 < a)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto.
- intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring.
- assert (F1: (0 < b)%Z).
- generalize Hx; unfold wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; auto with zarith.
- generalize (BigN.spec_pos n); fold b; auto with zarith.
- assert (F2: (0 < Zgcd a b)%Z).
- case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); intros H3; auto.
- generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; fold a b; intros H1.
- intros; repeat rewrite BigZ.spec_mul; rewrite Zmult_comm; apply Qeq_refl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_1.
- rewrite BigN.spec_div; rewrite BigN.spec_gcd;
- auto with zarith.
- fold a b; intros H2.
- red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite spec_to_N; fold a b.
- rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p2)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto with zarith.
- rewrite H2; ring.
- intros H2.
- red; simpl.
- repeat rewrite BigZ.spec_mul.
- rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- rewrite Z2P_correct; auto with zarith.
- rewrite (spec_to_N p1); fold a b.
- case (Zle_lt_or_eq _ _
- (BigN.spec_pos (n / BigN.gcd (BigZ.to_N p1) n))%bigN); intros F3.
- rewrite Z2P_correct; auto with zarith.
- rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd;
- fold a b; auto with zarith.
- repeat rewrite <- Zmult_assoc.
- rewrite (Zmult_comm (BigZ.to_Z p2)).
- repeat rewrite Zmult_assoc.
- rewrite Zgcd_div_swap; auto; try ring.
- apply False_ind; generalize F1.
- rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto.
- generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b;
- auto with zarith.
- intros HH; rewrite <- HH; auto with zarith.
- assert (FF:= Zgcd_is_gcd a b); inversion FF; auto.
- intros p1 n1 p2 n2 Hn1 Hn2.
- match goal with |- [norm ?X ?Y] == _ =>
- apply Qeq_trans with ([Qq X Y]);
- [apply spec_norm | idtac]
- end; try apply Qeq_refl.
- rewrite BigN.spec_mul.
- apply Zmult_lt_0_compat.
- generalize Hn1; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; auto with zarith.
- generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith.
- generalize Hn2; simpl.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; auto with zarith.
- generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith.
- Qed.
-
- Theorem spec_mul_normc x y: wf x -> wf y ->
- [[mul_norm x y]] = [[x]] * [[y]].
- intros x y Hx Hy; unfold to_Qc.
- apply trans_equal with (!! ([x] * [y])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_mul_norm; auto.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
- Definition inv (x: t): t :=
- match x with
- | Qz (BigZ.Pos n) =>
- if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one n
- | Qz (BigZ.Neg n) =>
- if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one n
- | Qq (BigZ.Pos n) d =>
- if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos d) n
- | Qq (BigZ.Neg n) d =>
- if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg d) n
- end.
-
-
- Theorem wf_inv: forall x, wf x -> wf (inv x).
- intros [ zx | nx dx]; unfold inv, wf; auto.
- case zx; clear zx.
- intros nx.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul.
- intros nx.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- intros _ HH; case HH.
- intros H1 _.
- case nx; clear nx.
- intros nx.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; simpl; auto.
- intros nx.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; simpl; auto.
- Qed.
-
- Theorem spec_inv x: wf x ->
- ([inv x] == /[x])%Q.
- intros [ [x | x] _ | [nx | nx] dx]; unfold inv.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z x)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith.
- unfold to_Q; rewrite BigZ.spec_1.
- red; unfold Qinv; simpl.
- generalize F; case BigN.to_Z; auto with zarith.
- intros p Hp; discriminate Hp.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z x)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith.
- red; unfold Qinv; simpl.
- generalize F; case BigN.to_Z; simpl; auto with zarith.
- intros p Hp; discriminate Hp.
- simpl wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1.
- intros HH; case HH.
- intros _.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z nx)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith.
- red; unfold Qinv; simpl.
- rewrite Z2P_correct; auto with zarith.
- generalize F; case BigN.to_Z; auto with zarith.
- intros p Hp; discriminate Hp.
- generalize (BigN.spec_pos dx); auto with zarith.
- simpl wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H1.
- intros HH; case HH.
- intros _.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; rewrite BigN.spec_0; intros H.
- unfold zero, to_Q; rewrite BigZ.spec_0.
- unfold BigZ.to_Z; rewrite H; apply Qeq_refl.
- assert (F: (0 < BigN.to_Z nx)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith.
- red; unfold Qinv; simpl.
- rewrite Z2P_correct; auto with zarith.
- generalize F; case BigN.to_Z; auto with zarith.
- simpl; intros.
- match goal with |- (?X = Zneg ?Y)%Z =>
- replace (Zneg Y) with (Zopp (Zpos Y));
- try rewrite Z2P_correct; auto with zarith
- end.
- rewrite Zpos_mult_morphism;
- rewrite Z2P_correct; auto with zarith; try ring.
- generalize (BigN.spec_pos dx); auto with zarith.
- intros p Hp; discriminate Hp.
- generalize (BigN.spec_pos dx); auto with zarith.
- Qed.
-
- Theorem spec_invc x: wf x ->
- [[inv x]] = /[[x]].
- intros x Hx; unfold to_Qc.
- apply trans_equal with (!! (/[x])).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_inv; auto.
- unfold Qcinv, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qinv_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
- Definition div x y := mul x (inv y).
-
- Theorem wf_div x y: wf x -> wf y -> wf (div x y).
- intros x y Hx Hy; unfold div; apply wf_mul; auto.
- apply wf_inv; auto.
- Qed.
-
- Theorem spec_div x y: wf x -> wf y ->
- ([div x y] == [x] / [y])%Q.
- intros x y Hx Hy; unfold div; rewrite spec_mul; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- apply wf_inv; auto.
- Qed.
-
- Theorem spec_divc x y: wf x -> wf y ->
- [[div x y]] = [[x]] / [[y]].
- intros x y Hx Hy; unfold div; rewrite spec_mulc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- apply wf_inv; auto.
- Qed.
-
- Definition div_norm x y := mul_norm x (inv y).
-
- Theorem wf_div_norm x y: wf x -> wf y -> wf (div_norm x y).
- intros x y Hx Hy; unfold div_norm; apply wf_mul_norm; auto.
- apply wf_inv; auto.
- Qed.
-
- Theorem spec_div_norm x y: wf x -> wf y ->
- ([div_norm x y] == [x] / [y])%Q.
- intros x y Hx Hy; unfold div_norm; rewrite spec_mul_norm; auto.
- unfold Qdiv; apply Qmult_comp.
- apply Qeq_refl.
- apply spec_inv; auto.
- apply wf_inv; auto.
- Qed.
-
- Theorem spec_div_normc x y: wf x -> wf y ->
- [[div_norm x y]] = [[x]] / [[y]].
- intros x y Hx Hy; unfold div_norm; rewrite spec_mul_normc; auto.
- unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto.
- apply spec_invc; auto.
- apply wf_inv; auto.
- Qed.
-
- Definition square (x: t): t :=
- match x with
- | Qz zx => Qz (BigZ.square zx)
- | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx)
- end.
-
- Theorem wf_square: forall x, wf x -> wf (square x).
- intros [ zx | nx dx]; unfold square, wf; auto.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigN.spec_square; intros H1 H2; case H2.
- case (Zmult_integral _ _ H1); auto.
- Qed.
-
- Theorem spec_square x: wf x -> ([square x] == [x] ^ 2)%Q.
- intros [ x | nx dx]; unfold square.
- intros _.
- red; simpl; rewrite BigZ.spec_square; auto with zarith.
- unfold wf.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- intros _ HH; case HH.
- intros H1 _.
- red; simpl; rewrite BigZ.spec_square; auto with zarith.
- assert (F: (0 < BigN.to_Z dx)%Z).
- case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith.
- assert (F1 : (0 < BigN.to_Z (BigN.square dx))%Z).
- rewrite BigN.spec_square; apply Zmult_lt_0_compat;
- auto with zarith.
- rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto with zarith.
- rewrite BigN.spec_square; auto with zarith.
- Qed.
-
- Theorem spec_squarec x: wf x -> [[square x]] = [[x]]^2.
- intros x Hx; unfold to_Qc.
- apply trans_equal with (!! ([x]^2)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_square; auto.
- simpl Qcpower.
- replace (!! [x] * 1) with (!![x]); try ring.
- simpl.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-
- Definition power_pos (x: t) p: t :=
- match x with
- | Qz zx => Qz (BigZ.power_pos zx p)
- | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p)
- end.
-
- Theorem wf_power_pos: forall x p, wf x -> wf (power_pos x p).
- intros [ zx | nx dx] p; unfold power_pos, wf; auto.
- repeat match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- rewrite BigN.spec_power_pos; simpl.
- intros H1 H2 _.
- case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith.
- intros H3; generalize (Zpower_pos_pos _ p H3); auto with zarith.
- Qed.
-
- Theorem spec_power_pos x p: wf x -> ([power_pos x p] == [x] ^ Zpos p)%Q.
- Proof.
- intros [x | nx dx] p; unfold power_pos.
- intros _; unfold power_pos; red; simpl.
- generalize (Qpower_decomp p (BigZ.to_Z x) 1).
- unfold Qeq; simpl.
- rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Zmult_1_r.
- intros H; rewrite H.
- rewrite BigZ.spec_power_pos; simpl; ring.
- unfold wf.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- intros _ HH; case HH.
- intros H1 _.
- assert (F1: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z).
- unfold Zpower; apply Zpower_pos_pos; auto.
- unfold power_pos; red; simpl.
- rewrite Z2P_correct; rewrite BigN.spec_power_pos; auto.
- generalize (Qpower_decomp p (BigZ.to_Z nx)
- (Z2P (BigN.to_Z dx))).
- unfold Qeq; simpl.
- repeat rewrite Z2P_correct; auto.
- unfold Qeq; simpl; intros HH.
- rewrite HH.
- rewrite BigZ.spec_power_pos; simpl; ring.
- Qed.
-
- Theorem spec_power_posc x p: wf x ->
- [[power_pos x p]] = [[x]] ^ nat_of_P p.
- intros x p Hx; unfold to_Qc.
- apply trans_equal with (!! ([x]^Zpos p)).
- unfold Q2Qc.
- apply Qc_decomp; intros _ _; unfold this.
- apply Qred_complete; apply spec_power_pos; auto.
- pattern p; apply Pind; clear p.
- simpl; ring.
- intros p Hrec.
- rewrite nat_of_P_succ_morphism; simpl Qcpower.
- rewrite <- Hrec.
- unfold Qcmult, Q2Qc.
- apply Qc_decomp; intros _ _;
- unfold this.
- apply Qred_complete.
- assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p).
- simpl; generalize Hx; case x; simpl; clear x Hx Hrec.
- intros x _; simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- intros nx dx.
- match goal with |- context[BigN.eq_bool ?X ?Y] =>
- generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool
- end; auto; rewrite BigN.spec_0.
- intros _ HH; case HH.
- intros H1 _.
- assert (F1: (0 < BigN.to_Z dx)%Z).
- generalize (BigN.spec_pos dx); auto with zarith.
- simpl; repeat rewrite Qpower_decomp; simpl.
- red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P.
- rewrite Pplus_one_succ_l.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- repeat rewrite Zpos_mult_morphism.
- repeat rewrite Z2P_correct; auto.
- 2: apply Zpower_pos_pos; auto.
- 2: apply Zpower_pos_pos; auto.
- rewrite Zpower_pos_is_exp.
- rewrite Zpower_pos_1_r; auto.
- rewrite F.
- apply Qmult_comp; apply Qeq_sym; apply Qred_correct.
- Qed.
-
-End Qv.
-
diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v
index a488c7c6..be9b2d4e 100644
--- a/theories/Numbers/Rational/SpecViaQ/QSig.v
+++ b/theories/Numbers/Rational/SpecViaQ/QSig.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: QSig.v 11028 2008-06-01 17:34:19Z letouzey $ i*)
+(*i $Id: QSig.v 11207 2008-07-04 16:50:32Z letouzey $ i*)
Require Import QArith Qpower.
@@ -40,14 +40,24 @@ Module Type QType.
Parameter compare : t -> t -> comparison.
- Parameter spec_compare: forall x y, compare x y = ([x] ?= [y]).
+ Parameter spec_compare : forall x y, compare x y = ([x] ?= [y]).
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 add : t -> t -> t.
+ 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 red : t -> t.
+
+ Parameter spec_red : forall x, [red x] == [x].
+ Parameter strong_spec_red : forall x, [red x] = Qred [x].
+
+ Parameter add : t -> t -> t.
Parameter spec_add: forall x y, [add x y] == [x] + [y].
@@ -75,10 +85,13 @@ Module Type QType.
Parameter spec_div: forall x y, [div x y] == [x] / [y].
- Parameter power_pos : t -> positive -> t.
+ Parameter power : t -> Z -> t.
- Parameter spec_power_pos: forall x n, [power_pos x n] == [x] ^ Zpos n.
+ Parameter spec_power: forall x z, [power x z] == [x] ^ z.
End QType.
-(* TODO: add norm function and variants, add eq_bool, what about Qc ? *) \ No newline at end of file
+(** NB: several of the above functions come with [..._norm] variants
+ that expect reduced arguments and return reduced results. *)
+
+(** TODO : also speak of specifications via Qcanon ... *)
diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v
index d19f29c3..c776070a 100644
--- a/theories/Program/Equality.v
+++ b/theories/Program/Equality.v
@@ -7,7 +7,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Equality.v 11023 2008-05-30 11:08:39Z msozeau $ i*)
+(*i $Id: Equality.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
(** Tactics related to (dependent) equality and proof irrelevance. *)
@@ -82,7 +82,7 @@ Ltac simpl_uip :=
(** Simplify equalities appearing in the context and goal. *)
-Ltac simpl_eq := simpl ; repeat (elim_eq_rect ; simpl) ; repeat (simpl_uip ; simpl).
+Ltac simpl_eq := simpl ; unfold eq_rec_r, eq_rec ; repeat (elim_eq_rect ; simpl) ; repeat (simpl_uip ; simpl).
(** Try to abstract a proof of equality, if no proof of the same equality is present in the context. *)
@@ -235,30 +235,43 @@ Ltac simpl_depind := subst* ; autoinjections ; try discriminates ;
and starts a dependent induction using this tactic. *)
Ltac do_depind tac H :=
+ generalize_eqs_vars H ; tac H ; repeat progress simpl_depind.
+
+(** A variant where generalized variables should be given by the user. *)
+
+Ltac do_depind' tac H :=
generalize_eqs H ; tac H ; repeat progress simpl_depind.
(** Calls [destruct] on the generalized hypothesis, results should be similar to inversion. *)
Tactic Notation "dependent" "destruction" ident(H) :=
- do_depind ltac:(fun H => destruct H ; intros) H ; subst*.
+ do_depind ltac:(fun hyp => destruct hyp ; intros) H ; subst*.
Tactic Notation "dependent" "destruction" ident(H) "using" constr(c) :=
- do_depind ltac:(fun H => destruct H using c ; intros) H.
+ do_depind ltac:(fun hyp => destruct hyp using c ; intros) H.
+
+(** This tactic also generalizes the goal by the given variables before the induction. *)
+
+Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) :=
+ do_depind' ltac:(fun hyp => revert l ; destruct hyp ; intros) H.
+
+Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) :=
+ do_depind' ltac:(fun hyp => revert l ; destruct hyp using c ; intros) H.
(** Then we have wrappers for usual calls to induction. One can customize the induction tactic by
writting another wrapper calling do_depind. *)
Tactic Notation "dependent" "induction" ident(H) :=
- do_depind ltac:(fun H => induction H ; intros) H.
+ do_depind ltac:(fun hyp => induction hyp ; intros) H.
Tactic Notation "dependent" "induction" ident(H) "using" constr(c) :=
- do_depind ltac:(fun H => induction H using c ; intros) H.
+ do_depind ltac:(fun hyp => induction hyp using c ; intros) H.
(** This tactic also generalizes the goal by the given variables before the induction. *)
Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) :=
- do_depind ltac:(fun H => generalize l ; clear l ; induction H ; intros) H.
+ do_depind' ltac:(fun hyp => generalize l ; clear l ; induction hyp ; intros) H.
Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) :=
- do_depind ltac:(fun H => generalize l ; clear l ; induction H using c ; intros) H.
+ do_depind' ltac:(fun hyp => generalize l ; clear l ; induction hyp using c ; intros) H.
diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v
index 41b170c9..bb5054b4 100644
--- a/theories/Program/Tactics.v
+++ b/theories/Program/Tactics.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Tactics.v 11122 2008-06-13 14:18:44Z msozeau $ i*)
+(*i $Id: Tactics.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
(** This module implements various tactics used to simplify the goals produced by Program,
which are also generally useful. *)
@@ -77,10 +77,10 @@ Ltac clear_dup :=
match goal with
| [ H : ?X |- _ ] =>
match goal with
- | [ H' : X |- _ ] =>
- match H' with
- | H => fail 2
- | _ => clear H' || clear H
+ | [ H' : ?Y |- _ ] =>
+ match H with
+ | H' => fail 2
+ | _ => conv X Y ; (clear H' || clear H)
end
end
end.
@@ -158,14 +158,6 @@ Ltac autoinjection :=
let tac H := progress (inversion H ; subst ; clear_dups) ; clear H in
match goal with
| [ H : ?f ?a = ?f' ?a' |- _ ] => tac H
- | [ H : ?f ?a ?b = ?f' ?a' ?b' |- _ ] => tac H
- | [ H : ?f ?a ?b ?c = ?f' ?a' ?b' ?c' |- _ ] => tac H
- | [ H : ?f ?a ?b ?c ?d= ?f' ?a' ?b' ?c' ?d' |- _ ] => tac H
- | [ H : ?f ?a ?b ?c ?d ?e= ?f' ?a' ?b' ?c' ?d' ?e' |- _ ] => tac H
- | [ H : ?f ?a ?b ?c ?d ?e ?g= ?f' ?a' ?b' ?c' ?d' ?e' ?g' |- _ ] => tac H
- | [ H : ?f ?a ?b ?c ?d ?e ?g ?h= ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' |- _ ] => tac H
- | [ H : ?f ?a ?b ?c ?d ?e ?g ?h ?i = ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' ?i' |- _ ] => tac H
- | [ H : ?f ?a ?b ?c ?d ?e ?g ?h ?i ?j = ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' ?i' ?j' |- _ ] => tac H
end.
Ltac autoinjections := repeat autoinjection.
@@ -222,7 +214,7 @@ Ltac refine_hyp c :=
end.
(** The default simplification tactic used by Program is defined by [program_simpl], sometimes [auto]
- is not enough, better rebind using [Obligations Tactic := tac] in this case,
+ is not enough, better rebind using [Obligation Tactic := tac] in this case,
possibly using [program_simplify] to use standard goal-cleaning tactics. *)
Ltac program_simplify :=
@@ -231,4 +223,4 @@ Ltac program_simplify :=
Ltac program_simpl := program_simplify ; auto.
-Ltac obligations_tactic := program_simpl.
+Ltac obligation_tactic := program_simpl.
diff --git a/theories/Program/Utils.v b/theories/Program/Utils.v
index 21eee0ca..fcd85f41 100644
--- a/theories/Program/Utils.v
+++ b/theories/Program/Utils.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Utils.v 10919 2008-05-11 22:04:26Z msozeau $ i*)
+(*i $Id: Utils.v 11309 2008-08-06 10:30:35Z herbelin $ i*)
Require Export Coq.Program.Tactics.
@@ -42,8 +42,8 @@ Notation dec := sumbool_of_bool.
(** Hide proofs and generates obligations when put in a term. *)
-Notation "'in_left'" := (@left _ _ _) : program_scope.
-Notation "'in_right'" := (@right _ _ _) : program_scope.
+Notation in_left := (@left _ _ _).
+Notation in_right := (@right _ _ _).
(** Extraction directives *)
(*
diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v
index 304fbf77..78cf2892 100644
--- a/theories/QArith/QArith_base.v
+++ b/theories/QArith/QArith_base.v
@@ -6,11 +6,11 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: QArith_base.v 10765 2008-04-08 16:15:23Z msozeau $ i*)
+(*i $Id: QArith_base.v 11301 2008-08-04 19:41:18Z herbelin $ i*)
Require Export ZArith.
Require Export ZArithRing.
-Require Export Setoid.
+Require Export Setoid Bool.
(** * Definition of [Q] and basic properties *)
@@ -28,24 +28,24 @@ Ltac simpl_mult := repeat rewrite Zpos_mult_morphism.
Notation "a # b" := (Qmake a b) (at level 55, no associativity) : Q_scope.
-Definition inject_Z (x : Z) := Qmake x 1.
+Definition inject_Z (x : Z) := Qmake x 1.
Arguments Scope inject_Z [Z_scope].
-Notation " 'QDen' p " := (Zpos (Qden p)) (at level 20, no associativity) : Q_scope.
+Notation QDen p := (Zpos (Qden p)).
Notation " 0 " := (0#1) : Q_scope.
Notation " 1 " := (1#1) : Q_scope.
Definition Qeq (p q : Q) := (Qnum p * QDen q)%Z = (Qnum q * QDen p)%Z.
Definition Qle (x y : Q) := (Qnum x * QDen y <= Qnum y * QDen x)%Z.
Definition Qlt (x y : Q) := (Qnum x * QDen y < Qnum y * QDen x)%Z.
-Notation Qgt := (fun a b : Q => Qlt b a).
-Notation Qge := (fun a b : Q => Qle b a).
+Notation Qgt a b := (Qlt b a) (only parsing).
+Notation Qge a b := (Qle b a) (only parsing).
-Infix "==" := Qeq (at level 70, no associativity) : Q_scope.
+Infix "==" := Qeq (at level 70, no associativity) : Q_scope.
Infix "<" := Qlt : Q_scope.
-Infix ">" := Qgt : Q_scope.
Infix "<=" := Qle : Q_scope.
-Infix ">=" := Qge : Q_scope.
+Notation "x > y" := (Qlt y x)(only parsing) : Q_scope.
+Notation "x >= y" := (Qle y x)(only parsing) : Q_scope.
Notation "x <= y <= z" := (x<=y/\y<=z) : Q_scope.
(** Another approach : using Qcompare for defining order relations. *)
@@ -84,7 +84,7 @@ rewrite Zcompare_Gt_Lt_antisym; auto.
rewrite Zcompare_Gt_Lt_antisym in H; auto.
Qed.
-Hint Unfold Qeq Qlt Qle: qarith.
+Hint Unfold Qeq Qlt Qle : qarith.
Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith.
(** * Properties of equality. *)
@@ -94,7 +94,7 @@ Proof.
auto with qarith.
Qed.
-Theorem Qeq_sym : forall x y, x == y -> y == x.
+Theorem Qeq_sym : forall x y, x == y -> y == x.
Proof.
auto with qarith.
Qed.
@@ -102,7 +102,7 @@ Qed.
Theorem Qeq_trans : forall x y z, x == y -> y == z -> x == z.
Proof.
unfold Qeq in |- *; intros.
-apply Zmult_reg_l with (QDen y).
+apply Zmult_reg_l with (QDen y).
auto with qarith.
transitivity (Qnum x * QDen y * QDen z)%Z; try ring.
rewrite H.
@@ -117,6 +117,44 @@ Proof.
intros; case (Z_eq_dec (Qnum x * QDen y) (Qnum y * QDen x)); auto.
Defined.
+Definition Qeq_bool x y :=
+ (Zeq_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z.
+
+Definition Qle_bool x y :=
+ (Zle_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z.
+
+Lemma Qeq_bool_iff : forall x y, Qeq_bool x y = true <-> x == y.
+Proof.
+ unfold Qeq_bool, Qeq; intros.
+ symmetry; apply Zeq_is_eq_bool.
+Qed.
+
+Lemma Qeq_bool_eq : forall x y, Qeq_bool x y = true -> x == y.
+Proof.
+ intros; rewrite <- Qeq_bool_iff; auto.
+Qed.
+
+Lemma Qeq_eq_bool : forall x y, x == y -> Qeq_bool x y = true.
+Proof.
+ intros; rewrite Qeq_bool_iff; auto.
+Qed.
+
+Lemma Qeq_bool_neq : forall x y, Qeq_bool x y = false -> ~ x == y.
+Proof.
+ intros x y H; rewrite <- Qeq_bool_iff, H; discriminate.
+Qed.
+
+Lemma Qle_bool_iff : forall x y, Qle_bool x y = true <-> x <= y.
+Proof.
+ unfold Qle_bool, Qle; intros.
+ symmetry; apply Zle_is_le_bool.
+Qed.
+
+Lemma Qle_bool_imp_le : forall x y, Qle_bool x y = true -> x <= y.
+Proof.
+ intros; rewrite <- Qle_bool_iff; auto.
+Qed.
+
(** We now consider [Q] seen as a setoid. *)
Definition Q_Setoid : Setoid_Theory Q Qeq.
@@ -130,7 +168,7 @@ Hint Resolve (Seq_refl Q Qeq Q_Setoid): qarith.
Hint Resolve (Seq_sym Q Qeq Q_Setoid): qarith.
Hint Resolve (Seq_trans Q Qeq Q_Setoid): qarith.
-Theorem Qnot_eq_sym : forall x y, ~x == y -> ~y == x.
+Theorem Qnot_eq_sym : forall x y, ~x == y -> ~y == x.
Proof.
auto with qarith.
Qed.
@@ -139,13 +177,13 @@ Hint Resolve Qnot_eq_sym : qarith.
(** * Addition, multiplication and opposite *)
-(** The addition, multiplication and opposite are defined
+(** The addition, multiplication and opposite are defined
in the straightforward way: *)
Definition Qplus (x y : Q) :=
(Qnum x * QDen y + Qnum y * QDen x) # (Qden x * Qden y).
-Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y).
+Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y).
Definition Qopp (x : Q) := (- Qnum x) # (Qden x).
@@ -164,8 +202,8 @@ Infix "+" := Qplus : Q_scope.
Notation "- x" := (Qopp x) : Q_scope.
Infix "-" := Qminus : Q_scope.
Infix "*" := Qmult : Q_scope.
-Notation "/ x" := (Qinv x) : Q_scope.
-Infix "/" := Qdiv : Q_scope.
+Notation "/ x" := (Qinv x) : Q_scope.
+Infix "/" := Qdiv : Q_scope.
(** A light notation for [Zpos] *)
@@ -181,7 +219,7 @@ Qed.
(** * Setoid compatibility results *)
-Add Morphism Qplus : Qplus_comp.
+Add Morphism Qplus : Qplus_comp.
Proof.
unfold Qeq, Qplus; simpl.
Open Scope Z_scope.
@@ -208,7 +246,7 @@ Qed.
Add Morphism Qminus : Qminus_comp.
Proof.
intros.
- unfold Qminus.
+ unfold Qminus.
rewrite H; rewrite H0; auto with qarith.
Qed.
@@ -232,11 +270,11 @@ Proof.
Open Scope Z_scope.
intros (p1, p2) (q1, q2); simpl.
case p1; simpl.
- intros.
+ intros.
assert (q1 = 0).
elim (Zmult_integral q1 ('p2)); auto with zarith.
intros; discriminate.
- subst; auto.
+ subst; auto.
case q1; simpl; intros; try discriminate.
rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto.
case q1; simpl; intros; try discriminate.
@@ -254,7 +292,7 @@ Add Morphism Qle with signature Qeq ==> Qeq ==> iff as Qle_comp.
Proof.
cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<=x3 -> x2<=x4).
split; apply H; assumption || (apply Qeq_sym ; assumption).
-
+
unfold Qeq, Qle; simpl.
Open Scope Z_scope.
intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *.
@@ -289,14 +327,26 @@ Proof.
replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring.
rewrite <- H0.
replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring.
- replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring.
+ replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring.
apply Zlt_gt.
apply Zmult_gt_0_lt_compat_l; auto with zarith.
Close Scope Z_scope.
Qed.
+Add Morphism Qeq_bool with signature Qeq ==> Qeq ==> (@eq bool) as Qeqb_comp.
+Proof.
+ intros; apply eq_true_iff_eq.
+ rewrite 2 Qeq_bool_iff, H, H0; split; auto with qarith.
+Qed.
+
+Add Morphism Qle_bool with signature Qeq ==> Qeq ==> (@eq bool) as Qleb_comp.
+Proof.
+ intros; apply eq_true_iff_eq.
+ rewrite 2 Qle_bool_iff, H, H0.
+ split; auto with qarith.
+Qed.
-Lemma Qcompare_egal_dec: forall n m p q : Q,
+Lemma Qcompare_egal_dec: forall n m p q : Q,
(n<m -> p<q) -> (n==m -> p==q) -> (n>m -> p>q) -> ((n?=m) = (p?=q)).
Proof.
intros.
@@ -306,7 +356,6 @@ Proof.
omega.
Qed.
-
Add Morphism Qcompare : Qcompare_comp.
Proof.
intros; apply Qcompare_egal_dec; rewrite H; rewrite H0; auto.
@@ -341,7 +390,7 @@ Lemma Qplus_0_r : forall x, x+0 == x.
Proof.
intros (x1, x2); unfold Qeq, Qplus; simpl.
rewrite Pmult_comm; simpl; ring.
-Qed.
+Qed.
(** Commutativity of addition: *)
@@ -374,6 +423,18 @@ Proof.
intros; red; simpl; rewrite Pmult_assoc; ring.
Qed.
+(** multiplication and zero *)
+
+Lemma Qmult_0_l : forall x , 0*x == 0.
+Proof.
+ intros; compute; reflexivity.
+Qed.
+
+Lemma Qmult_0_r : forall x , x*0 == 0.
+Proof.
+ intros; red; simpl; ring.
+Qed.
+
(** [1] is a neutral element for multiplication: *)
Lemma Qmult_1_l : forall n, 1*n == n.
@@ -385,7 +446,7 @@ Theorem Qmult_1_r : forall n, n*1==n.
Proof.
intro; red; simpl.
rewrite Zmult_1_r with (n := Qnum n).
- rewrite Pmult_comm; simpl; trivial.
+ rewrite Pmult_comm; simpl; trivial.
Qed.
(** Commutativity of multiplication *)
@@ -427,7 +488,7 @@ Proof.
rewrite <- H0; ring.
Qed.
-(** * Inverse and division. *)
+(** * Inverse and division. *)
Lemma Qinv_involutive : forall q, (/ / q) == q.
Proof.
@@ -438,13 +499,13 @@ Theorem Qmult_inv_r : forall x, ~ x == 0 -> x*(/x) == 1.
Proof.
intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl;
intros; simpl_mult; try ring.
- elim H; auto.
+ elim H; auto.
Qed.
Lemma Qinv_mult_distr : forall p q, / (p * q) == /p * /q.
Proof.
intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl.
- destruct x1; simpl; auto;
+ destruct x1; simpl; auto;
destruct y1; simpl; auto.
Qed.
@@ -485,10 +546,10 @@ Proof.
red; trivial.
apply Zle_trans with (y1 * 'x2 * 'z2).
replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
- apply Zmult_le_compat_r; auto with zarith.
+ apply Zmult_le_compat_r; auto with zarith.
replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
- apply Zmult_le_compat_r; auto with zarith.
+ apply Zmult_le_compat_r; auto with zarith.
Close Scope Z_scope.
Qed.
@@ -516,9 +577,9 @@ Proof.
apply Zgt_le_trans with (y1 * 'x2 * 'z2).
replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
- apply Zmult_gt_compat_r; auto with zarith.
+ apply Zmult_gt_compat_r; auto with zarith.
replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
- apply Zmult_le_compat_r; auto with zarith.
+ apply Zmult_le_compat_r; auto with zarith.
Close Scope Z_scope.
Qed.
@@ -532,9 +593,9 @@ Proof.
apply Zle_gt_trans with (y1 * 'x2 * 'z2).
replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
- apply Zmult_le_compat_r; auto with zarith.
+ apply Zmult_le_compat_r; auto with zarith.
replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
- apply Zmult_gt_compat_r; auto with zarith.
+ apply Zmult_gt_compat_r; auto with zarith.
Close Scope Z_scope.
Qed.
@@ -572,7 +633,7 @@ Proof.
unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto.
Qed.
-Hint Resolve Qle_not_lt Qlt_not_le Qnot_le_lt Qnot_lt_le
+Hint Resolve Qle_not_lt Qlt_not_le Qnot_le_lt Qnot_lt_le
Qlt_le_weak Qlt_not_eq Qle_antisym Qle_refl: qartih.
(** Some decidability results about orders. *)
@@ -679,7 +740,7 @@ Proof.
intros [[|n|n] d] Ha; assumption.
Qed.
-Lemma Qle_shift_div_l : forall a b c,
+Lemma Qle_shift_div_l : forall a b c,
0 < c -> a*c <= b -> a <= b/c.
Proof.
intros a b c Hc H.
@@ -690,7 +751,7 @@ rewrite Qmult_div_r; try assumption.
auto with *.
Qed.
-Lemma Qle_shift_inv_l : forall a c,
+Lemma Qle_shift_inv_l : forall a c,
0 < c -> a*c <= 1 -> a <= /c.
Proof.
intros a c Hc H.
@@ -699,7 +760,7 @@ change (a <= 1/c).
apply Qle_shift_div_l; assumption.
Qed.
-Lemma Qle_shift_div_r : forall a b c,
+Lemma Qle_shift_div_r : forall a b c,
0 < b -> a <= c*b -> a/b <= c.
Proof.
intros a b c Hc H.
@@ -710,7 +771,7 @@ rewrite Qmult_div_r; try assumption.
auto with *.
Qed.
-Lemma Qle_shift_inv_r : forall b c,
+Lemma Qle_shift_inv_r : forall b c,
0 < b -> 1 <= c*b -> /b <= c.
Proof.
intros b c Hc H.
@@ -772,7 +833,7 @@ Qed.
(** * Rational to the n-th power *)
-Definition Qpower_positive (q:Q)(p:positive) : Q :=
+Definition Qpower_positive (q:Q)(p:positive) : Q :=
pow_pos Qmult q p.
Add Morphism Qpower_positive with signature Qeq ==> @eq _ ==> Qeq as Qpower_positive_comp.
diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v
index 5d548aea..9841ef89 100644
--- a/theories/QArith/Qfield.v
+++ b/theories/QArith/Qfield.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Qfield.v 10739 2008-04-01 14:45:20Z herbelin $ i*)
+(*i $Id: Qfield.v 11208 2008-07-04 16:57:46Z letouzey $ i*)
Require Export Field.
Require Export QArith_base.
@@ -14,24 +14,9 @@ Require Import NArithRing.
(** * field and ring tactics for rational numbers *)
-Definition Qeq_bool (x y : Q) :=
- if Qeq_dec x y then true else false.
-
-Lemma Qeq_bool_correct : forall x y : Q, Qeq_bool x y = true -> x==y.
-Proof.
- intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto.
- intros _ H; inversion H.
-Qed.
-
-Lemma Qeq_bool_complete : forall x y : Q, x==y -> Qeq_bool x y = true.
-Proof.
- intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto.
-Qed.
-
-Definition Qsft : field_theory 0 1 Qplus Qmult Qminus Qopp Qdiv Qinv Qeq.
+Definition Qsrt : ring_theory 0 1 Qplus Qmult Qminus Qopp Qeq.
Proof.
constructor.
- constructor.
exact Qplus_0_l.
exact Qplus_comm.
exact Qplus_assoc.
@@ -41,6 +26,12 @@ Proof.
exact Qmult_plus_distr_l.
reflexivity.
exact Qplus_opp_r.
+Qed.
+
+Definition Qsft : field_theory 0 1 Qplus Qmult Qminus Qopp Qdiv Qinv Qeq.
+Proof.
+ constructor.
+ exact Qsrt.
discriminate.
reflexivity.
intros p Hp.
@@ -83,8 +74,8 @@ Ltac Qpow_tac t :=
end.
Add Field Qfield : Qsft
- (decidable Qeq_bool_correct,
- completeness Qeq_bool_complete,
+ (decidable Qeq_bool_eq,
+ completeness Qeq_eq_bool,
constants [Qcst],
power_tac Qpower_theory [Qpow_tac]).
diff --git a/theories/Strings/String.v b/theories/Strings/String.v
index 53260480..00f28a9c 100644
--- a/theories/Strings/String.v
+++ b/theories/Strings/String.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(* $Id: String.v 10855 2008-04-27 11:16:15Z msozeau $ *)
+(* $Id: String.v 11206 2008-07-04 16:21:28Z letouzey $ *)
(** Contributed by Laurent Théry (INRIA);
Adapted to Coq V8 by the Coq Development Team *)
@@ -225,7 +225,7 @@ Fixpoint index (n : nat) (s1 s2 : string) {struct s2} : option nat :=
end
end.
-(* Dirty trick to evaluate locally that prefix reduces itself *)
+(* Dirty trick to avoid locally that prefix reduces itself *)
Opaque prefix.
(** If the result of [index] is [Some m], [s1] in [s2] at position [m] *)
diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v
index 34114d46..71befa4a 100644
--- a/theories/ZArith/Zbool.v
+++ b/theories/ZArith/Zbool.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(* $Id: Zbool.v 10063 2007-08-08 14:21:03Z emakarov $ *)
+(* $Id: Zbool.v 11208 2008-07-04 16:57:46Z letouzey $ *)
Require Import BinInt.
Require Import Zeven.
@@ -16,7 +16,7 @@ Require Import ZArith_dec.
Require Import Sumbool.
Unset Boxed Definitions.
-
+Open Local Scope Z_scope.
(** * Boolean operations from decidabilty of order *)
(** The decidability of equality and order relations over
@@ -37,80 +37,82 @@ Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x).
(** * Boolean comparisons of binary integers *)
Definition Zle_bool (x y:Z) :=
- match (x ?= y)%Z with
+ match x ?= y with
| Gt => false
| _ => true
end.
Definition Zge_bool (x y:Z) :=
- match (x ?= y)%Z with
+ match x ?= y with
| Lt => false
| _ => true
end.
Definition Zlt_bool (x y:Z) :=
- match (x ?= y)%Z with
+ match x ?= y with
| Lt => true
| _ => false
end.
Definition Zgt_bool (x y:Z) :=
- match (x ?= y)%Z with
+ match x ?= y with
| Gt => true
| _ => false
end.
Definition Zeq_bool (x y:Z) :=
- match (x ?= y)%Z with
+ match x ?= y with
| Eq => true
| _ => false
end.
Definition Zneq_bool (x y:Z) :=
- match (x ?= y)%Z with
+ match x ?= y with
| Eq => false
| _ => true
end.
+(** Properties in term of [if ... then ... else ...] *)
+
Lemma Zle_cases :
- forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z.
+ forall n m:Z, if Zle_bool n m then (n <= m) else (n > m).
Proof.
intros x y; unfold Zle_bool, Zle, Zgt in |- *.
- case (x ?= y)%Z; auto; discriminate.
+ case (x ?= y); auto; discriminate.
Qed.
Lemma Zlt_cases :
- forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z.
+ forall n m:Z, if Zlt_bool n m then (n < m) else (n >= m).
Proof.
intros x y; unfold Zlt_bool, Zlt, Zge in |- *.
- case (x ?= y)%Z; auto; discriminate.
+ case (x ?= y); auto; discriminate.
Qed.
Lemma Zge_cases :
- forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z.
+ forall n m:Z, if Zge_bool n m then (n >= m) else (n < m).
Proof.
intros x y; unfold Zge_bool, Zge, Zlt in |- *.
- case (x ?= y)%Z; auto; discriminate.
+ case (x ?= y); auto; discriminate.
Qed.
Lemma Zgt_cases :
- forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z.
+ forall n m:Z, if Zgt_bool n m then (n > m) else (n <= m).
Proof.
intros x y; unfold Zgt_bool, Zgt, Zle in |- *.
- case (x ?= y)%Z; auto; discriminate.
+ case (x ?= y); auto; discriminate.
Qed.
(** Lemmas on [Zle_bool] used in contrib/graphs *)
-Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m)%Z.
+Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m).
Proof.
unfold Zle_bool, Zle in |- *. intros x y. unfold not in |- *.
- case (x ?= y)%Z; intros; discriminate.
+ case (x ?= y); intros; discriminate.
Qed.
-Lemma Zle_imp_le_bool : forall n m:Z, (n <= m)%Z -> Zle_bool n m = true.
+Lemma Zle_imp_le_bool : forall n m:Z, (n <= m) -> Zle_bool n m = true.
Proof.
- unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y)%Z; trivial. intro. elim (H (refl_equal _)).
+ unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y); trivial. intro. elim (H (refl_equal _)).
Qed.
Lemma Zle_bool_refl : forall n:Z, Zle_bool n n = true.
@@ -136,8 +138,8 @@ Qed.
Definition Zle_bool_total :
forall x y:Z, {Zle_bool x y = true} + {Zle_bool y x = true}.
Proof.
- intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y)%Z = Gt <-> (y ?= x)%Z = Lt).
- case (x ?= y)%Z. left. reflexivity.
+ intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y) = Gt <-> (y ?= x) = Lt).
+ case (x ?= y). left. reflexivity.
left. reflexivity.
right. rewrite (proj1 H (refl_equal _)). reflexivity.
apply Zcompare_Gt_Lt_antisym.
@@ -159,39 +161,40 @@ Qed.
Lemma Zone_min_pos : forall n:Z, Zle_bool n 0 = false -> Zle_bool 1 n = true.
Proof.
- intros x; intros. apply Zle_imp_le_bool. change (Zsucc 0 <= x)%Z in |- *. apply Zgt_le_succ. generalize H.
- unfold Zle_bool, Zgt in |- *. case (x ?= 0)%Z. intro H0. discriminate H0.
+ intros x; intros. apply Zle_imp_le_bool. change (Zsucc 0 <= x) in |- *. apply Zgt_le_succ. generalize H.
+ unfold Zle_bool, Zgt in |- *. case (x ?= 0). intro H0. discriminate H0.
intro H0. discriminate H0.
reflexivity.
Qed.
+(** Properties in term of [iff] *)
-Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true.
+Lemma Zle_is_le_bool : forall n m:Z, (n <= m) <-> Zle_bool n m = true.
Proof.
intros. split. intro. apply Zle_imp_le_bool. assumption.
intro. apply Zle_bool_imp_le. assumption.
Qed.
-Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> Zle_bool m n = true.
+Lemma Zge_is_le_bool : forall n m:Z, (n >= m) <-> Zle_bool m n = true.
Proof.
intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption.
intro. apply Zle_ge. apply Zle_bool_imp_le. assumption.
Qed.
-Lemma Zlt_is_lt_bool : forall n m:Z, (n < m)%Z <-> Zlt_bool n m = true.
+Lemma Zlt_is_lt_bool : forall n m:Z, (n < m) <-> Zlt_bool n m = true.
Proof.
intros n m; unfold Zlt_bool, Zlt.
-destruct (n ?= m)%Z; simpl; split; now intro.
+destruct (n ?= m); simpl; split; now intro.
Qed.
-Lemma Zgt_is_gt_bool : forall n m:Z, (n > m)%Z <-> Zgt_bool n m = true.
+Lemma Zgt_is_gt_bool : forall n m:Z, (n > m) <-> Zgt_bool n m = true.
Proof.
intros n m; unfold Zgt_bool, Zgt.
-destruct (n ?= m)%Z; simpl; split; now intro.
+destruct (n ?= m); simpl; split; now intro.
Qed.
Lemma Zlt_is_le_bool :
- forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true.
+ forall n m:Z, (n < m) <-> Zle_bool n (m - 1) = true.
Proof.
intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H.
assumption.
@@ -199,9 +202,29 @@ Proof.
Qed.
Lemma Zgt_is_le_bool :
- forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true.
+ forall n m:Z, (n > m) <-> Zle_bool m (n - 1) = true.
Proof.
- intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y).
+ intros x y. apply iff_trans with (y < x). split. exact (Zgt_lt x y).
exact (Zlt_gt y x).
exact (Zlt_is_le_bool y x).
Qed.
+
+Lemma Zeq_is_eq_bool : forall x y, x = y <-> Zeq_bool x y = true.
+Proof.
+ intros; unfold Zeq_bool.
+ generalize (Zcompare_Eq_iff_eq x y); destruct Zcompare; intuition;
+ try discriminate.
+Qed.
+
+Lemma Zeq_bool_eq : forall x y, Zeq_bool x y = true -> x = y.
+Proof.
+ intros x y H; apply <- Zeq_is_eq_bool; auto.
+Qed.
+
+Lemma Zeq_bool_neq : forall x y, Zeq_bool x y = false -> x <> y.
+Proof.
+ unfold Zeq_bool; red ; intros; subst.
+ rewrite Zcompare_refl in H.
+ discriminate.
+Qed.
+
diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v
index 6c5b07d2..8244d4ce 100644
--- a/theories/ZArith/Zcompare.v
+++ b/theories/ZArith/Zcompare.v
@@ -40,6 +40,15 @@ Proof.
| destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ].
Qed.
+Ltac destr_zcompare :=
+ match goal with |- context [Zcompare ?x ?y] =>
+ let H := fresh "H" in
+ case_eq (Zcompare x y); intro H;
+ [generalize (Zcompare_Eq_eq _ _ H); clear H; intro H |
+ change (x<y)%Z in H |
+ change (x>y)%Z in H ]
+ end.
+
Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m.
Proof.
intros x y; split; intro E;
diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v
index e77475e0..9be372a3 100644
--- a/theories/ZArith/Znumtheory.v
+++ b/theories/ZArith/Znumtheory.v
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i $Id: Znumtheory.v 10295 2007-11-06 22:46:21Z letouzey $ i*)
+(*i $Id: Znumtheory.v 11282 2008-07-28 11:51:53Z msozeau $ i*)
Require Import ZArith_base.
Require Import ZArithRing.
@@ -522,7 +522,7 @@ Lemma Zis_gcd_mult :
forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d).
Proof.
intros a b c d; simple induction 1; constructor; intuition.
- elim (Zis_gcd_bezout a b d H); intros.
+ elim (Zis_gcd_bezout a b d H). intros.
elim H3; intros.
elim H4; intros.
apply Zdivide_intro with (u * q + v * q0).