diff options
| author |  Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
|---|---|---|
| committer | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
| commit | 5b7eafd0f00a16d78f99a27f5c7d5a0de77dc7e6 (patch) | |
| tree | 631ad791a7685edafeb1fb2e8faeedc8379318ae /theories/Numbers | |
| parent | da178a880e3ace820b41d38b191d3785b82991f5 (diff) | |
Imported Upstream snapshot 8.3~beta0+13298
Diffstat (limited to 'theories/Numbers')
74 files changed, 9726 insertions, 7463 deletions
diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v index 83ecd10d..dd7d9046 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 11207 2008-07-04 16:50:32Z letouzey $ i*) +(*i $Id$ i*) (** * BigNumPrelude *) @@ -21,6 +21,8 @@ Require Export ZArith. Require Export Znumtheory. Require Export Zpow_facts. +Declare ML Module "numbers_syntax_plugin". + (* *** Nota Bene *** All results that were general enough has been moved in ZArith. Only remain here specialized lemmas and compatibility elements. @@ -28,8 +30,8 @@ Require Export Zpow_facts. *) -Open Local Scope Z_scope. - +Local Open Scope Z_scope. + (* For compatibility of scripts, weaker version of some lemmas of Zdiv *) Lemma Zlt0_not_eq : forall n, 0<n -> n<>0. @@ -43,14 +45,14 @@ Definition Z_div_plus_l a b c H := Zdiv.Z_div_plus_full_l a b c (Zlt0_not_eq _ H (* Automation *) -Hint Extern 2 (Zle _ _) => +Hint Extern 2 (Zle _ _) => (match goal with |- Zpos _ <= Zpos _ => exact (refl_equal _) | H: _ <= ?p |- _ <= ?p => apply Zle_trans with (2 := H) | H: _ < ?p |- _ <= ?p => apply Zlt_le_weak; apply Zle_lt_trans with (2 := H) end). -Hint Extern 2 (Zlt _ _) => +Hint Extern 2 (Zlt _ _) => (match goal with |- Zpos _ < Zpos _ => exact (refl_equal _) | H: _ <= ?p |- _ <= ?p => apply Zlt_le_trans with (2 := H) @@ -60,13 +62,13 @@ Hint Extern 2 (Zlt _ _) => Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. -(************************************** +(************************************** Properties of order and product **************************************) - Theorem beta_lex: forall a b c d beta, - a * beta + b <= c * beta + d -> - 0 <= b < beta -> 0 <= d < beta -> + Theorem beta_lex: forall a b c d beta, + a * beta + b <= c * beta + d -> + 0 <= b < beta -> 0 <= d < beta -> a <= c. Proof. intros a b c d beta H1 (H3, H4) (H5, H6). @@ -78,15 +80,15 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. Theorem beta_lex_inv: forall a b c d beta, a < c -> 0 <= b < beta -> - 0 <= d < beta -> - a * beta + b < c * beta + d. + 0 <= d < beta -> + a * beta + b < c * beta + d. Proof. intros a b c d beta H1 (H3, H4) (H5, H6). case (Zle_or_lt (c * beta + d) (a * beta + b)); auto with zarith. intros H7; contradict H1;apply Zle_not_lt;apply beta_lex with (1 := H7);auto. Qed. - Lemma beta_mult : forall h l beta, + Lemma beta_mult : forall h l beta, 0 <= h < beta -> 0 <= l < beta -> 0 <= h*beta+l < beta^2. Proof. intros h l beta H1 H2;split. auto with zarith. @@ -94,7 +96,7 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. apply beta_lex_inv;auto with zarith. Qed. - Lemma Zmult_lt_b : + Lemma Zmult_lt_b : forall b x y, 0 <= x < b -> 0 <= y < b -> 0 <= x * y <= b^2 - 2*b + 1. Proof. intros b x y (Hx1,Hx2) (Hy1,Hy2);split;auto with zarith. @@ -104,17 +106,17 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. Qed. Lemma sum_mul_carry : forall xh xl yh yl wc cc beta, - 1 < beta -> + 1 < beta -> 0 <= wc < beta -> 0 <= xh < beta -> 0 <= xl < beta -> 0 <= yh < beta -> 0 <= yl < beta -> 0 <= cc < beta^2 -> - wc*beta^2 + cc = xh*yl + xl*yh -> + wc*beta^2 + cc = xh*yl + xl*yh -> 0 <= wc <= 1. Proof. - intros xh xl yh yl wc cc beta U H1 H2 H3 H4 H5 H6 H7. + intros xh xl yh yl wc cc beta U H1 H2 H3 H4 H5 H6 H7. assert (H8 := Zmult_lt_b beta xh yl H2 H5). assert (H9 := Zmult_lt_b beta xl yh H3 H4). split;auto with zarith. @@ -132,7 +134,7 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. apply Zle_lt_trans with ((beta-1)*(beta-1)+(beta-1)); auto with zarith. apply Zplus_le_compat; auto with zarith. apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); + repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); rewrite Zpower_2; auto with zarith. Qed. @@ -147,7 +149,7 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. apply Zle_lt_trans with ((beta-1)*(beta-1)+(2*beta-2));auto with zarith. apply Zplus_le_compat; auto with zarith. apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); + repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); rewrite Zpower_2; auto with zarith. Qed. @@ -199,9 +201,9 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. apply Zplus_le_lt_compat; auto with zarith. replace b with ((b - a) + a); try ring. rewrite Zpower_exp; auto with zarith. - pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); + pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); try rewrite <- Zmult_minus_distr_r. - rewrite (Zmult_comm (2 ^(b - a))); rewrite Zmult_mod_distr_l; + rewrite (Zmult_comm (2 ^(b - a))); rewrite Zmult_mod_distr_l; auto with zarith. rewrite (Zmult_comm (2 ^a)); apply Zmult_le_compat_r; auto with zarith. match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; @@ -222,22 +224,22 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. split; auto with zarith. assert (0 <= 2 ^a * r); auto with zarith. apply Zplus_le_0_compat; auto with zarith. - match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; + match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. pattern (2 ^ b) at 2;replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a); try ring. apply Zplus_le_lt_compat; auto with zarith. replace b with ((b - a) + a); try ring. rewrite Zpower_exp; auto with zarith. - pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); + pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); try rewrite <- Zmult_minus_distr_r. repeat rewrite (fun x => Zmult_comm x (2 ^ a)); rewrite Zmult_mod_distr_l; auto with zarith. apply Zmult_le_compat_l; auto with zarith. - match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; + match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. Qed. - Theorem Zdiv_shift_r: + Theorem Zdiv_shift_r: forall a b r t, 0 <= a <= b -> 0 <= r -> 0 <= t < 2 ^a -> (r * 2 ^a + t) / (2 ^ b) = (r * 2 ^a) / (2 ^ b). Proof. @@ -251,7 +253,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. rewrite <- Zmod_shift_r; auto with zarith. rewrite (Zmult_comm (2 ^ b)); rewrite Z_div_plus_full_l; auto with zarith. rewrite (fun x y => @Zdiv_small (x mod y)); auto with zarith. - match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; + match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. Qed. @@ -262,8 +264,8 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. a * 2^p = a / 2^(n - p) * 2^n + (a*2^p) mod 2^n. Proof. intros n p a H1 H2. - pattern (a*2^p) at 1;replace (a*2^p) with - (a*2^p/2^n * 2^n + a*2^p mod 2^n). + pattern (a*2^p) at 1;replace (a*2^p) with + (a*2^p/2^n * 2^n + a*2^p mod 2^n). 2:symmetry;rewrite (Zmult_comm (a*2^p/2^n));apply Z_div_mod_eq. replace (a * 2 ^ p / 2 ^ n) with (a / 2 ^ (n - p));trivial. replace (2^n) with (2^(n-p)*2^p). @@ -277,8 +279,8 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Qed. - Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n -> - ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) = + Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n -> + ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) = a mod 2 ^ p. Proof. intros. @@ -310,16 +312,16 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Lemma div_le_0 : forall p x, 0 <= x -> 0 <= x / 2 ^ p. Proof. intros p x Hle;destruct (Z_le_gt_dec 0 p). - apply Zdiv_le_lower_bound;auto with zarith. + apply Zdiv_le_lower_bound;auto with zarith. replace (2^p) with 0. destruct x;compute;intro;discriminate. destruct p;trivial;discriminate z. Qed. - + Lemma div_lt : forall p x y, 0 <= x < y -> x / 2^p < y. Proof. intros p x y H;destruct (Z_le_gt_dec 0 p). - apply Zdiv_lt_upper_bound;auto with zarith. + apply Zdiv_lt_upper_bound;auto with zarith. apply Zlt_le_trans with y;auto with zarith. rewrite <- (Zmult_1_r y);apply Zmult_le_compat;auto with zarith. assert (0 < 2^p);auto with zarith. @@ -331,7 +333,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Theorem Zgcd_div_pos a b: 0 < b -> 0 < Zgcd a b -> 0 < b / Zgcd a b. Proof. - intros a b Ha Hg. + intros Ha Hg. case (Zle_lt_or_eq 0 (b/Zgcd a b)); auto. apply Z_div_pos; auto with zarith. intros H; generalize Ha. @@ -343,7 +345,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Theorem Zdiv_neg a b: a < 0 -> 0 < b -> a / b < 0. Proof. - intros a b Ha Hb. + intros Ha Hb. assert (b > 0) by omega. generalize (Z_mult_div_ge a _ H); intros. assert (b * (a / b) < 0)%Z. @@ -354,22 +356,8 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. 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 -> + Lemma Zdiv_gcd_zero : forall a b, b / Zgcd a b = 0 -> b <> 0 -> Zgcd a b = 0. Proof. intros. @@ -381,13 +369,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. intros; subst k; simpl in *; subst b; elim H0; auto. Qed. - Lemma Zgcd_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, + Lemma Zgcd_mult_rel_prime : forall a b c, Zgcd a c = 1 -> Zgcd b c = 1 -> Zgcd (a*b) c = 1. Proof. intros. @@ -396,7 +378,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Qed. Lemma Zcompare_gt : forall (A:Type)(a a':A)(p q:Z), - match (p?=q)%Z with Gt => a | _ => a' end = + match (p?=q)%Z with Gt => a | _ => a' end = if Z_le_gt_dec p q then a' else a. Proof. intros. diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v index 528d78c3..51df2fa3 100644 --- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v +++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v @@ -8,12 +8,12 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(* $Id: CyclicAxioms.v 11012 2008-05-28 16:34:43Z letouzey $ *) +(* $Id$ *) (** * Signature and specification of a bounded integer structure *) -(** This file specifies how to represent [Z/nZ] when [n=2^d], - [d] being the number of digits of these bounded integers. *) +(** This file specifies how to represent [Z/nZ] when [n=2^d], + [d] being the number of digits of these bounded integers. *) Set Implicit Arguments. @@ -22,7 +22,7 @@ Require Import Znumtheory. Require Import BigNumPrelude. Require Import DoubleType. -Open Local Scope Z_scope. +Local Open Scope Z_scope. (** First, a description via an operator record and a spec record. *) @@ -33,7 +33,7 @@ Section Z_nZ_Op. Record znz_op := mk_znz_op { (* Conversion functions with Z *) - znz_digits : positive; + znz_digits : positive; znz_zdigits: znz; znz_to_Z : znz -> Z; znz_of_pos : positive -> N * znz; (* Euclidean division by [2^digits] *) @@ -78,12 +78,12 @@ Section Z_nZ_Op. znz_div : znz -> znz -> znz * znz; znz_mod_gt : znz -> znz -> znz; (* specialized version of [znz_mod] *) - znz_mod : znz -> znz -> znz; + znz_mod : znz -> znz -> znz; znz_gcd_gt : znz -> znz -> znz; (* specialized version of [znz_gcd] *) - znz_gcd : znz -> znz -> znz; + znz_gcd : znz -> znz -> znz; (* [znz_add_mul_div p i j] is a combination of the [(digits-p)] - low bits of [i] above the [p] high bits of [j]: + low bits of [i] above the [p] high bits of [j]: [znz_add_mul_div p i j = i*2^p+j/2^(digits-p)] *) znz_add_mul_div : znz -> znz -> znz -> znz; (* [znz_pos_mod p i] is [i mod 2^p] *) @@ -135,7 +135,7 @@ Section Z_nZ_Spec. Let w_mul_c := w_op.(znz_mul_c). Let w_mul := w_op.(znz_mul). Let w_square_c := w_op.(znz_square_c). - + Let w_div21 := w_op.(znz_div21). Let w_div_gt := w_op.(znz_div_gt). Let w_div := w_op.(znz_div). @@ -229,25 +229,25 @@ Section Z_nZ_Spec. spec_div : forall a b, 0 < [|b|] -> let (q,r) := w_div a b in [|a|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]; - + 0 <= [|r|] < [|b|]; + spec_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> [|w_mod_gt a b|] = [|a|] mod [|b|]; spec_mod : forall a b, 0 < [|b|] -> [|w_mod a b|] = [|a|] mod [|b|]; - + spec_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]; spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|w_gcd a b|]; - + (* shift operations *) spec_head00: forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits; spec_head0 : forall x, 0 < [|x|] -> - wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB; + wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB; spec_tail00: forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits; - spec_tail0 : forall x, 0 < [|x|] -> - exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|w_tail0 x|]) ; + spec_tail0 : forall x, 0 < [|x|] -> + exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|w_tail0 x|]) ; spec_add_mul_div : forall x y p, [|p|] <= Zpos w_digits -> [| w_add_mul_div p x y |] = @@ -272,23 +272,23 @@ End Z_nZ_Spec. (** Generic construction of double words *) Section WW. - + Variable w : Type. Variable w_op : znz_op w. Variable op_spec : znz_spec w_op. - + Let wB := base w_op.(znz_digits). Let w_to_Z := w_op.(znz_to_Z). Let w_eq0 := w_op.(znz_eq0). Let w_0 := w_op.(znz_0). - Definition znz_W0 h := + Definition znz_W0 h := if w_eq0 h then W0 else WW h w_0. - Definition znz_0W l := + Definition znz_0W l := if w_eq0 l then W0 else WW w_0 l. - Definition znz_WW h l := + Definition znz_WW h l := if w_eq0 h then znz_0W l else WW h l. Lemma spec_W0 : forall h, @@ -300,7 +300,7 @@ Section WW. unfold w_0; rewrite op_spec.(spec_0); auto with zarith. Qed. - Lemma spec_0W : forall l, + Lemma spec_0W : forall l, zn2z_to_Z wB w_to_Z (znz_0W l) = w_to_Z l. Proof. unfold zn2z_to_Z, znz_0W, w_to_Z; simpl; intros. @@ -309,7 +309,7 @@ Section WW. unfold w_0; rewrite op_spec.(spec_0); auto with zarith. Qed. - Lemma spec_WW : forall h l, + Lemma spec_WW : forall h l, zn2z_to_Z wB w_to_Z (znz_WW h l) = (w_to_Z h)*wB + w_to_Z l. Proof. unfold znz_WW, w_to_Z; simpl; intros. @@ -324,7 +324,7 @@ End WW. (** Injecting [Z] numbers into a cyclic structure *) Section znz_of_pos. - + Variable w : Type. Variable w_op : znz_op w. Variable op_spec : znz_spec w_op. @@ -349,7 +349,7 @@ Section znz_of_pos. apply Zle_trans with X; auto with zarith end. match goal with |- ?X <= _ => - pattern X at 1; rewrite <- (Zmult_1_l); + pattern X at 1; rewrite <- (Zmult_1_l); apply Zmult_le_compat_r; auto with zarith end. case p1; simpl; intros; red; simpl; intros; discriminate. @@ -373,3 +373,112 @@ Module Type CyclicType. Parameter w_op : znz_op w. Parameter w_spec : znz_spec w_op. End CyclicType. + + +(** A Cyclic structure can be seen as a ring *) + +Module CyclicRing (Import Cyclic : CyclicType). + +Definition t := w. + +Local Notation "[| x |]" := (w_op.(znz_to_Z) x) (at level 0, x at level 99). + +Definition eq (n m : t) := [| n |] = [| m |]. +Definition zero : t := w_op.(znz_0). +Definition one := w_op.(znz_1). +Definition add := w_op.(znz_add). +Definition sub := w_op.(znz_sub). +Definition mul := w_op.(znz_mul). +Definition opp := w_op.(znz_opp). + +Local Infix "==" := eq (at level 70). +Local Notation "0" := zero. +Local Notation "1" := one. +Local Infix "+" := add. +Local Infix "-" := sub. +Local Infix "*" := mul. +Local Notation "!!" := (base (znz_digits w_op)). + +Hint Rewrite + w_spec.(spec_0) w_spec.(spec_1) + w_spec.(spec_add) w_spec.(spec_mul) w_spec.(spec_opp) w_spec.(spec_sub) + : cyclic. + +Ltac zify := + unfold eq, zero, one, add, sub, mul, opp in *; autorewrite with cyclic. + +Lemma add_0_l : forall x, 0 + x == x. +Proof. +intros. zify. rewrite Zplus_0_l. +apply Zmod_small. apply w_spec.(spec_to_Z). +Qed. + +Lemma add_comm : forall x y, x + y == y + x. +Proof. +intros. zify. now rewrite Zplus_comm. +Qed. + +Lemma add_assoc : forall x y z, x + (y + z) == x + y + z. +Proof. +intros. zify. now rewrite Zplus_mod_idemp_r, Zplus_mod_idemp_l, Zplus_assoc. +Qed. + +Lemma mul_1_l : forall x, 1 * x == x. +Proof. +intros. zify. rewrite Zmult_1_l. +apply Zmod_small. apply w_spec.(spec_to_Z). +Qed. + +Lemma mul_comm : forall x y, x * y == y * x. +Proof. +intros. zify. now rewrite Zmult_comm. +Qed. + +Lemma mul_assoc : forall x y z, x * (y * z) == x * y * z. +Proof. +intros. zify. now rewrite Zmult_mod_idemp_r, Zmult_mod_idemp_l, Zmult_assoc. +Qed. + +Lemma mul_add_distr_r : forall x y z, (x+y)*z == x*z + y*z. +Proof. +intros. zify. now rewrite <- Zplus_mod, Zmult_mod_idemp_l, Zmult_plus_distr_l. +Qed. + +Lemma add_opp_r : forall x y, x + opp y == x-y. +Proof. +intros. zify. rewrite <- Zminus_mod_idemp_r. unfold Zminus. +destruct (Z_eq_dec ([|y|] mod !!) 0) as [EQ|NEQ]. +rewrite Z_mod_zero_opp_full, EQ, 2 Zplus_0_r; auto. +rewrite Z_mod_nz_opp_full by auto. +rewrite <- Zplus_mod_idemp_r, <- Zminus_mod_idemp_l. +rewrite Z_mod_same_full. simpl. now rewrite Zplus_mod_idemp_r. +Qed. + +Lemma add_opp_diag_r : forall x, x + opp x == 0. +Proof. +intros. red. rewrite add_opp_r. zify. now rewrite Zminus_diag, Zmod_0_l. +Qed. + +Lemma CyclicRing : ring_theory 0 1 add mul sub opp eq. +Proof. +constructor. +exact add_0_l. exact add_comm. exact add_assoc. +exact mul_1_l. exact mul_comm. exact mul_assoc. +exact mul_add_distr_r. +symmetry. apply add_opp_r. +exact add_opp_diag_r. +Qed. + +Definition eqb x y := + match w_op.(znz_compare) x y with Eq => true | _ => false end. + +Lemma eqb_eq : forall x y, eqb x y = true <-> x == y. +Proof. + intros. unfold eqb, eq. generalize (w_spec.(spec_compare) x y). + destruct (w_op.(znz_compare) x y); intuition; try discriminate. +Qed. + +Lemma eqb_correct : forall x y, eqb x y = true -> x==y. +Proof. now apply eqb_eq. Qed. + +End CyclicRing.
\ No newline at end of file diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v index fb3f0cef..517e48ad 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 11238 2008-07-19 09:34:03Z herbelin $ i*) +(*i $Id$ i*) Require Export NZAxioms. Require Import BigNumPrelude. @@ -17,89 +17,79 @@ Require Import CyclicAxioms. (** * From [CyclicType] to [NZAxiomsSig] *) -(** A [Z/nZ] representation given by a module type [CyclicType] - implements [NZAxiomsSig], e.g. the common properties between - N and Z with no ordering. Notice that the [n] in [Z/nZ] is +(** A [Z/nZ] representation given by a module type [CyclicType] + implements [NZAxiomsSig], e.g. the common properties between + N and Z with no ordering. Notice that the [n] in [Z/nZ] is a power of 2. *) Module NZCyclicAxiomsMod (Import Cyclic : CyclicType) <: NZAxiomsSig. -Open Local Scope Z_scope. +Local Open Scope Z_scope. -Definition NZ := w. +Definition t := w. -Definition NZ_to_Z : NZ -> Z := znz_to_Z w_op. -Definition Z_to_NZ : Z -> NZ := znz_of_Z w_op. -Notation Local wB := (base w_op.(znz_digits)). +Definition NZ_to_Z : t -> Z := znz_to_Z w_op. +Definition Z_to_NZ : Z -> t := znz_of_Z w_op. +Local Notation wB := (base w_op.(znz_digits)). -Notation Local "[| x |]" := (w_op.(znz_to_Z) x) (at level 0, x at level 99). +Local Notation "[| x |]" := (w_op.(znz_to_Z) x) (at level 0, x at level 99). -Definition NZeq (n m : NZ) := [| n |] = [| m |]. -Definition NZ0 := w_op.(znz_0). -Definition NZsucc := w_op.(znz_succ). -Definition NZpred := w_op.(znz_pred). -Definition NZadd := w_op.(znz_add). -Definition NZsub := w_op.(znz_sub). -Definition NZmul := w_op.(znz_mul). +Definition eq (n m : t) := [| n |] = [| m |]. +Definition zero := w_op.(znz_0). +Definition succ := w_op.(znz_succ). +Definition pred := w_op.(znz_pred). +Definition add := w_op.(znz_add). +Definition sub := w_op.(znz_sub). +Definition mul := w_op.(znz_mul). -Theorem NZeq_equiv : equiv NZ NZeq. -Proof. -unfold equiv, reflexive, symmetric, transitive, NZeq; repeat split; intros; auto. -now transitivity [| y |]. -Qed. +Local Infix "==" := eq (at level 70). +Local Notation "0" := zero. +Local Notation S := succ. +Local Notation P := pred. +Local Infix "+" := add. +Local Infix "-" := sub. +Local Infix "*" := mul. -Add Relation NZ NZeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. +Hint Rewrite w_spec.(spec_0) w_spec.(spec_succ) w_spec.(spec_pred) + w_spec.(spec_add) w_spec.(spec_mul) w_spec.(spec_sub) : w. +Ltac wsimpl := + unfold eq, zero, succ, pred, add, sub, mul; autorewrite with w. +Ltac wcongruence := repeat red; intros; wsimpl; congruence. -Add Morphism NZsucc with signature NZeq ==> NZeq as NZsucc_wd. +Instance eq_equiv : Equivalence eq. Proof. -unfold NZeq; intros n m H. do 2 rewrite w_spec.(spec_succ). now rewrite H. +unfold eq. firstorder. Qed. -Add Morphism NZpred with signature NZeq ==> NZeq as NZpred_wd. +Instance succ_wd : Proper (eq ==> eq) succ. Proof. -unfold NZeq; intros n m H. do 2 rewrite w_spec.(spec_pred). now rewrite H. +wcongruence. Qed. -Add Morphism NZadd with signature NZeq ==> NZeq ==> NZeq as NZadd_wd. +Instance pred_wd : Proper (eq ==> eq) pred. Proof. -unfold NZeq; intros n1 n2 H1 m1 m2 H2. do 2 rewrite w_spec.(spec_add). -now rewrite H1, H2. +wcongruence. Qed. -Add Morphism NZsub with signature NZeq ==> NZeq ==> NZeq as NZsub_wd. +Instance add_wd : Proper (eq ==> eq ==> eq) add. Proof. -unfold NZeq; intros n1 n2 H1 m1 m2 H2. do 2 rewrite w_spec.(spec_sub). -now rewrite H1, H2. +wcongruence. Qed. -Add Morphism NZmul with signature NZeq ==> NZeq ==> NZeq as NZmul_wd. +Instance sub_wd : Proper (eq ==> eq ==> eq) sub. Proof. -unfold NZeq; intros n1 n2 H1 m1 m2 H2. do 2 rewrite w_spec.(spec_mul). -now rewrite H1, H2. +wcongruence. Qed. -Delimit Scope IntScope with Int. -Bind Scope IntScope with NZ. -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 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. -Notation "x * y" := (NZmul x y) : IntScope. +Instance mul_wd : Proper (eq ==> eq ==> eq) mul. +Proof. +wcongruence. +Qed. Theorem gt_wB_1 : 1 < wB. Proof. -unfold base. -apply Zpower_gt_1; unfold Zlt; auto with zarith. +unfold base. apply Zpower_gt_1; unfold Zlt; auto with zarith. Qed. Theorem gt_wB_0 : 0 < wB. @@ -107,7 +97,7 @@ Proof. pose proof gt_wB_1; auto with zarith. Qed. -Lemma NZsucc_mod_wB : forall n : Z, (n + 1) mod wB = ((n mod wB) + 1) mod wB. +Lemma succ_mod_wB : forall n : Z, (n + 1) mod wB = ((n mod wB) + 1) mod wB. Proof. intro n. pattern 1 at 2. replace 1 with (1 mod wB). rewrite <- Zplus_mod. @@ -115,7 +105,7 @@ reflexivity. now rewrite Zmod_small; [ | split; [auto with zarith | apply gt_wB_1]]. Qed. -Lemma NZpred_mod_wB : forall n : Z, (n - 1) mod wB = ((n mod wB) - 1) mod wB. +Lemma pred_mod_wB : forall n : Z, (n - 1) mod wB = ((n mod wB) - 1) mod wB. Proof. intro n. pattern 1 at 2. replace 1 with (1 mod wB). rewrite <- Zminus_mod. @@ -123,34 +113,32 @@ reflexivity. now rewrite Zmod_small; [ | split; [auto with zarith | apply gt_wB_1]]. Qed. -Lemma NZ_to_Z_mod : forall n : NZ, [| n |] mod wB = [| n |]. +Lemma NZ_to_Z_mod : forall n, [| n |] mod wB = [| n |]. Proof. intro n; rewrite Zmod_small. reflexivity. apply w_spec.(spec_to_Z). Qed. -Theorem NZpred_succ : forall n : NZ, P (S n) == n. +Theorem pred_succ : forall n, P (S n) == n. Proof. -intro n; unfold NZsucc, NZpred, NZeq. rewrite w_spec.(spec_pred), w_spec.(spec_succ). -rewrite <- NZpred_mod_wB. +intro n. wsimpl. +rewrite <- pred_mod_wB. replace ([| n |] + 1 - 1)%Z with [| n |] by auto with zarith. apply NZ_to_Z_mod. Qed. -Lemma Z_to_NZ_0 : Z_to_NZ 0%Z == 0%Int. +Lemma Z_to_NZ_0 : Z_to_NZ 0%Z == 0. Proof. -unfold NZeq, NZ_to_Z, Z_to_NZ. rewrite znz_of_Z_correct. -symmetry; apply w_spec.(spec_0). +unfold NZ_to_Z, Z_to_NZ. wsimpl. +rewrite znz_of_Z_correct; auto. exact w_spec. split; [auto with zarith |apply gt_wB_0]. Qed. Section Induction. -Variable A : NZ -> Prop. -Hypothesis A_wd : predicate_wd NZeq A. +Variable A : t -> Prop. +Hypothesis A_wd : Proper (eq ==> iff) A. Hypothesis A0 : A 0. -Hypothesis AS : forall n : NZ, A n <-> A (S n). (* Below, we use only -> direction *) - -Add Morphism A with signature NZeq ==> iff as A_morph. -Proof. apply A_wd. Qed. +Hypothesis AS : forall n, A n <-> A (S n). + (* Below, we use only -> direction *) Let B (n : Z) := A (Z_to_NZ n). @@ -163,8 +151,8 @@ Lemma BS : forall n : Z, 0 <= n -> n < wB - 1 -> B n -> B (n + 1). Proof. intros n H1 H2 H3. unfold B in *. apply -> AS in H3. -setoid_replace (Z_to_NZ (n + 1)) with (S (Z_to_NZ n)) using relation NZeq. assumption. -unfold NZeq. rewrite w_spec.(spec_succ). +setoid_replace (Z_to_NZ (n + 1)) with (S (Z_to_NZ n)). assumption. +wsimpl. unfold NZ_to_Z, Z_to_NZ. do 2 (rewrite znz_of_Z_correct; [ | exact w_spec | auto with zarith]). symmetry; apply Zmod_small; auto with zarith. @@ -177,11 +165,11 @@ apply Zbounded_induction with wB. apply B0. apply BS. assumption. assumption. Qed. -Theorem NZinduction : forall n : NZ, A n. +Theorem bi_induction : forall n, A n. Proof. -intro n. setoid_replace n with (Z_to_NZ (NZ_to_Z n)) using relation NZeq. +intro n. setoid_replace n with (Z_to_NZ (NZ_to_Z n)). apply B_holds. apply w_spec.(spec_to_Z). -unfold NZeq, NZ_to_Z, Z_to_NZ; rewrite znz_of_Z_correct. +unfold eq, NZ_to_Z, Z_to_NZ; rewrite znz_of_Z_correct. reflexivity. exact w_spec. apply w_spec.(spec_to_Z). @@ -189,47 +177,40 @@ Qed. End Induction. -Theorem NZadd_0_l : forall n : NZ, 0 + n == n. +Theorem add_0_l : forall n, 0 + n == n. Proof. -intro n; unfold NZadd, NZ0, NZeq. rewrite w_spec.(spec_add). rewrite w_spec.(spec_0). +intro n. wsimpl. rewrite Zplus_0_l. rewrite Zmod_small; [reflexivity | apply w_spec.(spec_to_Z)]. Qed. -Theorem NZadd_succ_l : forall n m : NZ, (S n) + m == S (n + m). +Theorem add_succ_l : forall n m, (S n) + m == S (n + m). Proof. -intros n m; unfold NZadd, NZsucc, NZeq. rewrite w_spec.(spec_add). -do 2 rewrite w_spec.(spec_succ). rewrite w_spec.(spec_add). -rewrite NZsucc_mod_wB. repeat rewrite Zplus_mod_idemp_l; try apply gt_wB_0. +intros n m. wsimpl. +rewrite succ_mod_wB. repeat rewrite Zplus_mod_idemp_l; try apply gt_wB_0. rewrite <- (Zplus_assoc ([| n |] mod wB) 1 [| m |]). rewrite Zplus_mod_idemp_l. rewrite (Zplus_comm 1 [| m |]); now rewrite Zplus_assoc. Qed. -Theorem NZsub_0_r : forall n : NZ, n - 0 == n. +Theorem sub_0_r : forall n, n - 0 == n. Proof. -intro n; unfold NZsub, NZ0, NZeq. rewrite w_spec.(spec_sub). -rewrite w_spec.(spec_0). rewrite Zminus_0_r. apply NZ_to_Z_mod. +intro n. wsimpl. rewrite Zminus_0_r. apply NZ_to_Z_mod. Qed. -Theorem NZsub_succ_r : forall n m : NZ, n - (S m) == P (n - m). +Theorem sub_succ_r : forall n m, n - (S m) == P (n - m). Proof. -intros n m; unfold NZsub, NZsucc, NZpred, NZeq. -rewrite w_spec.(spec_pred). do 2 rewrite w_spec.(spec_sub). -rewrite w_spec.(spec_succ). rewrite Zminus_mod_idemp_r. -rewrite Zminus_mod_idemp_l. -now replace ([|n|] - ([|m|] + 1))%Z with ([|n|] - [|m|] - 1)%Z by auto with zarith. +intros n m. wsimpl. rewrite Zminus_mod_idemp_r, Zminus_mod_idemp_l. +now replace ([|n|] - ([|m|] + 1))%Z with ([|n|] - [|m|] - 1)%Z + by auto with zarith. Qed. -Theorem NZmul_0_l : forall n : NZ, 0 * n == 0. +Theorem mul_0_l : forall n, 0 * n == 0. Proof. -intro n; unfold NZmul, NZ0, NZ, NZeq. rewrite w_spec.(spec_mul). -rewrite w_spec.(spec_0). now rewrite Zmult_0_l. +intro n. wsimpl. now rewrite Zmult_0_l. Qed. -Theorem NZmul_succ_l : forall n m : NZ, (S n) * m == n * m + m. +Theorem mul_succ_l : forall n m, (S n) * m == n * m + m. Proof. -intros n m; unfold NZmul, NZsucc, NZadd, NZeq. rewrite w_spec.(spec_mul). -rewrite w_spec.(spec_add), w_spec.(spec_mul), w_spec.(spec_succ). -rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l. +intros n m. wsimpl. rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l. now rewrite Zmult_plus_distr_l, Zmult_1_l. Qed. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v index 61d8d0fb..aa798e1c 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleAdd.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -17,7 +17,7 @@ Require Import BigNumPrelude. Require Import DoubleType. Require Import DoubleBase. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section DoubleAdd. Variable w : Type. @@ -36,10 +36,10 @@ Section DoubleAdd. Definition ww_succ_c x := match x with | W0 => C0 ww_1 - | WW xh xl => + | WW xh xl => match w_succ_c xl with | C0 l => C0 (WW xh l) - | C1 l => + | C1 l => match w_succ_c xh with | C0 h => C0 (WW h w_0) | C1 h => C1 W0 @@ -47,13 +47,13 @@ Section DoubleAdd. end end. - Definition ww_succ x := + Definition ww_succ x := match x with | W0 => ww_1 | WW xh xl => match w_succ_c xl with | C0 l => WW xh l - | C1 l => w_W0 (w_succ xh) + | C1 l => w_W0 (w_succ xh) end end. @@ -63,12 +63,12 @@ Section DoubleAdd. | _, W0 => C0 x | WW xh xl, WW yh yl => match w_add_c xl yl with - | C0 l => + | C0 l => match w_add_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (w_WW h l) - end - | C1 l => + end + | C1 l => match w_add_carry_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (w_WW h l) @@ -85,12 +85,12 @@ Section DoubleAdd. | _, W0 => f0 x | WW xh xl, WW yh yl => match w_add_c xl yl with - | C0 l => + | C0 l => match w_add_c xh yh with | C0 h => f0 (WW h l) | C1 h => f1 (w_WW h l) - end - | C1 l => + end + | C1 l => match w_add_carry_c xh yh with | C0 h => f0 (WW h l) | C1 h => f1 (w_WW h l) @@ -118,12 +118,12 @@ Section DoubleAdd. | WW xh xl, W0 => ww_succ_c (WW xh xl) | WW xh xl, WW yh yl => match w_add_carry_c xl yl with - | C0 l => + | C0 l => match w_add_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (WW h l) end - | C1 l => + | C1 l => match w_add_carry_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (w_WW h l) @@ -131,7 +131,7 @@ Section DoubleAdd. end end. - Definition ww_add_carry x y := + Definition ww_add_carry x y := match x, y with | W0, W0 => ww_1 | W0, WW yh yl => ww_succ (WW yh yl) @@ -146,7 +146,7 @@ Section DoubleAdd. (*Section DoubleProof.*) Variable w_digits : positive. Variable w_to_Z : w -> Z. - + Notation wB := (base w_digits). Notation wwB := (base (ww_digits w_digits)). @@ -157,11 +157,11 @@ Section DoubleAdd. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Variable spec_w_0 : [|w_0|] = 0. @@ -172,7 +172,7 @@ Section DoubleAdd. Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. Variable spec_w_succ_c : forall x, [+|w_succ_c x|] = [|x|] + 1. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. - Variable spec_w_add_carry_c : + Variable spec_w_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1. Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB. Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. @@ -187,11 +187,11 @@ Section DoubleAdd. rewrite <- Zplus_assoc;rewrite <- H;rewrite Zmult_1_l. assert ([|l|] = 0). generalize (spec_to_Z xl)(spec_to_Z l);omega. rewrite H0;generalize (spec_w_succ_c xh);destruct (w_succ_c xh) as [h|h]; - intro H1;unfold interp_carry in H1. + intro H1;unfold interp_carry in H1. simpl;rewrite H1;rewrite spec_w_0;ring. unfold interp_carry;simpl ww_to_Z;rewrite wwB_wBwB. assert ([|xh|] = wB - 1). generalize (spec_to_Z xh)(spec_to_Z h);omega. - rewrite H2;ring. + rewrite H2;ring. Qed. Lemma spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]]. @@ -222,12 +222,12 @@ Section DoubleAdd. Proof. destruct x as [ |xh xl];simpl;trivial. apply spec_f0;trivial. - destruct y as [ |yh yl];simpl. + destruct y as [ |yh yl];simpl. apply spec_f0;simpl;rewrite Zplus_0_r;trivial. generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; intros H;unfold interp_carry in H. generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; - intros H1;unfold interp_carry in *. + intros H1;unfold interp_carry in *. apply spec_f0. simpl;rewrite H;rewrite H1;ring. apply spec_f1. simpl;rewrite spec_w_WW;rewrite H. rewrite Zplus_assoc;rewrite wwB_wBwB. rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. @@ -236,12 +236,12 @@ Section DoubleAdd. as [h|h]; intros H1;unfold interp_carry in *. apply spec_f0;simpl;rewrite H1. rewrite Zmult_plus_distr_l. rewrite <- Zplus_assoc;rewrite H;ring. - apply spec_f1. simpl;rewrite spec_w_WW;rewrite wwB_wBwB. - rewrite Zplus_assoc; rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. + apply spec_f1. simpl;rewrite spec_w_WW;rewrite wwB_wBwB. + rewrite Zplus_assoc; rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. rewrite Zmult_1_l in H1;rewrite H1. rewrite Zmult_plus_distr_l. rewrite <- Zplus_assoc;rewrite H;ring. Qed. - + End Cont. Lemma spec_ww_add_carry_c : @@ -251,16 +251,16 @@ Section DoubleAdd. exact (spec_ww_succ_c y). destruct y as [ |yh yl];simpl. rewrite Zplus_0_r;exact (spec_ww_succ_c (WW xh xl)). - replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) + replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. - generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) + generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H. generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. unfold interp_carry;repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) - as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. + generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) + as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. unfold interp_carry;rewrite spec_w_WW; repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. Qed. @@ -287,9 +287,9 @@ Section DoubleAdd. rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial. destruct y as [ |yh yl]. change [[W0]] with 0;rewrite Zplus_0_r. - rewrite Zmod_small;trivial. + rewrite Zmod_small;trivial. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)). - simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) + simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring. generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; unfold interp_carry;intros H;simpl;rewrite <- H. @@ -305,14 +305,14 @@ Section DoubleAdd. exact (spec_ww_succ y). destruct y as [ |yh yl]. change [[W0]] with 0;rewrite Zplus_0_r. exact (spec_ww_succ (WW xh xl)). - simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) + simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. - generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) + generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) as [l|l];unfold interp_carry;intros H;rewrite <- H;simpl ww_to_Z. rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial. rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial. - Qed. + Qed. (* End DoubleProof. *) End DoubleAdd. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v index 952516ac..88c34915 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleBase.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -16,7 +16,7 @@ Require Import ZArith. Require Import BigNumPrelude. Require Import DoubleType. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section DoubleBase. Variable w : Type. @@ -29,8 +29,8 @@ Section DoubleBase. Variable w_zdigits: w. Variable w_add: w -> w -> zn2z w. Variable w_to_Z : w -> Z. - Variable w_compare : w -> w -> comparison. - + Variable w_compare : w -> w -> comparison. + Definition ww_digits := xO w_digits. Definition ww_zdigits := w_add w_zdigits w_zdigits. @@ -46,7 +46,7 @@ Section DoubleBase. | W0, W0 => W0 | _, _ => WW xh xl end. - + Definition ww_W0 h : zn2z (zn2z w) := match h with | W0 => W0 @@ -58,10 +58,10 @@ Section DoubleBase. | W0 => W0 | _ => WW W0 l end. - - Definition double_WW (n:nat) := - match n return word w n -> word w n -> word w (S n) with - | O => w_WW + + Definition double_WW (n:nat) := + match n return word w n -> word w n -> word w (S n) with + | O => w_WW | S n => fun (h l : zn2z (word w n)) => match h, l with @@ -70,8 +70,8 @@ Section DoubleBase. end end. - Fixpoint double_digits (n:nat) : positive := - match n with + Fixpoint double_digits (n:nat) : positive := + match n with | O => w_digits | S n => xO (double_digits n) end. @@ -80,7 +80,7 @@ Section DoubleBase. Fixpoint double_to_Z (n:nat) : word w n -> Z := match n return word w n -> Z with - | O => w_to_Z + | O => w_to_Z | S n => zn2z_to_Z (double_wB n) (double_to_Z n) end. @@ -98,21 +98,21 @@ Section DoubleBase. end. Definition double_0 n : word w n := - match n return word w n with + match n return word w n with | O => w_0 | S _ => W0 end. - + Definition double_split (n:nat) (x:zn2z (word w n)) := - match x with - | W0 => - match n return word w n * word w n with + match x with + | W0 => + match n return word w n * word w n with | O => (w_0,w_0) | S _ => (W0, W0) end | WW h l => (h,l) end. - + Definition ww_compare x y := match x, y with | W0, W0 => Eq @@ -148,15 +148,15 @@ Section DoubleBase. end end. - + Section DoubleProof. Notation wB := (base w_digits). Notation wwB := (base ww_digits). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z x) (at level 0, x at level 99). - Notation "[+[ c ]]" := + Notation "[+[ c ]]" := (interp_carry 1 wwB ww_to_Z c) (at level 0, x at level 99). - Notation "[-[ c ]]" := + Notation "[-[ c ]]" := (interp_carry (-1) wwB ww_to_Z c) (at level 0, x at level 99). Notation "[! n | x !]" := (double_to_Z n x) (at level 0, x at level 99). @@ -188,7 +188,7 @@ Section DoubleBase. Proof. simpl;rewrite spec_w_Bm1;rewrite wwB_wBwB;ring. Qed. Lemma lt_0_wB : 0 < wB. - Proof. + Proof. unfold base;apply Zpower_gt_0. unfold Zlt;reflexivity. unfold Zle;intros H;discriminate H. Qed. @@ -197,25 +197,25 @@ Section DoubleBase. Proof. rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_lt_0_compat;apply lt_0_wB. Qed. Lemma wB_pos: 1 < wB. - Proof. + Proof. unfold base;apply Zlt_le_trans with (2^1). unfold Zlt;reflexivity. apply Zpower_le_monotone. unfold Zlt;reflexivity. split;unfold Zle;intros H. discriminate H. clear spec_w_0W w_0W spec_w_Bm1 spec_to_Z spec_w_WW w_WW. destruct w_digits; discriminate H. Qed. - - Lemma wwB_pos: 1 < wwB. + + Lemma wwB_pos: 1 < wwB. Proof. assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Zmult_1_r 1). rewrite Zpower_2. apply Zmult_lt_compat2;(split;[unfold Zlt;reflexivity|trivial]). - apply Zlt_le_weak;trivial. + apply Zlt_le_weak;trivial. Qed. Theorem wB_div_2: 2 * (wB / 2) = wB. Proof. - clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W + clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W spec_to_Z;unfold base. assert (2 ^ Zpos w_digits = 2 * (2 ^ (Zpos w_digits - 1))). pattern 2 at 2; rewrite <- Zpower_1_r. @@ -228,7 +228,7 @@ Section DoubleBase. Theorem wwB_div_2 : wwB / 2 = wB / 2 * wB. Proof. - clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W + clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W spec_to_Z. rewrite wwB_wBwB; rewrite Zpower_2. pattern wB at 1; rewrite <- wB_div_2; auto. @@ -236,11 +236,11 @@ Section DoubleBase. repeat (rewrite (Zmult_comm 2); rewrite Z_div_mult); auto with zarith. Qed. - Lemma mod_wwB : forall z x, + Lemma mod_wwB : forall z x, (z*wB + [|x|]) mod wwB = (z mod wB)*wB + [|x|]. Proof. intros z x. - rewrite Zplus_mod. + rewrite Zplus_mod. pattern wwB at 1;rewrite wwB_wBwB; rewrite Zpower_2. rewrite Zmult_mod_distr_r;try apply lt_0_wB. rewrite (Zmod_small [|x|]). @@ -260,8 +260,8 @@ Section DoubleBase. destruct (spec_to_Z x);trivial. Qed. - Lemma wB_div_plus : forall x y p, - 0 <= p -> + Lemma wB_div_plus : forall x y p, + 0 <= p -> ([|x|]*wB + [|y|]) / 2^(Zpos w_digits + p) = [|x|] / 2^p. Proof. clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. @@ -277,7 +277,7 @@ Section DoubleBase. assert (0 < Zpos w_digits). compute;reflexivity. unfold ww_digits;rewrite Zpos_xO;auto with zarith. Qed. - + Lemma w_to_Z_wwB : forall x, x < wB -> x < wwB. Proof. intros x H;apply Zlt_trans with wB;trivial;apply lt_wB_wwB. @@ -298,7 +298,7 @@ Section DoubleBase. Proof. intros n;unfold double_wB;simpl. unfold base;rewrite (Zpos_xO (double_digits n)). - replace (2 * Zpos (double_digits n)) with + replace (2 * Zpos (double_digits n)) with (Zpos (double_digits n) + Zpos (double_digits n)). symmetry; apply Zpower_exp;intro;discriminate. ring. @@ -327,7 +327,7 @@ Section DoubleBase. unfold base; auto with zarith. Qed. - Lemma spec_double_to_Z : + Lemma spec_double_to_Z : forall n (x:word w n), 0 <= [!n | x!] < double_wB n. Proof. clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. @@ -347,7 +347,7 @@ Section DoubleBase. Qed. Lemma spec_get_low: - forall n x, + forall n x, [!n | x!] < wB -> [|get_low n x|] = [!n | x!]. Proof. clear spec_w_1 spec_w_Bm1. @@ -380,19 +380,19 @@ Section DoubleBase. Qed. Lemma spec_extend_aux : forall n x, [!S n|extend_aux n x!] = [[x]]. - Proof. induction n;simpl;trivial. Qed. + Proof. induction n;simpl;trivial. Qed. Lemma spec_extend : forall n x, [!S n|extend n x!] = [|x|]. - Proof. + Proof. intros n x;assert (H:= spec_w_0W x);unfold extend. - destruct (w_0W x);simpl;trivial. + destruct (w_0W x);simpl;trivial. rewrite <- H;exact (spec_extend_aux n (WW w0 w1)). Qed. Lemma spec_double_0 : forall n, [!n|double_0 n!] = 0. Proof. destruct n;trivial. Qed. - Lemma spec_double_split : forall n x, + Lemma spec_double_split : forall n x, let (h,l) := double_split n x in [!S n|x!] = [!n|h!] * double_wB n + [!n|l!]. Proof. @@ -401,9 +401,9 @@ Section DoubleBase. rewrite spec_w_0;trivial. Qed. - Lemma wB_lex_inv: forall a b c d, - a < c -> - a * wB + [|b|] < c * wB + [|d|]. + Lemma wB_lex_inv: forall a b c d, + a < c -> + a * wB + [|b|] < c * wB + [|d|]. Proof. intros a b c d H1; apply beta_lex_inv with (1 := H1); auto. Qed. @@ -420,7 +420,7 @@ Section DoubleBase. intros H;rewrite spec_w_0 in H. rewrite <- H;simpl;rewrite <- spec_w_0;apply spec_w_compare. change 0 with (0*wB+0);pattern 0 at 2;rewrite <- spec_w_0. - apply wB_lex_inv;trivial. + apply wB_lex_inv;trivial. absurd (0 <= [|yh|]). apply Zgt_not_le;trivial. destruct (spec_to_Z yh);trivial. generalize (spec_w_compare xh w_0);destruct (w_compare xh w_0); @@ -429,8 +429,8 @@ Section DoubleBase. absurd (0 <= [|xh|]). apply Zgt_not_le;apply Zlt_gt;trivial. destruct (spec_to_Z xh);trivial. apply Zlt_gt;change 0 with (0*wB+0);pattern 0 at 2;rewrite <- spec_w_0. - apply wB_lex_inv;apply Zgt_lt;trivial. - + apply wB_lex_inv;apply Zgt_lt;trivial. + generalize (spec_w_compare xh yh);destruct (w_compare xh yh);intros H. rewrite H;generalize (spec_w_compare xl yl);destruct (w_compare xl yl); intros H1;[rewrite H1|apply Zplus_lt_compat_l|apply Zplus_gt_compat_l]; @@ -439,7 +439,7 @@ Section DoubleBase. apply Zlt_gt;apply wB_lex_inv;apply Zgt_lt;trivial. Qed. - + End DoubleProof. End DoubleBase. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v index cca32a59..eea29e7c 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleCyclic.v 11012 2008-05-28 16:34:43Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -22,10 +22,10 @@ Require Import DoubleMul. Require Import DoubleSqrt. Require Import DoubleLift. Require Import DoubleDivn1. -Require Import DoubleDiv. +Require Import DoubleDiv. Require Import CyclicAxioms. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section Z_2nZ. @@ -80,7 +80,7 @@ Section Z_2nZ. Let w_gcd_gt := w_op.(znz_gcd_gt). Let w_gcd := w_op.(znz_gcd). - Let w_add_mul_div := w_op.(znz_add_mul_div). + Let w_add_mul_div := w_op.(znz_add_mul_div). Let w_pos_mod := w_op.(znz_pos_mod). @@ -93,7 +93,7 @@ Section Z_2nZ. Let wB := base w_digits. Let w_Bm2 := w_pred w_Bm1. - + Let ww_1 := ww_1 w_0 w_1. Let ww_Bm1 := ww_Bm1 w_Bm1. @@ -112,16 +112,16 @@ Section Z_2nZ. Let ww_of_pos p := match w_of_pos p with | (N0, l) => (N0, WW w_0 l) - | (Npos ph,l) => + | (Npos ph,l) => let (n,h) := w_of_pos ph in (n, w_WW h l) end. Let head0 := - Eval lazy beta delta [ww_head0] in + Eval lazy beta delta [ww_head0] in ww_head0 w_0 w_0W w_compare w_head0 w_add2 w_zdigits _ww_zdigits. Let tail0 := - Eval lazy beta delta [ww_tail0] in + Eval lazy beta delta [ww_tail0] in ww_tail0 w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits. Let ww_WW := Eval lazy beta delta [ww_WW] in (@ww_WW w). @@ -132,7 +132,7 @@ Section Z_2nZ. Let compare := Eval lazy beta delta[ww_compare] in ww_compare w_0 w_compare. - Let eq0 (x:zn2z w) := + Let eq0 (x:zn2z w) := match x with | W0 => true | _ => false @@ -147,7 +147,7 @@ Section Z_2nZ. Let opp_carry := Eval lazy beta delta [ww_opp_carry] in ww_opp_carry w_WW ww_Bm1 w_opp_carry. - + (* ** Additions ** *) Let succ_c := @@ -157,16 +157,16 @@ Section Z_2nZ. Eval lazy beta delta [ww_add_c] in ww_add_c w_WW w_add_c w_add_carry_c. Let add_carry_c := - Eval lazy beta iota delta [ww_add_carry_c ww_succ_c] in + Eval lazy beta iota delta [ww_add_carry_c ww_succ_c] in ww_add_carry_c w_0 w_WW ww_1 w_succ_c w_add_c w_add_carry_c. - Let succ := + Let succ := Eval lazy beta delta [ww_succ] in ww_succ w_W0 ww_1 w_succ_c w_succ. Let add := Eval lazy beta delta [ww_add] in ww_add w_add_c w_add w_add_carry. - Let add_carry := + Let add_carry := Eval lazy beta iota delta [ww_add_carry ww_succ] in ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ w_add w_add_carry. @@ -174,9 +174,9 @@ Section Z_2nZ. Let pred_c := Eval lazy beta delta [ww_pred_c] in ww_pred_c w_Bm1 w_WW ww_Bm1 w_pred_c. - + Let sub_c := - Eval lazy beta iota delta [ww_sub_c ww_opp_c] in + Eval lazy beta iota delta [ww_sub_c ww_opp_c] in ww_sub_c w_0 w_WW w_opp_c w_opp_carry w_sub_c w_sub_carry_c. Let sub_carry_c := @@ -186,8 +186,8 @@ Section Z_2nZ. Let pred := Eval lazy beta delta [ww_pred] in ww_pred w_Bm1 w_WW ww_Bm1 w_pred_c w_pred. - Let sub := - Eval lazy beta iota delta [ww_sub ww_opp] in + Let sub := + Eval lazy beta iota delta [ww_sub ww_opp] in ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry. Let sub_carry := @@ -204,7 +204,7 @@ Section Z_2nZ. Let karatsuba_c := Eval lazy beta iota delta [ww_karatsuba_c double_mul_c kara_prod] in - ww_karatsuba_c w_0 w_1 w_WW w_W0 w_compare w_add w_sub w_mul_c + ww_karatsuba_c w_0 w_1 w_WW w_W0 w_compare w_add w_sub w_mul_c add_c add add_carry sub_c sub. Let mul := @@ -219,7 +219,7 @@ Section Z_2nZ. Let div32 := Eval lazy beta iota delta [w_div32] in - w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c + w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c. Let div21 := @@ -234,40 +234,40 @@ Section Z_2nZ. Let div_gt := Eval lazy beta delta [ww_div_gt] in - ww_div_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp + ww_div_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits. Let div := Eval lazy beta delta [ww_div] in ww_div ww_1 compare div_gt. - + Let mod_gt := Eval lazy beta delta [ww_mod_gt] in ww_mod_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_mod_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits add_mul_div w_zdigits. - Let mod_ := + Let mod_ := Eval lazy beta delta [ww_mod] in ww_mod compare mod_gt. - Let pos_mod := - Eval lazy beta delta [ww_pos_mod] in + Let pos_mod := + Eval lazy beta delta [ww_pos_mod] in ww_pos_mod w_0 w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits. - Let is_even := + Let is_even := Eval lazy beta delta [ww_is_even] in ww_is_even w_is_even. - Let sqrt2 := + Let sqrt2 := Eval lazy beta delta [ww_sqrt2] in ww_sqrt2 w_is_even w_compare w_0 w_1 w_Bm1 w_0W w_sub w_square_c w_div21 w_add_mul_div w_zdigits w_add_c w_sqrt2 w_pred pred_c pred add_c add sub_c add_mul_div. - Let sqrt := + Let sqrt := Eval lazy beta delta [ww_sqrt] in ww_sqrt w_is_even w_0 w_sub w_add_mul_div w_zdigits _ww_zdigits w_sqrt2 pred add_mul_div head0 compare low. - Let gcd_gt_fix := + Let gcd_gt_fix := Eval cbv beta delta [ww_gcd_gt_aux ww_gcd_gt_body] in ww_gcd_gt_aux w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt @@ -278,7 +278,7 @@ Section Z_2nZ. Eval lazy beta delta [gcd_cont] in gcd_cont ww_1 w_1 w_compare. Let gcd_gt := - Eval lazy beta delta [ww_gcd_gt] in + Eval lazy beta delta [ww_gcd_gt] in ww_gcd_gt w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont. Let gcd := @@ -286,18 +286,18 @@ Section Z_2nZ. ww_gcd compare w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont. (* ** Record of operators on 2 words *) - - Definition mk_zn2z_op := + + Definition mk_zn2z_op := mk_znz_op _ww_digits _ww_zdigits to_Z ww_of_pos head0 tail0 W0 ww_1 ww_Bm1 compare eq0 opp_c opp opp_carry - succ_c add_c add_carry_c - succ add add_carry - pred_c sub_c sub_carry_c + succ_c add_c add_carry_c + succ add add_carry + pred_c sub_c sub_carry_c pred sub sub_carry - mul_c mul square_c + mul_c mul square_c div21 div_gt div mod_gt mod_ gcd_gt gcd @@ -307,17 +307,17 @@ Section Z_2nZ. sqrt2 sqrt. - Definition mk_zn2z_op_karatsuba := + Definition mk_zn2z_op_karatsuba := mk_znz_op _ww_digits _ww_zdigits to_Z ww_of_pos head0 tail0 W0 ww_1 ww_Bm1 compare eq0 opp_c opp opp_carry - succ_c add_c add_carry_c - succ add add_carry - pred_c sub_c sub_carry_c + succ_c add_c add_carry_c + succ add add_carry + pred_c sub_c sub_carry_c pred sub sub_carry - karatsuba_c mul square_c + karatsuba_c mul square_c div21 div_gt div mod_gt mod_ gcd_gt gcd @@ -330,7 +330,7 @@ Section Z_2nZ. (* Proof *) Variable op_spec : znz_spec w_op. - Hint Resolve + Hint Resolve (spec_to_Z op_spec) (spec_of_pos op_spec) (spec_0 op_spec) @@ -358,13 +358,13 @@ Section Z_2nZ. (spec_square_c op_spec) (spec_div21 op_spec) (spec_div_gt op_spec) - (spec_div op_spec) + (spec_div op_spec) (spec_mod_gt op_spec) - (spec_mod op_spec) + (spec_mod op_spec) (spec_gcd_gt op_spec) - (spec_gcd op_spec) - (spec_head0 op_spec) - (spec_tail0 op_spec) + (spec_gcd op_spec) + (spec_head0 op_spec) + (spec_tail0 op_spec) (spec_add_mul_div op_spec) (spec_pos_mod) (spec_is_even) @@ -417,20 +417,20 @@ Section Z_2nZ. Let spec_ww_Bm1 : [|ww_Bm1|] = wwB - 1. Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed. - Let spec_ww_compare : + Let spec_ww_compare : forall x y, match compare x y with | Eq => [|x|] = [|y|] | Lt => [|x|] < [|y|] | Gt => [|x|] > [|y|] end. - Proof. - refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto. - exact (spec_compare op_spec). + Proof. + refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto. + exact (spec_compare op_spec). Qed. Let spec_ww_eq0 : forall x, eq0 x = true -> [|x|] = 0. - Proof. destruct x;simpl;intros;trivial;discriminate. Qed. + Proof. destruct x;simpl;intros;trivial;discriminate. Qed. Let spec_ww_opp_c : forall x, [-|opp_c x|] = -[|x|]. Proof. @@ -440,7 +440,7 @@ Section Z_2nZ. Let spec_ww_opp : forall x, [|opp x|] = (-[|x|]) mod wwB. Proof. - refine(spec_ww_opp w_0 w_0 W0 w_opp_c w_opp_carry w_opp + refine(spec_ww_opp w_0 w_0 W0 w_opp_c w_opp_carry w_opp w_digits w_to_Z _ _ _ _ _); auto. Qed. @@ -480,25 +480,25 @@ Section Z_2nZ. Let spec_ww_add_carry : forall x y, [|add_carry x y|]=([|x|]+[|y|]+1)mod wwB. Proof. - refine (spec_ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ + refine (spec_ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ w_add w_add_carry w_digits w_to_Z _ _ _ _ _ _ _ _);wwauto. Qed. Let spec_ww_pred_c : forall x, [-|pred_c x|] = [|x|] - 1. Proof. - refine (spec_ww_pred_c w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_digits w_to_Z + refine (spec_ww_pred_c w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_digits w_to_Z _ _ _ _ _);wwauto. Qed. Let spec_ww_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|]. Proof. - refine (spec_ww_sub_c w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c + refine (spec_ww_sub_c w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _);wwauto. Qed. Let spec_ww_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|]-[|y|]-1. Proof. - refine (spec_ww_sub_carry_c w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c + refine (spec_ww_sub_carry_c w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c w_sub_c w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _ _);wwauto. Qed. @@ -533,17 +533,17 @@ Section Z_2nZ. _ _ _ _ _ _ _ _ _ _ _ _); wwauto. unfold w_digits; apply spec_more_than_1_digit; auto. exact (spec_compare op_spec). - Qed. + Qed. Let spec_ww_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wwB. Proof. refine (spec_ww_mul w_W0 w_add w_mul_c w_mul add w_digits w_to_Z _ _ _ _ _); - wwauto. + wwauto. Qed. Let spec_ww_square_c : forall x, [[square_c x]] = [|x|] * [|x|]. Proof. - refine (spec_ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add + refine (spec_ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add add_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _ _);wwauto. Qed. @@ -574,7 +574,7 @@ Section Z_2nZ. 0 <= [|r|] < [|b|]. Proof. refine (spec_ww_div21 w_0 w_0W div32 ww_1 compare sub w_digits w_to_Z - _ _ _ _ _ _ _);wwauto. + _ _ _ _ _ _ _);wwauto. Qed. Let spec_add2: forall x y, @@ -602,7 +602,7 @@ Section Z_2nZ. unfold wB, base; auto with zarith. Qed. - Let spec_ww_digits: + Let spec_ww_digits: [|_ww_zdigits|] = Zpos (xO w_digits). Proof. unfold w_to_Z, _ww_zdigits. @@ -615,7 +615,7 @@ Section Z_2nZ. Let spec_ww_head00 : forall x, [|x|] = 0 -> [|head0 x|] = Zpos _ww_digits. Proof. - refine (spec_ww_head00 w_0 w_0W + refine (spec_ww_head00 w_0 w_0W w_compare w_head0 w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); auto. exact (spec_compare op_spec). @@ -626,8 +626,8 @@ Section Z_2nZ. Let spec_ww_head0 : forall x, 0 < [|x|] -> wwB/ 2 <= 2 ^ [|head0 x|] * [|x|] < wwB. Proof. - refine (spec_ww_head0 w_0 w_0W w_compare w_head0 - w_add2 w_zdigits _ww_zdigits + refine (spec_ww_head0 w_0 w_0W w_compare w_head0 + w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_zdigits op_spec). @@ -635,7 +635,7 @@ Section Z_2nZ. Let spec_ww_tail00 : forall x, [|x|] = 0 -> [|tail0 x|] = Zpos _ww_digits. Proof. - refine (spec_ww_tail00 w_0 w_0W + refine (spec_ww_tail00 w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); wwauto. exact (spec_compare op_spec). @@ -647,7 +647,7 @@ Section Z_2nZ. Let spec_ww_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * 2 ^ [|tail0 x|]. Proof. - refine (spec_ww_tail0 (w_digits := w_digits) w_0 w_0W w_compare w_tail0 + refine (spec_ww_tail0 (w_digits := w_digits) w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_zdigits op_spec). @@ -659,19 +659,19 @@ Section Z_2nZ. ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos _ww_digits) - [|p|]))) mod wwB. Proof. - refine (@spec_ww_add_mul_div w w_0 w_WW w_W0 w_0W compare w_add_mul_div + refine (@spec_ww_add_mul_div w w_0 w_WW w_W0 w_0W compare w_add_mul_div sub w_digits w_zdigits low w_to_Z _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_zdigits op_spec). Qed. - Let spec_ww_div_gt : forall a b, + Let spec_ww_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> let (q,r) := div_gt a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. -refine -(@spec_ww_div_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 +refine +(@spec_ww_div_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ @@ -707,14 +707,14 @@ refine refine (spec_ww_div w_digits ww_1 compare div_gt w_to_Z _ _ _ _);auto. Qed. - Let spec_ww_mod_gt : forall a b, + Let spec_ww_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> [|mod_gt a b|] = [|a|] mod [|b|]. Proof. - refine (@spec_ww_mod_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 + refine (@spec_ww_mod_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_div_gt w_mod_gt - w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div - w_zdigits w_to_Z + w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div + w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_div_gt op_spec). @@ -731,12 +731,12 @@ refine Let spec_ww_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|gcd_gt a b|]. Proof. - refine (@spec_ww_gcd_gt w w_digits W0 w_to_Z _ + refine (@spec_ww_gcd_gt w w_digits W0 w_to_Z _ w_0 w_0 w_eq0 w_gcd_gt _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);auto. refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0 - w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z + w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_div21 op_spec). @@ -753,7 +753,7 @@ refine _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);auto. refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0 - w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z + w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_compare op_spec). exact (spec_div21 op_spec). @@ -798,7 +798,7 @@ refine Let spec_ww_sqrt : forall x, [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2. Proof. - refine (@spec_ww_sqrt w w_is_even w_0 w_1 w_Bm1 + refine (@spec_ww_sqrt w w_is_even w_0 w_1 w_Bm1 w_sub w_add_mul_div w_digits w_zdigits _ww_zdigits w_sqrt2 pred add_mul_div head0 compare _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto. @@ -814,7 +814,7 @@ refine apply mk_znz_spec;auto. exact spec_ww_add_mul_div. - refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW + refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_pos_mod op_spec). @@ -828,7 +828,7 @@ refine Proof. apply mk_znz_spec;auto. exact spec_ww_add_mul_div. - refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW + refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _);wwauto. exact (spec_pos_mod op_spec). @@ -838,10 +838,10 @@ refine rewrite <- Zpos_xO; exact spec_ww_digits. Qed. -End Z_2nZ. - +End Z_2nZ. + Section MulAdd. - + Variable w: Type. Variable op: znz_op w. Variable sop: znz_spec op. @@ -870,7 +870,7 @@ Section MulAdd. End MulAdd. -(** Modular versions of DoubleCyclic *) +(** Modular versions of DoubleCyclic *) Module DoubleCyclic (C:CyclicType) <: CyclicType. Definition w := zn2z C.w. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v index 075aef59..9204b4e0 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleDiv.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -20,7 +20,7 @@ Require Import DoubleDivn1. Require Import DoubleAdd. Require Import DoubleSub. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Ltac zarith := auto with zarith. @@ -41,13 +41,13 @@ Section POS_MOD. Variable ww_zdigits : zn2z w. - Definition ww_pos_mod p x := + Definition ww_pos_mod p x := let zdigits := w_0W w_zdigits in match x with | W0 => W0 | WW xh xl => match ww_compare p zdigits with - | Eq => w_WW w_0 xl + | Eq => w_WW w_0 xl | Lt => w_WW w_0 (w_pos_mod (low p) xl) | Gt => match ww_compare p ww_zdigits with @@ -87,7 +87,7 @@ Section POS_MOD. | Lt => [[x]] < [[y]] | Gt => [[x]] > [[y]] end. - Variable spec_ww_sub: forall x y, + Variable spec_ww_sub: forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits. @@ -106,7 +106,7 @@ Section POS_MOD. unfold ww_pos_mod; case w1. simpl; rewrite Zmod_small; split; auto with zarith. intros xh xl; generalize (spec_ww_compare p (w_0W w_zdigits)); - case ww_compare; + case ww_compare; rewrite spec_w_0W; rewrite spec_zdigits; fold wB; intros H1. rewrite H1; simpl ww_to_Z. @@ -135,13 +135,13 @@ Section POS_MOD. autorewrite with w_rewrite rm10. rewrite Zmod_mod; auto with zarith. generalize (spec_ww_compare p ww_zdigits); - case ww_compare; rewrite spec_ww_zdigits; + case ww_compare; rewrite spec_ww_zdigits; rewrite spec_zdigits; intros H2. replace (2^[[p]]) with wwB. rewrite Zmod_small; auto with zarith. unfold base; rewrite H2. rewrite spec_ww_digits; auto. - assert (HH0: [|low (ww_sub p (w_0W w_zdigits))|] = + assert (HH0: [|low (ww_sub p (w_0W w_zdigits))|] = [[p]] - Zpos w_digits). rewrite spec_low. rewrite spec_ww_sub. @@ -152,11 +152,11 @@ generalize (spec_ww_compare p ww_zdigits); apply Zlt_le_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_le_lin; auto with zarith. exists wB; unfold base; rewrite <- Zpower_exp; auto with zarith. - rewrite spec_ww_digits; + rewrite spec_ww_digits; apply f_equal with (f := Zpower 2); rewrite Zpos_xO; auto with zarith. simpl ww_to_Z; autorewrite with w_rewrite. rewrite spec_pos_mod; rewrite HH0. - pattern [|xh|] at 2; + pattern [|xh|] at 2; rewrite Z_div_mod_eq with (b := 2 ^ ([[p]] - Zpos w_digits)); auto with zarith. rewrite (fun x => (Zmult_comm (2 ^ x))); rewrite Zmult_plus_distr_l. @@ -196,7 +196,7 @@ generalize (spec_ww_compare p ww_zdigits); split; auto with zarith. rewrite Zpos_xO; auto with zarith. Qed. - + End POS_MOD. Section DoubleDiv32. @@ -222,24 +222,24 @@ Section DoubleDiv32. match w_compare a1 b1 with | Lt => let (q,r) := w_div21 a1 a2 b1 in - match ww_sub_c (w_WW r a3) (w_mul_c q b2) with + match ww_sub_c (w_WW r a3) (w_mul_c q b2) with | C0 r1 => (q,r1) | C1 r1 => let q := w_pred q in - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2))) (fun r2 => (q,r2)) r1 (WW b1 b2) end | Eq => - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2))) (fun r => (w_Bm1,r)) (WW (w_sub a2 b2) a3) (WW b1 b2) | Gt => (w_0, W0) (* cas absurde *) end. - (* Proof *) + (* Proof *) Variable w_digits : positive. Variable w_to_Z : w -> Z. @@ -253,8 +253,8 @@ Section DoubleDiv32. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). @@ -273,7 +273,7 @@ Section DoubleDiv32. | Gt => [|x|] > [|y|] end. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. - Variable spec_w_add_carry_c : + Variable spec_w_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1. Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. @@ -315,8 +315,8 @@ Section DoubleDiv32. wB/2 <= [|b1|] -> [[WW a1 a2]] < [[WW b1 b2]] -> let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ + [|a1|] * wwB + [|a2|] * wB + [|a3|] = + [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]. Proof. intros a1 a2 a3 b1 b2 Hle Hlt. @@ -327,17 +327,17 @@ Section DoubleDiv32. match w_compare a1 b1 with | Lt => let (q,r) := w_div21 a1 a2 b1 in - match ww_sub_c (w_WW r a3) (w_mul_c q b2) with + match ww_sub_c (w_WW r a3) (w_mul_c q b2) with | C0 r1 => (q,r1) | C1 r1 => let q := w_pred q in - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2))) (fun r2 => (q,r2)) r1 (WW b1 b2) end | Eq => - ww_add_c_cont w_WW w_add_c w_add_carry_c + ww_add_c_cont w_WW w_add_c w_add_carry_c (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2))) (fun r => (w_Bm1,r)) (WW (w_sub a2 b2) a3) (WW b1 b2) @@ -360,7 +360,7 @@ Section DoubleDiv32. [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]);eauto. rewrite H0;intros r. - repeat + repeat (rewrite spec_ww_add;eauto || rewrite spec_w_Bm1 || rewrite spec_w_Bm2); simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. assert (0<= ([[r]] + ([|b1|] * wB + [|b2|])) - wwB < [|b1|] * wB + [|b2|]). @@ -385,7 +385,7 @@ Section DoubleDiv32. 1 ([[r]] + ([|b1|] * wB + [|b2|]) - wwB));zarith;try (ring;fail). split. rewrite H1;rewrite Hcmp;ring. trivial. Spec_ww_to_Z (WW b1 b2). simpl in HH4;zarith. - rewrite H0;intros r;repeat + rewrite H0;intros r;repeat (rewrite spec_w_Bm1 || rewrite spec_w_Bm2); simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. assert ([[r]]=([|a2|]-[|b2|])*wB+[|a3|]+([|b1|]*wB+[|b2|])). zarith. @@ -409,7 +409,7 @@ Section DoubleDiv32. as [r1|r1];repeat (rewrite spec_w_WW || rewrite spec_mul_c); unfold interp_carry;intros H1. rewrite H1. - split. ring. split. + split. ring. split. rewrite <- H1;destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z r1);trivial. apply Zle_lt_trans with ([|r|] * wB + [|a3|]). assert ( 0 <= [|q|] * [|b2|]);zarith. @@ -418,7 +418,7 @@ Section DoubleDiv32. rewrite <- H1;ring. Spec_ww_to_Z r1; assert (0 <= [|r|]*wB). zarith. assert (0 < [|q|] * [|b2|]). zarith. - assert (0 < [|q|]). + assert (0 < [|q|]). apply Zmult_lt_0_reg_r_2 with [|b2|];zarith. eapply spec_ww_add_c_cont with (P := fun (x y:zn2z w) (res:w*zn2z w) => @@ -440,18 +440,18 @@ Section DoubleDiv32. wwB * 1 + ([|r|] * wB + [|a3|] - [|q|] * [|b2|] + 2 * ([|b1|] * wB + [|b2|]))). rewrite H7;rewrite H2;ring. - assert - ([|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) + assert + ([|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) < [|b1|]*wB + [|b2|]). Spec_ww_to_Z r2;omega. Spec_ww_to_Z (WW b1 b2). simpl in HH5. - assert - (0 <= [|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) + assert + (0 <= [|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) < wwB). split;try omega. replace (2*([|b1|]*wB+[|b2|])) with ((2*[|b1|])*wB+2*[|b2|]). 2:ring. assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB). rewrite wwB_wBwB; rewrite Zpower_2; zarith. omega. - rewrite <- (Zmod_unique + rewrite <- (Zmod_unique ([[r2]] + ([|b1|] * wB + [|b2|])) wwB 1 @@ -486,7 +486,7 @@ Section DoubleDiv21. Definition ww_div21 a1 a2 b := match a1 with - | W0 => + | W0 => match ww_compare a2 b with | Gt => (ww_1, ww_sub a2 b) | Eq => (ww_1, W0) @@ -529,8 +529,8 @@ Section DoubleDiv21. Notation wwB := (base (ww_digits w_digits)). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Variable spec_w_0 : [|w_0|] = 0. @@ -540,8 +540,8 @@ Section DoubleDiv21. wB/2 <= [|b1|] -> [[WW a1 a2]] < [[WW b1 b2]] -> let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ + [|a1|] * wwB + [|a2|] * wB + [|a3|] = + [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]. Variable spec_ww_1 : [[ww_1]] = 1. Variable spec_ww_compare : forall x y, @@ -591,10 +591,10 @@ Section DoubleDiv21. intros Hlt H; match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] => generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U); intros q1 r H0 - end; (assert (Eq1: wB / 2 <= [|b1|]);[ + end; (assert (Eq1: wB / 2 <= [|b1|]);[ apply (@beta_lex (wB / 2) 0 [|b1|] [|b2|] wB); auto with zarith; autorewrite with rm10;repeat rewrite (Zmult_comm wB); - rewrite <- wwB_div_2; trivial + rewrite <- wwB_div_2; trivial | generalize (H0 Eq1 Hlt);clear H0;destruct r as [ |r1 r2];simpl; try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Zplus_0_r; intros (H1,H2) ]). @@ -611,10 +611,10 @@ Section DoubleDiv21. rewrite <- wwB_wBwB;rewrite H1. rewrite spec_w_0 in H4;rewrite Zplus_0_r in H4. repeat rewrite Zmult_plus_distr_l. rewrite <- (Zmult_assoc [|r1|]). - rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H4;simpl;ring. + rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H4;simpl;ring. split;[rewrite wwB_wBwB | split;zarith]. - replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|])) - with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]). + replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|])) + with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]). rewrite H1;ring. rewrite wwB_wBwB;ring. change [|a4|] with (0*wB+[|a4|]);apply beta_lex_inv;zarith. assert (1 <= wB/2);zarith. @@ -624,7 +624,7 @@ Section DoubleDiv21. intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end. split;trivial. replace (([|a1h|] * wB + [|a1l|]) * wwB + ([|a3|] * wB + [|a4|])) with - (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB + [|a4|]); + (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB + [|a4|]); [rewrite H1 | rewrite wwB_wBwB;ring]. replace (([|q1|]*([|b1|]*wB+[|b2|])+([|r1|]*wB+[|r2|]))*wB+[|a4|]) with (([|q1|]*([|b1|]*wB+[|b2|]))*wB+([|r1|]*wwB+[|r2|]*wB+[|a4|])); @@ -666,22 +666,22 @@ Section DoubleDivGt. Eval lazy beta iota delta [ww_sub ww_opp] in let p := w_head0 bh in match w_compare p w_0 with - | Gt => + | Gt => let b1 := w_add_mul_div p bh bl in let b2 := w_add_mul_div p bl w_0 in let a1 := w_add_mul_div p w_0 ah in let a2 := w_add_mul_div p ah al in let a3 := w_add_mul_div p al w_0 in let (q,r) := w_div32 a1 a2 a3 b1 b2 in - (WW w_0 q, ww_add_mul_div + (WW w_0 q, ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r) | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry (WW ah al) (WW bh bl)) end. - Definition ww_div_gt a b := - Eval lazy beta iota delta [ww_div_gt_aux double_divn1 + Definition ww_div_gt a b := + Eval lazy beta iota delta [ww_div_gt_aux double_divn1 double_divn1_p double_divn1_p_aux double_divn1_0 double_divn1_0_aux double_split double_0 double_WW] in match a, b with @@ -691,11 +691,11 @@ Section DoubleDivGt. if w_eq0 ah then let (q,r) := w_div_gt al bl in (WW w_0 q, w_0W r) - else + else match w_compare w_0 bh with - | Eq => + | Eq => let(q,r):= - double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl in (q, w_0W r) | Lt => ww_div_gt_aux ah al bh bl @@ -707,7 +707,7 @@ Section DoubleDivGt. Eval lazy beta iota delta [ww_sub ww_opp] in let p := w_head0 bh in match w_compare p w_0 with - | Gt => + | Gt => let b1 := w_add_mul_div p bh bl in let b2 := w_add_mul_div p bl w_0 in let a1 := w_add_mul_div p w_0 ah in @@ -716,13 +716,13 @@ Section DoubleDivGt. let (q,r) := w_div32 a1 a2 a3 b1 b2 in ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r - | _ => + | _ => ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry (WW ah al) (WW bh bl) end. - Definition ww_mod_gt a b := - Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 + Definition ww_mod_gt a b := + Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 double_modn1_p double_modn1_p_aux double_modn1_0 double_modn1_0_aux double_split double_0 double_WW snd] in match a, b with @@ -730,10 +730,10 @@ Section DoubleDivGt. | _, W0 => W0 | WW ah al, WW bh bl => if w_eq0 ah then w_0W (w_mod_gt al bl) - else + else match w_compare w_0 bh with - | Eq => - w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | Eq => + w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl) | Lt => ww_mod_gt_aux ah al bh bl | Gt => W0 (* cas absurde *) @@ -741,14 +741,14 @@ Section DoubleDivGt. end. Definition ww_gcd_gt_body (cont: w->w->w->w->zn2z w) (ah al bh bl: w) := - Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 + Eval lazy beta iota delta [ww_mod_gt_aux double_modn1 double_modn1_p double_modn1_p_aux double_modn1_0 double_modn1_0_aux double_split double_0 double_WW snd] in match w_compare w_0 bh with | Eq => match w_compare w_0 bl with | Eq => WW ah al (* normalement n'arrive pas si forme normale *) - | Lt => + | Lt => let m := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl in WW w_0 (w_gcd_gt bl m) @@ -757,14 +757,14 @@ Section DoubleDivGt. | Lt => let m := ww_mod_gt_aux ah al bh bl in match m with - | W0 => WW bh bl + | W0 => WW bh bl | WW mh ml => match w_compare w_0 mh with | Eq => match w_compare w_0 ml with | Eq => WW bh bl - | _ => - let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | _ => + let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW bh bl) ml in WW w_0 (w_gcd_gt ml r) end @@ -779,18 +779,18 @@ Section DoubleDivGt. end | Gt => W0 (* absurde *) end. - - Fixpoint ww_gcd_gt_aux - (p:positive) (cont: w -> w -> w -> w -> zn2z w) (ah al bh bl : w) + + Fixpoint ww_gcd_gt_aux + (p:positive) (cont: w -> w -> w -> w -> zn2z w) (ah al bh bl : w) {struct p} : zn2z w := - ww_gcd_gt_body + ww_gcd_gt_body (fun mh ml rh rl => match p with | xH => cont mh ml rh rl | xO p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl | xI p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl end) ah al bh bl. - + (* Proof *) Variable w_to_Z : w -> Z. @@ -816,7 +816,7 @@ Section DoubleDivGt. | Gt => [|x|] > [|y|] end. Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. - + Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|]. Variable spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB. Variable spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1. @@ -854,8 +854,8 @@ Section DoubleDivGt. wB/2 <= [|b1|] -> [[WW a1 a2]] < [[WW b1 b2]] -> let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ + [|a1|] * wwB + [|a2|] * wB + [|a3|] = + [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ 0 <= [[r]] < [|b1|] * wB + [|b2|]. Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits. @@ -899,14 +899,14 @@ Section DoubleDivGt. change (let (q, r) := let p := w_head0 bh in match w_compare p w_0 with - | Gt => + | Gt => let b1 := w_add_mul_div p bh bl in let b2 := w_add_mul_div p bl w_0 in let a1 := w_add_mul_div p w_0 ah in let a2 := w_add_mul_div p ah al in let a3 := w_add_mul_div p al w_0 in let (q,r) := w_div32 a1 a2 a3 b1 b2 in - (WW w_0 q, ww_add_mul_div + (WW w_0 q, ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r) | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c @@ -931,7 +931,7 @@ Section DoubleDivGt. case (spec_to_Z (w_head0 bh)); auto with zarith. assert ([|w_head0 bh|] < Zpos w_digits). destruct (Z_lt_ge_dec [|w_head0 bh|] (Zpos w_digits));trivial. - elimtype False. + exfalso. assert (2 ^ [|w_head0 bh|] * [|bh|] >= wB);auto with zarith. apply Zle_ge; replace wB with (wB * 1);try ring. Spec_w_to_Z bh;apply Zmult_le_compat;zarith. @@ -945,11 +945,11 @@ Section DoubleDivGt. (spec_add_mul_div bl w_0 Hb); rewrite spec_w_0; repeat rewrite Zmult_0_l;repeat rewrite Zplus_0_l; rewrite Zdiv_0_l;repeat rewrite Zplus_0_r. - Spec_w_to_Z ah;Spec_w_to_Z bh. + Spec_w_to_Z ah;Spec_w_to_Z bh. unfold base;repeat rewrite Zmod_shift_r;zarith. assert (H3:=to_Z_div_minus_p ah HHHH);assert(H4:=to_Z_div_minus_p al HHHH); assert (H5:=to_Z_div_minus_p bl HHHH). - rewrite Zmult_comm in Hh. + rewrite Zmult_comm in Hh. assert (2^[|w_head0 bh|] < wB). unfold base;apply Zpower_lt_monotone;zarith. unfold base in H0;rewrite Zmod_small;zarith. fold wB; rewrite (Zmod_small ([|bh|] * 2 ^ [|w_head0 bh|]));zarith. @@ -964,15 +964,15 @@ Section DoubleDivGt. (w_add_mul_div (w_head0 bh) al w_0) (w_add_mul_div (w_head0 bh) bh bl) (w_add_mul_div (w_head0 bh) bl w_0)) as (q,r). - rewrite V1;rewrite V2. rewrite Zmult_plus_distr_l. - rewrite <- (Zplus_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)). + rewrite V1;rewrite V2. rewrite Zmult_plus_distr_l. + rewrite <- (Zplus_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)). unfold base;rewrite <- shift_unshift_mod;zarith. fold wB. replace ([|bh|] * 2 ^ [|w_head0 bh|] * wB + [|bl|] * 2 ^ [|w_head0 bh|]) with ([[WW bh bl]] * 2^[|w_head0 bh|]). 2:simpl;ring. fold wwB. rewrite wwB_wBwB. rewrite Zpower_2. rewrite U1;rewrite U2;rewrite U3. - rewrite Zmult_assoc. rewrite Zmult_plus_distr_l. + rewrite Zmult_assoc. rewrite Zmult_plus_distr_l. rewrite (Zplus_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)). - rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. + rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. unfold base;repeat rewrite <- shift_unshift_mod;zarith. fold wB. replace ([|ah|] * 2 ^ [|w_head0 bh|] * wB + [|al|] * 2 ^ [|w_head0 bh|]) with ([[WW ah al]] * 2^[|w_head0 bh|]). 2:simpl;ring. @@ -1027,7 +1027,7 @@ Section DoubleDivGt. [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]. Proof. - intros a b Hgt Hpos;unfold ww_div_gt. + intros a b Hgt Hpos;unfold ww_div_gt. change (let (q,r) := match a, b with | W0, _ => (W0,W0) | _, W0 => (W0,W0) @@ -1035,23 +1035,23 @@ Section DoubleDivGt. if w_eq0 ah then let (q,r) := w_div_gt al bl in (WW w_0 q, w_0W r) - else + else match w_compare w_0 bh with - | Eq => + | Eq => let(q,r):= - double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl in (q, w_0W r) | Lt => ww_div_gt_aux ah al bh bl | Gt => (W0,W0) (* cas absurde *) end - end in [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]). + end in [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]). destruct a as [ |ah al]. simpl in Hgt;omega. destruct b as [ |bh bl]. simpl in Hpos;omega. Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl. assert (H:=@spec_eq0 ah);destruct (w_eq0 ah). simpl ww_to_Z;rewrite H;trivial. simpl in Hgt;rewrite H in Hgt;trivial. - assert ([|bh|] <= 0). + assert ([|bh|] <= 0). apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;rewrite H1;simpl in Hgt. simpl. simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos. @@ -1066,12 +1066,12 @@ Section DoubleDivGt. w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hpos). unfold double_to_Z,double_wB,double_digits in H2. - destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl). rewrite spec_w_0W;unfold ww_to_Z;trivial. apply spec_ww_div_gt_aux;trivial. rewrite spec_w_0 in Hcmp;trivial. - rewrite spec_w_0 in Hcmp;elimtype False;omega. + rewrite spec_w_0 in Hcmp;exfalso;omega. Qed. Lemma spec_ww_mod_gt_aux_eq : forall ah al bh bl, @@ -1104,26 +1104,26 @@ Section DoubleDivGt. rewrite Zmult_comm in H;destruct H. symmetry;apply Zmod_unique with [|q|];trivial. Qed. - + Lemma spec_ww_mod_gt_eq : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> [[ww_mod_gt a b]] = [[snd (ww_div_gt a b)]]. Proof. intros a b Hgt Hpos. - change (ww_mod_gt a b) with + change (ww_mod_gt a b) with (match a, b with | W0, _ => W0 | _, W0 => W0 | WW ah al, WW bh bl => if w_eq0 ah then w_0W (w_mod_gt al bl) - else + else match w_compare w_0 bh with - | Eq => - w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | Eq => + w_0W (double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl) | Lt => ww_mod_gt_aux ah al bh bl | Gt => W0 (* cas absurde *) end end). - change (ww_div_gt a b) with + change (ww_div_gt a b) with (match a, b with | W0, _ => (W0,W0) | _, W0 => (W0,W0) @@ -1131,11 +1131,11 @@ Section DoubleDivGt. if w_eq0 ah then let (q,r) := w_div_gt al bl in (WW w_0 q, w_0W r) - else + else match w_compare w_0 bh with - | Eq => + | Eq => let(q,r):= - double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 + double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 a bl in (q, w_0W r) | Lt => ww_div_gt_aux ah al bh bl @@ -1147,7 +1147,7 @@ Section DoubleDivGt. Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl. assert (H:=@spec_eq0 ah);destruct (w_eq0 ah). simpl in Hgt;rewrite H in Hgt;trivial. - assert ([|bh|] <= 0). + assert ([|bh|] <= 0). apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt. simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos. @@ -1155,7 +1155,7 @@ Section DoubleDivGt. destruct (w_div_gt al bl);simpl;rewrite spec_w_0W;trivial. clear H. assert (H2 := spec_compare w_0 bh);destruct (w_compare w_0 bh). - rewrite (@spec_double_modn1_aux w w_zdigits w_0 w_WW w_head0 w_add_mul_div + rewrite (@spec_double_modn1_aux w w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_w_0 spec_compare 1 (WW ah al) bl). destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl);simpl;trivial. @@ -1174,7 +1174,7 @@ Section DoubleDivGt. rewrite Zmult_comm;trivial. Qed. - Lemma Zis_gcd_mod : forall a b d, + Lemma Zis_gcd_mod : forall a b d, 0 < b -> Zis_gcd b (a mod b) d -> Zis_gcd a b d. Proof. intros a b d H H1; apply Zis_gcd_for_euclid with (a/b). @@ -1182,12 +1182,12 @@ Section DoubleDivGt. ring_simplify (b * (a / b) + a mod b - a / b * b);trivial. zarith. Qed. - Lemma spec_ww_gcd_gt_aux_body : + Lemma spec_ww_gcd_gt_aux_body : forall ah al bh bl n cont, - [[WW bh bl]] <= 2^n -> + [[WW bh bl]] <= 2^n -> [[WW ah al]] > [[WW bh bl]] -> - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^(n-1) -> + (forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^(n-1) -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> Zis_gcd [[WW ah al]] [[WW bh bl]] [[ww_gcd_gt_body cont ah al bh bl]]. Proof. @@ -1196,7 +1196,7 @@ Section DoubleDivGt. | Eq => match w_compare w_0 bl with | Eq => WW ah al (* normalement n'arrive pas si forme normale *) - | Lt => + | Lt => let m := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW ah al) bl in WW w_0 (w_gcd_gt bl m) @@ -1205,14 +1205,14 @@ Section DoubleDivGt. | Lt => let m := ww_mod_gt_aux ah al bh bl in match m with - | W0 => WW bh bl + | W0 => WW bh bl | WW mh ml => match w_compare w_0 mh with | Eq => match w_compare w_0 ml with | Eq => WW bh bl - | _ => - let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 + | _ => + let r := double_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 w_compare w_sub 1 (WW bh bl) ml in WW w_0 (w_gcd_gt ml r) end @@ -1227,10 +1227,10 @@ Section DoubleDivGt. end | Gt => W0 (* absurde *) end). - assert (Hbh := spec_compare w_0 bh);destruct (w_compare w_0 bh). + assert (Hbh := spec_compare w_0 bh);destruct (w_compare w_0 bh). simpl ww_to_Z in *. rewrite spec_w_0 in Hbh;rewrite <- Hbh; rewrite Zmult_0_l;rewrite Zplus_0_l. - assert (Hbl := spec_compare w_0 bl); destruct (w_compare w_0 bl). + assert (Hbl := spec_compare w_0 bl); destruct (w_compare w_0 bl). rewrite spec_w_0 in Hbl;rewrite <- Hbl;apply Zis_gcd_0. simpl;rewrite spec_w_0;rewrite Zmult_0_l;rewrite Zplus_0_l. rewrite spec_w_0 in Hbl. @@ -1239,54 +1239,54 @@ Section DoubleDivGt. rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hbl). - apply spec_gcd_gt. - rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply spec_gcd_gt. + rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. + apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. - rewrite spec_w_0 in Hbl;Spec_w_to_Z bl;elimtype False;omega. + rewrite spec_w_0 in Hbl;Spec_w_to_Z bl;exfalso;omega. rewrite spec_w_0 in Hbh;assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh). - assert (H2 : 0 < [[WW bh bl]]). + assert (H2 : 0 < [[WW bh bl]]). simpl;Spec_w_to_Z bl. apply Zlt_le_trans with ([|bh|]*wB);zarith. apply Zmult_lt_0_compat;zarith. apply Zis_gcd_mod;trivial. rewrite <- H. simpl in *;destruct (ww_mod_gt_aux ah al bh bl) as [ |mh ml]. - simpl;apply Zis_gcd_0;zarith. - assert (Hmh := spec_compare w_0 mh);destruct (w_compare w_0 mh). + simpl;apply Zis_gcd_0;zarith. + assert (Hmh := spec_compare w_0 mh);destruct (w_compare w_0 mh). simpl;rewrite spec_w_0 in Hmh; rewrite <- Hmh;simpl. - assert (Hml := spec_compare w_0 ml);destruct (w_compare w_0 ml). + assert (Hml := spec_compare w_0 ml);destruct (w_compare w_0 ml). rewrite <- Hml;rewrite spec_w_0;simpl;apply Zis_gcd_0. - simpl;rewrite spec_w_0;simpl. + simpl;rewrite spec_w_0;simpl. rewrite spec_w_0 in Hml. apply Zis_gcd_mod;zarith. change ([|bh|] * wB + [|bl|]) with (double_to_Z w_digits w_to_Z 1 (WW bh bl)). rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW bh bl) ml Hml). - apply spec_gcd_gt. - rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply spec_gcd_gt. + rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. + apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. - rewrite spec_w_0 in Hml;Spec_w_to_Z ml;elimtype False;omega. + rewrite spec_w_0 in Hml;Spec_w_to_Z ml;exfalso;omega. rewrite spec_w_0 in Hmh. assert ([[WW bh bl]] > [[WW mh ml]]). - rewrite H;simpl; apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + rewrite H;simpl; apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. assert (H1:= spec_ww_mod_gt_aux _ _ _ H0 Hmh). - assert (H3 : 0 < [[WW mh ml]]). + assert (H3 : 0 < [[WW mh ml]]). simpl;Spec_w_to_Z ml. apply Zlt_le_trans with ([|mh|]*wB);zarith. apply Zmult_lt_0_compat;zarith. apply Zis_gcd_mod;zarith. simpl in *;rewrite <- H1. destruct (ww_mod_gt_aux bh bl mh ml) as [ |rh rl]. simpl; apply Zis_gcd_0. simpl;apply Hcont. simpl in H1;rewrite H1. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. - apply Zle_trans with (2^n/2). - apply Zdiv_le_lower_bound;zarith. + apply Zle_trans with (2^n/2). + apply Zdiv_le_lower_bound;zarith. apply Zle_trans with ([|bh|] * wB + [|bl|]);zarith. assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Zlt_gt _ _ H3)). assert (H4' : 0 <= [[WW bh bl]]/[[WW mh ml]]). apply Zge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1. pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3'. destruct (Zle_lt_or_eq _ _ H4'). - assert (H6' : [[WW bh bl]] mod [[WW mh ml]] = + assert (H6' : [[WW bh bl]] mod [[WW mh ml]] = [[WW bh bl]] - [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). simpl;pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3';ring. simpl in H6'. assert ([[WW mh ml]] <= [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). @@ -1300,14 +1300,14 @@ Section DoubleDivGt. rewrite Z_div_mult;zarith. assert (2^1 <= 2^n). change (2^1) with 2;zarith. assert (H7 := @Zpower_le_monotone_inv 2 1 n);zarith. - rewrite spec_w_0 in Hmh;Spec_w_to_Z mh;elimtype False;zarith. - rewrite spec_w_0 in Hbh;Spec_w_to_Z bh;elimtype False;zarith. + rewrite spec_w_0 in Hmh;Spec_w_to_Z mh;exfalso;zarith. + rewrite spec_w_0 in Hbh;Spec_w_to_Z bh;exfalso;zarith. Qed. - Lemma spec_ww_gcd_gt_aux : + Lemma spec_ww_gcd_gt_aux : forall p cont n, - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + (forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^n -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] -> @@ -1334,7 +1334,7 @@ Section DoubleDivGt. apply Zle_trans with (2 ^ (Zpos p + n -1));zarith. apply Zpower_le_monotone2;zarith. apply Zle_trans with (2 ^ (2*Zpos p + n -1));zarith. - apply Zpower_le_monotone2;zarith. + apply Zpower_le_monotone2;zarith. apply spec_ww_gcd_gt_aux_body with (n := n+1);trivial. rewrite Zplus_comm;trivial. ring_simplify (n + 1 - 1);trivial. @@ -1352,16 +1352,16 @@ Section DoubleDiv. Variable ww_div_gt : zn2z w -> zn2z w -> zn2z w * zn2z w. Variable ww_mod_gt : zn2z w -> zn2z w -> zn2z w. - Definition ww_div a b := - match ww_compare a b with - | Gt => ww_div_gt a b + Definition ww_div a b := + match ww_compare a b with + | Gt => ww_div_gt a b | Eq => (ww_1, W0) | Lt => (W0, a) end. - Definition ww_mod a b := - match ww_compare a b with - | Gt => ww_mod_gt a b + Definition ww_mod a b := + match ww_compare a b with + | Gt => ww_mod_gt a b | Eq => W0 | Lt => a end. @@ -1401,7 +1401,7 @@ Section DoubleDiv. Proof. intros a b Hpos;unfold ww_div. assert (H:=spec_ww_compare a b);destruct (ww_compare a b). - simpl;rewrite spec_ww_1;split;zarith. + simpl;rewrite spec_ww_1;split;zarith. simpl;split;[ring|Spec_ww_to_Z a;zarith]. apply spec_ww_div_gt;trivial. Qed. @@ -1409,7 +1409,7 @@ Section DoubleDiv. Lemma spec_ww_mod : forall a b, 0 < [[b]] -> [[ww_mod a b]] = [[a]] mod [[b]]. Proof. - intros a b Hpos;unfold ww_mod. + intros a b Hpos;unfold ww_mod. assert (H := spec_ww_compare a b);destruct (ww_compare a b). simpl;apply Zmod_unique with 1;try rewrite H;zarith. Spec_ww_to_Z a;symmetry;apply Zmod_small;zarith. @@ -1424,8 +1424,8 @@ Section DoubleDiv. Variable w_gcd_gt : w -> w -> w. Variable _ww_digits : positive. Variable spec_ww_digits_ : _ww_digits = xO w_digits. - Variable ww_gcd_gt_fix : - positive -> (w -> w -> w -> w -> zn2z w) -> + Variable ww_gcd_gt_fix : + positive -> (w -> w -> w -> w -> zn2z w) -> w -> w -> w -> w -> zn2z w. Variable spec_w_0 : [|w_0|] = 0. @@ -1440,10 +1440,10 @@ Section DoubleDiv. Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. Variable spec_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]. - Variable spec_gcd_gt_fix : + Variable spec_gcd_gt_fix : forall p cont n, - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + (forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^n -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] -> @@ -1451,20 +1451,20 @@ Section DoubleDiv. Zis_gcd [[WW ah al]] [[WW bh bl]] [[ww_gcd_gt_fix p cont ah al bh bl]]. - Definition gcd_cont (xh xl yh yl:w) := + Definition gcd_cont (xh xl yh yl:w) := match w_compare w_1 yl with - | Eq => ww_1 + | Eq => ww_1 | _ => WW xh xl end. - Lemma spec_gcd_cont : forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + Lemma spec_gcd_cont : forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 1 -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[gcd_cont xh xl yh yl]]. Proof. intros xh xl yh yl Hgt' Hle. simpl in Hle. assert ([|yh|] = 0). - change 1 with (0*wB+1) in Hle. + change 1 with (0*wB+1) in Hle. assert (0 <= 1 < wB). split;zarith. apply wB_pos. assert (H1:= beta_lex _ _ _ _ _ Hle (spec_to_Z yl) H). Spec_w_to_Z yh;zarith. @@ -1473,20 +1473,20 @@ Section DoubleDiv. simpl;rewrite H;simpl;destruct (w_compare w_1 yl). rewrite spec_ww_1;rewrite <- Hcmpy;apply Zis_gcd_mod;zarith. rewrite <- (Zmod_unique ([|xh|]*wB+[|xl|]) 1 ([|xh|]*wB+[|xl|]) 0);zarith. - rewrite H in Hle; elimtype False;zarith. + rewrite H in Hle; exfalso;zarith. assert ([|yl|] = 0). Spec_w_to_Z yl;zarith. rewrite H0;simpl;apply Zis_gcd_0;trivial. Qed. - + Variable cont : w -> w -> w -> w -> zn2z w. - Variable spec_cont : forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> + Variable spec_cont : forall xh xl yh yl, + [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 1 -> Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]. - - Definition ww_gcd_gt a b := - match a, b with + + Definition ww_gcd_gt a b := + match a, b with | W0, _ => b | _, W0 => a | WW ah al, WW bh bl => @@ -1509,8 +1509,8 @@ Section DoubleDiv. destruct a as [ |ah al]. simpl;apply Zis_gcd_sym;apply Zis_gcd_0. destruct b as [ |bh bl]. simpl;apply Zis_gcd_0. simpl in Hgt. generalize (@spec_eq0 ah);destruct (w_eq0 ah);intros. - simpl;rewrite H in Hgt;trivial;rewrite H;trivial;rewrite spec_w_0;simpl. - assert ([|bh|] <= 0). + simpl;rewrite H in Hgt;trivial;rewrite H;trivial;rewrite spec_w_0;simpl. + assert ([|bh|] <= 0). apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. Spec_w_to_Z bh;assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt. rewrite H1;simpl;auto. clear H. @@ -1522,7 +1522,7 @@ Section DoubleDiv. Lemma spec_ww_gcd : forall a b, Zis_gcd [[a]] [[b]] [[ww_gcd a b]]. Proof. intros a b. - change (ww_gcd a b) with + change (ww_gcd a b) with (match ww_compare a b with | Gt => ww_gcd_gt a b | Eq => a diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v index d6f6a05f..386bbb9e 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleDivn1.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -17,7 +17,7 @@ Require Import BigNumPrelude. Require Import DoubleType. Require Import DoubleBase. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section GENDIVN1. @@ -31,19 +31,19 @@ Section GENDIVN1. Variable w_div21 : w -> w -> w -> w * w. Variable w_compare : w -> w -> comparison. Variable w_sub : w -> w -> w. - - + + (* ** For proofs ** *) Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). + + Notation wB := (base w_digits). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[! n | x !]" := (double_to_Z w_digits w_to_Z n x) + Notation "[! n | x !]" := (double_to_Z w_digits w_to_Z n x) (at level 0, x at level 99). Notation "[[ x ]]" := (zn2z_to_Z wB w_to_Z x) (at level 0, x at level 99). - + Variable spec_to_Z : forall x, 0 <= [| x |] < wB. Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits. Variable spec_0 : [|w_0|] = 0. @@ -68,10 +68,10 @@ Section GENDIVN1. | Lt => [|x|] < [|y|] | Gt => [|x|] > [|y|] end. - Variable spec_sub: forall x y, + Variable spec_sub: forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. - + Section DIVAUX. Variable b2p : w. @@ -85,10 +85,10 @@ Section GENDIVN1. Fixpoint double_divn1_0 (n:nat) : w -> word w n -> word w n * w := match n return w -> word w n -> word w n * w with - | O => fun r x => w_div21 r x b2p - | S n => double_divn1_0_aux n (double_divn1_0 n) + | O => fun r x => w_div21 r x b2p + | S n => double_divn1_0_aux n (double_divn1_0 n) end. - + Lemma spec_split : forall (n : nat) (x : zn2z (word w n)), let (h, l) := double_split w_0 n x in [!S n | x!] = [!n | h!] * double_wB w_digits n + [!n | l!]. @@ -132,11 +132,11 @@ Section GENDIVN1. induction n;simpl;intros;trivial. unfold double_modn1_0_aux, double_divn1_0_aux. destruct (double_split w_0 n x) as (hh,hl). - rewrite (IHn r hh). + rewrite (IHn r hh). destruct (double_divn1_0 n r hh) as (qh,rh);simpl. rewrite IHn. destruct (double_divn1_0 n rh hl);trivial. Qed. - + Variable p : w. Variable p_bounded : [|p|] <= Zpos w_digits. @@ -148,18 +148,18 @@ Section GENDIVN1. intros;apply spec_add_mul_div;auto. Qed. - Definition double_divn1_p_aux n - (divn1 : w -> word w n -> word w n -> word w n * w) r h l := + Definition double_divn1_p_aux n + (divn1 : w -> word w n -> word w n -> word w n * w) r h l := let (hh,hl) := double_split w_0 n h in - let (lh,ll) := double_split w_0 n l in + let (lh,ll) := double_split w_0 n l in let (qh,rh) := divn1 r hh hl in let (ql,rl) := divn1 rh hl lh in (double_WW w_WW n qh ql, rl). Fixpoint double_divn1_p (n:nat) : w -> word w n -> word w n -> word w n * w := match n return w -> word w n -> word w n -> word w n * w with - | O => fun r h l => w_div21 r (w_add_mul_div p h l) b2p - | S n => double_divn1_p_aux n (double_divn1_p n) + | O => fun r h l => w_div21 r (w_add_mul_div p h l) b2p + | S n => double_divn1_p_aux n (double_divn1_p n) end. Lemma p_lt_double_digits : forall n, [|p|] <= Zpos (double_digits w_digits n). @@ -175,8 +175,8 @@ Section GENDIVN1. Lemma spec_double_divn1_p : forall n r h l, [|r|] < [|b2p|] -> let (q,r') := double_divn1_p n r h l in - [|r|] * double_wB w_digits n + - ([!n|h!]*2^[|p|] + + [|r|] * double_wB w_digits n + + ([!n|h!]*2^[|p|] + [!n|l!] / (2^(Zpos(double_digits w_digits n) - [|p|]))) mod double_wB w_digits n = [!n|q!] * [|b2p|] + [|r'|] /\ 0 <= [|r'|] < [|b2p|]. @@ -198,26 +198,26 @@ Section GENDIVN1. ([!n|lh!] * double_wB w_digits n + [!n|ll!]) / 2^(Zpos (double_digits w_digits (S n)) - [|p|])) mod (double_wB w_digits n * double_wB w_digits n)) with - (([|r|] * double_wB w_digits n + ([!n|hh!] * 2^[|p|] + + (([|r|] * double_wB w_digits n + ([!n|hh!] * 2^[|p|] + [!n|hl!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod double_wB w_digits n) * double_wB w_digits n + - ([!n|hl!] * 2^[|p|] + - [!n|lh!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod + ([!n|hl!] * 2^[|p|] + + [!n|lh!] / 2^(Zpos (double_digits w_digits n) - [|p|])) mod double_wB w_digits n). generalize (IHn r hh hl H);destruct (double_divn1_p n r hh hl) as (qh,rh); intros (H3,H4);rewrite H3. - assert ([|rh|] < [|b2p|]). omega. + assert ([|rh|] < [|b2p|]). omega. replace (([!n|qh!] * [|b2p|] + [|rh|]) * double_wB w_digits n + ([!n|hl!] * 2 ^ [|p|] + [!n|lh!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])) mod - double_wB w_digits n) with + double_wB w_digits n) with ([!n|qh!] * [|b2p|] *double_wB w_digits n + ([|rh|]*double_wB w_digits n + ([!n|hl!] * 2 ^ [|p|] + [!n|lh!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])) mod double_wB w_digits n)). 2:ring. generalize (IHn rh hl lh H0);destruct (double_divn1_p n rh hl lh) as (ql,rl); intros (H5,H6);rewrite H5. - split;[rewrite spec_double_WW;trivial;ring|trivial]. + split;[rewrite spec_double_WW;trivial;ring|trivial]. assert (Uhh := spec_double_to_Z w_digits w_to_Z spec_to_Z n hh); unfold double_wB,base in Uhh. assert (Uhl := spec_double_to_Z w_digits w_to_Z spec_to_Z n hl); @@ -228,37 +228,37 @@ Section GENDIVN1. unfold double_wB,base in Ull. unfold double_wB,base. assert (UU:=p_lt_double_digits n). - rewrite Zdiv_shift_r;auto with zarith. - 2:change (Zpos (double_digits w_digits (S n))) + rewrite Zdiv_shift_r;auto with zarith. + 2:change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n));auto with zarith. replace (2 ^ (Zpos (double_digits w_digits (S n)) - [|p|])) with (2^(Zpos (double_digits w_digits n) - [|p|])*2^Zpos (double_digits w_digits n)). rewrite Zdiv_mult_cancel_r;auto with zarith. - rewrite Zmult_plus_distr_l with (p:= 2^[|p|]). + rewrite Zmult_plus_distr_l with (p:= 2^[|p|]). pattern ([!n|hl!] * 2^[|p|]) at 2; rewrite (shift_unshift_mod (Zpos(double_digits w_digits n))([|p|])([!n|hl!])); auto with zarith. - rewrite Zplus_assoc. - replace + rewrite Zplus_assoc. + replace ([!n|hh!] * 2^Zpos (double_digits w_digits n)* 2^[|p|] + ([!n|hl!] / 2^(Zpos (double_digits w_digits n)-[|p|])* 2^Zpos(double_digits w_digits n))) - with - (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl / + with + (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl / 2^(Zpos (double_digits w_digits n)-[|p|])) * 2^Zpos(double_digits w_digits n));try (ring;fail). rewrite <- Zplus_assoc. rewrite <- (Zmod_shift_r ([|p|]));auto with zarith. - replace + replace (2 ^ Zpos (double_digits w_digits n) * 2 ^ Zpos (double_digits w_digits n)) with (2 ^ (Zpos (double_digits w_digits n) + Zpos (double_digits w_digits n))). rewrite (Zmod_shift_r (Zpos (double_digits w_digits n)));auto with zarith. replace (2 ^ (Zpos (double_digits w_digits n) + Zpos (double_digits w_digits n))) - with (2^Zpos(double_digits w_digits n) *2^Zpos(double_digits w_digits n)). + with (2^Zpos(double_digits w_digits n) *2^Zpos(double_digits w_digits n)). rewrite (Zmult_comm (([!n|hh!] * 2 ^ [|p|] + [!n|hl!] / 2 ^ (Zpos (double_digits w_digits n) - [|p|])))). rewrite Zmult_mod_distr_l;auto with zarith. - ring. + ring. rewrite Zpower_exp;auto with zarith. assert (0 < Zpos (double_digits w_digits n)). unfold Zlt;reflexivity. auto with zarith. @@ -267,24 +267,24 @@ Section GENDIVN1. split;auto with zarith. apply Zdiv_lt_upper_bound;auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace ([|p|] + (Zpos (double_digits w_digits n) - [|p|])) with + replace ([|p|] + (Zpos (double_digits w_digits n) - [|p|])) with (Zpos(double_digits w_digits n));auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (double_digits w_digits (S n)) - [|p|]) with - (Zpos (double_digits w_digits n) - [|p|] + + replace (Zpos (double_digits w_digits (S n)) - [|p|]) with + (Zpos (double_digits w_digits n) - [|p|] + Zpos (double_digits w_digits n));trivial. - change (Zpos (double_digits w_digits (S n))) with + change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n)). ring. Qed. Definition double_modn1_p_aux n (modn1 : w -> word w n -> word w n -> w) r h l:= let (hh,hl) := double_split w_0 n h in - let (lh,ll) := double_split w_0 n l in + let (lh,ll) := double_split w_0 n l in modn1 (modn1 r hh hl) hl lh. Fixpoint double_modn1_p (n:nat) : w -> word w n -> word w n -> w := match n return w -> word w n -> word w n -> w with - | O => fun r h l => snd (w_div21 r (w_add_mul_div p h l) b2p) + | O => fun r h l => snd (w_div21 r (w_add_mul_div p h l) b2p) | S n => double_modn1_p_aux n (double_modn1_p n) end. @@ -302,8 +302,8 @@ Section GENDIVN1. Fixpoint high (n:nat) : word w n -> w := match n return word w n -> w with - | O => fun a => a - | S n => + | O => fun a => a + | S n => fun (a:zn2z (word w n)) => match a with | W0 => w_0 @@ -314,20 +314,20 @@ Section GENDIVN1. Lemma spec_double_digits:forall n, Zpos w_digits <= Zpos (double_digits w_digits n). Proof. induction n;simpl;auto with zarith. - change (Zpos (xO (double_digits w_digits n))) with + change (Zpos (xO (double_digits w_digits n))) with (2*Zpos (double_digits w_digits n)). assert (0 < Zpos w_digits);auto with zarith. exact (refl_equal Lt). Qed. - Lemma spec_high : forall n (x:word w n), + Lemma spec_high : forall n (x:word w n), [|high n x|] = [!n|x!] / 2^(Zpos (double_digits w_digits n) - Zpos w_digits). Proof. induction n;intros. unfold high,double_digits,double_to_Z. replace (Zpos w_digits - Zpos w_digits) with 0;try ring. simpl. rewrite <- (Zdiv_unique [|x|] 1 [|x|] 0);auto with zarith. - assert (U2 := spec_double_digits n). + assert (U2 := spec_double_digits n). assert (U3 : 0 < Zpos w_digits). exact (refl_equal Lt). destruct x;unfold high;fold high. unfold double_to_Z,zn2z_to_Z;rewrite spec_0. @@ -337,31 +337,31 @@ Section GENDIVN1. simpl [!S n|WW w0 w1!]. unfold double_wB,base;rewrite Zdiv_shift_r;auto with zarith. replace (2 ^ (Zpos (double_digits w_digits (S n)) - Zpos w_digits)) with - (2^(Zpos (double_digits w_digits n) - Zpos w_digits) * + (2^(Zpos (double_digits w_digits n) - Zpos w_digits) * 2^Zpos (double_digits w_digits n)). rewrite Zdiv_mult_cancel_r;auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (double_digits w_digits n) - Zpos w_digits + + replace (Zpos (double_digits w_digits n) - Zpos w_digits + Zpos (double_digits w_digits n)) with (Zpos (double_digits w_digits (S n)) - Zpos w_digits);trivial. - change (Zpos (double_digits w_digits (S n))) with + change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n));ring. - change (Zpos (double_digits w_digits (S n))) with + change (Zpos (double_digits w_digits (S n))) with (2*Zpos (double_digits w_digits n)); auto with zarith. Qed. - - Definition double_divn1 (n:nat) (a:word w n) (b:w) := + + Definition double_divn1 (n:nat) (a:word w n) (b:w) := let p := w_head0 b in match w_compare p w_0 with | Gt => let b2p := w_add_mul_div p b w_0 in let ha := high n a in let k := w_sub w_zdigits p in - let lsr_n := w_add_mul_div k w_0 in + let lsr_n := w_add_mul_div k w_0 in let r0 := w_add_mul_div p w_0 ha in let (q,r) := double_divn1_p b2p p n r0 a (double_0 w_0 n) in (q, lsr_n r) - | _ => double_divn1_0 b n w_0 a + | _ => double_divn1_0 b n w_0 a end. Lemma spec_double_divn1 : forall n a b, @@ -392,21 +392,21 @@ Section GENDIVN1. apply Zmult_le_compat;auto with zarith. assert (wB <= 2^[|w_head0 b|]). unfold base;apply Zpower_le_monotone;auto with zarith. omega. - assert ([|w_add_mul_div (w_head0 b) b w_0|] = + assert ([|w_add_mul_div (w_head0 b) b w_0|] = 2 ^ [|w_head0 b|] * [|b|]). rewrite (spec_add_mul_div b w_0); auto with zarith. rewrite spec_0;rewrite Zdiv_0_l; try omega. rewrite Zplus_0_r; rewrite Zmult_comm. rewrite Zmod_small; auto with zarith. assert (H5 := spec_to_Z (high n a)). - assert + assert ([|w_add_mul_div (w_head0 b) w_0 (high n a)|] <[|w_add_mul_div (w_head0 b) b w_0|]). rewrite H4. rewrite spec_add_mul_div;auto with zarith. rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. assert (([|high n a|]/2^(Zpos w_digits - [|w_head0 b|])) < wB). - apply Zdiv_lt_upper_bound;auto with zarith. + apply Zdiv_lt_upper_bound;auto with zarith. apply Zlt_le_trans with wB;auto with zarith. pattern wB at 1;replace wB with (wB*1);try ring. apply Zmult_le_compat;auto with zarith. @@ -420,8 +420,8 @@ Section GENDIVN1. apply Zmult_le_compat;auto with zarith. pattern 2 at 1;rewrite <- Zpower_1_r. apply Zpower_le_monotone;split;auto with zarith. - rewrite <- H4 in H0. - assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith. + rewrite <- H4 in H0. + assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith. assert (H7:= spec_double_divn1_p H0 Hb3 n a (double_0 w_0 n) H6). destruct (double_divn1_p (w_add_mul_div (w_head0 b) b w_0) (w_head0 b) n (w_add_mul_div (w_head0 b) w_0 (high n a)) a @@ -436,7 +436,7 @@ Section GENDIVN1. rewrite Zmod_small;auto with zarith. rewrite spec_high. rewrite Zdiv_Zdiv;auto with zarith. rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (double_digits w_digits n) - Zpos w_digits + + replace (Zpos (double_digits w_digits n) - Zpos w_digits + (Zpos w_digits - [|w_head0 b|])) with (Zpos (double_digits w_digits n) - [|w_head0 b|]);trivial;ring. assert (H8 := Zpower_gt_0 2 (Zpos w_digits - [|w_head0 b|]));auto with zarith. @@ -448,11 +448,11 @@ Section GENDIVN1. rewrite H8 in H7;unfold double_wB,base in H7. rewrite <- shift_unshift_mod in H7;auto with zarith. rewrite H4 in H7. - assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|] + assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|] = [|r|]/2^[|w_head0 b|]). rewrite spec_add_mul_div. rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. - replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|]) + replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|]) with ([|w_head0 b|]). rewrite Zmod_small;auto with zarith. assert (H9 := spec_to_Z r). @@ -474,11 +474,11 @@ Section GENDIVN1. split. rewrite <- (Z_div_mult [!n|a!] (2^[|w_head0 b|]));auto with zarith. rewrite H71;rewrite H9. - replace ([!n|q!] * (2 ^ [|w_head0 b|] * [|b|])) + replace ([!n|q!] * (2 ^ [|w_head0 b|] * [|b|])) with ([!n|q!] *[|b|] * 2^[|w_head0 b|]); try (ring;fail). rewrite Z_div_plus_l;auto with zarith. - assert (H10 := spec_to_Z + assert (H10 := spec_to_Z (w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r));split; auto with zarith. rewrite H9. @@ -487,19 +487,19 @@ Section GENDIVN1. exact (spec_double_to_Z w_digits w_to_Z spec_to_Z n a). Qed. - - Definition double_modn1 (n:nat) (a:word w n) (b:w) := + + Definition double_modn1 (n:nat) (a:word w n) (b:w) := let p := w_head0 b in match w_compare p w_0 with | Gt => let b2p := w_add_mul_div p b w_0 in let ha := high n a in let k := w_sub w_zdigits p in - let lsr_n := w_add_mul_div k w_0 in + let lsr_n := w_add_mul_div k w_0 in let r0 := w_add_mul_div p w_0 ha in let r := double_modn1_p b2p p n r0 a (double_0 w_0 n) in lsr_n r - | _ => double_modn1_0 b n w_0 a + | _ => double_modn1_0 b n w_0 a end. Lemma spec_double_modn1_aux : forall n a b, @@ -525,4 +525,4 @@ Section GENDIVN1. destruct H1 as (h1,h2);rewrite h1;ring. Qed. -End GENDIVN1. +End GENDIVN1. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v index 50c72487..21e694e5 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleLift.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -17,7 +17,7 @@ Require Import BigNumPrelude. Require Import DoubleType. Require Import DoubleBase. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section DoubleLift. Variable w : Type. @@ -61,13 +61,13 @@ Section DoubleLift. (* 0 < p < ww_digits *) - Definition ww_add_mul_div p x y := + Definition ww_add_mul_div p x y := let zdigits := w_0W w_zdigits in match x, y with | W0, W0 => W0 | W0, WW yh yl => match ww_compare p zdigits with - | Eq => w_0W yh + | Eq => w_0W yh | Lt => w_0W (w_add_mul_div (low p) w_0 yh) | Gt => let n := low (ww_sub p zdigits) in @@ -75,15 +75,15 @@ Section DoubleLift. end | WW xh xl, W0 => match ww_compare p zdigits with - | Eq => w_W0 xl + | Eq => w_W0 xl | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl w_0) | Gt => let n := low (ww_sub p zdigits) in - w_W0 (w_add_mul_div n xl w_0) + w_W0 (w_add_mul_div n xl w_0) end | WW xh xl, WW yh yl => match ww_compare p zdigits with - | Eq => w_WW xl yh + | Eq => w_WW xl yh | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl yh) | Gt => let n := low (ww_sub p zdigits) in @@ -93,7 +93,7 @@ Section DoubleLift. Section DoubleProof. Variable w_to_Z : w -> Z. - + Notation wB := (base w_digits). Notation wwB := (base (ww_digits w_digits)). Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). @@ -122,21 +122,21 @@ Section DoubleLift. Variable spec_w_head0 : forall x, 0 < [|x|] -> wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB. Variable spec_w_tail00 : forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits. - Variable spec_w_tail0 : forall x, 0 < [|x|] -> + Variable spec_w_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2* y + 1) * (2 ^ [|w_tail0 x|]). Variable spec_w_add_mul_div : forall x y p, [|p|] <= Zpos w_digits -> [| w_add_mul_div p x y |] = ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB. - Variable spec_w_add: forall x y, + Variable spec_w_add: forall x y, [[w_add x y]] = [|x|] + [|y|]. - Variable spec_ww_sub: forall x y, + Variable spec_ww_sub: forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits. Variable spec_low: forall x, [| low x|] = [[x]] mod wB. - + Variable spec_ww_zdigits : [[ww_zdigits]] = Zpos ww_Digits. Hint Resolve div_le_0 div_lt w_to_Z_wwB: lift. @@ -168,7 +168,7 @@ Section DoubleLift. rewrite spec_w_0; auto with zarith. rewrite spec_w_0; auto with zarith. Qed. - + Lemma spec_ww_head0 : forall x, 0 < [[x]] -> wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB. Proof. @@ -179,7 +179,7 @@ Section DoubleLift. assert (H0 := spec_compare w_0 xh);rewrite spec_w_0 in H0. destruct (w_compare w_0 xh). rewrite <- H0. simpl Zplus. rewrite <- H0 in H;simpl in H. - case (spec_to_Z w_zdigits); + case (spec_to_Z w_zdigits); case (spec_to_Z (w_head0 xl)); intros HH1 HH2 HH3 HH4. rewrite spec_w_add. rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith. @@ -209,7 +209,7 @@ Section DoubleLift. rewrite <- Zmult_assoc; apply Zmult_lt_compat_l; zarith. rewrite <- (Zplus_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith. apply Zmult_lt_reg_r with (2 ^ p); zarith. - rewrite <- Zpower_exp;zarith. + rewrite <- Zpower_exp;zarith. rewrite Zmult_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith. assert (H1 := spec_to_Z xh);zarith. Qed. @@ -293,8 +293,8 @@ Section DoubleLift. Qed. Hint Rewrite Zdiv_0_l Zmult_0_l Zplus_0_l Zmult_0_r Zplus_0_r - spec_w_W0 spec_w_0W spec_w_WW spec_w_0 - (wB_div w_digits w_to_Z spec_to_Z) + spec_w_W0 spec_w_0W spec_w_WW spec_w_0 + (wB_div w_digits w_to_Z spec_to_Z) (wB_div_plus w_digits w_to_Z spec_to_Z) : w_rewrite. Ltac w_rewrite := autorewrite with w_rewrite;trivial. @@ -303,12 +303,12 @@ Section DoubleLift. [[p]] <= Zpos (xO w_digits) -> [[match ww_compare p zdigits with | Eq => w_WW xl yh - | Lt => w_WW (w_add_mul_div (low p) xh xl) + | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl yh) | Gt => let n := low (ww_sub p zdigits) in w_WW (w_add_mul_div n xl yh) (w_add_mul_div n yh yl) - end]] = + end]] = ([[WW xh xl]] * (2^[[p]]) + [[WW yh yl]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB. Proof. @@ -317,7 +317,7 @@ Section DoubleLift. case (spec_to_w_Z p); intros Hv1 Hv2. replace (Zpos (xO w_digits)) with (Zpos w_digits + Zpos w_digits). 2 : rewrite Zpos_xO;ring. - replace (Zpos w_digits + Zpos w_digits - [[p]]) with + replace (Zpos w_digits + Zpos w_digits - [[p]]) with (Zpos w_digits + (Zpos w_digits - [[p]])). 2:ring. intros Hp; assert (Hxh := spec_to_Z xh);assert (Hxl:=spec_to_Z xl); assert (Hx := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)); @@ -330,7 +330,7 @@ Section DoubleLift. fold wB. rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc;rewrite <- Zplus_assoc. rewrite <- Zpower_2. - rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|]. + rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|]. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xl yh)). ring. simpl ww_to_Z; w_rewrite;zarith. assert (HH0: [|low p|] = [[p]]). @@ -353,7 +353,7 @@ Section DoubleLift. rewrite Zmult_plus_distr_l. pattern ([|xl|] * 2 ^ [[p]]) at 2; rewrite shift_unshift_mod with (n:= Zpos w_digits);fold wB;zarith. - replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring. + replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring. rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. unfold base at 5;rewrite <- Zmod_shift_r;zarith. unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); @@ -387,8 +387,8 @@ Section DoubleLift. lazy zeta; simpl ww_to_Z; w_rewrite;zarith. repeat rewrite spec_w_add_mul_div;zarith. rewrite HH0. - pattern wB at 5;replace wB with - (2^(([[p]] - Zpos w_digits) + pattern wB at 5;replace wB with + (2^(([[p]] - Zpos w_digits) + (Zpos w_digits - ([[p]] - Zpos w_digits)))). rewrite Zpower_exp;zarith. rewrite Zmult_assoc. rewrite Z_div_plus_l;zarith. @@ -401,28 +401,28 @@ Section DoubleLift. repeat rewrite <- Zplus_assoc. unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); fold wB;fold wwB;zarith. - unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits) + unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits) (b:= Zpos w_digits);fold wB;fold wwB;zarith. rewrite wwB_wBwB; rewrite Zpower_2; rewrite Zmult_mod_distr_r;zarith. rewrite Zmult_plus_distr_l. - replace ([|xh|] * wB * 2 ^ u) with + replace ([|xh|] * wB * 2 ^ u) with ([|xh|]*2^u*wB). 2:ring. - repeat rewrite <- Zplus_assoc. + repeat rewrite <- Zplus_assoc. rewrite (Zplus_comm ([|xh|] * 2 ^ u * wB)). rewrite Z_mod_plus;zarith. rewrite Z_mod_mult;zarith. unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. - unfold u; split;zarith. + unfold u; split;zarith. split;zarith. unfold u; apply Zdiv_lt_upper_bound;zarith. rewrite <- Zpower_exp;zarith. - fold u. - ring_simplify (u + (Zpos w_digits - u)); fold + fold u. + ring_simplify (u + (Zpos w_digits - u)); fold wB;zarith. unfold ww_digits;rewrite Zpos_xO;zarith. unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. unfold u; split;zarith. unfold u; split;zarith. apply Zdiv_lt_upper_bound;zarith. rewrite <- Zpower_exp;zarith. - fold u. + fold u. ring_simplify (u + (Zpos w_digits - u)); fold wB; auto with zarith. unfold u;zarith. unfold u;zarith. @@ -446,7 +446,7 @@ Section DoubleLift. clear H1;w_rewrite);simpl ww_add_mul_div. replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial]. intros Heq;rewrite <- Heq;clear Heq; auto. - generalize (spec_ww_compare p (w_0W w_zdigits)); + generalize (spec_ww_compare p (w_0W w_zdigits)); case ww_compare; intros H1; w_rewrite. rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. generalize H1; w_rewrite; rewrite spec_zdigits; clear H1; intros H1. @@ -459,7 +459,7 @@ Section DoubleLift. rewrite HH0; auto with zarith. replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial]. intros Heq;rewrite <- Heq;clear Heq. - generalize (spec_ww_compare p (w_0W w_zdigits)); + generalize (spec_ww_compare p (w_0W w_zdigits)); case ww_compare; intros H1; w_rewrite. rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. rewrite Zpos_xO in H;zarith. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v index c7d83acc..7090c76a 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleMul.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -17,7 +17,7 @@ Require Import BigNumPrelude. Require Import DoubleType. Require Import DoubleBase. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section DoubleMul. Variable w : Type. @@ -45,7 +45,7 @@ Section DoubleMul. (* (xh*B+xl) (yh*B + yl) xh*yh = hh = |hhh|hhl|B2 xh*yl +xl*yh = cc = |cch|ccl|B - xl*yl = ll = |llh|lll + xl*yl = ll = |llh|lll *) Definition double_mul_c (cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w) x y := @@ -56,7 +56,7 @@ Section DoubleMul. let hh := w_mul_c xh yh in let ll := w_mul_c xl yl in let (wc,cc) := cross xh xl yh yl hh ll in - match cc with + match cc with | W0 => WW (ww_add hh (w_W0 wc)) ll | WW cch ccl => match ww_add_c (w_W0 ccl) ll with @@ -67,8 +67,8 @@ Section DoubleMul. end. Definition ww_mul_c := - double_mul_c - (fun xh xl yh yl hh ll=> + double_mul_c + (fun xh xl yh yl hh ll=> match ww_add_c (w_mul_c xh yl) (w_mul_c xl yh) with | C0 cc => (w_0, cc) | C1 cc => (w_1, cc) @@ -77,11 +77,11 @@ Section DoubleMul. Definition w_2 := w_add w_1 w_1. Definition kara_prod xh xl yh yl hh ll := - match ww_add_c hh ll with + match ww_add_c hh ll with C0 m => match w_compare xl xh with Eq => (w_0, m) - | Lt => + | Lt => match w_compare yl yh with Eq => (w_0, m) | Lt => (w_0, ww_sub m (w_mul_c (w_sub xh xl) (w_sub yh yl))) @@ -89,7 +89,7 @@ Section DoubleMul. C1 m1 => (w_1, m1) | C0 m1 => (w_0, m1) end end - | Gt => + | Gt => match w_compare yl yh with Eq => (w_0, m) | Lt => match ww_add_c m (w_mul_c (w_sub xl xh) (w_sub yh yl)) with @@ -101,17 +101,17 @@ Section DoubleMul. | C1 m => match w_compare xl xh with Eq => (w_1, m) - | Lt => + | Lt => match w_compare yl yh with Eq => (w_1, m) | Lt => match ww_sub_c m (w_mul_c (w_sub xh xl) (w_sub yh yl)) with C0 m1 => (w_1, m1) | C1 m1 => (w_0, m1) - end + end | Gt => match ww_add_c m (w_mul_c (w_sub xh xl) (w_sub yl yh)) with C1 m1 => (w_2, m1) | C0 m1 => (w_1, m1) end end - | Gt => + | Gt => match w_compare yl yh with Eq => (w_1, m) | Lt => match ww_add_c m (w_mul_c (w_sub xl xh) (w_sub yh yl)) with @@ -129,8 +129,8 @@ Section DoubleMul. Definition ww_mul x y := match x, y with | W0, _ => W0 - | _, W0 => W0 - | WW xh xl, WW yh yl => + | _, W0 => W0 + | WW xh xl, WW yh yl => let ccl := w_add (w_mul xh yl) (w_mul xl yh) in ww_add (w_W0 ccl) (w_mul_c xl yl) end. @@ -161,9 +161,9 @@ Section DoubleMul. Variable w_mul_add : w -> w -> w -> w * w. Fixpoint double_mul_add_n1 (n:nat) : word w n -> w -> w -> w * word w n := - match n return word w n -> w -> w -> w * word w n with - | O => w_mul_add - | S n1 => + match n return word w n -> w -> w -> w * word w n with + | O => w_mul_add + | S n1 => let mul_add := double_mul_add_n1 n1 in fun x y r => match x with @@ -183,11 +183,11 @@ Section DoubleMul. Variable wn_0W : wn -> zn2z wn. Variable wn_WW : wn -> wn -> zn2z wn. Variable w_mul_add_n1 : wn -> w -> w -> w*wn. - Fixpoint double_mul_add_mn1 (m:nat) : + Fixpoint double_mul_add_mn1 (m:nat) : word wn m -> w -> w -> w*word wn m := - match m return word wn m -> w -> w -> w*word wn m with - | O => w_mul_add_n1 - | S m1 => + match m return word wn m -> w -> w -> w*word wn m with + | O => w_mul_add_n1 + | S m1 => let mul_add := double_mul_add_mn1 m1 in fun x y r => match x with @@ -207,11 +207,11 @@ Section DoubleMul. | WW h l => match w_add_c l r with | C0 lr => (h,lr) - | C1 lr => (w_succ h, lr) + | C1 lr => (w_succ h, lr) end end. - + (*Section DoubleProof. *) Variable w_digits : positive. Variable w_to_Z : w -> Z. @@ -225,11 +225,11 @@ Section DoubleMul. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Notation "[|| x ||]" := @@ -269,8 +269,8 @@ Section DoubleMul. forall x y, [[ww_add_carry x y]] = ([[x]] + [[y]] + 1) mod wwB. Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]]. - - + + Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB. Proof. intros x;apply spec_ww_to_Z;auto. Qed. @@ -281,21 +281,21 @@ Section DoubleMul. Ltac zarith := auto with zarith mult. Lemma wBwB_lex: forall a b c d, - a * wB^2 + [[b]] <= c * wB^2 + [[d]] -> + a * wB^2 + [[b]] <= c * wB^2 + [[d]] -> a <= c. - Proof. + Proof. intros a b c d H; apply beta_lex with [[b]] [[d]] (wB^2);zarith. Qed. - Lemma wBwB_lex_inv: forall a b c d, - a < c -> - a * wB^2 + [[b]] < c * wB^2 + [[d]]. + Lemma wBwB_lex_inv: forall a b c d, + a < c -> + a * wB^2 + [[b]] < c * wB^2 + [[d]]. Proof. intros a b c d H; apply beta_lex_inv; zarith. Qed. Lemma sum_mul_carry : forall xh xl yh yl wc cc, - [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] -> + [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] -> 0 <= [|wc|] <= 1. Proof. intros. @@ -303,14 +303,14 @@ Section DoubleMul. apply wB_pos. Qed. - Theorem mult_add_ineq: forall xH yH crossH, + Theorem mult_add_ineq: forall xH yH crossH, 0 <= [|xH|] * [|yH|] + [|crossH|] < wwB. Proof. intros;rewrite wwB_wBwB;apply mult_add_ineq;zarith. Qed. - + Hint Resolve mult_add_ineq : mult. - + Lemma spec_mul_aux : forall xh xl yh yl wc (cc:zn2z w) hh ll, [[hh]] = [|xh|] * [|yh|] -> [[ll]] = [|xl|] * [|yl|] -> @@ -325,9 +325,9 @@ Section DoubleMul. end||] = ([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|]). Proof. intros;assert (U1 := wB_pos w_digits). - replace (([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|])) with + replace (([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|])) with ([|xh|]*[|yh|]*wB^2 + ([|xh|]*[|yl|] + [|xl|]*[|yh|])*wB + [|xl|]*[|yl|]). - 2:ring. rewrite <- H1;rewrite <- H;rewrite <- H0. + 2:ring. rewrite <- H1;rewrite <- H;rewrite <- H0. assert (H2 := sum_mul_carry _ _ _ _ _ _ H1). destruct cc as [ | cch ccl]; simpl zn2z_to_Z; simpl ww_to_Z. rewrite spec_ww_add;rewrite spec_w_W0;rewrite Zmod_small; @@ -346,7 +346,7 @@ Section DoubleMul. rewrite <- Zmult_plus_distr_l. assert (((2 * wB - 4) + 2)*wB <= ([|wc|] * wB + [|cch|])*wB). apply Zmult_le_compat;zarith. - rewrite Zmult_plus_distr_l in H3. + rewrite Zmult_plus_distr_l in H3. intros. assert (U2 := spec_to_Z ccl);omega. generalize (spec_ww_add_c (w_W0 ccl) ll);destruct (ww_add_c (w_W0 ccl) ll) as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Zmult_1_l; @@ -363,8 +363,8 @@ Section DoubleMul. (forall xh xl yh yl hh ll, [[hh]] = [|xh|]*[|yh|] -> [[ll]] = [|xl|]*[|yl|] -> - let (wc,cc) := cross xh xl yh yl hh ll in - [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]) -> + let (wc,cc) := cross xh xl yh yl hh ll in + [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]) -> forall x y, [||double_mul_c cross x y||] = [[x]] * [[y]]. Proof. intros cross Hcross x y;destruct x as [ |xh xl];simpl;trivial. @@ -376,7 +376,7 @@ Section DoubleMul. rewrite <- wwB_wBwB;trivial. Qed. - Lemma spec_ww_mul_c : forall x y, [||ww_mul_c x y||] = [[x]] * [[y]]. + Lemma spec_ww_mul_c : forall x y, [||ww_mul_c x y||] = [[x]] * [[y]]. Proof. intros x y;unfold ww_mul_c;apply spec_double_mul_c. intros xh xl yh yl hh ll H1 H2. @@ -402,9 +402,9 @@ Section DoubleMul. let (wc,cc) := kara_prod xh xl yh yl hh ll in [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]. Proof. - intros xh xl yh yl hh ll H H0; rewrite <- kara_prod_aux; + intros xh xl yh yl hh ll H H0; rewrite <- kara_prod_aux; rewrite <- H; rewrite <- H0; unfold kara_prod. - assert (Hxh := (spec_to_Z xh)); assert (Hxl := (spec_to_Z xl)); + assert (Hxh := (spec_to_Z xh)); assert (Hxl := (spec_to_Z xl)); assert (Hyh := (spec_to_Z yh)); assert (Hyl := (spec_to_Z yl)). generalize (spec_ww_add_c hh ll); case (ww_add_c hh ll); intros z Hz; rewrite <- Hz; unfold interp_carry; assert (Hz1 := (spec_ww_to_Z z)). @@ -412,7 +412,7 @@ Section DoubleMul. try rewrite Hxlh; try rewrite spec_w_0; try (ring; fail). generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh. rewrite Hylh; rewrite spec_w_0; try (ring; fail). - rewrite spec_w_0; try (ring; fail). + rewrite spec_w_0; try (ring; fail). repeat (rewrite spec_ww_sub || rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). split; auto with zarith. @@ -508,8 +508,8 @@ Section DoubleMul. repeat rewrite Zmod_small; auto with zarith; try (ring; fail). Qed. - Lemma sub_carry : forall xh xl yh yl z, - 0 <= z -> + Lemma sub_carry : forall xh xl yh yl z, + 0 <= z -> [|xh|]*[|yl|] + [|xl|]*[|yh|] = wwB + z -> z < wwB. Proof. @@ -519,7 +519,7 @@ Section DoubleMul. generalize (Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)). rewrite <- wwB_wBwB;intros H1 H2. assert (H3 := wB_pos w_digits). - assert (2*wB <= wwB). + assert (2*wB <= wwB). rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat;zarith. omega. Qed. @@ -528,7 +528,7 @@ Section DoubleMul. let H:= fresh "H" in assert (H:= spec_ww_to_Z x). - Ltac Zmult_lt_b x y := + Ltac Zmult_lt_b x y := let H := fresh "H" in assert (H := Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)). @@ -582,7 +582,7 @@ Section DoubleMul. Variable w_mul_add : w -> w -> w -> w * w. Variable spec_w_mul_add : forall x y r, let (h,l):= w_mul_add x y r in - [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. + [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. Lemma spec_double_mul_add_n1 : forall n x y r, let (h,l) := double_mul_add_n1 w_mul_add n x y r in @@ -590,7 +590,7 @@ Section DoubleMul. Proof. induction n;intros x y r;trivial. exact (spec_w_mul_add x y r). - unfold double_mul_add_n1;destruct x as[ |xh xl]; + unfold double_mul_add_n1;destruct x as[ |xh xl]; fold(double_mul_add_n1 w_mul_add). rewrite spec_w_0;rewrite spec_extend;simpl;trivial. assert(H:=IHn xl y r);destruct (double_mul_add_n1 w_mul_add n xl y r)as(rl,l). @@ -599,13 +599,13 @@ Section DoubleMul. rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc;rewrite <- H. rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite U;ring. - Qed. - + Qed. + End DoubleMulAddn1Proof. - Lemma spec_w_mul_add : forall x y r, + Lemma spec_w_mul_add : forall x y r, let (h,l):= w_mul_add x y r in - [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. + [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. Proof. intros x y r;unfold w_mul_add;assert (H:=spec_w_mul_c x y); destruct (w_mul_c x y) as [ |h l];simpl;rewrite <- H. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v index 043ff351..83a2e717 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleSqrt.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -17,7 +17,7 @@ Require Import BigNumPrelude. Require Import DoubleType. Require Import DoubleBase. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section DoubleSqrt. Variable w : Type. @@ -52,7 +52,7 @@ Section DoubleSqrt. Let wwBm1 := ww_Bm1 w_Bm1. - Definition ww_is_even x := + Definition ww_is_even x := match x with | W0 => true | WW xh xl => w_is_even xl @@ -62,7 +62,7 @@ Section DoubleSqrt. match w_compare x z with | Eq => match w_compare y z with - Eq => (C1 w_1, w_0) + Eq => (C1 w_1, w_0) | Gt => (C1 w_1, w_sub y z) | Lt => (C1 w_0, y) end @@ -120,7 +120,7 @@ Section DoubleSqrt. let ( q, r) := w_sqrt2 x1 x2 in let (q1, r1) := w_div2s r y1 q in match q1 with - C0 q1 => + C0 q1 => let q2 := w_square_c q1 in let a := WW q q1 in match r1 with @@ -132,9 +132,9 @@ Section DoubleSqrt. | C0 r2 => match ww_sub_c (WW r2 y2) q2 with C0 r3 => (a, C0 r3) - | C1 r3 => + | C1 r3 => let a2 := ww_add_mul_div (w_0W w_1) a W0 in - match ww_pred_c a2 with + match ww_pred_c a2 with C0 a3 => (ww_pred a, ww_add_c a3 r3) | C1 a3 => @@ -166,20 +166,20 @@ Section DoubleSqrt. | Gt => match ww_add_mul_div p x W0 with W0 => W0 - | WW x1 x2 => + | WW x1 x2 => let (r, _) := w_sqrt2 x1 x2 in - WW w_0 (w_add_mul_div - (w_sub w_zdigits + WW w_0 (w_add_mul_div + (w_sub w_zdigits (low (ww_add_mul_div (ww_pred ww_zdigits) W0 p))) w_0 r) end - | _ => + | _ => match x with W0 => W0 | WW x1 x2 => WW w_0 (fst (w_sqrt2 x1 x2)) end end. - + Variable w_to_Z : w -> Z. @@ -192,11 +192,11 @@ Section DoubleSqrt. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). Notation "[|| x ||]" := @@ -269,14 +269,12 @@ Section DoubleSqrt. Let spec_ww_Bm1 : [[wwBm1]] = wwB - 1. Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed. - - Hint Rewrite spec_w_0 spec_w_1 w_Bm1 spec_w_WW spec_w_sub - spec_w_div21 spec_w_add_mul_div spec_ww_Bm1 - spec_w_add_c spec_w_sqrt2: w_rewrite. + Hint Rewrite spec_w_0 spec_w_1 spec_w_WW spec_w_sub + spec_w_add_mul_div spec_ww_Bm1 spec_w_add_c : w_rewrite. Lemma spec_ww_is_even : forall x, if ww_is_even x then [[x]] mod 2 = 0 else [[x]] mod 2 = 1. -clear spec_more_than_1_digit. +clear spec_more_than_1_digit. intros x; case x; simpl ww_is_even. simpl. rewrite Zmod_small; auto with zarith. @@ -379,8 +377,8 @@ intros x; case x; simpl ww_is_even. end. rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. destruct (spec_to_Z w1) as [H1 H2];auto with zarith. - split; auto with zarith. - apply Zdiv_lt_upper_bound; auto with zarith. + split; auto with zarith. + apply Zdiv_lt_upper_bound; auto with zarith. rewrite Hp; ring. Qed. @@ -402,7 +400,7 @@ intros x; case x; simpl ww_is_even. rewrite Zmax_right; auto with zarith. rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. destruct (spec_to_Z w1) as [H1 H2];auto with zarith. - split; auto with zarith. + split; auto with zarith. unfold base. match goal with |- _ < _ ^ ?X => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; @@ -434,7 +432,7 @@ intros x; case x; simpl ww_is_even. intros w1. rewrite spec_ww_add_mul_div; auto with zarith. autorewrite with w_rewrite rm10. - rewrite spec_w_0W; rewrite spec_w_1. + rewrite spec_w_0W; rewrite spec_w_1. rewrite Zpower_1_r; auto with zarith. rewrite Zmult_comm; auto. rewrite spec_w_0W; rewrite spec_w_1; auto with zarith. @@ -458,7 +456,7 @@ intros x; case x; simpl ww_is_even. match goal with |- 0 <= ?X - 1 => assert (0 < X); auto with zarith end. - apply Zpower_gt_0; auto with zarith. + apply Zpower_gt_0; auto with zarith. match goal with |- 0 <= ?X - 1 => assert (0 < X); auto with zarith; red; reflexivity end. @@ -542,7 +540,7 @@ intros x; case x; simpl ww_is_even. rewrite add_mult_div_2_plus_1; unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -559,7 +557,7 @@ intros x; case x; simpl ww_is_even. unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -592,7 +590,7 @@ intros x; case x; simpl ww_is_even. rewrite H1; unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -611,7 +609,7 @@ intros x; case x; simpl ww_is_even. rewrite H1; unfold base. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; + rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith end. rewrite Zpos_minus; auto with zarith. @@ -682,7 +680,7 @@ intros x; case x; simpl ww_is_even. rewrite Zsquare_mult; replace (p * p) with ((- p) * (- p)); try ring. apply Zmult_le_0_compat; auto with zarith. Qed. - + Lemma spec_split: forall x, [|fst (split x)|] * wB + [|snd (split x)|] = [[x]]. intros x; case x; simpl; autorewrite with w_rewrite; @@ -751,7 +749,7 @@ intros x; case x; simpl ww_is_even. match goal with |- ?X <= ?Y => replace Y with (2 * (wB/ 2 - 1)); auto with zarith end. - pattern wB at 2; rewrite <- wB_div_2; auto with zarith. + pattern wB at 2; rewrite <- wB_div_2; auto with zarith. match type of H1 with ?X = _ => assert (U5: X < wB / 4 * wB) end. @@ -764,9 +762,9 @@ intros x; case x; simpl ww_is_even. destruct (spec_to_Z w3);auto with zarith. generalize (@spec_w_div2s c w0 w4 U1 H2). case (w_div2s c w0 w4). - intros c0; case c0; intros w5; + intros c0; case c0; intros w5; repeat (rewrite C0_id || rewrite C1_plus_wB). - intros c1; case c1; intros w6; + intros c1; case c1; intros w6; repeat (rewrite C0_id || rewrite C1_plus_wB). intros (H3, H4). match goal with |- context [ww_sub_c ?y ?z] => @@ -1038,7 +1036,7 @@ intros x; case x; simpl ww_is_even. end. apply Zle_not_lt; rewrite <- H3; auto with zarith. rewrite Zmult_plus_distr_l. - apply Zlt_le_trans with ((2 * [|w4|]) * wB + 0); + apply Zlt_le_trans with ((2 * [|w4|]) * wB + 0); auto with zarith. apply beta_lex_inv; auto with zarith. destruct (spec_to_Z w0);auto with zarith. @@ -1119,9 +1117,9 @@ intros x; case x; simpl ww_is_even. auto with zarith. simpl ww_to_Z. assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z x);auto with zarith. - Qed. - - Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2. + Qed. + + Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2. pattern wwB at 1; rewrite wwB_wBwB; rewrite Zpower_2. rewrite <- wB_div_2. match goal with |- context[(2 * ?X) * (2 * ?Z)] => @@ -1134,7 +1132,7 @@ intros x; case x; simpl ww_is_even. Lemma spec_ww_head1 - : forall x : zn2z w, + : forall x : zn2z w, (ww_is_even (ww_head1 x) = true) /\ (0 < [[x]] -> wwB / 4 <= 2 ^ [[ww_head1 x]] * [[x]] < wwB). assert (U := wB_pos w_digits). @@ -1167,7 +1165,7 @@ intros x; case x; simpl ww_is_even. rewrite Hp. rewrite Zminus_mod; auto with zarith. rewrite H2; repeat rewrite Zmod_small; auto with zarith. - intros H3; rewrite Hp. + intros H3; rewrite Hp. case (spec_ww_head0 x); auto; intros Hv3 Hv4. assert (Hu: forall u, 0 < u -> 2 * 2 ^ (u - 1) = 2 ^u). intros u Hu. @@ -1189,7 +1187,7 @@ intros x; case x; simpl ww_is_even. apply sym_equal; apply Zdiv_unique with 0; auto with zarith. rewrite Zmult_assoc; rewrite wB_div_4; auto with zarith. - rewrite wwB_wBwB; ring. + rewrite wwB_wBwB; ring. Qed. Lemma spec_ww_sqrt : forall x, @@ -1198,14 +1196,14 @@ intros x; case x; simpl ww_is_even. intro x; unfold ww_sqrt. generalize (spec_ww_is_zero x); case (ww_is_zero x). simpl ww_to_Z; simpl Zpower; unfold Zpower_pos; simpl; - auto with zarith. + auto with zarith. intros H1. generalize (spec_ww_compare (ww_head1 x) W0); case ww_compare; simpl ww_to_Z; autorewrite with rm10. generalize H1; case x. intros HH; contradict HH; simpl ww_to_Z; auto with zarith. intros w0 w1; simpl ww_to_Z; autorewrite with w_rewrite rm10. - intros H2; case (spec_ww_head1 (WW w0 w1)); intros H3 H4 H5. + intros H2; case (spec_ww_head1 (WW w0 w1)); intros H3 H4 H5. generalize (H4 H2); clear H4; rewrite H5; clear H5; autorewrite with rm10. intros (H4, H5). assert (V: wB/4 <= [|w0|]). @@ -1241,7 +1239,7 @@ intros x; case x; simpl ww_is_even. apply Zle_not_lt; unfold base. apply Zle_trans with (2 ^ [[ww_head1 x]]). apply Zpower_le_monotone; auto with zarith. - pattern (2 ^ [[ww_head1 x]]) at 1; + pattern (2 ^ [[ww_head1 x]]) at 1; rewrite <- (Zmult_1_r (2 ^ [[ww_head1 x]])). apply Zmult_le_compat_l; auto with zarith. generalize (spec_ww_add_mul_div x W0 (ww_head1 x) Hv2); @@ -1283,13 +1281,13 @@ intros x; case x; simpl ww_is_even. rewrite Zmod_small; auto with zarith. split; auto with zarith. apply Zlt_le_trans with (Zpos (xO w_digits)); auto with zarith. - unfold base; apply Zpower2_le_lin; auto with zarith. + unfold base; apply Zpower2_le_lin; auto with zarith. assert (Hv4: [[ww_head1 x]]/2 < wB). apply Zle_lt_trans with (Zpos w_digits). apply Zmult_le_reg_r with 2; auto with zarith. repeat rewrite (fun x => Zmult_comm x 2). rewrite <- Hv0; rewrite <- Zpos_xO; auto. - unfold base; apply Zpower2_lt_lin; auto with zarith. + unfold base; apply Zpower2_lt_lin; auto with zarith. assert (Hv5: [[(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))]] = [[ww_head1 x]]/2). rewrite spec_ww_add_mul_div. @@ -1330,14 +1328,14 @@ intros x; case x; simpl ww_is_even. rewrite tmp; clear tmp. apply Zpower_le_monotone3; auto with zarith. split; auto with zarith. - pattern [|w2|] at 2; + pattern [|w2|] at 2; rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith. match goal with |- ?X <= ?X + ?Y => assert (0 <= Y); auto with zarith end. case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith. - case c; unfold interp_carry; autorewrite with rm10; + case c; unfold interp_carry; autorewrite with rm10; intros w3; assert (V3 := spec_to_Z w3);auto with zarith. apply Zmult_lt_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith. rewrite H4. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v index 269d62bb..a7e55671 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleSub.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. @@ -17,7 +17,7 @@ Require Import BigNumPrelude. Require Import DoubleType. Require Import DoubleBase. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section DoubleSub. Variable w : Type. @@ -39,7 +39,7 @@ Section DoubleSub. Definition ww_opp_c x := match x with | W0 => C0 W0 - | WW xh xl => + | WW xh xl => match w_opp_c xl with | C0 _ => match w_opp_c xh with @@ -53,7 +53,7 @@ Section DoubleSub. Definition ww_opp x := match x with | W0 => W0 - | WW xh xl => + | WW xh xl => match w_opp_c xl with | C0 _ => WW (w_opp xh) w_0 | C1 l => WW (w_opp_carry xh) l @@ -72,14 +72,14 @@ Section DoubleSub. | WW xh xl => match w_pred_c xl with | C0 l => C0 (w_WW xh l) - | C1 _ => - match w_pred_c xh with + | C1 _ => + match w_pred_c xh with | C0 h => C0 (WW h w_Bm1) | C1 _ => C1 ww_Bm1 end end end. - + Definition ww_pred x := match x with | W0 => ww_Bm1 @@ -89,19 +89,19 @@ Section DoubleSub. | C1 l => WW (w_pred xh) w_Bm1 end end. - + Definition ww_sub_c x y := match y, x with | W0, _ => C0 x | WW yh yl, W0 => ww_opp_c (WW yh yl) | WW yh yl, WW xh xl => match w_sub_c xl yl with - | C0 l => + | C0 l => match w_sub_c xh yh with | C0 h => C0 (w_WW h l) | C1 h => C1 (WW h l) end - | C1 l => + | C1 l => match w_sub_carry_c xh yh with | C0 h => C0 (WW h l) | C1 h => C1 (WW h l) @@ -109,7 +109,7 @@ Section DoubleSub. end end. - Definition ww_sub x y := + Definition ww_sub x y := match y, x with | W0, _ => x | WW yh yl, W0 => ww_opp (WW yh yl) @@ -127,7 +127,7 @@ Section DoubleSub. | WW yh yl, W0 => C1 (ww_opp_carry (WW yh yl)) | WW yh yl, WW xh xl => match w_sub_carry_c xl yl with - | C0 l => + | C0 l => match w_sub_c xh yh with | C0 h => C0 (w_WW h l) | C1 h => C1 (WW h l) @@ -155,7 +155,7 @@ Section DoubleSub. (*Section DoubleProof.*) Variable w_digits : positive. Variable w_to_Z : w -> Z. - + Notation wB := (base w_digits). Notation wwB := (base (ww_digits w_digits)). @@ -166,13 +166,13 @@ Section DoubleSub. (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[+[ c ]]" := + (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) + Notation "[-[ c ]]" := + (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) (at level 0, x at level 99). - + Variable spec_w_0 : [|w_0|] = 0. Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1. Variable spec_ww_Bm1 : [[ww_Bm1]] = wwB - 1. @@ -187,7 +187,7 @@ Section DoubleSub. Variable spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|]. Variable spec_sub_carry_c : forall x y, [-|w_sub_carry_c x y|] = [|x|] - [|y|] - 1. - + Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB. Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. Variable spec_sub_carry : @@ -197,12 +197,12 @@ Section DoubleSub. Lemma spec_ww_opp_c : forall x, [-[ww_opp_c x]] = -[[x]]. Proof. destruct x as [ |xh xl];simpl. reflexivity. - rewrite Zopp_plus_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl) + rewrite Zopp_plus_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H; - rewrite Zopp_mult_distr_l. + rewrite Zopp_mult_distr_l. assert ([|l|] = 0). assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. - rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh) + rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh) as [h|h];intros H1;unfold interp_carry in *;rewrite <- H1. assert ([|h|] = 0). assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega. @@ -216,7 +216,7 @@ Section DoubleSub. Proof. destruct x as [ |xh xl];simpl. reflexivity. rewrite Zopp_plus_distr;rewrite Zopp_mult_distr_l. - generalize (spec_opp_c xl);destruct (w_opp_c xl) + generalize (spec_opp_c xl);destruct (w_opp_c xl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. rewrite spec_w_0;rewrite Zplus_0_r;rewrite wwB_wBwB. assert ([|l|] = 0). @@ -247,7 +247,7 @@ Section DoubleSub. assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. rewrite H0;change ([|xh|] + -1) with ([|xh|] - 1). generalize (spec_pred_c xh);destruct (w_pred_c xh) as [h|h]; - intros H1;unfold interp_carry in H1;rewrite <- H1. + intros H1;unfold interp_carry in H1;rewrite <- H1. simpl;rewrite spec_w_Bm1;ring. assert ([|h|] = wB - 1). assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega. @@ -258,14 +258,14 @@ Section DoubleSub. Proof. destruct y as [ |yh yl];simpl. ring. destruct x as [ |xh xl];simpl. exact (spec_ww_opp_c (WW yh yl)). - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|])). 2:ring. generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl) as [l|l];intros H; unfold interp_carry in H;rewrite <- H. generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1;simpl ww_to_Z; @@ -275,37 +275,37 @@ Section DoubleSub. Lemma spec_ww_sub_carry_c : forall x y, [-[ww_sub_carry_c x y]] = [[x]] - [[y]] - 1. Proof. - destruct y as [ |yh yl];simpl. + destruct y as [ |yh yl];simpl. unfold Zminus;simpl;rewrite Zplus_0_r;exact (spec_ww_pred_c x). destruct x as [ |xh xl]. unfold interp_carry;rewrite spec_w_WW;simpl ww_to_Z;rewrite wwB_wBwB; repeat rewrite spec_opp_carry;ring. simpl ww_to_Z. - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|]-1)). 2:ring. - generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl) + generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H. generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1;try rewrite spec_w_WW; simpl ww_to_Z; try rewrite wwB_wBwB;ring. - Qed. - + Qed. + Lemma spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB. Proof. - destruct x as [ |xh xl];simpl. + destruct x as [ |xh xl];simpl. apply Zmod_unique with (-1). apply spec_ww_to_Z;trivial. rewrite spec_ww_Bm1;ring. replace ([|xh|]*wB + [|xl|] - 1) with ([|xh|]*wB + ([|xl|] - 1)). 2:ring. generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l];intro H; unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. - rewrite Zmod_small. apply spec_w_WW. + rewrite Zmod_small. apply spec_w_WW. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh l)). - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. change ([|xh|] + -1) with ([|xh|] - 1). assert ([|l|] = wB - 1). assert (H1:= spec_to_Z l);assert (H2:= spec_to_Z xl);omega. @@ -318,7 +318,7 @@ Section DoubleSub. destruct y as [ |yh yl];simpl. ring_simplify ([[x]] - 0);rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial. destruct x as [ |xh xl];simpl. exact (spec_ww_opp (WW yh yl)). - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|])). 2:ring. generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl)as[l|l];intros H; unfold interp_carry in H;rewrite <- H. @@ -338,7 +338,7 @@ Section DoubleSub. apply spec_ww_to_Z;trivial. fold (ww_opp_carry (WW yh yl)). rewrite (spec_ww_opp_carry (WW yh yl));simpl ww_to_Z;ring. - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) + replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|] - 1)). 2:ring. generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl)as[l|l]; intros H;unfold interp_carry in H;rewrite <- H;rewrite spec_w_WW. @@ -354,4 +354,4 @@ End DoubleSub. - + diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v index 28d40094..88cbb484 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v @@ -8,12 +8,12 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: DoubleType.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Set Implicit Arguments. Require Import ZArith. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Definition base digits := Zpower 2 (Zpos digits). @@ -37,10 +37,10 @@ Section Zn2Z. Variable znz : Type. - (** From a type [znz] representing a cyclic structure Z/nZ, + (** From a type [znz] representing a cyclic structure Z/nZ, we produce a representation of Z/2nZ by pairs of elements of [znz] - (plus a special case for zero). High half of the new number comes - first. + (plus a special case for zero). High half of the new number comes + first. *) Inductive zn2z := @@ -57,10 +57,10 @@ End Zn2Z. Implicit Arguments W0 [znz]. -(** From a cyclic representation [w], we iterate the [zn2z] construct - [n] times, gaining the type of binary trees of depth at most [n], - whose leafs are either W0 (if depth < n) or elements of w - (if depth = n). +(** From a cyclic representation [w], we iterate the [zn2z] construct + [n] times, gaining the type of binary trees of depth at most [n], + whose leafs are either W0 (if depth < n) or elements of w + (if depth = n). *) Fixpoint word (w:Type) (n:nat) : Type := diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v index 6da1c6ec..8addf5b9 100644 --- a/theories/Numbers/Cyclic/Int31/Cyclic31.v +++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Cyclic31.v 11907 2009-02-10 23:54:28Z letouzey $ i*) +(*i $Id$ i*) (** * Int31 numbers defines indeed a cyclic structure : Z/(2^31)Z *) @@ -24,8 +24,8 @@ Require Import BigNumPrelude. Require Import CyclicAxioms. Require Import ROmega. -Open Scope nat_scope. -Open Scope int31_scope. +Local Open Scope nat_scope. +Local Open Scope int31_scope. Section Basics. @@ -34,9 +34,9 @@ Section Basics. Lemma iszero_eq0 : forall x, iszero x = true -> x=0. Proof. destruct x; simpl; intros. - repeat - match goal with H:(if ?d then _ else _) = true |- _ => - destruct d; try discriminate + repeat + match goal with H:(if ?d then _ else _) = true |- _ => + destruct d; try discriminate end. reflexivity. Qed. @@ -46,26 +46,26 @@ Section Basics. intros x H Eq; rewrite Eq in H; simpl in *; discriminate. Qed. - Lemma sneakl_shiftr : forall x, + Lemma sneakl_shiftr : forall x, x = sneakl (firstr x) (shiftr x). Proof. destruct x; simpl; auto. Qed. - Lemma sneakr_shiftl : forall x, + Lemma sneakr_shiftl : forall x, x = sneakr (firstl x) (shiftl x). Proof. destruct x; simpl; auto. Qed. - Lemma twice_zero : forall x, + Lemma twice_zero : forall x, twice x = 0 <-> twice_plus_one x = 1. Proof. - destruct x; simpl in *; split; + destruct x; simpl in *; split; intro H; injection H; intros; subst; auto. Qed. - Lemma twice_or_twice_plus_one : forall x, + Lemma twice_or_twice_plus_one : forall x, x = twice (shiftr x) \/ x = twice_plus_one (shiftr x). Proof. intros; case_eq (firstr x); intros. @@ -79,13 +79,13 @@ Section Basics. Definition nshiftr n x := iter_nat n _ shiftr x. - Lemma nshiftr_S : + Lemma nshiftr_S : forall n x, nshiftr (S n) x = shiftr (nshiftr n x). Proof. reflexivity. Qed. - Lemma nshiftr_S_tail : + Lemma nshiftr_S_tail : forall n x, nshiftr (S n) x = nshiftr n (shiftr x). Proof. induction n; simpl; auto. @@ -103,7 +103,7 @@ Section Basics. destruct x; simpl; auto. Qed. - Lemma nshiftr_above_size : forall k x, size<=k -> + Lemma nshiftr_above_size : forall k x, size<=k -> nshiftr k x = 0. Proof. intros. @@ -117,13 +117,13 @@ Section Basics. Definition nshiftl n x := iter_nat n _ shiftl x. - Lemma nshiftl_S : + Lemma nshiftl_S : forall n x, nshiftl (S n) x = shiftl (nshiftl n x). Proof. reflexivity. Qed. - Lemma nshiftl_S_tail : + Lemma nshiftl_S_tail : forall n x, nshiftl (S n) x = nshiftl n (shiftl x). Proof. induction n; simpl; auto. @@ -141,7 +141,7 @@ Section Basics. destruct x; simpl; auto. Qed. - Lemma nshiftl_above_size : forall k x, size<=k -> + Lemma nshiftl_above_size : forall k x, size<=k -> nshiftl k x = 0. Proof. intros. @@ -151,27 +151,27 @@ Section Basics. simpl; rewrite nshiftl_S, IHn; auto. Qed. - Lemma firstr_firstl : + Lemma firstr_firstl : forall x, firstr x = firstl (nshiftl (pred size) x). Proof. destruct x; simpl; auto. Qed. - Lemma firstl_firstr : + Lemma firstl_firstr : forall x, firstl x = firstr (nshiftr (pred size) x). Proof. destruct x; simpl; auto. Qed. - + (** More advanced results about [nshiftr] *) - Lemma nshiftr_predsize_0_firstl : forall x, + Lemma nshiftr_predsize_0_firstl : forall x, nshiftr (pred size) x = 0 -> firstl x = D0. Proof. destruct x; compute; intros H; injection H; intros; subst; auto. Qed. - Lemma nshiftr_0_propagates : forall n p x, n <= p -> + Lemma nshiftr_0_propagates : forall n p x, n <= p -> nshiftr n x = 0 -> nshiftr p x = 0. Proof. intros. @@ -181,7 +181,7 @@ Section Basics. simpl; rewrite nshiftr_S; rewrite IHn0; auto. Qed. - Lemma nshiftr_0_firstl : forall n x, n < size -> + Lemma nshiftr_0_firstl : forall n x, n < size -> nshiftr n x = 0 -> firstl x = D0. Proof. intros. @@ -194,8 +194,8 @@ Section Basics. (** Not used for the moment. Are they really useful ? *) Lemma int31_ind_sneakl : forall P : int31->Prop, - P 0 -> - (forall x d, P x -> P (sneakl d x)) -> + P 0 -> + (forall x d, P x -> P (sneakl d x)) -> forall x, P x. Proof. intros. @@ -210,10 +210,10 @@ Section Basics. change x with (nshiftr (size-size) x); auto. Qed. - Lemma int31_ind_twice : forall P : int31->Prop, - P 0 -> - (forall x, P x -> P (twice x)) -> - (forall x, P x -> P (twice_plus_one x)) -> + Lemma int31_ind_twice : forall P : int31->Prop, + P 0 -> + (forall x, P x -> P (twice x)) -> + (forall x, P x -> P (twice_plus_one x)) -> forall x, P x. Proof. induction x using int31_ind_sneakl; auto. @@ -224,21 +224,21 @@ Section Basics. (** * Some generic results about [recr] *) Section Recr. - + (** [recr] satisfies the fixpoint equation used for its definition. *) Variable (A:Type)(case0:A)(caserec:digits->int31->A->A). - - Lemma recr_aux_eqn : forall n x, iszero x = false -> - recr_aux (S n) A case0 caserec x = + + Lemma recr_aux_eqn : forall n x, iszero x = false -> + recr_aux (S n) A case0 caserec x = caserec (firstr x) (shiftr x) (recr_aux n A case0 caserec (shiftr x)). Proof. intros; simpl; rewrite H; auto. Qed. - Lemma recr_aux_converges : + Lemma recr_aux_converges : forall n p x, n <= size -> n <= p -> - recr_aux n A case0 caserec (nshiftr (size - n) x) = + recr_aux n A case0 caserec (nshiftr (size - n) x) = recr_aux p A case0 caserec (nshiftr (size - n) x). Proof. induction n. @@ -255,8 +255,8 @@ Section Basics. apply IHn; auto with arith. Qed. - Lemma recr_eqn : forall x, iszero x = false -> - recr A case0 caserec x = + Lemma recr_eqn : forall x, iszero x = false -> + recr A case0 caserec x = caserec (firstr x) (shiftr x) (recr A case0 caserec (shiftr x)). Proof. intros. @@ -265,11 +265,11 @@ Section Basics. rewrite (recr_aux_converges size (S size)); auto with arith. rewrite recr_aux_eqn; auto. Qed. - - (** [recr] is usually equivalent to a variant [recrbis] + + (** [recr] is usually equivalent to a variant [recrbis] written without [iszero] check. *) - Fixpoint recrbis_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) + Fixpoint recrbis_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) (i:int31) : A := match n with | O => case0 @@ -277,7 +277,7 @@ Section Basics. let si := shiftr i in caserec (firstr i) si (recrbis_aux next A case0 caserec si) end. - + Definition recrbis := recrbis_aux size. Hypothesis case0_caserec : caserec D0 0 case0 = case0. @@ -291,8 +291,8 @@ Section Basics. replace (recrbis_aux n A case0 caserec 0) with case0; auto. clear H IHn; induction n; simpl; congruence. Qed. - - Lemma recrbis_equiv : forall x, + + Lemma recrbis_equiv : forall x, recrbis A case0 caserec x = recr A case0 caserec x. Proof. intros; apply recrbis_aux_equiv; auto. @@ -348,7 +348,7 @@ Section Basics. rewrite incr_eqn1; destruct x; simpl; auto. Qed. - Lemma incr_twice_plus_one_firstl : + Lemma incr_twice_plus_one_firstl : forall x, firstl x = D0 -> incr (twice_plus_one x) = twice (incr x). Proof. intros. @@ -356,9 +356,9 @@ Section Basics. f_equal; f_equal. destruct x; simpl in *; rewrite H; auto. Qed. - - (** The previous result is actually true even without the - constraint on [firstl], but this is harder to prove + + (** The previous result is actually true even without the + constraint on [firstl], but this is harder to prove (see later). *) End Incr. @@ -369,9 +369,9 @@ Section Basics. (** Variant of [phi] via [recrbis] *) - Let Phi := fun b (_:int31) => + Let Phi := fun b (_:int31) => match b with D0 => Zdouble | D1 => Zdouble_plus_one end. - + Definition phibis_aux n x := recrbis_aux n _ Z0 Phi x. Lemma phibis_aux_equiv : forall x, phibis_aux size x = phi x. @@ -382,7 +382,7 @@ Section Basics. (** Recursive equations satisfied by [phi] *) - Lemma phi_eqn1 : forall x, firstr x = D0 -> + Lemma phi_eqn1 : forall x, firstr x = D0 -> phi x = Zdouble (phi (shiftr x)). Proof. intros. @@ -392,7 +392,7 @@ Section Basics. rewrite H; auto. Qed. - Lemma phi_eqn2 : forall x, firstr x = D1 -> + Lemma phi_eqn2 : forall x, firstr x = D1 -> phi x = Zdouble_plus_one (phi (shiftr x)). Proof. intros. @@ -402,7 +402,7 @@ Section Basics. rewrite H; auto. Qed. - Lemma phi_twice_firstl : forall x, firstl x = D0 -> + Lemma phi_twice_firstl : forall x, firstl x = D0 -> phi (twice x) = Zdouble (phi x). Proof. intros. @@ -411,7 +411,7 @@ Section Basics. destruct x; simpl in *; rewrite H; auto. Qed. - Lemma phi_twice_plus_one_firstl : forall x, firstl x = D0 -> + Lemma phi_twice_plus_one_firstl : forall x, firstl x = D0 -> phi (twice_plus_one x) = Zdouble_plus_one (phi x). Proof. intros. @@ -427,23 +427,23 @@ Section Basics. Lemma phibis_aux_pos : forall n x, (0 <= phibis_aux n x)%Z. Proof. induction n. - simpl; unfold phibis_aux; simpl; auto with zarith. + simpl; unfold phibis_aux; simpl; auto with zarith. intros. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux n (shiftr x)). destruct (firstr x). specialize IHn with (shiftr x); rewrite Zdouble_mult; omega. specialize IHn with (shiftr x); rewrite Zdouble_plus_one_mult; omega. Qed. - Lemma phibis_aux_bounded : - forall n x, n <= size -> + Lemma phibis_aux_bounded : + forall n x, n <= size -> (phibis_aux n (nshiftr (size-n) x) < 2 ^ (Z_of_nat n))%Z. Proof. induction n. simpl; unfold phibis_aux; simpl; auto with zarith. intros. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux n (shiftr (nshiftr (size - S n) x))). assert (shiftr (nshiftr (size - S n) x) = nshiftr (size-n) x). replace (size - n)%nat with (S (size - (S n))) by omega. @@ -468,8 +468,8 @@ Section Basics. apply phibis_aux_bounded; auto. Qed. - Lemma phibis_aux_lowerbound : - forall n x, firstr (nshiftr n x) = D1 -> + Lemma phibis_aux_lowerbound : + forall n x, firstr (nshiftr n x) = D1 -> (2 ^ Z_of_nat n <= phibis_aux (S n) x)%Z. Proof. induction n. @@ -480,7 +480,7 @@ Section Basics. intros. remember (S n) as m. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux m (shiftr x)). subst m. rewrite inj_S, Zpower_Zsucc; auto with zarith. @@ -488,13 +488,13 @@ Section Basics. apply IHn. rewrite <- nshiftr_S_tail; auto. destruct (firstr x). - change (Zdouble (phibis_aux (S n) (shiftr x))) with + change (Zdouble (phibis_aux (S n) (shiftr x))) with (2*(phibis_aux (S n) (shiftr x)))%Z. omega. rewrite Zdouble_plus_one_mult; omega. Qed. - Lemma phi_lowerbound : + Lemma phi_lowerbound : forall x, firstl x = D1 -> (2^(Z_of_nat (pred size)) <= phi x)%Z. Proof. intros. @@ -508,9 +508,9 @@ Section Basics. Section EqShiftL. - (** After killing [n] bits at the left, are the numbers equal ?*) + (** After killing [n] bits at the left, are the numbers equal ?*) - Definition EqShiftL n x y := + Definition EqShiftL n x y := nshiftl n x = nshiftl n y. Lemma EqShiftL_zero : forall x y, EqShiftL O x y <-> x = y. @@ -523,7 +523,7 @@ Section Basics. red; intros; rewrite 2 nshiftl_above_size; auto. Qed. - Lemma EqShiftL_le : forall k k' x y, k <= k' -> + Lemma EqShiftL_le : forall k k' x y, k <= k' -> EqShiftL k x y -> EqShiftL k' x y. Proof. unfold EqShiftL; intros. @@ -534,18 +534,18 @@ Section Basics. rewrite 2 nshiftl_S; f_equal; auto. Qed. - Lemma EqShiftL_firstr : forall k x y, k < size -> + Lemma EqShiftL_firstr : forall k x y, k < size -> EqShiftL k x y -> firstr x = firstr y. Proof. intros. rewrite 2 firstr_firstl. f_equal. - apply EqShiftL_le with k; auto. + apply EqShiftL_le with k; auto. unfold size. auto with arith. Qed. - Lemma EqShiftL_twice : forall k x y, + Lemma EqShiftL_twice : forall k x y, EqShiftL k (twice x) (twice y) <-> EqShiftL (S k) x y. Proof. intros; unfold EqShiftL. @@ -553,7 +553,7 @@ Section Basics. Qed. (** * From int31 to list of digits. *) - + (** Lower (=rightmost) bits comes first. *) Definition i2l := recrbis _ nil (fun d _ rec => d::rec). @@ -561,10 +561,10 @@ Section Basics. Lemma i2l_length : forall x, length (i2l x) = size. Proof. intros; reflexivity. - Qed. + Qed. - Fixpoint lshiftl l x := - match l with + Fixpoint lshiftl l x := + match l with | nil => x | d::l => sneakl d (lshiftl l x) end. @@ -576,19 +576,19 @@ Section Basics. destruct x; compute; auto. Qed. - Lemma i2l_sneakr : forall x d, + Lemma i2l_sneakr : forall x d, i2l (sneakr d x) = tail (i2l x) ++ d::nil. Proof. destruct x; compute; auto. Qed. - Lemma i2l_sneakl : forall x d, + Lemma i2l_sneakl : forall x d, i2l (sneakl d x) = d :: removelast (i2l x). Proof. destruct x; compute; auto. Qed. - Lemma i2l_l2i : forall l, length l = size -> + Lemma i2l_l2i : forall l, length l = size -> i2l (l2i l) = l. Proof. repeat (destruct l as [ |? l]; [intros; discriminate | ]). @@ -596,9 +596,9 @@ Section Basics. intros _; compute; auto. Qed. - Fixpoint cstlist (A:Type)(a:A) n := - match n with - | O => nil + Fixpoint cstlist (A:Type)(a:A) n := + match n with + | O => nil | S n => a::cstlist _ a n end. @@ -612,7 +612,7 @@ Section Basics. induction (i2l x); simpl; f_equal; auto. rewrite H0; clear H0. reflexivity. - + intros. rewrite nshiftl_S. unfold shiftl; rewrite i2l_sneakl. @@ -657,10 +657,10 @@ Section Basics. f_equal; auto. Qed. - (** This equivalence allows to prove easily the following delicate + (** This equivalence allows to prove easily the following delicate result *) - Lemma EqShiftL_twice_plus_one : forall k x y, + Lemma EqShiftL_twice_plus_one : forall k x y, EqShiftL k (twice_plus_one x) (twice_plus_one y) <-> EqShiftL (S k) x y. Proof. intros. @@ -683,7 +683,7 @@ Section Basics. subst lx n; rewrite i2l_length; omega. Qed. - Lemma EqShiftL_shiftr : forall k x y, EqShiftL k x y -> + Lemma EqShiftL_shiftr : forall k x y, EqShiftL k x y -> EqShiftL (S k) (shiftr x) (shiftr y). Proof. intros. @@ -704,41 +704,41 @@ Section Basics. omega. Qed. - Lemma EqShiftL_incrbis : forall n k x y, n<=size -> + Lemma EqShiftL_incrbis : forall n k x y, n<=size -> (n+k=S size)%nat -> - EqShiftL k x y -> + EqShiftL k x y -> EqShiftL k (incrbis_aux n x) (incrbis_aux n y). Proof. induction n; simpl; intros. red; auto. - destruct (eq_nat_dec k size). + destruct (eq_nat_dec k size). subst k; apply EqShiftL_size; auto. - unfold incrbis_aux; simpl; + unfold incrbis_aux; simpl; fold (incrbis_aux n (shiftr x)); fold (incrbis_aux n (shiftr y)). rewrite (EqShiftL_firstr k x y); auto; try omega. case_eq (firstr y); intros. rewrite EqShiftL_twice_plus_one. apply EqShiftL_shiftr; auto. - + rewrite EqShiftL_twice. apply IHn; try omega. apply EqShiftL_shiftr; auto. Qed. - Lemma EqShiftL_incr : forall x y, + Lemma EqShiftL_incr : forall x y, EqShiftL 1 x y -> EqShiftL 1 (incr x) (incr y). Proof. intros. rewrite <- 2 incrbis_aux_equiv. apply EqShiftL_incrbis; auto. Qed. - + End EqShiftL. (** * More equations about [incr] *) - Lemma incr_twice_plus_one : + Lemma incr_twice_plus_one : forall x, incr (twice_plus_one x) = twice (incr x). Proof. intros. @@ -757,7 +757,7 @@ Section Basics. destruct (incr (shiftr x)); simpl; discriminate. Qed. - Lemma incr_inv : forall x y, + Lemma incr_inv : forall x y, incr x = twice_plus_one y -> x = twice y. Proof. intros. @@ -777,7 +777,7 @@ Section Basics. (** First, recursive equations *) - Lemma phi_inv_double_plus_one : forall z, + Lemma phi_inv_double_plus_one : forall z, phi_inv (Zdouble_plus_one z) = twice_plus_one (phi_inv z). Proof. destruct z; simpl; auto. @@ -789,14 +789,14 @@ Section Basics. auto. Qed. - Lemma phi_inv_double : forall z, + Lemma phi_inv_double : forall z, phi_inv (Zdouble z) = twice (phi_inv z). Proof. destruct z; simpl; auto. rewrite incr_twice_plus_one; auto. Qed. - Lemma phi_inv_incr : forall z, + Lemma phi_inv_incr : forall z, phi_inv (Zsucc z) = incr (phi_inv z). Proof. destruct z. @@ -816,19 +816,19 @@ Section Basics. rewrite incr_twice_plus_one; auto. Qed. - (** [phi_inv o inv], the always-exact and easy-to-prove trip : + (** [phi_inv o inv], the always-exact and easy-to-prove trip : from int31 to Z and then back to int31. *) - Lemma phi_inv_phi_aux : - forall n x, n <= size -> - phi_inv (phibis_aux n (nshiftr (size-n) x)) = + Lemma phi_inv_phi_aux : + forall n x, n <= size -> + phi_inv (phibis_aux n (nshiftr (size-n) x)) = nshiftr (size-n) x. Proof. induction n. intros; simpl. rewrite nshiftr_size; auto. intros. - unfold phibis_aux, recrbis_aux; fold recrbis_aux; + unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux n (shiftr (nshiftr (size-S n) x))). assert (shiftr (nshiftr (size - S n) x) = nshiftr (size-n) x). replace (size - n)%nat with (S (size - (S n))); auto; omega. @@ -863,10 +863,10 @@ Section Basics. (** * [positive_to_int31] *) - (** A variant of [p2i] with [twice] and [twice_plus_one] instead of + (** A variant of [p2i] with [twice] and [twice_plus_one] instead of [2*i] and [2*i+1] *) - Fixpoint p2ibis n p : (N*int31)%type := + Fixpoint p2ibis n p : (N*int31)%type := match n with | O => (Npos p, On) | S n => match p with @@ -876,7 +876,7 @@ Section Basics. end end. - Lemma p2ibis_bounded : forall n p, + Lemma p2ibis_bounded : forall n p, nshiftr n (snd (p2ibis n p)) = 0. Proof. induction n. @@ -906,20 +906,20 @@ Section Basics. replace (shiftr In) with 0; auto. apply nshiftr_n_0. Qed. - + Lemma p2ibis_spec : forall n p, n<=size -> - Zpos p = ((Z_of_N (fst (p2ibis n p)))*2^(Z_of_nat n) + + Zpos p = ((Z_of_N (fst (p2ibis n p)))*2^(Z_of_nat n) + phi (snd (p2ibis n p)))%Z. Proof. induction n; intros. simpl; rewrite Pmult_1_r; auto. - replace (2^(Z_of_nat (S n)))%Z with (2*2^(Z_of_nat n))%Z by - (rewrite <- Zpower_Zsucc, <- Zpos_P_of_succ_nat; + replace (2^(Z_of_nat (S n)))%Z with (2*2^(Z_of_nat n))%Z by + (rewrite <- Zpower_Zsucc, <- Zpos_P_of_succ_nat; auto with zarith). rewrite (Zmult_comm 2). assert (n<=size) by omega. - destruct p; simpl; [ | | auto]; - specialize (IHn p H0); + destruct p; simpl; [ | | auto]; + specialize (IHn p H0); generalize (p2ibis_bounded n p); destruct (p2ibis n p) as (r,i); simpl in *; intros. @@ -937,25 +937,25 @@ Section Basics. (** We now prove that this [p2ibis] is related to [phi_inv_positive] *) - Lemma phi_inv_positive_p2ibis : forall n p, (n<=size)%nat -> + Lemma phi_inv_positive_p2ibis : forall n p, (n<=size)%nat -> EqShiftL (size-n) (phi_inv_positive p) (snd (p2ibis n p)). Proof. induction n. intros. apply EqShiftL_size; auto. intros. - simpl p2ibis; destruct p; [ | | red; auto]; - specialize IHn with p; - destruct (p2ibis n p); simpl snd in *; simpl phi_inv_positive; - rewrite ?EqShiftL_twice_plus_one, ?EqShiftL_twice; - replace (S (size - S n))%nat with (size - n)%nat by omega; + simpl p2ibis; destruct p; [ | | red; auto]; + specialize IHn with p; + destruct (p2ibis n p); simpl snd in *; simpl phi_inv_positive; + rewrite ?EqShiftL_twice_plus_one, ?EqShiftL_twice; + replace (S (size - S n))%nat with (size - n)%nat by omega; apply IHn; omega. Qed. (** This gives the expected result about [phi o phi_inv], at least for the positive case. *) - Lemma phi_phi_inv_positive : forall p, + Lemma phi_phi_inv_positive : forall p, phi (phi_inv_positive p) = (Zpos p) mod (2^(Z_of_nat size)). Proof. intros. @@ -975,12 +975,12 @@ Section Basics. Lemma double_twice_firstl : forall x, firstl x = D0 -> Twon*x = twice x. Proof. - intros. + intros. unfold mul31. rewrite <- Zdouble_mult, <- phi_twice_firstl, phi_inv_phi; auto. Qed. - Lemma double_twice_plus_one_firstl : forall x, firstl x = D0 -> + Lemma double_twice_plus_one_firstl : forall x, firstl x = D0 -> Twon*x+In = twice_plus_one x. Proof. intros. @@ -989,14 +989,14 @@ Section Basics. rewrite phi_twice_firstl, <- Zdouble_plus_one_mult, <- phi_twice_plus_one_firstl, phi_inv_phi; auto. Qed. - - Lemma p2i_p2ibis : forall n p, (n<=size)%nat -> + + Lemma p2i_p2ibis : forall n p, (n<=size)%nat -> p2i n p = p2ibis n p. Proof. induction n; simpl; auto; intros. - destruct p; auto; specialize IHn with p; - generalize (p2ibis_bounded n p); - rewrite IHn; try omega; destruct (p2ibis n p); simpl; intros; + destruct p; auto; specialize IHn with p; + generalize (p2ibis_bounded n p); + rewrite IHn; try omega; destruct (p2ibis n p); simpl; intros; f_equal; auto. apply double_twice_plus_one_firstl. apply (nshiftr_0_firstl n); auto; omega. @@ -1004,7 +1004,7 @@ Section Basics. apply (nshiftr_0_firstl n); auto; omega. Qed. - Lemma positive_to_int31_phi_inv_positive : forall p, + Lemma positive_to_int31_phi_inv_positive : forall p, snd (positive_to_int31 p) = phi_inv_positive p. Proof. intros; unfold positive_to_int31. @@ -1014,8 +1014,8 @@ Section Basics. apply (phi_inv_positive_p2ibis size); auto. Qed. - Lemma positive_to_int31_spec : forall p, - Zpos p = ((Z_of_N (fst (positive_to_int31 p)))*2^(Z_of_nat size) + + Lemma positive_to_int31_spec : forall p, + Zpos p = ((Z_of_N (fst (positive_to_int31 p)))*2^(Z_of_nat size) + phi (snd (positive_to_int31 p)))%Z. Proof. unfold positive_to_int31. @@ -1023,11 +1023,11 @@ Section Basics. apply p2ibis_spec; auto. Qed. - (** Thanks to the result about [phi o phi_inv_positive], we can - now establish easily the most general results about + (** Thanks to the result about [phi o phi_inv_positive], we can + now establish easily the most general results about [phi o twice] and so one. *) - - Lemma phi_twice : forall x, + + Lemma phi_twice : forall x, phi (twice x) = (Zdouble (phi x)) mod 2^(Z_of_nat size). Proof. intros. @@ -1041,7 +1041,7 @@ Section Basics. compute in H; elim H; auto. Qed. - Lemma phi_twice_plus_one : forall x, + Lemma phi_twice_plus_one : forall x, phi (twice_plus_one x) = (Zdouble_plus_one (phi x)) mod 2^(Z_of_nat size). Proof. intros. @@ -1055,14 +1055,14 @@ Section Basics. compute in H; elim H; auto. Qed. - Lemma phi_incr : forall x, + Lemma phi_incr : forall x, phi (incr x) = (Zsucc (phi x)) mod 2^(Z_of_nat size). Proof. intros. pattern x at 1; rewrite <- (phi_inv_phi x). rewrite <- phi_inv_incr. assert (0 <= Zsucc (phi x))%Z. - change (Zsucc (phi x)) with ((phi x)+1)%Z; + change (Zsucc (phi x)) with ((phi x)+1)%Z; generalize (phi_bounded x); omega. destruct (Zsucc (phi x)). simpl; auto. @@ -1070,10 +1070,10 @@ Section Basics. compute in H; elim H; auto. Qed. - (** With the previous results, we can deal with [phi o phi_inv] even + (** With the previous results, we can deal with [phi o phi_inv] even in the negative case *) - Lemma phi_phi_inv_negative : + Lemma phi_phi_inv_negative : forall p, phi (incr (complement_negative p)) = (Zneg p) mod 2^(Z_of_nat size). Proof. induction p. @@ -1091,11 +1091,11 @@ Section Basics. rewrite incr_twice_plus_one, phi_twice. remember (phi (incr (complement_negative p))) as q. rewrite Zdouble_mult, IHp, Zmult_mod_idemp_r; auto with zarith. - + simpl; auto. Qed. - Lemma phi_phi_inv : + Lemma phi_phi_inv : forall z, phi (phi_inv z) = z mod 2 ^ (Z_of_nat size). Proof. destruct z. @@ -1120,7 +1120,7 @@ Let w_pos_mod p i := end. (** Parity test *) -Let w_iseven i := +Let w_iseven i := let (_,r) := i/2 in match r ?= 0 with Eq => true | _ => false end. @@ -1140,7 +1140,7 @@ Definition int31_op := (mk_znz_op w_iszero (* Basic arithmetic operations *) (fun i => 0 -c i) - (fun i => 0 - i) + opp31 (fun i => 0-i-1) (fun i => i +c 1) add31c @@ -1181,14 +1181,14 @@ Definition int31_op := (mk_znz_op End Int31_Op. Section Int31_Spec. - - Open Local Scope Z_scope. + + Local Open Scope Z_scope. Notation "[| x |]" := (phi x) (at level 0, x at level 99). - Notation Local wB := (2 ^ (Z_of_nat size)). - - Lemma wB_pos : wB > 0. + Local Notation wB := (2 ^ (Z_of_nat size)). + + Lemma wB_pos : wB > 0. Proof. auto with zarith. Qed. @@ -1216,12 +1216,12 @@ Section Int31_Spec. Proof. reflexivity. Qed. - + Lemma spec_1 : [| 1 |] = 1. Proof. reflexivity. Qed. - + Lemma spec_Bm1 : [| Tn |] = wB - 1. Proof. reflexivity. @@ -1252,16 +1252,16 @@ Section Int31_Spec. destruct (Z_lt_le_dec (X+Y) wB). contradict H1; auto using Zmod_small with zarith. rewrite <- (Z_mod_plus_full (X+Y) (-1) wB). - rewrite Zmod_small; romega. + rewrite Zmod_small; romega. generalize (Zcompare_Eq_eq ((X+Y) mod wB) (X+Y)); intros Heq. - destruct Zcompare; intros; + destruct Zcompare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. Lemma spec_succ_c : forall x, [+|add31c x 1|] = [|x|] + 1. Proof. - intros; apply spec_add_c. + intros; apply spec_add_c. Qed. Lemma spec_add_carry_c : forall x y, [+|add31carryc x y|] = [|x|] + [|y|] + 1. @@ -1279,7 +1279,7 @@ Section Int31_Spec. rewrite Zmod_small; romega. generalize (Zcompare_Eq_eq ((X+Y+1) mod wB) (X+Y+1)); intros Heq. - destruct Zcompare; intros; + destruct Zcompare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1304,7 +1304,7 @@ Section Int31_Spec. (** Substraction *) Lemma spec_sub_c : forall x y, [-|sub31c x y|] = [|x|] - [|y|]. - Proof. + Proof. unfold sub31c, sub31, interp_carry; intros. rewrite phi_phi_inv. generalize (phi_bounded x)(phi_bounded y); intros. @@ -1337,7 +1337,7 @@ Section Int31_Spec. contradict H1; apply Zmod_small; romega. generalize (Zcompare_Eq_eq ((X-Y-1) mod wB) (X-Y-1)); intros Heq. - destruct Zcompare; intros; + destruct Zcompare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1355,7 +1355,7 @@ Section Int31_Spec. Qed. Lemma spec_opp_c : forall x, [-|sub31c 0 x|] = -[|x|]. - Proof. + Proof. intros; apply spec_sub_c. Qed. @@ -1402,7 +1402,7 @@ Section Int31_Spec. change (wB*wB) with (wB^2); ring. unfold phi_inv2. - destruct x; unfold zn2z_to_Z; rewrite ?phi_phi_inv; + destruct x; unfold zn2z_to_Z; rewrite ?phi_phi_inv; change base with wB; auto. Qed. @@ -1426,7 +1426,7 @@ Section Int31_Spec. intros; apply spec_mul_c. Qed. - (** Division *) + (** Division *) Lemma spec_div21 : forall a1 a2 b, wB/2 <= [|b|] -> @@ -1537,7 +1537,7 @@ Section Int31_Spec. intros (H,_); compute in H; elim H; auto. Qed. - Lemma iter_int31_iter_nat : forall A f i a, + Lemma iter_int31_iter_nat : forall A f i a, iter_int31 i A f a = iter_nat (Zabs_nat [|i|]) A f a. Proof. intros. @@ -1548,17 +1548,17 @@ Section Int31_Spec. revert i a; induction size. simpl; auto. simpl; intros. - case_eq (firstr i); intros H; rewrite 2 IHn; + case_eq (firstr i); intros H; rewrite 2 IHn; unfold phibis_aux; simpl; rewrite H; fold (phibis_aux n (shiftr i)); - generalize (phibis_aux_pos n (shiftr i)); intros; - set (z := phibis_aux n (shiftr i)) in *; clearbody z; + generalize (phibis_aux_pos n (shiftr i)); intros; + set (z := phibis_aux n (shiftr i)) in *; clearbody z; rewrite <- iter_nat_plus. f_equal. rewrite Zdouble_mult, Zmult_comm, <- Zplus_diag_eq_mult_2. symmetry; apply Zabs_nat_Zplus; auto with zarith. - change (iter_nat (S (Zabs_nat z + Zabs_nat z)) A f a = + change (iter_nat (S (Zabs_nat z + Zabs_nat z)) A f a = iter_nat (Zabs_nat (Zdouble_plus_one z)) A f a); f_equal. rewrite Zdouble_plus_one_mult, Zmult_comm, <- Zplus_diag_eq_mult_2. rewrite Zabs_nat_Zplus; auto with zarith. @@ -1566,13 +1566,13 @@ Section Int31_Spec. change (Zabs_nat 1) with 1%nat; omega. Qed. - Fixpoint addmuldiv31_alt n i j := - match n with - | O => i + Fixpoint addmuldiv31_alt n i j := + match n with + | O => i | S n => addmuldiv31_alt n (sneakl (firstl j) i) (shiftl j) end. - Lemma addmuldiv31_equiv : forall p x y, + Lemma addmuldiv31_equiv : forall p x y, addmuldiv31 p x y = addmuldiv31_alt (Zabs_nat [|p|]) x y. Proof. intros. @@ -1588,7 +1588,7 @@ Section Int31_Spec. Qed. Lemma spec_add_mul_div : forall x y p, [|p|] <= Zpos 31 -> - [| addmuldiv31 p x y |] = + [| addmuldiv31 p x y |] = ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos 31) - [|p|]))) mod wB. Proof. intros. @@ -1626,7 +1626,7 @@ Section Int31_Spec. replace (31-Z_of_nat n) with (Zsucc(31-Zsucc(Z_of_nat n))) by ring. rewrite Zpower_Zsucc, <- Zdiv_Zdiv; auto with zarith. rewrite Zmult_comm, Z_div_mult; auto with zarith. - + rewrite phi_twice_plus_one, Zdouble_plus_one_mult. rewrite phi_twice; auto. change (Zdouble [|y|]) with (2*[|y|]). @@ -1644,7 +1644,7 @@ Section Int31_Spec. unfold wB'. rewrite <- Zpower_Zsucc, <- inj_S by (auto with zarith). f_equal. rewrite H1. - replace wB with (2^(Z_of_nat n)*2^(31-Z_of_nat n)) by + replace wB with (2^(Z_of_nat n)*2^(31-Z_of_nat n)) by (rewrite <- Zpower_exp; auto with zarith; f_equal; unfold size; ring). unfold Zminus; rewrite Zopp_mult_distr_l. rewrite Z_div_plus; auto with zarith. @@ -1669,8 +1669,8 @@ Section Int31_Spec. apply Zlt_le_trans with wB; auto with zarith. apply Zpower_le_monotone; auto with zarith. intros. - case_eq ([|p|] ?= 31); intros; - [ apply H; rewrite (Zcompare_Eq_eq _ _ H0); auto with zarith | | + case_eq ([|p|] ?= 31); intros; + [ apply H; rewrite (Zcompare_Eq_eq _ _ H0); auto with zarith | | apply H; change ([|p|]>31)%Z in H0; auto with zarith ]. change ([|p|]<31) in H0. rewrite spec_add_mul_div by auto with zarith. @@ -1701,16 +1701,16 @@ Section Int31_Spec. simpl; auto. Qed. - Fixpoint head031_alt n x := - match n with + Fixpoint head031_alt n x := + match n with | O => 0%nat - | S n => match firstl x with + | S n => match firstl x with | D0 => S (head031_alt n (shiftl x)) | D1 => 0%nat end end. - Lemma head031_equiv : + Lemma head031_equiv : forall x, [|head031 x|] = Z_of_nat (head031_alt size x). Proof. intros. @@ -1720,10 +1720,10 @@ Section Int31_Spec. unfold head031, recl. change On with (phi_inv (Z_of_nat (31-size))). - replace (head031_alt size x) with + replace (head031_alt size x) with (head031_alt size x + (31 - size))%nat by (apply plus_0_r; auto). assert (size <= 31)%nat by auto with arith. - + revert x H; induction size; intros. simpl; auto. unfold recl_aux; fold recl_aux. @@ -1748,7 +1748,7 @@ Section Int31_Spec. change [|In|] with 1. replace (31-n)%nat with (S (31 - S n))%nat by omega. rewrite inj_S; ring. - + clear - H H2. rewrite (sneakr_shiftl x) in H. rewrite H2 in H. @@ -1793,7 +1793,7 @@ Section Int31_Spec. rewrite (sneakr_shiftl x), H1, H; auto. rewrite <- nshiftl_S_tail; auto. - + change (2^(Z_of_nat 0)) with 1; rewrite Zmult_1_l. generalize (phi_bounded x); unfold size; split; auto with zarith. change (2^(Z_of_nat 31)/2) with (2^(Z_of_nat (pred size))). @@ -1809,16 +1809,16 @@ Section Int31_Spec. simpl; auto. Qed. - Fixpoint tail031_alt n x := - match n with + Fixpoint tail031_alt n x := + match n with | O => 0%nat - | S n => match firstr x with + | S n => match firstr x with | D0 => S (tail031_alt n (shiftr x)) | D1 => 0%nat end end. - Lemma tail031_equiv : + Lemma tail031_equiv : forall x, [|tail031 x|] = Z_of_nat (tail031_alt size x). Proof. intros. @@ -1828,10 +1828,10 @@ Section Int31_Spec. unfold tail031, recr. change On with (phi_inv (Z_of_nat (31-size))). - replace (tail031_alt size x) with + replace (tail031_alt size x) with (tail031_alt size x + (31 - size))%nat by (apply plus_0_r; auto). assert (size <= 31)%nat by auto with arith. - + revert x H; induction size; intros. simpl; auto. unfold recr_aux; fold recr_aux. @@ -1856,7 +1856,7 @@ Section Int31_Spec. change [|In|] with 1. replace (31-n)%nat with (S (31 - S n))%nat by omega. rewrite inj_S; ring. - + clear - H H2. rewrite (sneakl_shiftr x) in H. rewrite H2 in H. @@ -1864,7 +1864,7 @@ Section Int31_Spec. rewrite (iszero_eq0 _ H0) in H; discriminate. Qed. - Lemma spec_tail0 : forall x, 0 < [|x|] -> + Lemma spec_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail031 x|]). Proof. intros. @@ -1882,23 +1882,23 @@ Section Int31_Spec. case_eq (firstr x); intros. rewrite (inj_S (tail031_alt n (shiftr x))), Zpower_Zsucc; auto with zarith. destruct (IHn (shiftr x)) as (y & Hy1 & Hy2). - + rewrite phi_nz; rewrite phi_nz in H; contradict H. rewrite (sneakl_shiftr x), H1, H; auto. rewrite <- nshiftr_S_tail; auto. - + exists y; split; auto. rewrite phi_eqn1; auto. rewrite Zdouble_mult, Hy2; ring. - + exists [|shiftr x|]. split. generalize (phi_bounded (shiftr x)); auto with zarith. rewrite phi_eqn2; auto. rewrite Zdouble_plus_one_mult; simpl; ring. Qed. - + (* Sqrt *) (* Direct transcription of an old proof @@ -1906,27 +1906,27 @@ Section Int31_Spec. Lemma quotient_by_2 a: a - 1 <= (a/2) + (a/2). Proof. - intros a; case (Z_mod_lt a 2); auto with zarith. + case (Z_mod_lt a 2); auto with zarith. intros H1; rewrite Zmod_eq_full; auto with zarith. Qed. - Lemma sqrt_main_trick j k: 0 <= j -> 0 <= k -> + Lemma sqrt_main_trick j k: 0 <= j -> 0 <= k -> (j * k) + j <= ((j + k)/2 + 1) ^ 2. Proof. - intros j k Hj; generalize Hj k; pattern j; apply natlike_ind; + intros Hj; generalize Hj k; pattern j; apply natlike_ind; auto; clear k j Hj. intros _ k Hk; repeat rewrite Zplus_0_l. apply Zmult_le_0_compat; generalize (Z_div_pos k 2); auto with zarith. intros j Hj Hrec _ k Hk; pattern k; apply natlike_ind; auto; clear k Hk. rewrite Zmult_0_r, Zplus_0_r, Zplus_0_l. - generalize (sqr_pos (Zsucc j / 2)) (quotient_by_2 (Zsucc j)); + generalize (sqr_pos (Zsucc j / 2)) (quotient_by_2 (Zsucc j)); unfold Zsucc. rewrite Zpower_2, Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. auto with zarith. intros k Hk _. replace ((Zsucc j + Zsucc k) / 2) with ((j + k)/2 + 1). generalize (Hrec Hj k Hk) (quotient_by_2 (j + k)). - unfold Zsucc; repeat rewrite Zpower_2; + unfold Zsucc; repeat rewrite Zpower_2; repeat rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. repeat rewrite Zmult_1_l; repeat rewrite Zmult_1_r. auto with zarith. @@ -1936,7 +1936,7 @@ Section Int31_Spec. Lemma sqrt_main i j: 0 <= i -> 0 < j -> i < ((j + (i/j))/2 + 1) ^ 2. Proof. - intros i j Hi Hj. + intros Hi Hj. assert (Hij: 0 <= i/j) by (apply Z_div_pos; auto with zarith). apply Zlt_le_trans with (2 := sqrt_main_trick _ _ (Zlt_le_weak _ _ Hj) Hij). pattern i at 1; rewrite (Z_div_mod_eq i j); case (Z_mod_lt i j); auto with zarith. @@ -1944,7 +1944,7 @@ Section Int31_Spec. Lemma sqrt_init i: 1 < i -> i < (i/2 + 1) ^ 2. Proof. - intros i Hi. + intros Hi. assert (H1: 0 <= i - 2) by auto with zarith. assert (H2: 1 <= (i / 2) ^ 2); auto with zarith. replace i with (1* 2 + (i - 2)); auto with zarith. @@ -1962,14 +1962,14 @@ Section Int31_Spec. Lemma sqrt_test_true i j: 0 <= i -> 0 < j -> i/j >= j -> j ^ 2 <= i. Proof. - intros i j Hi Hj Hd; rewrite Zpower_2. + intros Hi Hj Hd; rewrite Zpower_2. apply Zle_trans with (j * (i/j)); auto with zarith. apply Z_mult_div_ge; auto with zarith. Qed. Lemma sqrt_test_false i j: 0 <= i -> 0 < j -> i/j < j -> (j + (i/j))/2 < j. Proof. - intros i j Hi Hj H; case (Zle_or_lt j ((j + (i/j))/2)); auto. + intros Hi Hj H; case (Zle_or_lt j ((j + (i/j))/2)); auto. intros H1; contradict H; apply Zle_not_lt. assert (2 * j <= j + (i/j)); auto with zarith. apply Zle_trans with (2 * ((j + (i/j))/2)); auto with zarith. @@ -1984,32 +1984,32 @@ Section Int31_Spec. Lemma Zcompare_spec i j: ZcompareSpec i j (i ?= j). Proof. - intros i j; case_eq (Zcompare i j); intros H. + case_eq (Zcompare i j); intros H. apply ZcompareSpecEq; apply Zcompare_Eq_eq; auto. apply ZcompareSpecLt; auto. apply ZcompareSpecGt; apply Zgt_lt; auto. Qed. Lemma sqrt31_step_def rec i j: - sqrt31_step rec i j = + sqrt31_step rec i j = match (fst (i/j) ?= j)%int31 with Lt => rec i (fst ((j + fst(i/j))/2))%int31 | _ => j end. Proof. - intros rec i j; unfold sqrt31_step; case div31; intros. + unfold sqrt31_step; case div31; intros. simpl; case compare31; auto. Qed. Lemma div31_phi i j: 0 < [|j|] -> [|fst (i/j)%int31|] = [|i|]/[|j|]. - intros i j Hj; generalize (spec_div i j Hj). + intros Hj; generalize (spec_div i j Hj). case div31; intros q r; simpl fst. intros (H1,H2); apply Zdiv_unique with [|r|]; auto with zarith. rewrite H1; ring. Qed. - Lemma sqrt31_step_correct rec i j: - 0 < [|i|] -> 0 < [|j|] -> [|i|] < ([|j|] + 1) ^ 2 -> + Lemma sqrt31_step_correct rec i j: + 0 < [|i|] -> 0 < [|j|] -> [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < wB -> (forall j1 : int31, 0 < [|j1|] < [|j|] -> [|i|] < ([|j1|] + 1) ^ 2 -> @@ -2017,15 +2017,15 @@ Section Int31_Spec. [|sqrt31_step rec i j|] ^ 2 <= [|i|] < ([|sqrt31_step rec i j|] + 1) ^ 2. Proof. assert (Hp2: 0 < [|2|]) by exact (refl_equal Lt). - intros rec i j Hi Hj Hij H31 Hrec; rewrite sqrt31_step_def. - generalize (spec_compare (fst (i/j)%int31) j); case compare31; + intros Hi Hj Hij H31 Hrec; rewrite sqrt31_step_def. + generalize (spec_compare (fst (i/j)%int31) j); case compare31; rewrite div31_phi; auto; intros Hc; try (split; auto; apply sqrt_test_true; auto with zarith; fail). apply Hrec; repeat rewrite div31_phi; auto with zarith. replace [|(j + fst (i / j)%int31)|] with ([|j|] + [|i|] / [|j|]). split. case (Zle_lt_or_eq 1 [|j|]); auto with zarith; intros Hj1. - replace ([|j|] + [|i|]/[|j|]) with + replace ([|j|] + [|i|]/[|j|]) with (1 * 2 + (([|j|] - 2) + [|i|] / [|j|])); try ring. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= [|i|]/ [|j|]) by (apply Z_div_pos; auto with zarith). @@ -2048,12 +2048,12 @@ Section Int31_Spec. Lemma iter31_sqrt_correct n rec i j: 0 < [|i|] -> 0 < [|j|] -> [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < 2 ^ (Z_of_nat size) -> - (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> + (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> [|i|] < ([|j1|] + 1) ^ 2 -> 2 * [|j1|] < 2 ^ (Z_of_nat size) -> [|rec i j1|] ^ 2 <= [|i|] < ([|rec i j1|] + 1) ^ 2) -> [|iter31_sqrt n rec i j|] ^ 2 <= [|i|] < ([|iter31_sqrt n rec i j|] + 1) ^ 2. Proof. - intros n; elim n; unfold iter31_sqrt; fold iter31_sqrt; clear n. + revert rec i j; elim n; unfold iter31_sqrt; fold iter31_sqrt; clear n. intros rec i j Hi Hj Hij H31 Hrec; apply sqrt31_step_correct; auto with zarith. intros; apply Hrec; auto with zarith. rewrite Zpower_0_r; auto with zarith. @@ -2098,7 +2098,7 @@ Section Int31_Spec. Qed. Lemma sqrt312_step_def rec ih il j: - sqrt312_step rec ih il j = + sqrt312_step rec ih il j = match (ih ?= j)%int31 with Eq => j | Gt => j @@ -2112,14 +2112,14 @@ Section Int31_Spec. end end. Proof. - intros rec ih il j; unfold sqrt312_step; case div3121; intros. + unfold sqrt312_step; case div3121; intros. simpl; case compare31; auto. Qed. - Lemma sqrt312_lower_bound ih il j: + Lemma sqrt312_lower_bound ih il j: phi2 ih il < ([|j|] + 1) ^ 2 -> [|ih|] <= [|j|]. Proof. - intros ih il j H1. + intros H1. case (phi_bounded j); intros Hbj _. case (phi_bounded il); intros Hbil _. case (phi_bounded ih); intros Hbih Hbih1. @@ -2133,22 +2133,22 @@ Section Int31_Spec. Lemma div312_phi ih il j: (2^30 <= [|j|] -> [|ih|] < [|j|] -> [|fst (div3121 ih il j)|] = phi2 ih il/[|j|])%Z. Proof. - intros ih il j Hj Hj1. + intros Hj Hj1. generalize (spec_div21 ih il j Hj Hj1). case div3121; intros q r (Hq, Hr). apply Zdiv_unique with (phi r); auto with zarith. simpl fst; apply trans_equal with (1 := Hq); ring. Qed. - Lemma sqrt312_step_correct rec ih il j: - 2 ^ 29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> + Lemma sqrt312_step_correct rec ih il j: + 2 ^ 29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> (forall j1, 0 < [|j1|] < [|j|] -> phi2 ih il < ([|j1|] + 1) ^ 2 -> [|rec ih il j1|] ^ 2 <= phi2 ih il < ([|rec ih il j1|] + 1) ^ 2) -> - [|sqrt312_step rec ih il j|] ^ 2 <= phi2 ih il + [|sqrt312_step rec ih il j|] ^ 2 <= phi2 ih il < ([|sqrt312_step rec ih il j|] + 1) ^ 2. Proof. assert (Hp2: (0 < [|2|])%Z) by exact (refl_equal Lt). - intros rec ih il j Hih Hj Hij Hrec; rewrite sqrt312_step_def. + intros Hih Hj Hij Hrec; rewrite sqrt312_step_def. assert (H1: ([|ih|] <= [|j|])%Z) by (apply sqrt312_lower_bound with il; auto). case (phi_bounded ih); intros Hih1 _. case (phi_bounded il); intros Hil1 _. @@ -2174,7 +2174,7 @@ Section Int31_Spec. case (Zle_lt_or_eq 1 ([|j|])); auto with zarith; intros Hf2. 2: contradict Hc; apply Zle_not_lt; rewrite <- Hf2, Zdiv_1_r; auto with zarith. assert (Hf3: 0 < ([|j|] + phi2 ih il / [|j|]) / 2). - replace ([|j|] + phi2 ih il/ [|j|])%Z with + replace ([|j|] + phi2 ih il/ [|j|])%Z with (1 * 2 + (([|j|] - 2) + phi2 ih il / [|j|])); try ring. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= ([|j|] - 2 + phi2 ih il / [|j|]) / 2) ; auto with zarith. @@ -2213,7 +2213,7 @@ Section Int31_Spec. rewrite div31_phi; change (phi 2) with 2%Z; auto. change (2 ^Z_of_nat size) with (base/2 + phi v30). assert (phi r / 2 < base/2); auto with zarith. - apply Zmult_gt_0_lt_reg_r with 2; auto with zarith. + apply Zmult_gt_0_lt_reg_r with 2; auto with zarith. change (base/2 * 2) with base. apply Zle_lt_trans with (phi r). rewrite Zmult_comm; apply Z_mult_div_ge; auto with zarith. @@ -2234,15 +2234,15 @@ Section Int31_Spec. apply Zge_le; apply Z_div_ge; auto with zarith. Qed. - Lemma iter312_sqrt_correct n rec ih il j: - 2^29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> - (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> - phi2 ih il < ([|j1|] + 1) ^ 2 -> + Lemma iter312_sqrt_correct n rec ih il j: + 2^29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> + (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> + phi2 ih il < ([|j1|] + 1) ^ 2 -> [|rec ih il j1|] ^ 2 <= phi2 ih il < ([|rec ih il j1|] + 1) ^ 2) -> - [|iter312_sqrt n rec ih il j|] ^ 2 <= phi2 ih il + [|iter312_sqrt n rec ih il j|] ^ 2 <= phi2 ih il < ([|iter312_sqrt n rec ih il j|] + 1) ^ 2. Proof. - intros n; elim n; unfold iter312_sqrt; fold iter312_sqrt; clear n. + revert rec ih il j; elim n; unfold iter312_sqrt; fold iter312_sqrt; clear n. intros rec ih il j Hi Hj Hij Hrec; apply sqrt312_step_correct; auto with zarith. intros; apply Hrec; auto with zarith. rewrite Zpower_0_r; auto with zarith. @@ -2265,7 +2265,7 @@ Section Int31_Spec. Proof. intros ih il Hih; unfold sqrt312. change [||WW ih il||] with (phi2 ih il). - assert (Hbin: forall s, s * s + 2* s + 1 = (s + 1) ^ 2) by + assert (Hbin: forall s, s * s + 2* s + 1 = (s + 1) ^ 2) by (intros s; ring). assert (Hb: 0 <= base) by (red; intros HH; discriminate). assert (Hi2: phi2 ih il < (phi Tn + 1) ^ 2). @@ -2428,9 +2428,9 @@ Section Int31_Spec. apply Zcompare_Eq_eq. now destruct ([|x|] ?= 0). Qed. - + (* Even *) - + Let w_is_even := int31_op.(znz_is_even). Lemma spec_is_even : forall x, @@ -2460,13 +2460,13 @@ Section Int31_Spec. exact spec_more_than_1_digit. exact spec_0. - exact spec_1. + exact spec_1. exact spec_Bm1. exact spec_compare. exact spec_eq0. - exact spec_opp_c. + exact spec_opp_c. exact spec_opp. exact spec_opp_carry. @@ -2500,7 +2500,7 @@ Section Int31_Spec. exact spec_head00. exact spec_head0. - exact spec_tail00. + exact spec_tail00. exact spec_tail0. exact spec_add_mul_div. diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v index 154b436b..cc224254 100644 --- a/theories/Numbers/Cyclic/Int31/Int31.v +++ b/theories/Numbers/Cyclic/Int31/Int31.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: Int31.v 11072 2008-06-08 16:13:37Z herbelin $ i*) +(*i $Id$ i*) Require Import NaryFunctions. Require Import Wf_nat. @@ -17,7 +17,7 @@ Require Export DoubleType. Unset Boxed Definitions. -(** * 31-bit integers *) +(** * 31-bit integers *) (** This file contains basic definitions of a 31-bit integer arithmetic. In fact it is more general than that. The only reason @@ -36,11 +36,13 @@ Definition size := 31%nat. Inductive digits : Type := D0 | D1. (** The type of 31-bit integers *) - -(** The type [int31] has a unique constructor [I31] that expects + +(** The type [int31] has a unique constructor [I31] that expects 31 arguments of type [digits]. *) -Inductive int31 : Type := I31 : nfun digits size int31. +Definition digits31 t := Eval compute in nfun digits size t. + +Inductive int31 : Type := I31 : digits31 int31. (* spiwack: Registration of the type of integers, so that the matchs in the functions below perform dynamic decompilation (otherwise some segfault @@ -50,7 +52,7 @@ Register int31 as int31 type in "coq_int31" by True. Delimit Scope int31_scope with int31. Bind Scope int31_scope with int31. -Open Scope int31_scope. +Local Open Scope int31_scope. (** * Constants *) @@ -69,26 +71,26 @@ Definition Twon : int31 := Eval compute in (napply_cst _ _ D0 (size-2) I31) D1 D (** * Bits manipulation *) -(** [sneakr b x] shifts [x] to the right by one bit. +(** [sneakr b x] shifts [x] to the right by one bit. Rightmost digit is lost while leftmost digit becomes [b]. - Pseudo-code is + Pseudo-code is [ match x with (I31 d0 ... dN) => I31 b d0 ... d(N-1) end ] *) Definition sneakr : digits -> int31 -> int31 := Eval compute in fun b => int31_rect _ (napply_except_last _ _ (size-1) (I31 b)). -(** [sneakl b x] shifts [x] to the left by one bit. +(** [sneakl b x] shifts [x] to the left by one bit. Leftmost digit is lost while rightmost digit becomes [b]. - Pseudo-code is + Pseudo-code is [ match x with (I31 d0 ... dN) => I31 d1 ... dN b end ] *) -Definition sneakl : digits -> int31 -> int31 := Eval compute in +Definition sneakl : digits -> int31 -> int31 := Eval compute in fun b => int31_rect _ (fun _ => napply_then_last _ _ b (size-1) I31). -(** [shiftl], [shiftr], [twice] and [twice_plus_one] are direct +(** [shiftl], [shiftr], [twice] and [twice_plus_one] are direct consequences of [sneakl] and [sneakr]. *) Definition shiftl := sneakl D0. @@ -96,31 +98,31 @@ Definition shiftr := sneakr D0. Definition twice := sneakl D0. Definition twice_plus_one := sneakl D1. -(** [firstl x] returns the leftmost digit of number [x]. +(** [firstl x] returns the leftmost digit of number [x]. Pseudo-code is [ match x with (I31 d0 ... dN) => d0 end ] *) -Definition firstl : int31 -> digits := Eval compute in +Definition firstl : int31 -> digits := Eval compute in int31_rect _ (fun d => napply_discard _ _ d (size-1)). -(** [firstr x] returns the rightmost digit of number [x]. +(** [firstr x] returns the rightmost digit of number [x]. Pseudo-code is [ match x with (I31 d0 ... dN) => dN end ] *) -Definition firstr : int31 -> digits := Eval compute in +Definition firstr : int31 -> digits := Eval compute in int31_rect _ (napply_discard _ _ (fun d=>d) (size-1)). -(** [iszero x] is true iff [x = I31 D0 ... D0]. Pseudo-code is +(** [iszero x] is true iff [x = I31 D0 ... D0]. Pseudo-code is [ match x with (I31 D0 ... D0) => true | _ => false end ] *) -Definition iszero : int31 -> bool := Eval compute in - let f d b := match d with D0 => b | D1 => false end +Definition iszero : int31 -> bool := Eval compute in + let f d b := match d with D0 => b | D1 => false end in int31_rect _ (nfold_bis _ _ f true size). -(* NB: DO NOT transform the above match in a nicer (if then else). +(* NB: DO NOT transform the above match in a nicer (if then else). It seems to work, but later "unfold iszero" takes forever. *) -(** [base] is [2^31], obtained via iterations of [Zdouble]. - It can also be seen as the smallest b > 0 s.t. phi_inv b = 0 +(** [base] is [2^31], obtained via iterations of [Zdouble]. + It can also be seen as the smallest b > 0 s.t. phi_inv b = 0 (see below) *) Definition base := Eval compute in @@ -140,7 +142,7 @@ Fixpoint recl_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) caserec (firstl i) si (recl_aux next A case0 caserec si) end. -Fixpoint recr_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) +Fixpoint recr_aux (n:nat)(A:Type)(case0:A)(caserec:digits->int31->A->A) (i:int31) : A := match n with | O => case0 @@ -159,22 +161,22 @@ Definition recr := recr_aux size. (** From int31 to Z, we simply iterates [Zdouble] or [Zdouble_plus_one]. *) -Definition phi : int31 -> Z := +Definition phi : int31 -> Z := recr Z (0%Z) (fun b _ => match b with D0 => Zdouble | D1 => Zdouble_plus_one end). -(** From positive to int31. An abstract definition could be : - [ phi_inv (2n) = 2*(phi_inv n) /\ +(** From positive to int31. An abstract definition could be : + [ phi_inv (2n) = 2*(phi_inv n) /\ phi_inv 2n+1 = 2*(phi_inv n) + 1 ] *) -Fixpoint phi_inv_positive p := +Fixpoint phi_inv_positive p := match p with | xI q => twice_plus_one (phi_inv_positive q) | xO q => twice (phi_inv_positive q) | xH => In end. -(** The negative part : 2-complement *) +(** The negative part : 2-complement *) Fixpoint complement_negative p := match p with @@ -186,9 +188,9 @@ Fixpoint complement_negative p := (** A simple incrementation function *) Definition incr : int31 -> int31 := - recr int31 In - (fun b si rec => match b with - | D0 => sneakl D1 si + recr int31 In + (fun b si rec => match b with + | D0 => sneakl D1 si | D1 => sneakl D0 rec end). (** We can now define the conversion from Z to int31. *) @@ -196,11 +198,11 @@ Definition incr : int31 -> int31 := Definition phi_inv : Z -> int31 := fun n => match n with | Z0 => On - | Zpos p => phi_inv_positive p + | Zpos p => phi_inv_positive p | Zneg p => incr (complement_negative p) end. -(** [phi_inv2] is similar to [phi_inv] but returns a double word +(** [phi_inv2] is similar to [phi_inv] but returns a double word [zn2z int31] *) Definition phi_inv2 n := @@ -211,7 +213,7 @@ Definition phi_inv2 n := (** [phi2] is similar to [phi] but takes a double word (two args) *) -Definition phi2 nh nl := +Definition phi2 nh nl := ((phi nh)*base+(phi nl))%Z. (** * Addition *) @@ -227,11 +229,11 @@ Notation "n + m" := (add31 n m) : int31_scope. (* mode, (phi n)+(phi m) is computed twice*) (* it may be considered to optimize it *) -Definition add31c (n m : int31) := +Definition add31c (n m : int31) := let npm := n+m in - match (phi npm ?= (phi n)+(phi m))%Z with - | Eq => C0 npm - | _ => C1 npm + match (phi npm ?= (phi n)+(phi m))%Z with + | Eq => C0 npm + | _ => C1 npm end. Notation "n '+c' m" := (add31c n m) (at level 50, no associativity) : int31_scope. @@ -254,7 +256,7 @@ Notation "n - m" := (sub31 n m) : int31_scope. (** Subtraction with carry (thus exact) *) -Definition sub31c (n m : int31) := +Definition sub31c (n m : int31) := let nmm := n-m in match (phi nmm ?= (phi n)-(phi m))%Z with | Eq => C0 nmm @@ -272,6 +274,10 @@ Definition sub31carryc (n m : int31) := | _ => C1 nmmmone end. +(** Opposite *) + +Definition opp31 x := On - x. +Notation "- x" := (opp31 x) : int31_scope. (** Multiplication *) @@ -290,13 +296,13 @@ Notation "n '*c' m" := (mul31c n m) (at level 40, no associativity) : int31_scop (** Division of a double size word modulo [2^31] *) -Definition div3121 (nh nl m : int31) := +Definition div3121 (nh nl m : int31) := let (q,r) := Zdiv_eucl (phi2 nh nl) (phi m) in (phi_inv q, phi_inv r). (** Division modulo [2^31] *) -Definition div31 (n m : int31) := +Definition div31 (n m : int31) := let (q,r) := Zdiv_eucl (phi n) (phi m) in (phi_inv q, phi_inv r). Notation "n / m" := (div31 n m) : int31_scope. @@ -307,13 +313,16 @@ Notation "n / m" := (div31 n m) : int31_scope. Definition compare31 (n m : int31) := ((phi n)?=(phi m))%Z. Notation "n ?= m" := (compare31 n m) (at level 70, no associativity) : int31_scope. +Definition eqb31 (n m : int31) := + match n ?= m with Eq => true | _ => false end. + -(** Computing the [i]-th iterate of a function: +(** Computing the [i]-th iterate of a function: [iter_int31 i A f = f^i] *) Definition iter_int31 i A f := - recr (A->A) (fun x => x) - (fun b si rec => match b with + recr (A->A) (fun x => x) + (fun b si rec => match b with | D0 => fun x => rec (rec x) | D1 => fun x => f (rec (rec x)) end) @@ -322,9 +331,9 @@ Definition iter_int31 i A f := (** Combining the [(31-p)] low bits of [i] above the [p] high bits of [j]: [addmuldiv31 p i j = i*2^p+j/2^(31-p)] (modulo [2^31]) *) -Definition addmuldiv31 p i j := - let (res, _ ) := - iter_int31 p (int31*int31) +Definition addmuldiv31 p i j := + let (res, _ ) := + iter_int31 p (int31*int31) (fun ij => let (i,j) := ij in (sneakl (firstl j) i, shiftl j)) (i,j) in @@ -346,7 +355,7 @@ Register addmuldiv31 as int31 addmuldiv in "coq_int31" by True. Definition gcd31 (i j:int31) := (fix euler (guard:nat) (i j:int31) {struct guard} := - match guard with + match guard with | O => In | S p => match j ?= On with | Eq => i @@ -370,17 +379,17 @@ Eval lazy delta [Twon] in | _ => j end. -Fixpoint iter31_sqrt (n: nat) (rec: int31 -> int31 -> int31) +Fixpoint iter31_sqrt (n: nat) (rec: int31 -> int31 -> int31) (i j: int31) {struct n} : int31 := - sqrt31_step + sqrt31_step (match n with O => rec | S n => (iter31_sqrt n (iter31_sqrt n rec)) end) i j. -Definition sqrt31 i := +Definition sqrt31 i := Eval lazy delta [On In Twon] in - match compare31 In i with + match compare31 In i with Gt => On | Eq => In | Lt => iter31_sqrt 31 (fun i j => j) i (fst (i/Twon)) @@ -388,7 +397,7 @@ Eval lazy delta [On In Twon] in Definition v30 := Eval compute in (addmuldiv31 (phi_inv (Z_of_nat size - 1)) In On). -Definition sqrt312_step (rec: int31 -> int31 -> int31 -> int31) +Definition sqrt312_step (rec: int31 -> int31 -> int31 -> int31) (ih il j: int31) := Eval lazy delta [Twon v30] in match ih ?= j with Eq => j | Gt => j | _ => @@ -401,28 +410,28 @@ Eval lazy delta [Twon v30] in | _ => j end end. -Fixpoint iter312_sqrt (n: nat) - (rec: int31 -> int31 -> int31 -> int31) +Fixpoint iter312_sqrt (n: nat) + (rec: int31 -> int31 -> int31 -> int31) (ih il j: int31) {struct n} : int31 := - sqrt312_step + sqrt312_step (match n with O => rec | S n => (iter312_sqrt n (iter312_sqrt n rec)) end) ih il j. -Definition sqrt312 ih il := +Definition sqrt312 ih il := Eval lazy delta [On In] in let s := iter312_sqrt 31 (fun ih il j => j) ih il Tn in match s *c s with W0 => (On, C0 On) (* impossible *) | WW ih1 il1 => match il -c il1 with - C0 il2 => + C0 il2 => match ih ?= ih1 with Gt => (s, C1 il2) | _ => (s, C0 il2) end - | C1 il2 => + | C1 il2 => match (ih - In) ?= ih1 with (* we could parametrize ih - 1 *) Gt => (s, C1 il2) | _ => (s, C0 il2) @@ -431,7 +440,7 @@ Eval lazy delta [On In] in end. -Fixpoint p2i n p : (N*int31)%type := +Fixpoint p2i n p : (N*int31)%type := match n with | O => (Npos p, On) | S n => match p with @@ -444,26 +453,26 @@ Fixpoint p2i n p : (N*int31)%type := Definition positive_to_int31 (p:positive) := p2i size p. (** Constant 31 converted into type int31. - It is used as default answer for numbers of zeros + It is used as default answer for numbers of zeros in [head0] and [tail0] *) Definition T31 : int31 := Eval compute in phi_inv (Z_of_nat size). Definition head031 (i:int31) := - recl _ (fun _ => T31) - (fun b si rec n => match b with + recl _ (fun _ => T31) + (fun b si rec n => match b with | D0 => rec (add31 n In) | D1 => n end) i On. Definition tail031 (i:int31) := - recr _ (fun _ => T31) - (fun b si rec n => match b with + recr _ (fun _ => T31) + (fun b si rec n => match b with | D0 => rec (add31 n In) | D1 => n end) i On. Register head031 as int31 head0 in "coq_int31" by True. -Register tail031 as int31 tail0 in "coq_int31" by True. +Register tail031 as int31 tail0 in "coq_int31" by True. diff --git a/theories/Numbers/Cyclic/Int31/Ring31.v b/theories/Numbers/Cyclic/Int31/Ring31.v new file mode 100644 index 00000000..2ec406b0 --- /dev/null +++ b/theories/Numbers/Cyclic/Int31/Ring31.v @@ -0,0 +1,103 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id$ i*) + +(** * Int31 numbers defines Z/(2^31)Z, and can hence be equipped + with a ring structure and a ring tactic *) + +Require Import Int31 Cyclic31 CyclicAxioms. + +Local Open Scope int31_scope. + +(** Detection of constants *) + +Local Open Scope list_scope. + +Ltac isInt31cst_lst l := + match l with + | nil => constr:true + | ?t::?l => match t with + | D1 => isInt31cst_lst l + | D0 => isInt31cst_lst l + | _ => constr:false + end + | _ => constr:false + end. + +Ltac isInt31cst t := + match t with + | I31 ?i0 ?i1 ?i2 ?i3 ?i4 ?i5 ?i6 ?i7 ?i8 ?i9 ?i10 + ?i11 ?i12 ?i13 ?i14 ?i15 ?i16 ?i17 ?i18 ?i19 ?i20 + ?i21 ?i22 ?i23 ?i24 ?i25 ?i26 ?i27 ?i28 ?i29 ?i30 => + let l := + constr:(i0::i1::i2::i3::i4::i5::i6::i7::i8::i9::i10 + ::i11::i12::i13::i14::i15::i16::i17::i18::i19::i20 + ::i21::i22::i23::i24::i25::i26::i27::i28::i29::i30::nil) + in isInt31cst_lst l + | Int31.On => constr:true + | Int31.In => constr:true + | Int31.Tn => constr:true + | Int31.Twon => constr:true + | _ => constr:false + end. + +Ltac Int31cst t := + match isInt31cst t with + | true => constr:t + | false => constr:NotConstant + end. + +(** The generic ring structure inferred from the Cyclic structure *) + +Module Int31ring := CyclicRing Int31Cyclic. + +(** Unlike in the generic [CyclicRing], we can use Leibniz here. *) + +Lemma Int31_canonic : forall x y, phi x = phi y -> x = y. +Proof. + intros x y EQ. + now rewrite <- (phi_inv_phi x), <- (phi_inv_phi y), EQ. +Qed. + +Lemma ring_theory_switch_eq : + forall A (R R':A->A->Prop) zero one add mul sub opp, + (forall x y : A, R x y -> R' x y) -> + ring_theory zero one add mul sub opp R -> + ring_theory zero one add mul sub opp R'. +Proof. +intros A R R' zero one add mul sub opp Impl Ring. +constructor; intros; apply Impl; apply Ring. +Qed. + +Lemma Int31Ring : ring_theory 0 1 add31 mul31 sub31 opp31 Logic.eq. +Proof. +exact (ring_theory_switch_eq _ _ _ _ _ _ _ _ _ Int31_canonic Int31ring.CyclicRing). +Qed. + +Lemma eqb31_eq : forall x y, eqb31 x y = true <-> x=y. +Proof. +unfold eqb31. intros x y. +generalize (Cyclic31.spec_compare x y). +destruct (x ?= y); intuition; subst; auto with zarith; try discriminate. +apply Int31_canonic; auto. +Qed. + +Lemma eqb31_correct : forall x y, eqb31 x y = true -> x=y. +Proof. now apply eqb31_eq. Qed. + +Add Ring Int31Ring : Int31Ring + (decidable eqb31_correct, + constants [Int31cst]). + +Section TestRing. +Let test : forall x y, 1 + x*y + x*x + 1 = 1*1 + 1 + y*x + 1*x*x. +intros. ring. +Qed. +End TestRing. + diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v index 7c770e97..4f0f6c7c 100644 --- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v +++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v @@ -6,13 +6,13 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: ZModulo.v 11033 2008-06-01 22:56:50Z letouzey $ *) +(* $Id$ *) -(** * Type [Z] viewed modulo a particular constant corresponds to [Z/nZ] +(** * Type [Z] viewed modulo a particular constant corresponds to [Z/nZ] as defined abstractly in CyclicAxioms. *) -(** Even if the construction provided here is not reused for building - the efficient arbitrary precision numbers, it provides a simple +(** Even if the construction provided here is not reused for building + the efficient arbitrary precision numbers, it provides a simple implementation of CyclicAxioms, hence ensuring its coherence. *) Set Implicit Arguments. @@ -24,7 +24,7 @@ Require Import BigNumPrelude. Require Import DoubleType. Require Import CyclicAxioms. -Open Local Scope Z_scope. +Local Open Scope Z_scope. Section ZModulo. @@ -56,9 +56,9 @@ Section ZModulo. destruct 1; auto. Qed. Let digits_gt_1 := spec_more_than_1_digit. - + Lemma wB_pos : wB > 0. - Proof. + Proof. unfold wB, base; auto with zarith. Qed. Hint Resolve wB_pos. @@ -79,7 +79,7 @@ Section ZModulo. auto. Qed. - Definition znz_of_pos x := + Definition znz_of_pos x := let (q,r) := Zdiv_eucl_POS x wB in (N_of_Z q, r). Lemma spec_of_pos : forall p, @@ -90,10 +90,10 @@ Section ZModulo. destruct (Zdiv_eucl_POS p wB); simpl; destruct 1. unfold znz_to_Z; rewrite Zmod_small; auto. assert (0 <= z). - replace z with (Zpos p / wB) by + replace z with (Zpos p / wB) by (symmetry; apply Zdiv_unique with z0; auto). apply Z_div_pos; auto with zarith. - replace (Z_of_N (N_of_Z z)) with z by + replace (Z_of_N (N_of_Z z)) with z by (destruct z; simpl; auto; elim H1; auto). rewrite Zmult_comm; auto. Qed. @@ -110,7 +110,7 @@ Section ZModulo. Definition znz_0 := 0. Definition znz_1 := 1. Definition znz_Bm1 := wB - 1. - + Lemma spec_0 : [|znz_0|] = 0. Proof. unfold znz_to_Z, znz_0. @@ -121,7 +121,7 @@ Section ZModulo. Proof. unfold znz_to_Z, znz_1. apply Zmod_small; split; auto with zarith. - unfold wB, base. + unfold wB, base. apply Zlt_trans with (Zpos digits); auto. apply Zpower2_lt_lin; auto with zarith. Qed. @@ -138,7 +138,7 @@ Section ZModulo. Definition znz_compare x y := Zcompare [|x|] [|y|]. - Lemma spec_compare : forall x y, + Lemma spec_compare : forall x y, match znz_compare x y with | Eq => [|x|] = [|y|] | Lt => [|x|] < [|y|] @@ -150,19 +150,19 @@ Section ZModulo. intros; apply Zcompare_Eq_eq; auto. Qed. - Definition znz_eq0 x := + Definition znz_eq0 x := match [|x|] with Z0 => true | _ => false end. - + Lemma spec_eq0 : forall x, znz_eq0 x = true -> [|x|] = 0. Proof. unfold znz_eq0; intros; now destruct [|x|]. Qed. - Definition znz_opp_c x := + Definition znz_opp_c x := if znz_eq0 x then C0 0 else C1 (- x). Definition znz_opp x := - x. Definition znz_opp_carry x := - x - 1. - + Lemma spec_opp_c : forall x, [-|znz_opp_c x|] = -[|x|]. Proof. intros; unfold znz_opp_c, znz_to_Z; auto. @@ -180,7 +180,7 @@ Section ZModulo. change ((- x) mod wB = (0 - (x mod wB)) mod wB). rewrite Zminus_mod_idemp_r; simpl; auto. Qed. - + Lemma spec_opp_carry : forall x, [|znz_opp_carry x|] = wB - [|x|] - 1. Proof. intros; unfold znz_opp_carry, znz_to_Z; auto. @@ -194,15 +194,15 @@ Section ZModulo. generalize (Z_mod_lt x wB wB_pos); omega. Qed. - Definition znz_succ_c x := - let y := Zsucc x in + Definition znz_succ_c x := + let y := Zsucc x in if znz_eq0 y then C1 0 else C0 y. - Definition znz_add_c x y := - let z := [|x|] + [|y|] in + Definition znz_add_c x y := + let z := [|x|] + [|y|] in if Z_lt_le_dec z wB then C0 z else C1 (z-wB). - Definition znz_add_carry_c x y := + Definition znz_add_carry_c x y := let z := [|x|]+[|y|]+1 in if Z_lt_le_dec z wB then C0 z else C1 (z-wB). @@ -210,7 +210,7 @@ Section ZModulo. Definition znz_add := Zplus. Definition znz_add_carry x y := x + y + 1. - Lemma Zmod_equal : + Lemma Zmod_equal : forall x y z, z>0 -> (x-y) mod z = 0 -> x mod z = y mod z. Proof. intros. @@ -225,12 +225,12 @@ Section ZModulo. Proof. intros; unfold znz_succ_c, znz_to_Z, Zsucc. case_eq (znz_eq0 (x+1)); intros; unfold interp_carry. - + rewrite Zmult_1_l. replace (wB + 0 mod wB) with wB by auto with zarith. symmetry; rewrite Zeq_plus_swap. assert ((x+1) mod wB = 0) by (apply spec_eq0; auto). - replace (wB-1) with ((wB-1) mod wB) by + replace (wB-1) with ((wB-1) mod wB) by (apply Zmod_small; generalize wB_pos; omega). rewrite <- Zminus_mod_idemp_l; rewrite Z_mod_same; simpl; auto. apply Zmod_equal; auto. @@ -289,15 +289,15 @@ Section ZModulo. rewrite Zplus_mod_idemp_l; auto. Qed. - Definition znz_pred_c x := + Definition znz_pred_c x := if znz_eq0 x then C1 (wB-1) else C0 (x-1). - Definition znz_sub_c x y := - let z := [|x|]-[|y|] in + Definition znz_sub_c x y := + let z := [|x|]-[|y|] in if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z. - Definition znz_sub_carry_c x y := - let z := [|x|]-[|y|]-1 in + Definition znz_sub_carry_c x y := + let z := [|x|]-[|y|]-1 in if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z. Definition znz_pred := Zpred. @@ -323,7 +323,7 @@ Section ZModulo. Proof. intros; unfold znz_sub_c, znz_to_Z, interp_carry. destruct Z_lt_le_dec. - replace ((wB + (x mod wB - y mod wB)) mod wB) with + replace ((wB + (x mod wB - y mod wB)) mod wB) with (wB + (x mod wB - y mod wB)). omega. symmetry; apply Zmod_small. @@ -337,7 +337,7 @@ Section ZModulo. Proof. intros; unfold znz_sub_carry_c, znz_to_Z, interp_carry. destruct Z_lt_le_dec. - replace ((wB + (x mod wB - y mod wB - 1)) mod wB) with + replace ((wB + (x mod wB - y mod wB - 1)) mod wB) with (wB + (x mod wB - y mod wB -1)). omega. symmetry; apply Zmod_small. @@ -358,7 +358,7 @@ Section ZModulo. intros; unfold znz_sub, znz_to_Z; apply Zminus_mod. Qed. - Lemma spec_sub_carry : + Lemma spec_sub_carry : forall x y, [|znz_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB. Proof. intros; unfold znz_sub_carry, znz_to_Z. @@ -367,15 +367,15 @@ Section ZModulo. rewrite Zminus_mod_idemp_l. auto. Qed. - - Definition znz_mul_c x y := + + Definition znz_mul_c x y := let (h,l) := Zdiv_eucl ([|x|]*[|y|]) wB in if znz_eq0 h then if znz_eq0 l then W0 else WW h l else WW h l. Definition znz_mul := Zmult. Definition znz_square_c x := znz_mul_c x x. - + Lemma spec_mul_c : forall x y, [|| znz_mul_c x y ||] = [|x|] * [|y|]. Proof. intros; unfold znz_mul_c, zn2z_to_Z. @@ -426,7 +426,7 @@ Section ZModulo. destruct Zdiv_eucl as (q,r); destruct 1; intros. injection H1; clear H1; intros. assert ([|r|]=r). - apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; + apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; auto with zarith. assert ([|q|]=q). apply Zmod_small. @@ -453,7 +453,7 @@ Section ZModulo. Definition znz_mod x y := [|x|] mod [|y|]. Definition znz_mod_gt x y := [|x|] mod [|y|]. - + Lemma spec_mod : forall a b, 0 < [|b|] -> [|znz_mod a b|] = [|a|] mod [|b|]. Proof. @@ -469,7 +469,7 @@ Section ZModulo. Proof. intros; apply spec_mod; auto. Qed. - + Definition znz_gcd x y := Zgcd [|x|] [|y|]. Definition znz_gcd_gt x y := Zgcd [|x|] [|y|]. @@ -516,7 +516,7 @@ Section ZModulo. intros. apply spec_gcd; auto. Qed. - Definition znz_div21 a1 a2 b := + Definition znz_div21 a1 a2 b := Zdiv_eucl ([|a1|]*wB+[|a2|]) [|b|]. Lemma spec_div21 : forall a1 a2 b, @@ -537,7 +537,7 @@ Section ZModulo. destruct Zdiv_eucl as (q,r); destruct 1; intros. injection H4; clear H4; intros. assert ([|r|]=r). - apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; + apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; auto with zarith. assert ([|q|]=q). apply Zmod_small. @@ -546,7 +546,6 @@ Section ZModulo. apply Z_div_pos; auto with zarith. subst a; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. - subst a; auto with zarith. subst a. replace (wB*[|b|]) with (([|b|]-1)*wB + wB) by ring. apply Zlt_le_trans with ([|a1|]*wB+wB); auto with zarith. @@ -577,7 +576,7 @@ Section ZModulo. apply Zmod_le; auto with zarith. Qed. - Definition znz_is_even x := + Definition znz_is_even x := if Z_eq_dec ([|x|] mod 2) 0 then true else false. Lemma spec_is_even : forall x, @@ -587,7 +586,7 @@ Section ZModulo. generalize (Z_mod_lt [|x|] 2); omega. Qed. - Definition znz_sqrt x := Zsqrt_plain [|x|]. + Definition znz_sqrt x := Zsqrt_plain [|x|]. Lemma spec_sqrt : forall x, [|znz_sqrt x|] ^ 2 <= [|x|] < ([|znz_sqrt x|] + 1) ^ 2. Proof. @@ -610,12 +609,12 @@ Section ZModulo. generalize wB_pos; auto with zarith. Qed. - Definition znz_sqrt2 x y := - let z := [|x|]*wB+[|y|] in - match z with + Definition znz_sqrt2 x y := + let z := [|x|]*wB+[|y|] in + match z with | Z0 => (0, C0 0) - | Zpos p => - let (s,r,_,_) := sqrtrempos p in + | Zpos p => + let (s,r,_,_) := sqrtrempos p in (s, if Z_lt_le_dec r wB then C0 r else C1 (r-wB)) | Zneg _ => (0, C0 0) end. @@ -652,7 +651,7 @@ Section ZModulo. rewrite Zpower_2; auto with zarith. replace [|r-wB|] with (r-wB) by (symmetry; apply Zmod_small; auto with zarith). rewrite Zpower_2; omega. - + assert (0<=Zneg p). rewrite Heqz; generalize wB_pos; auto with zarith. compute in H0; elim H0; auto. @@ -666,8 +665,8 @@ Section ZModulo. apply two_power_pos_correct. Qed. - Definition znz_head0 x := match [|x|] with - | Z0 => znz_zdigits + Definition znz_head0 x := match [|x|] with + | Z0 => znz_zdigits | Zpos p => znz_zdigits - log_inf p - 1 | _ => 0 end. @@ -696,7 +695,7 @@ Section ZModulo. change (Zpos x~0) with (2*(Zpos x)) in H. replace p with (Zsucc (p-1)) in H; auto with zarith. rewrite Zpower_Zsucc in H; auto with zarith. - + simpl; intros; destruct p; compute; auto with zarith. Qed. @@ -731,8 +730,8 @@ Section ZModulo. by ring. unfold wB, base, znz_zdigits; auto with zarith. apply Zmult_le_compat; auto with zarith. - - apply Zlt_le_trans + + apply Zlt_le_trans with (2^(znz_zdigits - log_inf p - 1)*(2^(Zsucc (log_inf p)))). apply Zmult_lt_compat_l; auto with zarith. rewrite <- Zpower_exp; auto with zarith. @@ -741,17 +740,17 @@ Section ZModulo. unfold wB, base, znz_zdigits; auto with zarith. Qed. - Fixpoint Ptail p := match p with + Fixpoint Ptail p := match p with | xO p => (Ptail p)+1 | _ => 0 - end. + end. Lemma Ptail_pos : forall p, 0 <= Ptail p. Proof. induction p; simpl; auto with zarith. Qed. Hint Resolve Ptail_pos. - + Lemma Ptail_bounded : forall p d, Zpos p < 2^(Zpos d) -> Ptail p < Zpos d. Proof. induction p; try (compute; auto; fail). @@ -776,7 +775,7 @@ Section ZModulo. Qed. Definition znz_tail0 x := - match [|x|] with + match [|x|] with | Z0 => znz_zdigits | Zpos p => Ptail p | Zneg _ => 0 @@ -789,7 +788,7 @@ Section ZModulo. apply spec_zdigits. Qed. - Lemma spec_tail0 : forall x, 0 < [|x|] -> + Lemma spec_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|znz_tail0 x|]). Proof. intros; unfold znz_tail0. @@ -819,7 +818,7 @@ Section ZModulo. (** Let's now group everything in two records *) - Definition zmod_op := mk_znz_op + Definition zmod_op := mk_znz_op (znz_digits : positive) (znz_zdigits: znz) (znz_to_Z : znz -> Z) @@ -860,11 +859,11 @@ Section ZModulo. (znz_div_gt : znz -> znz -> znz * znz) (znz_div : znz -> znz -> znz * znz) - (znz_mod_gt : znz -> znz -> znz) - (znz_mod : znz -> znz -> znz) + (znz_mod_gt : znz -> znz -> znz) + (znz_mod : znz -> znz -> znz) (znz_gcd_gt : znz -> znz -> znz) - (znz_gcd : znz -> znz -> znz) + (znz_gcd : znz -> znz -> znz) (znz_add_mul_div : znz -> znz -> znz -> znz) (znz_pos_mod : znz -> znz -> znz) @@ -879,54 +878,54 @@ Section ZModulo. spec_more_than_1_digit spec_0 - spec_1 - spec_Bm1 - - spec_compare - spec_eq0 - - spec_opp_c - spec_opp - spec_opp_carry - - spec_succ_c - spec_add_c - spec_add_carry_c - spec_succ - spec_add - spec_add_carry - - spec_pred_c - spec_sub_c - spec_sub_carry_c - spec_pred - spec_sub - spec_sub_carry - - spec_mul_c - spec_mul - spec_square_c - - spec_div21 - spec_div_gt - spec_div - - spec_mod_gt - spec_mod - - spec_gcd_gt - spec_gcd - - spec_head00 - spec_head0 - spec_tail00 - spec_tail0 - - spec_add_mul_div - spec_pos_mod - - spec_is_even - spec_sqrt2 + spec_1 + spec_Bm1 + + spec_compare + spec_eq0 + + spec_opp_c + spec_opp + spec_opp_carry + + spec_succ_c + spec_add_c + spec_add_carry_c + spec_succ + spec_add + spec_add_carry + + spec_pred_c + spec_sub_c + spec_sub_carry_c + spec_pred + spec_sub + spec_sub_carry + + spec_mul_c + spec_mul + spec_square_c + + spec_div21 + spec_div_gt + spec_div + + spec_mod_gt + spec_mod + + spec_gcd_gt + spec_gcd + + spec_head00 + spec_head0 + spec_tail00 + spec_tail0 + + spec_add_mul_div + spec_pos_mod + + spec_is_even + spec_sqrt2 spec_sqrt. End ZModulo. @@ -935,7 +934,7 @@ End ZModulo. Module Type PositiveNotOne. Parameter p : positive. - Axiom not_one : p<> 1%positive. + Axiom not_one : p<> 1%positive. End PositiveNotOne. Module ZModuloCyclicType (P:PositiveNotOne) <: CyclicType. diff --git a/theories/Numbers/Integer/Abstract/ZAdd.v b/theories/Numbers/Integer/Abstract/ZAdd.v index df941d90..5663408d 100644 --- a/theories/Numbers/Integer/Abstract/ZAdd.v +++ b/theories/Numbers/Integer/Abstract/ZAdd.v @@ -8,338 +8,286 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZAdd.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export ZBase. -Module ZAddPropFunct (Import ZAxiomsMod : ZAxiomsSig). -Module Export ZBasePropMod := ZBasePropFunct ZAxiomsMod. -Open Local Scope IntScope. +Module ZAddPropFunct (Import Z : ZAxiomsSig'). +Include ZBasePropFunct Z. -Theorem Zadd_wd : - forall n1 n2 : Z, n1 == n2 -> forall m1 m2 : Z, m1 == m2 -> n1 + m1 == n2 + m2. -Proof NZadd_wd. +(** Theorems that are either not valid on N or have different proofs + on N and Z *) -Theorem Zadd_0_l : forall n : Z, 0 + n == n. -Proof NZadd_0_l. - -Theorem Zadd_succ_l : forall n m : Z, (S n) + m == S (n + m). -Proof NZadd_succ_l. - -Theorem Zsub_0_r : forall n : Z, n - 0 == n. -Proof NZsub_0_r. - -Theorem Zsub_succ_r : forall n m : Z, n - (S m) == P (n - m). -Proof NZsub_succ_r. - -Theorem Zopp_0 : - 0 == 0. -Proof Zopp_0. - -Theorem Zopp_succ : forall n : Z, - (S n) == P (- n). -Proof Zopp_succ. - -(* Theorems that are valid for both natural numbers and integers *) - -Theorem Zadd_0_r : forall n : Z, n + 0 == n. -Proof NZadd_0_r. - -Theorem Zadd_succ_r : forall n m : Z, n + S m == S (n + m). -Proof NZadd_succ_r. - -Theorem Zadd_comm : forall n m : Z, n + m == m + n. -Proof NZadd_comm. - -Theorem Zadd_assoc : forall n m p : Z, n + (m + p) == (n + m) + p. -Proof NZadd_assoc. - -Theorem Zadd_shuffle1 : forall n m p q : Z, (n + m) + (p + q) == (n + p) + (m + q). -Proof NZadd_shuffle1. - -Theorem Zadd_shuffle2 : forall n m p q : Z, (n + m) + (p + q) == (n + q) + (m + p). -Proof NZadd_shuffle2. - -Theorem Zadd_1_l : forall n : Z, 1 + n == S n. -Proof NZadd_1_l. - -Theorem Zadd_1_r : forall n : Z, n + 1 == S n. -Proof NZadd_1_r. - -Theorem Zadd_cancel_l : forall n m p : Z, p + n == p + m <-> n == m. -Proof NZadd_cancel_l. - -Theorem Zadd_cancel_r : forall n m p : Z, n + p == m + p <-> n == m. -Proof NZadd_cancel_r. - -(* Theorems that are either not valid on N or have different proofs on N and Z *) - -Theorem Zadd_pred_l : forall n m : Z, P n + m == P (n + m). +Theorem add_pred_l : forall n m, P n + m == P (n + m). Proof. intros n m. -rewrite <- (Zsucc_pred n) at 2. -rewrite Zadd_succ_l. now rewrite Zpred_succ. +rewrite <- (succ_pred n) at 2. +rewrite add_succ_l. now rewrite pred_succ. Qed. -Theorem Zadd_pred_r : forall n m : Z, n + P m == P (n + m). +Theorem add_pred_r : forall n m, n + P m == P (n + m). Proof. -intros n m; rewrite (Zadd_comm n (P m)), (Zadd_comm n m); -apply Zadd_pred_l. +intros n m; rewrite (add_comm n (P m)), (add_comm n m); +apply add_pred_l. Qed. -Theorem Zadd_opp_r : forall n m : Z, n + (- m) == n - m. +Theorem add_opp_r : forall n m, n + (- m) == n - m. Proof. -NZinduct m. -rewrite Zopp_0; rewrite Zsub_0_r; now rewrite Zadd_0_r. -intro m. rewrite Zopp_succ, Zsub_succ_r, Zadd_pred_r; now rewrite Zpred_inj_wd. +nzinduct m. +rewrite opp_0; rewrite sub_0_r; now rewrite add_0_r. +intro m. rewrite opp_succ, sub_succ_r, add_pred_r; now rewrite pred_inj_wd. Qed. -Theorem Zsub_0_l : forall n : Z, 0 - n == - n. +Theorem sub_0_l : forall n, 0 - n == - n. Proof. -intro n; rewrite <- Zadd_opp_r; now rewrite Zadd_0_l. +intro n; rewrite <- add_opp_r; now rewrite add_0_l. Qed. -Theorem Zsub_succ_l : forall n m : Z, S n - m == S (n - m). +Theorem sub_succ_l : forall n m, S n - m == S (n - m). Proof. -intros n m; do 2 rewrite <- Zadd_opp_r; now rewrite Zadd_succ_l. +intros n m; do 2 rewrite <- add_opp_r; now rewrite add_succ_l. Qed. -Theorem Zsub_pred_l : forall n m : Z, P n - m == P (n - m). +Theorem sub_pred_l : forall n m, P n - m == P (n - m). Proof. -intros n m. rewrite <- (Zsucc_pred n) at 2. -rewrite Zsub_succ_l; now rewrite Zpred_succ. +intros n m. rewrite <- (succ_pred n) at 2. +rewrite sub_succ_l; now rewrite pred_succ. Qed. -Theorem Zsub_pred_r : forall n m : Z, n - (P m) == S (n - m). +Theorem sub_pred_r : forall n m, n - (P m) == S (n - m). Proof. -intros n m. rewrite <- (Zsucc_pred m) at 2. -rewrite Zsub_succ_r; now rewrite Zsucc_pred. +intros n m. rewrite <- (succ_pred m) at 2. +rewrite sub_succ_r; now rewrite succ_pred. Qed. -Theorem Zopp_pred : forall n : Z, - (P n) == S (- n). +Theorem opp_pred : forall n, - (P n) == S (- n). Proof. -intro n. rewrite <- (Zsucc_pred n) at 2. -rewrite Zopp_succ. now rewrite Zsucc_pred. +intro n. rewrite <- (succ_pred n) at 2. +rewrite opp_succ. now rewrite succ_pred. Qed. -Theorem Zsub_diag : forall n : Z, n - n == 0. +Theorem sub_diag : forall n, n - n == 0. Proof. -NZinduct n. -now rewrite Zsub_0_r. -intro n. rewrite Zsub_succ_r, Zsub_succ_l; now rewrite Zpred_succ. +nzinduct n. +now rewrite sub_0_r. +intro n. rewrite sub_succ_r, sub_succ_l; now rewrite pred_succ. Qed. -Theorem Zadd_opp_diag_l : forall n : Z, - n + n == 0. +Theorem add_opp_diag_l : forall n, - n + n == 0. Proof. -intro n; now rewrite Zadd_comm, Zadd_opp_r, Zsub_diag. +intro n; now rewrite add_comm, add_opp_r, sub_diag. Qed. -Theorem Zadd_opp_diag_r : forall n : Z, n + (- n) == 0. +Theorem add_opp_diag_r : forall n, n + (- n) == 0. Proof. -intro n; rewrite Zadd_comm; apply Zadd_opp_diag_l. +intro n; rewrite add_comm; apply add_opp_diag_l. Qed. -Theorem Zadd_opp_l : forall n m : Z, - m + n == n - m. +Theorem add_opp_l : forall n m, - m + n == n - m. Proof. -intros n m; rewrite <- Zadd_opp_r; now rewrite Zadd_comm. +intros n m; rewrite <- add_opp_r; now rewrite add_comm. Qed. -Theorem Zadd_sub_assoc : forall n m p : Z, n + (m - p) == (n + m) - p. +Theorem add_sub_assoc : forall n m p, n + (m - p) == (n + m) - p. Proof. -intros n m p; do 2 rewrite <- Zadd_opp_r; now rewrite Zadd_assoc. +intros n m p; do 2 rewrite <- add_opp_r; now rewrite add_assoc. Qed. -Theorem Zopp_involutive : forall n : Z, - (- n) == n. +Theorem opp_involutive : forall n, - (- n) == n. Proof. -NZinduct n. -now do 2 rewrite Zopp_0. -intro n. rewrite Zopp_succ, Zopp_pred; now rewrite Zsucc_inj_wd. +nzinduct n. +now do 2 rewrite opp_0. +intro n. rewrite opp_succ, opp_pred; now rewrite succ_inj_wd. Qed. -Theorem Zopp_add_distr : forall n m : Z, - (n + m) == - n + (- m). +Theorem opp_add_distr : forall n m, - (n + m) == - n + (- m). Proof. -intros n m; NZinduct n. -rewrite Zopp_0; now do 2 rewrite Zadd_0_l. -intro n. rewrite Zadd_succ_l; do 2 rewrite Zopp_succ; rewrite Zadd_pred_l. -now rewrite Zpred_inj_wd. +intros n m; nzinduct n. +rewrite opp_0; now do 2 rewrite add_0_l. +intro n. rewrite add_succ_l; do 2 rewrite opp_succ; rewrite add_pred_l. +now rewrite pred_inj_wd. Qed. -Theorem Zopp_sub_distr : forall n m : Z, - (n - m) == - n + m. +Theorem opp_sub_distr : forall n m, - (n - m) == - n + m. Proof. -intros n m; rewrite <- Zadd_opp_r, Zopp_add_distr. -now rewrite Zopp_involutive. +intros n m; rewrite <- add_opp_r, opp_add_distr. +now rewrite opp_involutive. Qed. -Theorem Zopp_inj : forall n m : Z, - n == - m -> n == m. +Theorem opp_inj : forall n m, - n == - m -> n == m. Proof. -intros n m H. apply Zopp_wd in H. now do 2 rewrite Zopp_involutive in H. +intros n m H. apply opp_wd in H. now do 2 rewrite opp_involutive in H. Qed. -Theorem Zopp_inj_wd : forall n m : Z, - n == - m <-> n == m. +Theorem opp_inj_wd : forall n m, - n == - m <-> n == m. Proof. -intros n m; split; [apply Zopp_inj | apply Zopp_wd]. +intros n m; split; [apply opp_inj | apply opp_wd]. Qed. -Theorem Zeq_opp_l : forall n m : Z, - n == m <-> n == - m. +Theorem eq_opp_l : forall n m, - n == m <-> n == - m. Proof. -intros n m. now rewrite <- (Zopp_inj_wd (- n) m), Zopp_involutive. +intros n m. now rewrite <- (opp_inj_wd (- n) m), opp_involutive. Qed. -Theorem Zeq_opp_r : forall n m : Z, n == - m <-> - n == m. +Theorem eq_opp_r : forall n m, n == - m <-> - n == m. Proof. -symmetry; apply Zeq_opp_l. +symmetry; apply eq_opp_l. Qed. -Theorem Zsub_add_distr : forall n m p : Z, n - (m + p) == (n - m) - p. +Theorem sub_add_distr : forall n m p, n - (m + p) == (n - m) - p. Proof. -intros n m p; rewrite <- Zadd_opp_r, Zopp_add_distr, Zadd_assoc. -now do 2 rewrite Zadd_opp_r. +intros n m p; rewrite <- add_opp_r, opp_add_distr, add_assoc. +now do 2 rewrite add_opp_r. Qed. -Theorem Zsub_sub_distr : forall n m p : Z, n - (m - p) == (n - m) + p. +Theorem sub_sub_distr : forall n m p, n - (m - p) == (n - m) + p. Proof. -intros n m p; rewrite <- Zadd_opp_r, Zopp_sub_distr, Zadd_assoc. -now rewrite Zadd_opp_r. +intros n m p; rewrite <- add_opp_r, opp_sub_distr, add_assoc. +now rewrite add_opp_r. Qed. -Theorem sub_opp_l : forall n m : Z, - n - m == - m - n. +Theorem sub_opp_l : forall n m, - n - m == - m - n. Proof. -intros n m. do 2 rewrite <- Zadd_opp_r. now rewrite Zadd_comm. +intros n m. do 2 rewrite <- add_opp_r. now rewrite add_comm. Qed. -Theorem Zsub_opp_r : forall n m : Z, n - (- m) == n + m. +Theorem sub_opp_r : forall n m, n - (- m) == n + m. Proof. -intros n m; rewrite <- Zadd_opp_r; now rewrite Zopp_involutive. +intros n m; rewrite <- add_opp_r; now rewrite opp_involutive. Qed. -Theorem Zadd_sub_swap : forall n m p : Z, n + m - p == n - p + m. +Theorem add_sub_swap : forall n m p, n + m - p == n - p + m. Proof. -intros n m p. rewrite <- Zadd_sub_assoc, <- (Zadd_opp_r n p), <- Zadd_assoc. -now rewrite Zadd_opp_l. +intros n m p. rewrite <- add_sub_assoc, <- (add_opp_r n p), <- add_assoc. +now rewrite add_opp_l. Qed. -Theorem Zsub_cancel_l : forall n m p : Z, n - m == n - p <-> m == p. +Theorem sub_cancel_l : forall n m p, n - m == n - p <-> m == p. Proof. -intros n m p. rewrite <- (Zadd_cancel_l (n - m) (n - p) (- n)). -do 2 rewrite Zadd_sub_assoc. rewrite Zadd_opp_diag_l; do 2 rewrite Zsub_0_l. -apply Zopp_inj_wd. +intros n m p. rewrite <- (add_cancel_l (n - m) (n - p) (- n)). +do 2 rewrite add_sub_assoc. rewrite add_opp_diag_l; do 2 rewrite sub_0_l. +apply opp_inj_wd. Qed. -Theorem Zsub_cancel_r : forall n m p : Z, n - p == m - p <-> n == m. +Theorem sub_cancel_r : forall n m p, n - p == m - p <-> n == m. Proof. intros n m p. -stepl (n - p + p == m - p + p) by apply Zadd_cancel_r. -now do 2 rewrite <- Zsub_sub_distr, Zsub_diag, Zsub_0_r. +stepl (n - p + p == m - p + p) by apply add_cancel_r. +now do 2 rewrite <- sub_sub_distr, sub_diag, sub_0_r. Qed. -(* The next several theorems are devoted to moving terms from one side of -an equation to the other. The name contains the operation in the original -equation (add or sub) and the indication whether the left or right term -is moved. *) +(** The next several theorems are devoted to moving terms from one + side of an equation to the other. The name contains the operation + in the original equation ([add] or [sub]) and the indication + whether the left or right term is moved. *) -Theorem Zadd_move_l : forall n m p : Z, n + m == p <-> m == p - n. +Theorem add_move_l : forall n m p, n + m == p <-> m == p - n. Proof. intros n m p. -stepl (n + m - n == p - n) by apply Zsub_cancel_r. -now rewrite Zadd_comm, <- Zadd_sub_assoc, Zsub_diag, Zadd_0_r. +stepl (n + m - n == p - n) by apply sub_cancel_r. +now rewrite add_comm, <- add_sub_assoc, sub_diag, add_0_r. Qed. -Theorem Zadd_move_r : forall n m p : Z, n + m == p <-> n == p - m. +Theorem add_move_r : forall n m p, n + m == p <-> n == p - m. Proof. -intros n m p; rewrite Zadd_comm; now apply Zadd_move_l. +intros n m p; rewrite add_comm; now apply add_move_l. Qed. -(* The two theorems above do not allow rewriting subformulas of the form -n - m == p to n == p + m since subtraction is in the right-hand side of -the equation. Hence the following two theorems. *) +(** The two theorems above do not allow rewriting subformulas of the + form [n - m == p] to [n == p + m] since subtraction is in the + right-hand side of the equation. Hence the following two + theorems. *) -Theorem Zsub_move_l : forall n m p : Z, n - m == p <-> - m == p - n. +Theorem sub_move_l : forall n m p, n - m == p <-> - m == p - n. Proof. -intros n m p; rewrite <- (Zadd_opp_r n m); apply Zadd_move_l. +intros n m p; rewrite <- (add_opp_r n m); apply add_move_l. Qed. -Theorem Zsub_move_r : forall n m p : Z, n - m == p <-> n == p + m. +Theorem sub_move_r : forall n m p, n - m == p <-> n == p + m. Proof. -intros n m p; rewrite <- (Zadd_opp_r n m). now rewrite Zadd_move_r, Zsub_opp_r. +intros n m p; rewrite <- (add_opp_r n m). now rewrite add_move_r, sub_opp_r. Qed. -Theorem Zadd_move_0_l : forall n m : Z, n + m == 0 <-> m == - n. +Theorem add_move_0_l : forall n m, n + m == 0 <-> m == - n. Proof. -intros n m; now rewrite Zadd_move_l, Zsub_0_l. +intros n m; now rewrite add_move_l, sub_0_l. Qed. -Theorem Zadd_move_0_r : forall n m : Z, n + m == 0 <-> n == - m. +Theorem add_move_0_r : forall n m, n + m == 0 <-> n == - m. Proof. -intros n m; now rewrite Zadd_move_r, Zsub_0_l. +intros n m; now rewrite add_move_r, sub_0_l. Qed. -Theorem Zsub_move_0_l : forall n m : Z, n - m == 0 <-> - m == - n. +Theorem sub_move_0_l : forall n m, n - m == 0 <-> - m == - n. Proof. -intros n m. now rewrite Zsub_move_l, Zsub_0_l. +intros n m. now rewrite sub_move_l, sub_0_l. Qed. -Theorem Zsub_move_0_r : forall n m : Z, n - m == 0 <-> n == m. +Theorem sub_move_0_r : forall n m, n - m == 0 <-> n == m. Proof. -intros n m. now rewrite Zsub_move_r, Zadd_0_l. +intros n m. now rewrite sub_move_r, add_0_l. Qed. -(* The following section is devoted to cancellation of like terms. The name -includes the first operator and the position of the term being canceled. *) +(** The following section is devoted to cancellation of like + terms. The name includes the first operator and the position of + the term being canceled. *) -Theorem Zadd_simpl_l : forall n m : Z, n + m - n == m. +Theorem add_simpl_l : forall n m, n + m - n == m. Proof. -intros; now rewrite Zadd_sub_swap, Zsub_diag, Zadd_0_l. +intros; now rewrite add_sub_swap, sub_diag, add_0_l. Qed. -Theorem Zadd_simpl_r : forall n m : Z, n + m - m == n. +Theorem add_simpl_r : forall n m, n + m - m == n. Proof. -intros; now rewrite <- Zadd_sub_assoc, Zsub_diag, Zadd_0_r. +intros; now rewrite <- add_sub_assoc, sub_diag, add_0_r. Qed. -Theorem Zsub_simpl_l : forall n m : Z, - n - m + n == - m. +Theorem sub_simpl_l : forall n m, - n - m + n == - m. Proof. -intros; now rewrite <- Zadd_sub_swap, Zadd_opp_diag_l, Zsub_0_l. +intros; now rewrite <- add_sub_swap, add_opp_diag_l, sub_0_l. Qed. -Theorem Zsub_simpl_r : forall n m : Z, n - m + m == n. +Theorem sub_simpl_r : forall n m, n - m + m == n. Proof. -intros; now rewrite <- Zsub_sub_distr, Zsub_diag, Zsub_0_r. +intros; now rewrite <- sub_sub_distr, sub_diag, sub_0_r. Qed. -(* Now we have two sums or differences; the name includes the two operators -and the position of the terms being canceled *) +(** Now we have two sums or differences; the name includes the two + operators and the position of the terms being canceled *) -Theorem Zadd_add_simpl_l_l : forall n m p : Z, (n + m) - (n + p) == m - p. +Theorem add_add_simpl_l_l : forall n m p, (n + m) - (n + p) == m - p. Proof. -intros n m p. now rewrite (Zadd_comm n m), <- Zadd_sub_assoc, -Zsub_add_distr, Zsub_diag, Zsub_0_l, Zadd_opp_r. +intros n m p. now rewrite (add_comm n m), <- add_sub_assoc, +sub_add_distr, sub_diag, sub_0_l, add_opp_r. Qed. -Theorem Zadd_add_simpl_l_r : forall n m p : Z, (n + m) - (p + n) == m - p. +Theorem add_add_simpl_l_r : forall n m p, (n + m) - (p + n) == m - p. Proof. -intros n m p. rewrite (Zadd_comm p n); apply Zadd_add_simpl_l_l. +intros n m p. rewrite (add_comm p n); apply add_add_simpl_l_l. Qed. -Theorem Zadd_add_simpl_r_l : forall n m p : Z, (n + m) - (m + p) == n - p. +Theorem add_add_simpl_r_l : forall n m p, (n + m) - (m + p) == n - p. Proof. -intros n m p. rewrite (Zadd_comm n m); apply Zadd_add_simpl_l_l. +intros n m p. rewrite (add_comm n m); apply add_add_simpl_l_l. Qed. -Theorem Zadd_add_simpl_r_r : forall n m p : Z, (n + m) - (p + m) == n - p. +Theorem add_add_simpl_r_r : forall n m p, (n + m) - (p + m) == n - p. Proof. -intros n m p. rewrite (Zadd_comm p m); apply Zadd_add_simpl_r_l. +intros n m p. rewrite (add_comm p m); apply add_add_simpl_r_l. Qed. -Theorem Zsub_add_simpl_r_l : forall n m p : Z, (n - m) + (m + p) == n + p. +Theorem sub_add_simpl_r_l : forall n m p, (n - m) + (m + p) == n + p. Proof. -intros n m p. now rewrite <- Zsub_sub_distr, Zsub_add_distr, Zsub_diag, -Zsub_0_l, Zsub_opp_r. +intros n m p. now rewrite <- sub_sub_distr, sub_add_distr, sub_diag, +sub_0_l, sub_opp_r. Qed. -Theorem Zsub_add_simpl_r_r : forall n m p : Z, (n - m) + (p + m) == n + p. +Theorem sub_add_simpl_r_r : forall n m p, (n - m) + (p + m) == n + p. Proof. -intros n m p. rewrite (Zadd_comm p m); apply Zsub_add_simpl_r_l. +intros n m p. rewrite (add_comm p m); apply sub_add_simpl_r_l. Qed. -(* Of course, there are many other variants *) +(** Of course, there are many other variants *) End ZAddPropFunct. diff --git a/theories/Numbers/Integer/Abstract/ZAddOrder.v b/theories/Numbers/Integer/Abstract/ZAddOrder.v index 101ea634..de12993f 100644 --- a/theories/Numbers/Integer/Abstract/ZAddOrder.v +++ b/theories/Numbers/Integer/Abstract/ZAddOrder.v @@ -8,365 +8,292 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZAddOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export ZLt. -Module ZAddOrderPropFunct (Import ZAxiomsMod : ZAxiomsSig). -Module Export ZOrderPropMod := ZOrderPropFunct ZAxiomsMod. -Open Local Scope IntScope. +Module ZAddOrderPropFunct (Import Z : ZAxiomsSig'). +Include ZOrderPropFunct Z. -(* Theorems that are true on both natural numbers and integers *) +(** Theorems that are either not valid on N or have different proofs + on N and Z *) -Theorem Zadd_lt_mono_l : forall n m p : Z, n < m <-> p + n < p + m. -Proof NZadd_lt_mono_l. - -Theorem Zadd_lt_mono_r : forall n m p : Z, n < m <-> n + p < m + p. -Proof NZadd_lt_mono_r. - -Theorem Zadd_lt_mono : forall n m p q : Z, n < m -> p < q -> n + p < m + q. -Proof NZadd_lt_mono. - -Theorem Zadd_le_mono_l : forall n m p : Z, n <= m <-> p + n <= p + m. -Proof NZadd_le_mono_l. - -Theorem Zadd_le_mono_r : forall n m p : Z, n <= m <-> n + p <= m + p. -Proof NZadd_le_mono_r. - -Theorem Zadd_le_mono : forall n m p q : Z, n <= m -> p <= q -> n + p <= m + q. -Proof NZadd_le_mono. - -Theorem Zadd_lt_le_mono : forall n m p q : Z, n < m -> p <= q -> n + p < m + q. -Proof NZadd_lt_le_mono. - -Theorem Zadd_le_lt_mono : forall n m p q : Z, n <= m -> p < q -> n + p < m + q. -Proof NZadd_le_lt_mono. - -Theorem Zadd_pos_pos : forall n m : Z, 0 < n -> 0 < m -> 0 < n + m. -Proof NZadd_pos_pos. - -Theorem Zadd_pos_nonneg : forall n m : Z, 0 < n -> 0 <= m -> 0 < n + m. -Proof NZadd_pos_nonneg. - -Theorem Zadd_nonneg_pos : forall n m : Z, 0 <= n -> 0 < m -> 0 < n + m. -Proof NZadd_nonneg_pos. - -Theorem Zadd_nonneg_nonneg : forall n m : Z, 0 <= n -> 0 <= m -> 0 <= n + m. -Proof NZadd_nonneg_nonneg. - -Theorem Zlt_add_pos_l : forall n m : Z, 0 < n -> m < n + m. -Proof NZlt_add_pos_l. - -Theorem Zlt_add_pos_r : forall n m : Z, 0 < n -> m < m + n. -Proof NZlt_add_pos_r. - -Theorem Zle_lt_add_lt : forall n m p q : Z, n <= m -> p + m < q + n -> p < q. -Proof NZle_lt_add_lt. - -Theorem Zlt_le_add_lt : forall n m p q : Z, n < m -> p + m <= q + n -> p < q. -Proof NZlt_le_add_lt. - -Theorem Zle_le_add_le : forall n m p q : Z, n <= m -> p + m <= q + n -> p <= q. -Proof NZle_le_add_le. - -Theorem Zadd_lt_cases : forall n m p q : Z, n + m < p + q -> n < p \/ m < q. -Proof NZadd_lt_cases. - -Theorem Zadd_le_cases : forall n m p q : Z, n + m <= p + q -> n <= p \/ m <= q. -Proof NZadd_le_cases. - -Theorem Zadd_neg_cases : forall n m : Z, n + m < 0 -> n < 0 \/ m < 0. -Proof NZadd_neg_cases. - -Theorem Zadd_pos_cases : forall n m : Z, 0 < n + m -> 0 < n \/ 0 < m. -Proof NZadd_pos_cases. - -Theorem Zadd_nonpos_cases : forall n m : Z, n + m <= 0 -> n <= 0 \/ m <= 0. -Proof NZadd_nonpos_cases. - -Theorem Zadd_nonneg_cases : forall n m : Z, 0 <= n + m -> 0 <= n \/ 0 <= m. -Proof NZadd_nonneg_cases. - -(* Theorems that are either not valid on N or have different proofs on N and Z *) - -Theorem Zadd_neg_neg : forall n m : Z, n < 0 -> m < 0 -> n + m < 0. +Theorem add_neg_neg : forall n m, n < 0 -> m < 0 -> n + m < 0. Proof. -intros n m H1 H2. rewrite <- (Zadd_0_l 0). now apply Zadd_lt_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_mono. Qed. -Theorem Zadd_neg_nonpos : forall n m : Z, n < 0 -> m <= 0 -> n + m < 0. +Theorem add_neg_nonpos : forall n m, n < 0 -> m <= 0 -> n + m < 0. Proof. -intros n m H1 H2. rewrite <- (Zadd_0_l 0). now apply Zadd_lt_le_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_le_mono. Qed. -Theorem Zadd_nonpos_neg : forall n m : Z, n <= 0 -> m < 0 -> n + m < 0. +Theorem add_nonpos_neg : forall n m, n <= 0 -> m < 0 -> n + m < 0. Proof. -intros n m H1 H2. rewrite <- (Zadd_0_l 0). now apply Zadd_le_lt_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_lt_mono. Qed. -Theorem Zadd_nonpos_nonpos : forall n m : Z, n <= 0 -> m <= 0 -> n + m <= 0. +Theorem add_nonpos_nonpos : forall n m, n <= 0 -> m <= 0 -> n + m <= 0. Proof. -intros n m H1 H2. rewrite <- (Zadd_0_l 0). now apply Zadd_le_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_mono. Qed. (** Sub and order *) -Theorem Zlt_0_sub : forall n m : Z, 0 < m - n <-> n < m. +Theorem lt_0_sub : forall n m, 0 < m - n <-> n < m. Proof. -intros n m. stepl (0 + n < m - n + n) by symmetry; apply Zadd_lt_mono_r. -rewrite Zadd_0_l; now rewrite Zsub_simpl_r. +intros n m. stepl (0 + n < m - n + n) by symmetry; apply add_lt_mono_r. +rewrite add_0_l; now rewrite sub_simpl_r. Qed. -Notation Zsub_pos := Zlt_0_sub (only parsing). +Notation sub_pos := lt_0_sub (only parsing). -Theorem Zle_0_sub : forall n m : Z, 0 <= m - n <-> n <= m. +Theorem le_0_sub : forall n m, 0 <= m - n <-> n <= m. Proof. -intros n m; stepl (0 + n <= m - n + n) by symmetry; apply Zadd_le_mono_r. -rewrite Zadd_0_l; now rewrite Zsub_simpl_r. +intros n m; stepl (0 + n <= m - n + n) by symmetry; apply add_le_mono_r. +rewrite add_0_l; now rewrite sub_simpl_r. Qed. -Notation Zsub_nonneg := Zle_0_sub (only parsing). +Notation sub_nonneg := le_0_sub (only parsing). -Theorem Zlt_sub_0 : forall n m : Z, n - m < 0 <-> n < m. +Theorem lt_sub_0 : forall n m, n - m < 0 <-> n < m. Proof. -intros n m. stepl (n - m + m < 0 + m) by symmetry; apply Zadd_lt_mono_r. -rewrite Zadd_0_l; now rewrite Zsub_simpl_r. +intros n m. stepl (n - m + m < 0 + m) by symmetry; apply add_lt_mono_r. +rewrite add_0_l; now rewrite sub_simpl_r. Qed. -Notation Zsub_neg := Zlt_sub_0 (only parsing). +Notation sub_neg := lt_sub_0 (only parsing). -Theorem Zle_sub_0 : forall n m : Z, n - m <= 0 <-> n <= m. +Theorem le_sub_0 : forall n m, n - m <= 0 <-> n <= m. Proof. -intros n m. stepl (n - m + m <= 0 + m) by symmetry; apply Zadd_le_mono_r. -rewrite Zadd_0_l; now rewrite Zsub_simpl_r. +intros n m. stepl (n - m + m <= 0 + m) by symmetry; apply add_le_mono_r. +rewrite add_0_l; now rewrite sub_simpl_r. Qed. -Notation Zsub_nonpos := Zle_sub_0 (only parsing). +Notation sub_nonpos := le_sub_0 (only parsing). -Theorem Zopp_lt_mono : forall n m : Z, n < m <-> - m < - n. +Theorem opp_lt_mono : forall n m, n < m <-> - m < - n. Proof. -intros n m. stepr (m + - m < m + - n) by symmetry; apply Zadd_lt_mono_l. -do 2 rewrite Zadd_opp_r. rewrite Zsub_diag. symmetry; apply Zlt_0_sub. +intros n m. stepr (m + - m < m + - n) by symmetry; apply add_lt_mono_l. +do 2 rewrite add_opp_r. rewrite sub_diag. symmetry; apply lt_0_sub. Qed. -Theorem Zopp_le_mono : forall n m : Z, n <= m <-> - m <= - n. +Theorem opp_le_mono : forall n m, n <= m <-> - m <= - n. Proof. -intros n m. stepr (m + - m <= m + - n) by symmetry; apply Zadd_le_mono_l. -do 2 rewrite Zadd_opp_r. rewrite Zsub_diag. symmetry; apply Zle_0_sub. +intros n m. stepr (m + - m <= m + - n) by symmetry; apply add_le_mono_l. +do 2 rewrite add_opp_r. rewrite sub_diag. symmetry; apply le_0_sub. Qed. -Theorem Zopp_pos_neg : forall n : Z, 0 < - n <-> n < 0. +Theorem opp_pos_neg : forall n, 0 < - n <-> n < 0. Proof. -intro n; rewrite (Zopp_lt_mono n 0); now rewrite Zopp_0. +intro n; rewrite (opp_lt_mono n 0); now rewrite opp_0. Qed. -Theorem Zopp_neg_pos : forall n : Z, - n < 0 <-> 0 < n. +Theorem opp_neg_pos : forall n, - n < 0 <-> 0 < n. Proof. -intro n. rewrite (Zopp_lt_mono 0 n). now rewrite Zopp_0. +intro n. rewrite (opp_lt_mono 0 n). now rewrite opp_0. Qed. -Theorem Zopp_nonneg_nonpos : forall n : Z, 0 <= - n <-> n <= 0. +Theorem opp_nonneg_nonpos : forall n, 0 <= - n <-> n <= 0. Proof. -intro n; rewrite (Zopp_le_mono n 0); now rewrite Zopp_0. +intro n; rewrite (opp_le_mono n 0); now rewrite opp_0. Qed. -Theorem Zopp_nonpos_nonneg : forall n : Z, - n <= 0 <-> 0 <= n. +Theorem opp_nonpos_nonneg : forall n, - n <= 0 <-> 0 <= n. Proof. -intro n. rewrite (Zopp_le_mono 0 n). now rewrite Zopp_0. +intro n. rewrite (opp_le_mono 0 n). now rewrite opp_0. Qed. -Theorem Zsub_lt_mono_l : forall n m p : Z, n < m <-> p - m < p - n. +Theorem sub_lt_mono_l : forall n m p, n < m <-> p - m < p - n. Proof. -intros n m p. do 2 rewrite <- Zadd_opp_r. rewrite <- Zadd_lt_mono_l. -apply Zopp_lt_mono. +intros n m p. do 2 rewrite <- add_opp_r. rewrite <- add_lt_mono_l. +apply opp_lt_mono. Qed. -Theorem Zsub_lt_mono_r : forall n m p : Z, n < m <-> n - p < m - p. +Theorem sub_lt_mono_r : forall n m p, n < m <-> n - p < m - p. Proof. -intros n m p; do 2 rewrite <- Zadd_opp_r; apply Zadd_lt_mono_r. +intros n m p; do 2 rewrite <- add_opp_r; apply add_lt_mono_r. Qed. -Theorem Zsub_lt_mono : forall n m p q : Z, n < m -> q < p -> n - p < m - q. +Theorem sub_lt_mono : forall n m p q, n < m -> q < p -> n - p < m - q. Proof. intros n m p q H1 H2. -apply NZlt_trans with (m - p); -[now apply -> Zsub_lt_mono_r | now apply -> Zsub_lt_mono_l]. +apply lt_trans with (m - p); +[now apply -> sub_lt_mono_r | now apply -> sub_lt_mono_l]. Qed. -Theorem Zsub_le_mono_l : forall n m p : Z, n <= m <-> p - m <= p - n. +Theorem sub_le_mono_l : forall n m p, n <= m <-> p - m <= p - n. Proof. -intros n m p; do 2 rewrite <- Zadd_opp_r; rewrite <- Zadd_le_mono_l; -apply Zopp_le_mono. +intros n m p; do 2 rewrite <- add_opp_r; rewrite <- add_le_mono_l; +apply opp_le_mono. Qed. -Theorem Zsub_le_mono_r : forall n m p : Z, n <= m <-> n - p <= m - p. +Theorem sub_le_mono_r : forall n m p, n <= m <-> n - p <= m - p. Proof. -intros n m p; do 2 rewrite <- Zadd_opp_r; apply Zadd_le_mono_r. +intros n m p; do 2 rewrite <- add_opp_r; apply add_le_mono_r. Qed. -Theorem Zsub_le_mono : forall n m p q : Z, n <= m -> q <= p -> n - p <= m - q. +Theorem sub_le_mono : forall n m p q, n <= m -> q <= p -> n - p <= m - q. Proof. intros n m p q H1 H2. -apply NZle_trans with (m - p); -[now apply -> Zsub_le_mono_r | now apply -> Zsub_le_mono_l]. +apply le_trans with (m - p); +[now apply -> sub_le_mono_r | now apply -> sub_le_mono_l]. Qed. -Theorem Zsub_lt_le_mono : forall n m p q : Z, n < m -> q <= p -> n - p < m - q. +Theorem sub_lt_le_mono : forall n m p q, n < m -> q <= p -> n - p < m - q. Proof. intros n m p q H1 H2. -apply NZlt_le_trans with (m - p); -[now apply -> Zsub_lt_mono_r | now apply -> Zsub_le_mono_l]. +apply lt_le_trans with (m - p); +[now apply -> sub_lt_mono_r | now apply -> sub_le_mono_l]. Qed. -Theorem Zsub_le_lt_mono : forall n m p q : Z, n <= m -> q < p -> n - p < m - q. +Theorem sub_le_lt_mono : forall n m p q, n <= m -> q < p -> n - p < m - q. Proof. intros n m p q H1 H2. -apply NZle_lt_trans with (m - p); -[now apply -> Zsub_le_mono_r | now apply -> Zsub_lt_mono_l]. +apply le_lt_trans with (m - p); +[now apply -> sub_le_mono_r | now apply -> sub_lt_mono_l]. Qed. -Theorem Zle_lt_sub_lt : forall n m p q : Z, n <= m -> p - n < q - m -> p < q. +Theorem le_lt_sub_lt : forall n m p q, n <= m -> p - n < q - m -> p < q. Proof. -intros n m p q H1 H2. apply (Zle_lt_add_lt (- m) (- n)); -[now apply -> Zopp_le_mono | now do 2 rewrite Zadd_opp_r]. +intros n m p q H1 H2. apply (le_lt_add_lt (- m) (- n)); +[now apply -> opp_le_mono | now do 2 rewrite add_opp_r]. Qed. -Theorem Zlt_le_sub_lt : forall n m p q : Z, n < m -> p - n <= q - m -> p < q. +Theorem lt_le_sub_lt : forall n m p q, n < m -> p - n <= q - m -> p < q. Proof. -intros n m p q H1 H2. apply (Zlt_le_add_lt (- m) (- n)); -[now apply -> Zopp_lt_mono | now do 2 rewrite Zadd_opp_r]. +intros n m p q H1 H2. apply (lt_le_add_lt (- m) (- n)); +[now apply -> opp_lt_mono | now do 2 rewrite add_opp_r]. Qed. -Theorem Zle_le_sub_lt : forall n m p q : Z, n <= m -> p - n <= q - m -> p <= q. +Theorem le_le_sub_lt : forall n m p q, n <= m -> p - n <= q - m -> p <= q. Proof. -intros n m p q H1 H2. apply (Zle_le_add_le (- m) (- n)); -[now apply -> Zopp_le_mono | now do 2 rewrite Zadd_opp_r]. +intros n m p q H1 H2. apply (le_le_add_le (- m) (- n)); +[now apply -> opp_le_mono | now do 2 rewrite add_opp_r]. Qed. -Theorem Zlt_add_lt_sub_r : forall n m p : Z, n + p < m <-> n < m - p. +Theorem lt_add_lt_sub_r : forall n m p, n + p < m <-> n < m - p. Proof. -intros n m p. stepl (n + p - p < m - p) by symmetry; apply Zsub_lt_mono_r. -now rewrite Zadd_simpl_r. +intros n m p. stepl (n + p - p < m - p) by symmetry; apply sub_lt_mono_r. +now rewrite add_simpl_r. Qed. -Theorem Zle_add_le_sub_r : forall n m p : Z, n + p <= m <-> n <= m - p. +Theorem le_add_le_sub_r : forall n m p, n + p <= m <-> n <= m - p. Proof. -intros n m p. stepl (n + p - p <= m - p) by symmetry; apply Zsub_le_mono_r. -now rewrite Zadd_simpl_r. +intros n m p. stepl (n + p - p <= m - p) by symmetry; apply sub_le_mono_r. +now rewrite add_simpl_r. Qed. -Theorem Zlt_add_lt_sub_l : forall n m p : Z, n + p < m <-> p < m - n. +Theorem lt_add_lt_sub_l : forall n m p, n + p < m <-> p < m - n. Proof. -intros n m p. rewrite Zadd_comm; apply Zlt_add_lt_sub_r. +intros n m p. rewrite add_comm; apply lt_add_lt_sub_r. Qed. -Theorem Zle_add_le_sub_l : forall n m p : Z, n + p <= m <-> p <= m - n. +Theorem le_add_le_sub_l : forall n m p, n + p <= m <-> p <= m - n. Proof. -intros n m p. rewrite Zadd_comm; apply Zle_add_le_sub_r. +intros n m p. rewrite add_comm; apply le_add_le_sub_r. Qed. -Theorem Zlt_sub_lt_add_r : forall n m p : Z, n - p < m <-> n < m + p. +Theorem lt_sub_lt_add_r : forall n m p, n - p < m <-> n < m + p. Proof. -intros n m p. stepl (n - p + p < m + p) by symmetry; apply Zadd_lt_mono_r. -now rewrite Zsub_simpl_r. +intros n m p. stepl (n - p + p < m + p) by symmetry; apply add_lt_mono_r. +now rewrite sub_simpl_r. Qed. -Theorem Zle_sub_le_add_r : forall n m p : Z, n - p <= m <-> n <= m + p. +Theorem le_sub_le_add_r : forall n m p, n - p <= m <-> n <= m + p. Proof. -intros n m p. stepl (n - p + p <= m + p) by symmetry; apply Zadd_le_mono_r. -now rewrite Zsub_simpl_r. +intros n m p. stepl (n - p + p <= m + p) by symmetry; apply add_le_mono_r. +now rewrite sub_simpl_r. Qed. -Theorem Zlt_sub_lt_add_l : forall n m p : Z, n - m < p <-> n < m + p. +Theorem lt_sub_lt_add_l : forall n m p, n - m < p <-> n < m + p. Proof. -intros n m p. rewrite Zadd_comm; apply Zlt_sub_lt_add_r. +intros n m p. rewrite add_comm; apply lt_sub_lt_add_r. Qed. -Theorem Zle_sub_le_add_l : forall n m p : Z, n - m <= p <-> n <= m + p. +Theorem le_sub_le_add_l : forall n m p, n - m <= p <-> n <= m + p. Proof. -intros n m p. rewrite Zadd_comm; apply Zle_sub_le_add_r. +intros n m p. rewrite add_comm; apply le_sub_le_add_r. Qed. -Theorem Zlt_sub_lt_add : forall n m p q : Z, n - m < p - q <-> n + q < m + p. +Theorem lt_sub_lt_add : forall n m p q, n - m < p - q <-> n + q < m + p. Proof. -intros n m p q. rewrite Zlt_sub_lt_add_l. rewrite Zadd_sub_assoc. -now rewrite <- Zlt_add_lt_sub_r. +intros n m p q. rewrite lt_sub_lt_add_l. rewrite add_sub_assoc. +now rewrite <- lt_add_lt_sub_r. Qed. -Theorem Zle_sub_le_add : forall n m p q : Z, n - m <= p - q <-> n + q <= m + p. +Theorem le_sub_le_add : forall n m p q, n - m <= p - q <-> n + q <= m + p. Proof. -intros n m p q. rewrite Zle_sub_le_add_l. rewrite Zadd_sub_assoc. -now rewrite <- Zle_add_le_sub_r. +intros n m p q. rewrite le_sub_le_add_l. rewrite add_sub_assoc. +now rewrite <- le_add_le_sub_r. Qed. -Theorem Zlt_sub_pos : forall n m : Z, 0 < m <-> n - m < n. +Theorem lt_sub_pos : forall n m, 0 < m <-> n - m < n. Proof. -intros n m. stepr (n - m < n - 0) by now rewrite Zsub_0_r. apply Zsub_lt_mono_l. +intros n m. stepr (n - m < n - 0) by now rewrite sub_0_r. apply sub_lt_mono_l. Qed. -Theorem Zle_sub_nonneg : forall n m : Z, 0 <= m <-> n - m <= n. +Theorem le_sub_nonneg : forall n m, 0 <= m <-> n - m <= n. Proof. -intros n m. stepr (n - m <= n - 0) by now rewrite Zsub_0_r. apply Zsub_le_mono_l. +intros n m. stepr (n - m <= n - 0) by now rewrite sub_0_r. apply sub_le_mono_l. Qed. -Theorem Zsub_lt_cases : forall n m p q : Z, n - m < p - q -> n < m \/ q < p. +Theorem sub_lt_cases : forall n m p q, n - m < p - q -> n < m \/ q < p. Proof. -intros n m p q H. rewrite Zlt_sub_lt_add in H. now apply Zadd_lt_cases. +intros n m p q H. rewrite lt_sub_lt_add in H. now apply add_lt_cases. Qed. -Theorem Zsub_le_cases : forall n m p q : Z, n - m <= p - q -> n <= m \/ q <= p. +Theorem sub_le_cases : forall n m p q, n - m <= p - q -> n <= m \/ q <= p. Proof. -intros n m p q H. rewrite Zle_sub_le_add in H. now apply Zadd_le_cases. +intros n m p q H. rewrite le_sub_le_add in H. now apply add_le_cases. Qed. -Theorem Zsub_neg_cases : forall n m : Z, n - m < 0 -> n < 0 \/ 0 < m. +Theorem sub_neg_cases : forall n m, n - m < 0 -> n < 0 \/ 0 < m. Proof. -intros n m H; rewrite <- Zadd_opp_r in H. -setoid_replace (0 < m) with (- m < 0) using relation iff by (symmetry; apply Zopp_neg_pos). -now apply Zadd_neg_cases. +intros n m H; rewrite <- add_opp_r in H. +setoid_replace (0 < m) with (- m < 0) using relation iff by (symmetry; apply opp_neg_pos). +now apply add_neg_cases. Qed. -Theorem Zsub_pos_cases : forall n m : Z, 0 < n - m -> 0 < n \/ m < 0. +Theorem sub_pos_cases : forall n m, 0 < n - m -> 0 < n \/ m < 0. Proof. -intros n m H; rewrite <- Zadd_opp_r in H. -setoid_replace (m < 0) with (0 < - m) using relation iff by (symmetry; apply Zopp_pos_neg). -now apply Zadd_pos_cases. +intros n m H; rewrite <- add_opp_r in H. +setoid_replace (m < 0) with (0 < - m) using relation iff by (symmetry; apply opp_pos_neg). +now apply add_pos_cases. Qed. -Theorem Zsub_nonpos_cases : forall n m : Z, n - m <= 0 -> n <= 0 \/ 0 <= m. +Theorem sub_nonpos_cases : forall n m, n - m <= 0 -> n <= 0 \/ 0 <= m. Proof. -intros n m H; rewrite <- Zadd_opp_r in H. -setoid_replace (0 <= m) with (- m <= 0) using relation iff by (symmetry; apply Zopp_nonpos_nonneg). -now apply Zadd_nonpos_cases. +intros n m H; rewrite <- add_opp_r in H. +setoid_replace (0 <= m) with (- m <= 0) using relation iff by (symmetry; apply opp_nonpos_nonneg). +now apply add_nonpos_cases. Qed. -Theorem Zsub_nonneg_cases : forall n m : Z, 0 <= n - m -> 0 <= n \/ m <= 0. +Theorem sub_nonneg_cases : forall n m, 0 <= n - m -> 0 <= n \/ m <= 0. Proof. -intros n m H; rewrite <- Zadd_opp_r in H. -setoid_replace (m <= 0) with (0 <= - m) using relation iff by (symmetry; apply Zopp_nonneg_nonpos). -now apply Zadd_nonneg_cases. +intros n m H; rewrite <- add_opp_r in H. +setoid_replace (m <= 0) with (0 <= - m) using relation iff by (symmetry; apply opp_nonneg_nonpos). +now apply add_nonneg_cases. Qed. Section PosNeg. -Variable P : Z -> Prop. -Hypothesis P_wd : predicate_wd Zeq P. - -Add Morphism P with signature Zeq ==> iff as P_morph. Proof. exact P_wd. Qed. +Variable P : Z.t -> Prop. +Hypothesis P_wd : Proper (Z.eq ==> iff) P. -Theorem Z0_pos_neg : - P 0 -> (forall n : Z, 0 < n -> P n /\ P (- n)) -> forall n : Z, P n. +Theorem zero_pos_neg : + P 0 -> (forall n, 0 < n -> P n /\ P (- n)) -> forall n, P n. Proof. -intros H1 H2 n. destruct (Zlt_trichotomy n 0) as [H3 | [H3 | H3]]. -apply <- Zopp_pos_neg in H3. apply H2 in H3. destruct H3 as [_ H3]. -now rewrite Zopp_involutive in H3. +intros H1 H2 n. destruct (lt_trichotomy n 0) as [H3 | [H3 | H3]]. +apply <- opp_pos_neg in H3. apply H2 in H3. destruct H3 as [_ H3]. +now rewrite opp_involutive in H3. now rewrite H3. apply H2 in H3; now destruct H3. Qed. End PosNeg. -Ltac Z0_pos_neg n := induction_maker n ltac:(apply Z0_pos_neg). +Ltac zero_pos_neg n := induction_maker n ltac:(apply zero_pos_neg). End ZAddOrderPropFunct. diff --git a/theories/Numbers/Integer/Abstract/ZAxioms.v b/theories/Numbers/Integer/Abstract/ZAxioms.v index c4a4b6b8..9158a214 100644 --- a/theories/Numbers/Integer/Abstract/ZAxioms.v +++ b/theories/Numbers/Integer/Abstract/ZAxioms.v @@ -8,58 +8,31 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NZAxioms. Set Implicit Arguments. -Module Type ZAxiomsSig. -Declare Module Export NZOrdAxiomsMod : NZOrdAxiomsSig. +Module Type Opp (Import T:Typ). + Parameter Inline opp : t -> t. +End Opp. -Delimit Scope IntScope with Int. -Notation Z := NZ. -Notation Zeq := NZeq. -Notation Z0 := NZ0. -Notation Z1 := (NZsucc NZ0). -Notation S := NZsucc. -Notation P := NZpred. -Notation Zadd := NZadd. -Notation Zmul := NZmul. -Notation Zsub := NZsub. -Notation Zlt := NZlt. -Notation Zle := NZle. -Notation Zmin := NZmin. -Notation Zmax := NZmax. -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 "1" := (NZsucc NZ0) : IntScope. -Notation "x + y" := (NZadd x y) : IntScope. -Notation "x - y" := (NZsub x y) : IntScope. -Notation "x * y" := (NZmul x y) : IntScope. -Notation "x < y" := (NZlt x y) : IntScope. -Notation "x <= y" := (NZle x y) : IntScope. -Notation "x > y" := (NZlt y x) (only parsing) : IntScope. -Notation "x >= y" := (NZle y x) (only parsing) : IntScope. +Module Type OppNotation (T:Typ)(Import O : Opp T). + Notation "- x" := (opp x) (at level 35, right associativity). +End OppNotation. -Parameter Zopp : Z -> Z. +Module Type Opp' (T:Typ) := Opp T <+ OppNotation T. -(*Notation "- 1" := (Zopp 1) : IntScope. -Check (-1).*) +(** We obtain integers by postulating that every number has a predecessor. *) -Add Morphism Zopp with signature Zeq ==> Zeq as Zopp_wd. +Module Type IsOpp (Import Z : NZAxiomsSig')(Import O : Opp' Z). + Declare Instance opp_wd : Proper (eq==>eq) opp. + Axiom succ_pred : forall n, S (P n) == n. + Axiom opp_0 : - 0 == 0. + Axiom opp_succ : forall n, - (S n) == P (- n). +End IsOpp. -Notation "- x" := (Zopp x) (at level 35, right associativity) : IntScope. -Notation "- 1" := (Zopp (NZsucc NZ0)) : IntScope. - -Open Local Scope IntScope. - -(* Integers are obtained by postulating that every number has a predecessor *) -Axiom Zsucc_pred : forall n : Z, S (P n) == n. - -Axiom Zopp_0 : - 0 == 0. -Axiom Zopp_succ : forall n : Z, - (S n) == P (- n). - -End ZAxiomsSig. +Module Type ZAxiomsSig := NZOrdAxiomsSig <+ Opp <+ IsOpp. +Module Type ZAxiomsSig' := NZOrdAxiomsSig' <+ Opp' <+ IsOpp. diff --git a/theories/Numbers/Integer/Abstract/ZBase.v b/theories/Numbers/Integer/Abstract/ZBase.v index 0f71f2cc..44bb02ec 100644 --- a/theories/Numbers/Integer/Abstract/ZBase.v +++ b/theories/Numbers/Integer/Abstract/ZBase.v @@ -8,78 +8,25 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZBase.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Export Decidable. Require Export ZAxioms. -Require Import NZMulOrder. +Require Import NZProperties. -Module ZBasePropFunct (Import ZAxiomsMod : ZAxiomsSig). - -(* Note: writing "Export" instead of "Import" on the previous line leads to -some warnings about hiding repeated declarations and results in the loss of -notations in Zadd and later *) - -Open Local Scope IntScope. - -Module Export NZMulOrderMod := NZMulOrderPropFunct NZOrdAxiomsMod. - -Theorem Zsucc_wd : forall n1 n2 : Z, n1 == n2 -> S n1 == S n2. -Proof NZsucc_wd. - -Theorem Zpred_wd : forall n1 n2 : Z, n1 == n2 -> P n1 == P n2. -Proof NZpred_wd. - -Theorem Zpred_succ : forall n : Z, P (S n) == n. -Proof NZpred_succ. - -Theorem Zeq_refl : forall n : Z, n == n. -Proof (proj1 NZeq_equiv). - -Theorem Zeq_sym : forall n m : Z, n == m -> m == n. -Proof (proj2 (proj2 NZeq_equiv)). - -Theorem Zeq_trans : forall n m p : Z, n == m -> m == p -> n == p. -Proof (proj1 (proj2 NZeq_equiv)). - -Theorem Zneq_sym : forall n m : Z, n ~= m -> m ~= n. -Proof NZneq_sym. - -Theorem Zsucc_inj : forall n1 n2 : Z, S n1 == S n2 -> n1 == n2. -Proof NZsucc_inj. - -Theorem Zsucc_inj_wd : forall n1 n2 : Z, S n1 == S n2 <-> n1 == n2. -Proof NZsucc_inj_wd. - -Theorem Zsucc_inj_wd_neg : forall n m : Z, S n ~= S m <-> n ~= m. -Proof NZsucc_inj_wd_neg. - -(* Decidability and stability of equality was proved only in NZOrder, but -since it does not mention order, we'll put it here *) - -Theorem Zeq_dec : forall n m : Z, decidable (n == m). -Proof NZeq_dec. - -Theorem Zeq_dne : forall n m : Z, ~ ~ n == m <-> n == m. -Proof NZeq_dne. - -Theorem Zcentral_induction : -forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, A z -> - (forall n : Z, A n <-> A (S n)) -> - forall n : Z, A n. -Proof NZcentral_induction. +Module ZBasePropFunct (Import Z : ZAxiomsSig'). +Include NZPropFunct Z. (* Theorems that are true for integers but not for natural numbers *) -Theorem Zpred_inj : forall n m : Z, P n == P m -> n == m. +Theorem pred_inj : forall n m, P n == P m -> n == m. Proof. -intros n m H. apply NZsucc_wd in H. now do 2 rewrite Zsucc_pred in H. +intros n m H. apply succ_wd in H. now do 2 rewrite succ_pred in H. Qed. -Theorem Zpred_inj_wd : forall n1 n2 : Z, P n1 == P n2 <-> n1 == n2. +Theorem pred_inj_wd : forall n1 n2, P n1 == P n2 <-> n1 == n2. Proof. -intros n1 n2; split; [apply Zpred_inj | apply NZpred_wd]. +intros n1 n2; split; [apply pred_inj | apply pred_wd]. Qed. End ZBasePropFunct. diff --git a/theories/Numbers/Integer/Abstract/ZDivEucl.v b/theories/Numbers/Integer/Abstract/ZDivEucl.v new file mode 100644 index 00000000..bcd16fec --- /dev/null +++ b/theories/Numbers/Integer/Abstract/ZDivEucl.v @@ -0,0 +1,605 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(** * Euclidean Division for integers, Euclid convention + + We use here the "usual" formulation of the Euclid Theorem + [forall a b, b<>0 -> exists b q, a = b*q+r /\ 0 < r < |b| ] + + The outcome of the modulo function is hence always positive. + This corresponds to convention "E" in the following paper: + + R. Boute, "The Euclidean definition of the functions div and mod", + ACM Transactions on Programming Languages and Systems, + Vol. 14, No.2, pp. 127-144, April 1992. + + See files [ZDivTrunc] and [ZDivFloor] for others conventions. +*) + +Require Import ZAxioms ZProperties NZDiv. + +Module Type ZDivSpecific (Import Z : ZAxiomsExtSig')(Import DM : DivMod' Z). + Axiom mod_always_pos : forall a b, 0 <= a mod b < abs b. +End ZDivSpecific. + +Module Type ZDiv (Z:ZAxiomsExtSig) + := DivMod Z <+ NZDivCommon Z <+ ZDivSpecific Z. + +Module Type ZDivSig := ZAxiomsExtSig <+ ZDiv. +Module Type ZDivSig' := ZAxiomsExtSig' <+ ZDiv <+ DivModNotation. + +Module ZDivPropFunct (Import Z : ZDivSig')(Import ZP : ZPropSig Z). + +(** We benefit from what already exists for NZ *) + + Module ZD <: NZDiv Z. + Definition div := div. + Definition modulo := modulo. + Definition div_wd := div_wd. + Definition mod_wd := mod_wd. + Definition div_mod := div_mod. + Lemma mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b. + Proof. + intros. rewrite <- (abs_eq b) at 3 by now apply lt_le_incl. + apply mod_always_pos. + Qed. + End ZD. + Module Import NZDivP := NZDivPropFunct Z ZP ZD. + +(** Another formulation of the main equation *) + +Lemma mod_eq : + forall a b, b~=0 -> a mod b == a - b*(a/b). +Proof. +intros. +rewrite <- add_move_l. +symmetry. now apply div_mod. +Qed. + +Ltac pos_or_neg a := + let LT := fresh "LT" in + let LE := fresh "LE" in + destruct (le_gt_cases 0 a) as [LE|LT]; [|rewrite <- opp_pos_neg in LT]. + +(** Uniqueness theorems *) + +Theorem div_mod_unique : forall b q1 q2 r1 r2 : t, + 0<=r1<abs b -> 0<=r2<abs b -> + b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. +Proof. +intros b q1 q2 r1 r2 Hr1 Hr2 EQ. +pos_or_neg b. +rewrite abs_eq in * by trivial. +apply div_mod_unique with b; trivial. +rewrite abs_neq' in * by auto using lt_le_incl. +rewrite eq_sym_iff. apply div_mod_unique with (-b); trivial. +rewrite 2 mul_opp_l. +rewrite add_move_l, sub_opp_r. +rewrite <-add_assoc. +symmetry. rewrite add_move_l, sub_opp_r. +now rewrite (add_comm r2), (add_comm r1). +Qed. + +Theorem div_unique: + forall a b q r, 0<=r<abs b -> a == b*q + r -> q == a/b. +Proof. +intros a b q r Hr EQ. +assert (Hb : b~=0). + pos_or_neg b. + rewrite abs_eq in Hr; intuition; order. + rewrite <- opp_0, eq_opp_r. rewrite abs_neq' in Hr; intuition; order. +destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. +now apply mod_always_pos. +now rewrite <- div_mod. +Qed. + +Theorem mod_unique: + forall a b q r, 0<=r<abs b -> a == b*q + r -> r == a mod b. +Proof. +intros a b q r Hr EQ. +assert (Hb : b~=0). + pos_or_neg b. + rewrite abs_eq in Hr; intuition; order. + rewrite <- opp_0, eq_opp_r. rewrite abs_neq' in Hr; intuition; order. +destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. +now apply mod_always_pos. +now rewrite <- div_mod. +Qed. + +(** Sign rules *) + +Lemma div_opp_r : forall a b, b~=0 -> a/(-b) == -(a/b). +Proof. +intros. symmetry. +apply div_unique with (a mod b). +rewrite abs_opp; apply mod_always_pos. +rewrite mul_opp_opp; now apply div_mod. +Qed. + +Lemma mod_opp_r : forall a b, b~=0 -> a mod (-b) == a mod b. +Proof. +intros. symmetry. +apply mod_unique with (-(a/b)). +rewrite abs_opp; apply mod_always_pos. +rewrite mul_opp_opp; now apply div_mod. +Qed. + +Lemma div_opp_l_z : forall a b, b~=0 -> a mod b == 0 -> + (-a)/b == -(a/b). +Proof. +intros a b Hb Hab. symmetry. +apply div_unique with (-(a mod b)). +rewrite Hab, opp_0. split; [order|]. +pos_or_neg b; [rewrite abs_eq | rewrite abs_neq']; order. +now rewrite mul_opp_r, <-opp_add_distr, <-div_mod. +Qed. + +Lemma div_opp_l_nz : forall a b, b~=0 -> a mod b ~= 0 -> + (-a)/b == -(a/b)-sgn b. +Proof. +intros a b Hb Hab. symmetry. +apply div_unique with (abs b -(a mod b)). +rewrite lt_sub_lt_add_l. +rewrite <- le_add_le_sub_l. nzsimpl. +rewrite <- (add_0_l (abs b)) at 2. +rewrite <- add_lt_mono_r. +destruct (mod_always_pos a b); intuition order. +rewrite <- 2 add_opp_r, mul_add_distr_l, 2 mul_opp_r. +rewrite sgn_abs. +rewrite add_shuffle2, add_opp_diag_l; nzsimpl. +rewrite <-opp_add_distr, <-div_mod; order. +Qed. + +Lemma mod_opp_l_z : forall a b, b~=0 -> a mod b == 0 -> + (-a) mod b == 0. +Proof. +intros a b Hb Hab. symmetry. +apply mod_unique with (-(a/b)). +split; [order|now rewrite abs_pos]. +now rewrite <-opp_0, <-Hab, mul_opp_r, <-opp_add_distr, <-div_mod. +Qed. + +Lemma mod_opp_l_nz : forall a b, b~=0 -> a mod b ~= 0 -> + (-a) mod b == abs b - (a mod b). +Proof. +intros a b Hb Hab. symmetry. +apply mod_unique with (-(a/b)-sgn b). +rewrite lt_sub_lt_add_l. +rewrite <- le_add_le_sub_l. nzsimpl. +rewrite <- (add_0_l (abs b)) at 2. +rewrite <- add_lt_mono_r. +destruct (mod_always_pos a b); intuition order. +rewrite <- 2 add_opp_r, mul_add_distr_l, 2 mul_opp_r. +rewrite sgn_abs. +rewrite add_shuffle2, add_opp_diag_l; nzsimpl. +rewrite <-opp_add_distr, <-div_mod; order. +Qed. + +Lemma div_opp_opp_z : forall a b, b~=0 -> a mod b == 0 -> + (-a)/(-b) == a/b. +Proof. +intros. now rewrite div_opp_r, div_opp_l_z, opp_involutive. +Qed. + +Lemma div_opp_opp_nz : forall a b, b~=0 -> a mod b ~= 0 -> + (-a)/(-b) == a/b + sgn(b). +Proof. +intros. rewrite div_opp_r, div_opp_l_nz by trivial. +now rewrite opp_sub_distr, opp_involutive. +Qed. + +Lemma mod_opp_opp_z : forall a b, b~=0 -> a mod b == 0 -> + (-a) mod (-b) == 0. +Proof. +intros. now rewrite mod_opp_r, mod_opp_l_z. +Qed. + +Lemma mod_opp_opp_nz : forall a b, b~=0 -> a mod b ~= 0 -> + (-a) mod (-b) == abs b - a mod b. +Proof. +intros. now rewrite mod_opp_r, mod_opp_l_nz. +Qed. + +(** A division by itself returns 1 *) + +Lemma div_same : forall a, a~=0 -> a/a == 1. +Proof. +intros. symmetry. apply div_unique with 0. +split; [order|now rewrite abs_pos]. +now nzsimpl. +Qed. + +Lemma mod_same : forall a, a~=0 -> a mod a == 0. +Proof. +intros. +rewrite mod_eq, div_same by trivial. nzsimpl. apply sub_diag. +Qed. + +(** A division of a small number by a bigger one yields zero. *) + +Theorem div_small: forall a b, 0<=a<b -> a/b == 0. +Proof. exact div_small. Qed. + +(** Same situation, in term of modulo: *) + +Theorem mod_small: forall a b, 0<=a<b -> a mod b == a. +Proof. exact mod_small. Qed. + +(** * Basic values of divisions and modulo. *) + +Lemma div_0_l: forall a, a~=0 -> 0/a == 0. +Proof. +intros. pos_or_neg a. apply div_0_l; order. +apply opp_inj. rewrite <- div_opp_r, opp_0 by trivial. now apply div_0_l. +Qed. + +Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. +Proof. +intros; rewrite mod_eq, div_0_l; now nzsimpl. +Qed. + +Lemma div_1_r: forall a, a/1 == a. +Proof. +intros. symmetry. apply div_unique with 0. +assert (H:=lt_0_1); rewrite abs_pos; intuition; order. +now nzsimpl. +Qed. + +Lemma mod_1_r: forall a, a mod 1 == 0. +Proof. +intros. rewrite mod_eq, div_1_r; nzsimpl; auto using sub_diag. +apply neq_sym, lt_neq; apply lt_0_1. +Qed. + +Lemma div_1_l: forall a, 1<a -> 1/a == 0. +Proof. exact div_1_l. Qed. + +Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1. +Proof. exact mod_1_l. Qed. + +Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. +Proof. +intros. symmetry. apply div_unique with 0. +split; [order|now rewrite abs_pos]. +nzsimpl; apply mul_comm. +Qed. + +Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. +Proof. +intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag. +Qed. + +(** * Order results about mod and div *) + +(** A modulo cannot grow beyond its starting point. *) + +Theorem mod_le: forall a b, 0<=a -> b~=0 -> a mod b <= a. +Proof. +intros. pos_or_neg b. apply mod_le; order. +rewrite <- mod_opp_r by trivial. apply mod_le; order. +Qed. + +Theorem div_pos : forall a b, 0<=a -> 0<b -> 0<= a/b. +Proof. exact div_pos. Qed. + +Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b. +Proof. exact div_str_pos. Qed. + +Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> 0<=a<abs b). +Proof. +intros a b Hb. +split. +intros EQ. +rewrite (div_mod a b Hb), EQ; nzsimpl. +apply mod_always_pos. +intros. pos_or_neg b. +apply div_small. +now rewrite <- (abs_eq b). +apply opp_inj; rewrite opp_0, <- div_opp_r by trivial. +apply div_small. +rewrite <- (abs_neq' b) by order. trivial. +Qed. + +Lemma mod_small_iff : forall a b, b~=0 -> (a mod b == a <-> 0<=a<abs b). +Proof. +intros. +rewrite <- div_small_iff, mod_eq by trivial. +rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l. +rewrite eq_sym_iff, eq_mul_0. tauto. +Qed. + +(** As soon as the divisor is strictly greater than 1, + the division is strictly decreasing. *) + +Lemma div_lt : forall a b, 0<a -> 1<b -> a/b < a. +Proof. exact div_lt. Qed. + +(** [le] is compatible with a positive division. *) + +Lemma div_le_mono : forall a b c, 0<c -> a<=b -> a/c <= b/c. +Proof. +intros a b c Hc Hab. +rewrite lt_eq_cases in Hab. destruct Hab as [LT|EQ]; + [|rewrite EQ; order]. +rewrite <- lt_succ_r. +rewrite (mul_lt_mono_pos_l c) by order. +nzsimpl. +rewrite (add_lt_mono_r _ _ (a mod c)). +rewrite <- div_mod by order. +apply lt_le_trans with b; trivial. +rewrite (div_mod b c) at 1 by order. +rewrite <- add_assoc, <- add_le_mono_l. +apply le_trans with (c+0). +nzsimpl; destruct (mod_always_pos b c); try order. +rewrite abs_eq in *; order. +rewrite <- add_le_mono_l. destruct (mod_always_pos a c); order. +Qed. + +(** In this convention, [div] performs Rounding-Toward-Bottom + when divisor is positive, and Rounding-Toward-Top otherwise. + + Since we cannot speak of rational values here, we express this + fact by multiplying back by [b], and this leads to a nice + unique statement. +*) + +Lemma mul_div_le : forall a b, b~=0 -> b*(a/b) <= a. +Proof. +intros. +rewrite (div_mod a b) at 2; trivial. +rewrite <- (add_0_r (b*(a/b))) at 1. +rewrite <- add_le_mono_l. +now destruct (mod_always_pos a b). +Qed. + +(** Giving a reversed bound is slightly more complex *) + +Lemma mul_succ_div_gt: forall a b, 0<b -> a < b*(S (a/b)). +Proof. +intros. +nzsimpl. +rewrite (div_mod a b) at 1; try order. +rewrite <- add_lt_mono_l. +destruct (mod_always_pos a b). +rewrite abs_eq in *; order. +Qed. + +Lemma mul_pred_div_gt: forall a b, b<0 -> a < b*(P (a/b)). +Proof. +intros a b Hb. +rewrite mul_pred_r, <- add_opp_r. +rewrite (div_mod a b) at 1; try order. +rewrite <- add_lt_mono_l. +destruct (mod_always_pos a b). +rewrite <- opp_pos_neg in Hb. rewrite abs_neq' in *; order. +Qed. + +(** NB: The three previous properties could be used as + specifications for [div]. *) + +(** Inequality [mul_div_le] is exact iff the modulo is zero. *) + +Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). +Proof. +intros. +rewrite (div_mod a b) at 1; try order. +rewrite <- (add_0_r (b*(a/b))) at 2. +apply add_cancel_l. +Qed. + +(** Some additionnal inequalities about div. *) + +Theorem div_lt_upper_bound: + forall a b q, 0<b -> a < b*q -> a/b < q. +Proof. +intros. +rewrite (mul_lt_mono_pos_l b) by trivial. +apply le_lt_trans with a; trivial. +apply mul_div_le; order. +Qed. + +Theorem div_le_upper_bound: + forall a b q, 0<b -> a <= b*q -> a/b <= q. +Proof. +intros. +rewrite <- (div_mul q b) by order. +apply div_le_mono; trivial. now rewrite mul_comm. +Qed. + +Theorem div_le_lower_bound: + forall a b q, 0<b -> b*q <= a -> q <= a/b. +Proof. +intros. +rewrite <- (div_mul q b) by order. +apply div_le_mono; trivial. now rewrite mul_comm. +Qed. + +(** A division respects opposite monotonicity for the divisor *) + +Lemma div_le_compat_l: forall p q r, 0<=p -> 0<q<=r -> p/r <= p/q. +Proof. exact div_le_compat_l. Qed. + +(** * Relations between usual operations and mod and div *) + +Lemma mod_add : forall a b c, c~=0 -> + (a + b * c) mod c == a mod c. +Proof. +intros. +symmetry. +apply mod_unique with (a/c+b); trivial. +now apply mod_always_pos. +rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. +now rewrite mul_comm. +Qed. + +Lemma div_add : forall a b c, c~=0 -> + (a + b * c) / c == a / c + b. +Proof. +intros. +apply (mul_cancel_l _ _ c); try order. +apply (add_cancel_r _ _ ((a+b*c) mod c)). +rewrite <- div_mod, mod_add by order. +rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. +now rewrite mul_comm. +Qed. + +Lemma div_add_l: forall a b c, b~=0 -> + (a * b + c) / b == a + c / b. +Proof. + intros a b c. rewrite (add_comm _ c), (add_comm a). + now apply div_add. +Qed. + +(** Cancellations. *) + +(** With the current convention, the following isn't always true + when [c<0]: [-3*-1 / -2*-1 = 3/2 = 1] while [-3/-2 = 2] *) + +Lemma div_mul_cancel_r : forall a b c, b~=0 -> 0<c -> + (a*c)/(b*c) == a/b. +Proof. +intros. +symmetry. +apply div_unique with ((a mod b)*c). +(* ineqs *) +rewrite abs_mul, (abs_eq c) by order. +rewrite <-(mul_0_l c), <-mul_lt_mono_pos_r, <-mul_le_mono_pos_r by trivial. +apply mod_always_pos. +(* equation *) +rewrite (div_mod a b) at 1 by order. +rewrite mul_add_distr_r. +rewrite add_cancel_r. +rewrite <- 2 mul_assoc. now rewrite (mul_comm c). +Qed. + +Lemma div_mul_cancel_l : forall a b c, b~=0 -> 0<c -> + (c*a)/(c*b) == a/b. +Proof. +intros. rewrite !(mul_comm c); now apply div_mul_cancel_r. +Qed. + +Lemma mul_mod_distr_l: forall a b c, b~=0 -> 0<c -> + (c*a) mod (c*b) == c * (a mod b). +Proof. +intros. +rewrite <- (add_cancel_l _ _ ((c*b)* ((c*a)/(c*b)))). +rewrite <- div_mod. +rewrite div_mul_cancel_l by trivial. +rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. +apply div_mod; order. +rewrite <- neq_mul_0; intuition; order. +Qed. + +Lemma mul_mod_distr_r: forall a b c, b~=0 -> 0<c -> + (a*c) mod (b*c) == (a mod b) * c. +Proof. + intros. rewrite !(mul_comm _ c); now rewrite mul_mod_distr_l. +Qed. + + +(** Operations modulo. *) + +Theorem mod_mod: forall a n, n~=0 -> + (a mod n) mod n == a mod n. +Proof. +intros. rewrite mod_small_iff by trivial. +now apply mod_always_pos. +Qed. + +Lemma mul_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)*b) mod n == (a*b) mod n. +Proof. + intros a b n Hn. symmetry. + rewrite (div_mod a n) at 1 by order. + rewrite add_comm, (mul_comm n), (mul_comm _ b). + rewrite mul_add_distr_l, mul_assoc. + rewrite mod_add by trivial. + now rewrite mul_comm. +Qed. + +Lemma mul_mod_idemp_r : forall a b n, n~=0 -> + (a*(b mod n)) mod n == (a*b) mod n. +Proof. + intros. rewrite !(mul_comm a). now apply mul_mod_idemp_l. +Qed. + +Theorem mul_mod: forall a b n, n~=0 -> + (a * b) mod n == ((a mod n) * (b mod n)) mod n. +Proof. + intros. now rewrite mul_mod_idemp_l, mul_mod_idemp_r. +Qed. + +Lemma add_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)+b) mod n == (a+b) mod n. +Proof. + intros a b n Hn. symmetry. + rewrite (div_mod a n) at 1 by order. + rewrite <- add_assoc, add_comm, mul_comm. + now rewrite mod_add. +Qed. + +Lemma add_mod_idemp_r : forall a b n, n~=0 -> + (a+(b mod n)) mod n == (a+b) mod n. +Proof. + intros. rewrite !(add_comm a). now apply add_mod_idemp_l. +Qed. + +Theorem add_mod: forall a b n, n~=0 -> + (a+b) mod n == (a mod n + b mod n) mod n. +Proof. + intros. now rewrite add_mod_idemp_l, add_mod_idemp_r. +Qed. + +(** With the current convention, the following result isn't always + true for negative divisors. For instance + [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ]. *) + +Lemma div_div : forall a b c, 0<b -> 0<c -> + (a/b)/c == a/(b*c). +Proof. + intros a b c Hb Hc. + apply div_unique with (b*((a/b) mod c) + a mod b). + (* begin 0<= ... <abs(b*c) *) + rewrite abs_mul. + destruct (mod_always_pos (a/b) c), (mod_always_pos a b). + split. + apply add_nonneg_nonneg; trivial. + apply mul_nonneg_nonneg; order. + apply lt_le_trans with (b*((a/b) mod c) + abs b). + now rewrite <- add_lt_mono_l. + rewrite (abs_eq b) by order. + now rewrite <- mul_succ_r, <- mul_le_mono_pos_l, le_succ_l. + (* end 0<= ... < abs(b*c) *) + rewrite (div_mod a b) at 1 by order. + rewrite add_assoc, add_cancel_r. + rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. + apply div_mod; order. +Qed. + +(** A last inequality: *) + +Theorem div_mul_le: + forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a/b) <= (c*a)/b. +Proof. exact div_mul_le. Qed. + +(** mod is related to divisibility *) + +Lemma mod_divides : forall a b, b~=0 -> + (a mod b == 0 <-> exists c, a == b*c). +Proof. +intros a b Hb. split. +intros Hab. exists (a/b). rewrite (div_mod a b Hb) at 1. + rewrite Hab; now nzsimpl. +intros (c,Hc). +rewrite Hc, mul_comm. +now apply mod_mul. +Qed. + + +End ZDivPropFunct. + diff --git a/theories/Numbers/Integer/Abstract/ZDivFloor.v b/theories/Numbers/Integer/Abstract/ZDivFloor.v new file mode 100644 index 00000000..1e7624ba --- /dev/null +++ b/theories/Numbers/Integer/Abstract/ZDivFloor.v @@ -0,0 +1,632 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(** * Euclidean Division for integers (Floor convention) + + We use here the convention known as Floor, or Round-Toward-Bottom, + where [a/b] is the closest integer below the exact fraction. + It can be summarized by: + + [a = bq+r /\ 0 <= |r| < |b| /\ Sign(r) = Sign(b)] + + This is the convention followed historically by [Zdiv] in Coq, and + corresponds to convention "F" in the following paper: + + R. Boute, "The Euclidean definition of the functions div and mod", + ACM Transactions on Programming Languages and Systems, + Vol. 14, No.2, pp. 127-144, April 1992. + + See files [ZDivTrunc] and [ZDivEucl] for others conventions. +*) + +Require Import ZAxioms ZProperties NZDiv. + +Module Type ZDivSpecific (Import Z:ZAxiomsSig')(Import DM : DivMod' Z). + Axiom mod_pos_bound : forall a b, 0 < b -> 0 <= a mod b < b. + Axiom mod_neg_bound : forall a b, b < 0 -> b < a mod b <= 0. +End ZDivSpecific. + +Module Type ZDiv (Z:ZAxiomsSig) + := DivMod Z <+ NZDivCommon Z <+ ZDivSpecific Z. + +Module Type ZDivSig := ZAxiomsExtSig <+ ZDiv. +Module Type ZDivSig' := ZAxiomsExtSig' <+ ZDiv <+ DivModNotation. + +Module ZDivPropFunct (Import Z : ZDivSig')(Import ZP : ZPropSig Z). + +(** We benefit from what already exists for NZ *) + + Module ZD <: NZDiv Z. + Definition div := div. + Definition modulo := modulo. + Definition div_wd := div_wd. + Definition mod_wd := mod_wd. + Definition div_mod := div_mod. + Lemma mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b. + Proof. intros. now apply mod_pos_bound. Qed. + End ZD. + Module Import NZDivP := NZDivPropFunct Z ZP ZD. + +(** Another formulation of the main equation *) + +Lemma mod_eq : + forall a b, b~=0 -> a mod b == a - b*(a/b). +Proof. +intros. +rewrite <- add_move_l. +symmetry. now apply div_mod. +Qed. + +(** Uniqueness theorems *) + +Theorem div_mod_unique : forall b q1 q2 r1 r2 : t, + (0<=r1<b \/ b<r1<=0) -> (0<=r2<b \/ b<r2<=0) -> + b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. +Proof. +intros b q1 q2 r1 r2 Hr1 Hr2 EQ. +destruct Hr1; destruct Hr2; try (intuition; order). +apply div_mod_unique with b; trivial. +rewrite <- (opp_inj_wd r1 r2). +apply div_mod_unique with (-b); trivial. +rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. +rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. +now rewrite 2 mul_opp_l, <- 2 opp_add_distr, opp_inj_wd. +Qed. + +Theorem div_unique: + forall a b q r, (0<=r<b \/ b<r<=0) -> a == b*q + r -> q == a/b. +Proof. +intros a b q r Hr EQ. +assert (Hb : b~=0) by (destruct Hr; intuition; order). +destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. +destruct Hr; [left; apply mod_pos_bound|right; apply mod_neg_bound]; + intuition order. +now rewrite <- div_mod. +Qed. + +Theorem div_unique_pos: + forall a b q r, 0<=r<b -> a == b*q + r -> q == a/b. +Proof. intros; apply div_unique with r; auto. Qed. + +Theorem div_unique_neg: + forall a b q r, 0<=r<b -> a == b*q + r -> q == a/b. +Proof. intros; apply div_unique with r; auto. Qed. + +Theorem mod_unique: + forall a b q r, (0<=r<b \/ b<r<=0) -> a == b*q + r -> r == a mod b. +Proof. +intros a b q r Hr EQ. +assert (Hb : b~=0) by (destruct Hr; intuition; order). +destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. +destruct Hr; [left; apply mod_pos_bound|right; apply mod_neg_bound]; + intuition order. +now rewrite <- div_mod. +Qed. + +Theorem mod_unique_pos: + forall a b q r, 0<=r<b -> a == b*q + r -> r == a mod b. +Proof. intros; apply mod_unique with q; auto. Qed. + +Theorem mod_unique_neg: + forall a b q r, b<r<=0 -> a == b*q + r -> r == a mod b. +Proof. intros; apply mod_unique with q; auto. Qed. + +(** Sign rules *) + +Ltac pos_or_neg a := + let LT := fresh "LT" in + let LE := fresh "LE" in + destruct (le_gt_cases 0 a) as [LE|LT]; [|rewrite <- opp_pos_neg in LT]. + +Fact mod_bound_or : forall a b, b~=0 -> 0<=a mod b<b \/ b<a mod b<=0. +Proof. +intros. +destruct (lt_ge_cases 0 b); [left|right]. + apply mod_pos_bound; trivial. apply mod_neg_bound; order. +Qed. + +Fact opp_mod_bound_or : forall a b, b~=0 -> + 0 <= -(a mod b) < -b \/ -b < -(a mod b) <= 0. +Proof. +intros. +destruct (lt_ge_cases 0 b); [right|left]. +rewrite <- opp_lt_mono, opp_nonpos_nonneg. + destruct (mod_pos_bound a b); intuition; order. +rewrite <- opp_lt_mono, opp_nonneg_nonpos. + destruct (mod_neg_bound a b); intuition; order. +Qed. + +Lemma div_opp_opp : forall a b, b~=0 -> -a/-b == a/b. +Proof. +intros. symmetry. apply div_unique with (- (a mod b)). +now apply opp_mod_bound_or. +rewrite mul_opp_l, <- opp_add_distr, <- div_mod; order. +Qed. + +Lemma mod_opp_opp : forall a b, b~=0 -> (-a) mod (-b) == - (a mod b). +Proof. +intros. symmetry. apply mod_unique with (a/b). +now apply opp_mod_bound_or. +rewrite mul_opp_l, <- opp_add_distr, <- div_mod; order. +Qed. + +(** With the current conventions, the other sign rules are rather complex. *) + +Lemma div_opp_l_z : + forall a b, b~=0 -> a mod b == 0 -> (-a)/b == -(a/b). +Proof. +intros a b Hb H. symmetry. apply div_unique with 0. +destruct (lt_ge_cases 0 b); [left|right]; intuition; order. +rewrite <- opp_0, <- H. +rewrite mul_opp_r, <- opp_add_distr, <- div_mod; order. +Qed. + +Lemma div_opp_l_nz : + forall a b, b~=0 -> a mod b ~= 0 -> (-a)/b == -(a/b)-1. +Proof. +intros a b Hb H. symmetry. apply div_unique with (b - a mod b). +destruct (lt_ge_cases 0 b); [left|right]. +rewrite le_0_sub. rewrite <- (sub_0_r b) at 5. rewrite <- sub_lt_mono_l. +destruct (mod_pos_bound a b); intuition; order. +rewrite le_sub_0. rewrite <- (sub_0_r b) at 1. rewrite <- sub_lt_mono_l. +destruct (mod_neg_bound a b); intuition; order. +rewrite <- (add_opp_r b), mul_sub_distr_l, mul_1_r, sub_add_simpl_r_l. +rewrite mul_opp_r, <-opp_add_distr, <-div_mod; order. +Qed. + +Lemma mod_opp_l_z : + forall a b, b~=0 -> a mod b == 0 -> (-a) mod b == 0. +Proof. +intros a b Hb H. symmetry. apply mod_unique with (-(a/b)). +destruct (lt_ge_cases 0 b); [left|right]; intuition; order. +rewrite <- opp_0, <- H. +rewrite mul_opp_r, <- opp_add_distr, <- div_mod; order. +Qed. + +Lemma mod_opp_l_nz : + forall a b, b~=0 -> a mod b ~= 0 -> (-a) mod b == b - a mod b. +Proof. +intros a b Hb H. symmetry. apply mod_unique with (-(a/b)-1). +destruct (lt_ge_cases 0 b); [left|right]. +rewrite le_0_sub. rewrite <- (sub_0_r b) at 5. rewrite <- sub_lt_mono_l. +destruct (mod_pos_bound a b); intuition; order. +rewrite le_sub_0. rewrite <- (sub_0_r b) at 1. rewrite <- sub_lt_mono_l. +destruct (mod_neg_bound a b); intuition; order. +rewrite <- (add_opp_r b), mul_sub_distr_l, mul_1_r, sub_add_simpl_r_l. +rewrite mul_opp_r, <-opp_add_distr, <-div_mod; order. +Qed. + +Lemma div_opp_r_z : + forall a b, b~=0 -> a mod b == 0 -> a/(-b) == -(a/b). +Proof. +intros. rewrite <- (opp_involutive a) at 1. +rewrite div_opp_opp; auto using div_opp_l_z. +Qed. + +Lemma div_opp_r_nz : + forall a b, b~=0 -> a mod b ~= 0 -> a/(-b) == -(a/b)-1. +Proof. +intros. rewrite <- (opp_involutive a) at 1. +rewrite div_opp_opp; auto using div_opp_l_nz. +Qed. + +Lemma mod_opp_r_z : + forall a b, b~=0 -> a mod b == 0 -> a mod (-b) == 0. +Proof. +intros. rewrite <- (opp_involutive a) at 1. +now rewrite mod_opp_opp, mod_opp_l_z, opp_0. +Qed. + +Lemma mod_opp_r_nz : + forall a b, b~=0 -> a mod b ~= 0 -> a mod (-b) == (a mod b) - b. +Proof. +intros. rewrite <- (opp_involutive a) at 1. +rewrite mod_opp_opp, mod_opp_l_nz by trivial. +now rewrite opp_sub_distr, add_comm, add_opp_r. +Qed. + +(** The sign of [a mod b] is the one of [b] *) + +(* TODO: a proper sgn function and theory *) + +Lemma mod_sign : forall a b, b~=0 -> (0 <= (a mod b) * b). +Proof. +intros. destruct (lt_ge_cases 0 b). +apply mul_nonneg_nonneg; destruct (mod_pos_bound a b); order. +apply mul_nonpos_nonpos; destruct (mod_neg_bound a b); order. +Qed. + +(** A division by itself returns 1 *) + +Lemma div_same : forall a, a~=0 -> a/a == 1. +Proof. +intros. pos_or_neg a. apply div_same; order. +rewrite <- div_opp_opp by trivial. now apply div_same. +Qed. + +Lemma mod_same : forall a, a~=0 -> a mod a == 0. +Proof. +intros. rewrite mod_eq, div_same by trivial. nzsimpl. apply sub_diag. +Qed. + +(** A division of a small number by a bigger one yields zero. *) + +Theorem div_small: forall a b, 0<=a<b -> a/b == 0. +Proof. exact div_small. Qed. + +(** Same situation, in term of modulo: *) + +Theorem mod_small: forall a b, 0<=a<b -> a mod b == a. +Proof. exact mod_small. Qed. + +(** * Basic values of divisions and modulo. *) + +Lemma div_0_l: forall a, a~=0 -> 0/a == 0. +Proof. +intros. pos_or_neg a. apply div_0_l; order. +rewrite <- div_opp_opp, opp_0 by trivial. now apply div_0_l. +Qed. + +Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. +Proof. +intros; rewrite mod_eq, div_0_l; now nzsimpl. +Qed. + +Lemma div_1_r: forall a, a/1 == a. +Proof. +intros. symmetry. apply div_unique with 0. left. split; order || apply lt_0_1. +now nzsimpl. +Qed. + +Lemma mod_1_r: forall a, a mod 1 == 0. +Proof. +intros. rewrite mod_eq, div_1_r; nzsimpl; auto using sub_diag. +intro EQ; symmetry in EQ; revert EQ; apply lt_neq; apply lt_0_1. +Qed. + +Lemma div_1_l: forall a, 1<a -> 1/a == 0. +Proof. exact div_1_l. Qed. + +Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1. +Proof. exact mod_1_l. Qed. + +Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. +Proof. +intros. symmetry. apply div_unique with 0. +destruct (lt_ge_cases 0 b); [left|right]; split; order. +nzsimpl; apply mul_comm. +Qed. + +Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. +Proof. +intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag. +Qed. + +(** * Order results about mod and div *) + +(** A modulo cannot grow beyond its starting point. *) + +Theorem mod_le: forall a b, 0<=a -> 0<b -> a mod b <= a. +Proof. exact mod_le. Qed. + +Theorem div_pos : forall a b, 0<=a -> 0<b -> 0<= a/b. +Proof. exact div_pos. Qed. + +Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b. +Proof. exact div_str_pos. Qed. + +Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> 0<=a<b \/ b<a<=0). +Proof. +intros a b Hb. +split. +intros EQ. +rewrite (div_mod a b Hb), EQ; nzsimpl. +now apply mod_bound_or. +destruct 1. now apply div_small. +rewrite <- div_opp_opp by trivial. apply div_small; trivial. +rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. +Qed. + +Lemma mod_small_iff : forall a b, b~=0 -> (a mod b == a <-> 0<=a<b \/ b<a<=0). +Proof. +intros. +rewrite <- div_small_iff, mod_eq by trivial. +rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l. +rewrite eq_sym_iff, eq_mul_0. tauto. +Qed. + +(** As soon as the divisor is strictly greater than 1, + the division is strictly decreasing. *) + +Lemma div_lt : forall a b, 0<a -> 1<b -> a/b < a. +Proof. exact div_lt. Qed. + +(** [le] is compatible with a positive division. *) + +Lemma div_le_mono : forall a b c, 0<c -> a<=b -> a/c <= b/c. +Proof. +intros a b c Hc Hab. +rewrite lt_eq_cases in Hab. destruct Hab as [LT|EQ]; + [|rewrite EQ; order]. +rewrite <- lt_succ_r. +rewrite (mul_lt_mono_pos_l c) by order. +nzsimpl. +rewrite (add_lt_mono_r _ _ (a mod c)). +rewrite <- div_mod by order. +apply lt_le_trans with b; trivial. +rewrite (div_mod b c) at 1 by order. +rewrite <- add_assoc, <- add_le_mono_l. +apply le_trans with (c+0). +nzsimpl; destruct (mod_pos_bound b c); order. +rewrite <- add_le_mono_l. destruct (mod_pos_bound a c); order. +Qed. + +(** In this convention, [div] performs Rounding-Toward-Bottom. + + Since we cannot speak of rational values here, we express this + fact by multiplying back by [b], and this leads to separates + statements according to the sign of [b]. + + First, [a/b] is below the exact fraction ... +*) + +Lemma mul_div_le : forall a b, 0<b -> b*(a/b) <= a. +Proof. +intros. +rewrite (div_mod a b) at 2; try order. +rewrite <- (add_0_r (b*(a/b))) at 1. +rewrite <- add_le_mono_l. +now destruct (mod_pos_bound a b). +Qed. + +Lemma mul_div_ge : forall a b, b<0 -> a <= b*(a/b). +Proof. +intros. rewrite <- div_opp_opp, opp_le_mono, <-mul_opp_l by order. +apply mul_div_le. now rewrite opp_pos_neg. +Qed. + +(** ... and moreover it is the larger such integer, since [S(a/b)] + is strictly above the exact fraction. +*) + +Lemma mul_succ_div_gt: forall a b, 0<b -> a < b*(S (a/b)). +Proof. +intros. +nzsimpl. +rewrite (div_mod a b) at 1; try order. +rewrite <- add_lt_mono_l. +destruct (mod_pos_bound a b); order. +Qed. + +Lemma mul_succ_div_lt: forall a b, b<0 -> b*(S (a/b)) < a. +Proof. +intros. rewrite <- div_opp_opp, opp_lt_mono, <-mul_opp_l by order. +apply mul_succ_div_gt. now rewrite opp_pos_neg. +Qed. + +(** NB: The four previous properties could be used as + specifications for [div]. *) + +(** Inequality [mul_div_le] is exact iff the modulo is zero. *) + +Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). +Proof. +intros. +rewrite (div_mod a b) at 1; try order. +rewrite <- (add_0_r (b*(a/b))) at 2. +apply add_cancel_l. +Qed. + +(** Some additionnal inequalities about div. *) + +Theorem div_lt_upper_bound: + forall a b q, 0<b -> a < b*q -> a/b < q. +Proof. +intros. +rewrite (mul_lt_mono_pos_l b) by trivial. +apply le_lt_trans with a; trivial. +now apply mul_div_le. +Qed. + +Theorem div_le_upper_bound: + forall a b q, 0<b -> a <= b*q -> a/b <= q. +Proof. +intros. +rewrite <- (div_mul q b) by order. +apply div_le_mono; trivial. now rewrite mul_comm. +Qed. + +Theorem div_le_lower_bound: + forall a b q, 0<b -> b*q <= a -> q <= a/b. +Proof. +intros. +rewrite <- (div_mul q b) by order. +apply div_le_mono; trivial. now rewrite mul_comm. +Qed. + +(** A division respects opposite monotonicity for the divisor *) + +Lemma div_le_compat_l: forall p q r, 0<=p -> 0<q<=r -> p/r <= p/q. +Proof. exact div_le_compat_l. Qed. + +(** * Relations between usual operations and mod and div *) + +Lemma mod_add : forall a b c, c~=0 -> + (a + b * c) mod c == a mod c. +Proof. +intros. +symmetry. +apply mod_unique with (a/c+b); trivial. +now apply mod_bound_or. +rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. +now rewrite mul_comm. +Qed. + +Lemma div_add : forall a b c, c~=0 -> + (a + b * c) / c == a / c + b. +Proof. +intros. +apply (mul_cancel_l _ _ c); try order. +apply (add_cancel_r _ _ ((a+b*c) mod c)). +rewrite <- div_mod, mod_add by order. +rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. +now rewrite mul_comm. +Qed. + +Lemma div_add_l: forall a b c, b~=0 -> + (a * b + c) / b == a + c / b. +Proof. + intros a b c. rewrite (add_comm _ c), (add_comm a). + now apply div_add. +Qed. + +(** Cancellations. *) + +Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> + (a*c)/(b*c) == a/b. +Proof. +intros. +symmetry. +apply div_unique with ((a mod b)*c). +(* ineqs *) +destruct (lt_ge_cases 0 c). +rewrite <-(mul_0_l c), <-2mul_lt_mono_pos_r, <-2mul_le_mono_pos_r by trivial. +now apply mod_bound_or. +rewrite <-(mul_0_l c), <-2mul_lt_mono_neg_r, <-2mul_le_mono_neg_r by order. +destruct (mod_bound_or a b); tauto. +(* equation *) +rewrite (div_mod a b) at 1 by order. +rewrite mul_add_distr_r. +rewrite add_cancel_r. +rewrite <- 2 mul_assoc. now rewrite (mul_comm c). +Qed. + +Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> + (c*a)/(c*b) == a/b. +Proof. +intros. rewrite !(mul_comm c); now apply div_mul_cancel_r. +Qed. + +Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 -> + (c*a) mod (c*b) == c * (a mod b). +Proof. +intros. +rewrite <- (add_cancel_l _ _ ((c*b)* ((c*a)/(c*b)))). +rewrite <- div_mod. +rewrite div_mul_cancel_l by trivial. +rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. +apply div_mod; order. +rewrite <- neq_mul_0; auto. +Qed. + +Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 -> + (a*c) mod (b*c) == (a mod b) * c. +Proof. + intros. rewrite !(mul_comm _ c); now rewrite mul_mod_distr_l. +Qed. + + +(** Operations modulo. *) + +Theorem mod_mod: forall a n, n~=0 -> + (a mod n) mod n == a mod n. +Proof. +intros. rewrite mod_small_iff by trivial. +now apply mod_bound_or. +Qed. + +Lemma mul_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)*b) mod n == (a*b) mod n. +Proof. + intros a b n Hn. symmetry. + rewrite (div_mod a n) at 1 by order. + rewrite add_comm, (mul_comm n), (mul_comm _ b). + rewrite mul_add_distr_l, mul_assoc. + intros. rewrite mod_add by trivial. + now rewrite mul_comm. +Qed. + +Lemma mul_mod_idemp_r : forall a b n, n~=0 -> + (a*(b mod n)) mod n == (a*b) mod n. +Proof. + intros. rewrite !(mul_comm a). now apply mul_mod_idemp_l. +Qed. + +Theorem mul_mod: forall a b n, n~=0 -> + (a * b) mod n == ((a mod n) * (b mod n)) mod n. +Proof. + intros. now rewrite mul_mod_idemp_l, mul_mod_idemp_r. +Qed. + +Lemma add_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)+b) mod n == (a+b) mod n. +Proof. + intros a b n Hn. symmetry. + rewrite (div_mod a n) at 1 by order. + rewrite <- add_assoc, add_comm, mul_comm. + intros. now rewrite mod_add. +Qed. + +Lemma add_mod_idemp_r : forall a b n, n~=0 -> + (a+(b mod n)) mod n == (a+b) mod n. +Proof. + intros. rewrite !(add_comm a). now apply add_mod_idemp_l. +Qed. + +Theorem add_mod: forall a b n, n~=0 -> + (a+b) mod n == (a mod n + b mod n) mod n. +Proof. + intros. now rewrite add_mod_idemp_l, add_mod_idemp_r. +Qed. + +(** With the current convention, the following result isn't always + true for negative divisors. For instance + [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ]. *) + +Lemma div_div : forall a b c, 0<b -> 0<c -> + (a/b)/c == a/(b*c). +Proof. + intros a b c Hb Hc. + apply div_unique with (b*((a/b) mod c) + a mod b). + (* begin 0<= ... <b*c \/ ... *) + left. + destruct (mod_pos_bound (a/b) c), (mod_pos_bound a b); trivial. + split. + apply add_nonneg_nonneg; trivial. + apply mul_nonneg_nonneg; order. + apply lt_le_trans with (b*((a/b) mod c) + b). + now rewrite <- add_lt_mono_l. + now rewrite <- mul_succ_r, <- mul_le_mono_pos_l, le_succ_l. + (* end 0<= ... < b*c \/ ... *) + rewrite (div_mod a b) at 1 by order. + rewrite add_assoc, add_cancel_r. + rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. + apply div_mod; order. +Qed. + +(** A last inequality: *) + +Theorem div_mul_le: + forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a/b) <= (c*a)/b. +Proof. exact div_mul_le. Qed. + +(** mod is related to divisibility *) + +Lemma mod_divides : forall a b, b~=0 -> + (a mod b == 0 <-> exists c, a == b*c). +Proof. +intros a b Hb. split. +intros Hab. exists (a/b). rewrite (div_mod a b Hb) at 1. + rewrite Hab. now nzsimpl. +intros (c,Hc). +rewrite Hc, mul_comm. +now apply mod_mul. +Qed. + +End ZDivPropFunct. + diff --git a/theories/Numbers/Integer/Abstract/ZDivTrunc.v b/theories/Numbers/Integer/Abstract/ZDivTrunc.v new file mode 100644 index 00000000..3200ba2a --- /dev/null +++ b/theories/Numbers/Integer/Abstract/ZDivTrunc.v @@ -0,0 +1,532 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(** * Euclidean Division for integers (Trunc convention) + + We use here the convention known as Trunc, or Round-Toward-Zero, + where [a/b] is the integer with the largest absolute value to + be between zero and the exact fraction. It can be summarized by: + + [a = bq+r /\ 0 <= |r| < |b| /\ Sign(r) = Sign(a)] + + This is the convention of Ocaml and many other systems (C, ASM, ...). + This convention is named "T" in the following paper: + + R. Boute, "The Euclidean definition of the functions div and mod", + ACM Transactions on Programming Languages and Systems, + Vol. 14, No.2, pp. 127-144, April 1992. + + See files [ZDivFloor] and [ZDivEucl] for others conventions. +*) + +Require Import ZAxioms ZProperties NZDiv. + +Module Type ZDivSpecific (Import Z:ZAxiomsSig')(Import DM : DivMod' Z). + Axiom mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b. + Axiom mod_opp_l : forall a b, b ~= 0 -> (-a) mod b == - (a mod b). + Axiom mod_opp_r : forall a b, b ~= 0 -> a mod (-b) == a mod b. +End ZDivSpecific. + +Module Type ZDiv (Z:ZAxiomsSig) + := DivMod Z <+ NZDivCommon Z <+ ZDivSpecific Z. + +Module Type ZDivSig := ZAxiomsExtSig <+ ZDiv. +Module Type ZDivSig' := ZAxiomsExtSig' <+ ZDiv <+ DivModNotation. + +Module ZDivPropFunct (Import Z : ZDivSig')(Import ZP : ZPropSig Z). + +(** We benefit from what already exists for NZ *) + + Module Import NZDivP := NZDivPropFunct Z ZP Z. + +Ltac pos_or_neg a := + let LT := fresh "LT" in + let LE := fresh "LE" in + destruct (le_gt_cases 0 a) as [LE|LT]; [|rewrite <- opp_pos_neg in LT]. + +(** Another formulation of the main equation *) + +Lemma mod_eq : + forall a b, b~=0 -> a mod b == a - b*(a/b). +Proof. +intros. +rewrite <- add_move_l. +symmetry. now apply div_mod. +Qed. + +(** A few sign rules (simple ones) *) + +Lemma mod_opp_opp : forall a b, b ~= 0 -> (-a) mod (-b) == - (a mod b). +Proof. intros. now rewrite mod_opp_r, mod_opp_l. Qed. + +Lemma div_opp_l : forall a b, b ~= 0 -> (-a)/b == -(a/b). +Proof. +intros. +rewrite <- (mul_cancel_l _ _ b) by trivial. +rewrite <- (add_cancel_r _ _ ((-a) mod b)). +now rewrite <- div_mod, mod_opp_l, mul_opp_r, <- opp_add_distr, <- div_mod. +Qed. + +Lemma div_opp_r : forall a b, b ~= 0 -> a/(-b) == -(a/b). +Proof. +intros. +assert (-b ~= 0) by (now rewrite eq_opp_l, opp_0). +rewrite <- (mul_cancel_l _ _ (-b)) by trivial. +rewrite <- (add_cancel_r _ _ (a mod (-b))). +now rewrite <- div_mod, mod_opp_r, mul_opp_opp, <- div_mod. +Qed. + +Lemma div_opp_opp : forall a b, b ~= 0 -> (-a)/(-b) == a/b. +Proof. intros. now rewrite div_opp_r, div_opp_l, opp_involutive. Qed. + +(** The sign of [a mod b] is the one of [a] *) + +(* TODO: a proper sgn function and theory *) + +Lemma mod_sign : forall a b, b~=0 -> 0 <= (a mod b) * a. +Proof. +assert (Aux : forall a b, 0<b -> 0 <= (a mod b) * a). + intros. pos_or_neg a. + apply mul_nonneg_nonneg; trivial. now destruct (mod_bound a b). + rewrite <- mul_opp_opp, <- mod_opp_l by order. + apply mul_nonneg_nonneg; try order. destruct (mod_bound (-a) b); order. +intros. pos_or_neg b. apply Aux; order. +rewrite <- mod_opp_r by order. apply Aux; order. +Qed. + + +(** Uniqueness theorems *) + +Theorem div_mod_unique : forall b q1 q2 r1 r2 : t, + (0<=r1<b \/ b<r1<=0) -> (0<=r2<b \/ b<r2<=0) -> + b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. +Proof. +intros b q1 q2 r1 r2 Hr1 Hr2 EQ. +destruct Hr1; destruct Hr2; try (intuition; order). +apply div_mod_unique with b; trivial. +rewrite <- (opp_inj_wd r1 r2). +apply div_mod_unique with (-b); trivial. +rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. +rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. +now rewrite 2 mul_opp_l, <- 2 opp_add_distr, opp_inj_wd. +Qed. + +Theorem div_unique: + forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> q == a/b. +Proof. intros; now apply div_unique with r. Qed. + +Theorem mod_unique: + forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> r == a mod b. +Proof. intros; now apply mod_unique with q. Qed. + +(** A division by itself returns 1 *) + +Lemma div_same : forall a, a~=0 -> a/a == 1. +Proof. +intros. pos_or_neg a. apply div_same; order. +rewrite <- div_opp_opp by trivial. now apply div_same. +Qed. + +Lemma mod_same : forall a, a~=0 -> a mod a == 0. +Proof. +intros. rewrite mod_eq, div_same by trivial. nzsimpl. apply sub_diag. +Qed. + +(** A division of a small number by a bigger one yields zero. *) + +Theorem div_small: forall a b, 0<=a<b -> a/b == 0. +Proof. exact div_small. Qed. + +(** Same situation, in term of modulo: *) + +Theorem mod_small: forall a b, 0<=a<b -> a mod b == a. +Proof. exact mod_small. Qed. + +(** * Basic values of divisions and modulo. *) + +Lemma div_0_l: forall a, a~=0 -> 0/a == 0. +Proof. +intros. pos_or_neg a. apply div_0_l; order. +rewrite <- div_opp_opp, opp_0 by trivial. now apply div_0_l. +Qed. + +Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. +Proof. +intros; rewrite mod_eq, div_0_l; now nzsimpl. +Qed. + +Lemma div_1_r: forall a, a/1 == a. +Proof. +intros. pos_or_neg a. now apply div_1_r. +apply opp_inj. rewrite <- div_opp_l. apply div_1_r; order. +intro EQ; symmetry in EQ; revert EQ; apply lt_neq, lt_0_1. +Qed. + +Lemma mod_1_r: forall a, a mod 1 == 0. +Proof. +intros. rewrite mod_eq, div_1_r; nzsimpl; auto using sub_diag. +intro EQ; symmetry in EQ; revert EQ; apply lt_neq; apply lt_0_1. +Qed. + +Lemma div_1_l: forall a, 1<a -> 1/a == 0. +Proof. exact div_1_l. Qed. + +Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1. +Proof. exact mod_1_l. Qed. + +Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. +Proof. +intros. pos_or_neg a; pos_or_neg b. apply div_mul; order. +rewrite <- div_opp_opp, <- mul_opp_r by order. apply div_mul; order. +rewrite <- opp_inj_wd, <- div_opp_l, <- mul_opp_l by order. apply div_mul; order. +rewrite <- opp_inj_wd, <- div_opp_r, <- mul_opp_opp by order. apply div_mul; order. +Qed. + +Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. +Proof. +intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag. +Qed. + +(** * Order results about mod and div *) + +(** A modulo cannot grow beyond its starting point. *) + +Theorem mod_le: forall a b, 0<=a -> 0<b -> a mod b <= a. +Proof. exact mod_le. Qed. + +Theorem div_pos : forall a b, 0<=a -> 0<b -> 0<= a/b. +Proof. exact div_pos. Qed. + +Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b. +Proof. exact div_str_pos. Qed. + +Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> abs a < abs b). +Proof. +intros. pos_or_neg a; pos_or_neg b. +rewrite div_small_iff; try order. rewrite 2 abs_eq; intuition; order. +rewrite <- opp_inj_wd, opp_0, <- div_opp_r, div_small_iff by order. + rewrite (abs_eq a), (abs_neq' b); intuition; order. +rewrite <- opp_inj_wd, opp_0, <- div_opp_l, div_small_iff by order. + rewrite (abs_neq' a), (abs_eq b); intuition; order. +rewrite <- div_opp_opp, div_small_iff by order. + rewrite (abs_neq' a), (abs_neq' b); intuition; order. +Qed. + +Lemma mod_small_iff : forall a b, b~=0 -> (a mod b == a <-> abs a < abs b). +Proof. +intros. rewrite mod_eq, <- div_small_iff by order. +rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l. +rewrite eq_sym_iff, eq_mul_0. tauto. +Qed. + +(** As soon as the divisor is strictly greater than 1, + the division is strictly decreasing. *) + +Lemma div_lt : forall a b, 0<a -> 1<b -> a/b < a. +Proof. exact div_lt. Qed. + +(** [le] is compatible with a positive division. *) + +Lemma div_le_mono : forall a b c, 0<c -> a<=b -> a/c <= b/c. +Proof. +intros. pos_or_neg a. apply div_le_mono; auto. +pos_or_neg b. apply le_trans with 0. + rewrite <- opp_nonneg_nonpos, <- div_opp_l by order. + apply div_pos; order. + apply div_pos; order. +rewrite opp_le_mono in *. rewrite <- 2 div_opp_l by order. + apply div_le_mono; intuition; order. +Qed. + +(** With this choice of division, + rounding of div is always done toward zero: *) + +Lemma mul_div_le : forall a b, 0<=a -> b~=0 -> 0 <= b*(a/b) <= a. +Proof. +intros. pos_or_neg b. +split. +apply mul_nonneg_nonneg; [|apply div_pos]; order. +apply mul_div_le; order. +rewrite <- mul_opp_opp, <- div_opp_r by order. +split. +apply mul_nonneg_nonneg; [|apply div_pos]; order. +apply mul_div_le; order. +Qed. + +Lemma mul_div_ge : forall a b, a<=0 -> b~=0 -> a <= b*(a/b) <= 0. +Proof. +intros. +rewrite <- opp_nonneg_nonpos, opp_le_mono, <-mul_opp_r, <-div_opp_l by order. +rewrite <- opp_nonneg_nonpos in *. +destruct (mul_div_le (-a) b); tauto. +Qed. + +(** For positive numbers, considering [S (a/b)] leads to an upper bound for [a] *) + +Lemma mul_succ_div_gt: forall a b, 0<=a -> 0<b -> a < b*(S (a/b)). +Proof. exact mul_succ_div_gt. Qed. + +(** Similar results with negative numbers *) + +Lemma mul_pred_div_lt: forall a b, a<=0 -> 0<b -> b*(P (a/b)) < a. +Proof. +intros. +rewrite opp_lt_mono, <- mul_opp_r, opp_pred, <- div_opp_l by order. +rewrite <- opp_nonneg_nonpos in *. +now apply mul_succ_div_gt. +Qed. + +Lemma mul_pred_div_gt: forall a b, 0<=a -> b<0 -> a < b*(P (a/b)). +Proof. +intros. +rewrite <- mul_opp_opp, opp_pred, <- div_opp_r by order. +rewrite <- opp_pos_neg in *. +now apply mul_succ_div_gt. +Qed. + +Lemma mul_succ_div_lt: forall a b, a<=0 -> b<0 -> b*(S (a/b)) < a. +Proof. +intros. +rewrite opp_lt_mono, <- mul_opp_l, <- div_opp_opp by order. +rewrite <- opp_nonneg_nonpos, <- opp_pos_neg in *. +now apply mul_succ_div_gt. +Qed. + +(** Inequality [mul_div_le] is exact iff the modulo is zero. *) + +Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). +Proof. +intros. rewrite mod_eq by order. rewrite sub_move_r; nzsimpl; tauto. +Qed. + +(** Some additionnal inequalities about div. *) + +Theorem div_lt_upper_bound: + forall a b q, 0<=a -> 0<b -> a < b*q -> a/b < q. +Proof. exact div_lt_upper_bound. Qed. + +Theorem div_le_upper_bound: + forall a b q, 0<b -> a <= b*q -> a/b <= q. +Proof. +intros. +rewrite <- (div_mul q b) by order. +apply div_le_mono; trivial. now rewrite mul_comm. +Qed. + +Theorem div_le_lower_bound: + forall a b q, 0<b -> b*q <= a -> q <= a/b. +Proof. +intros. +rewrite <- (div_mul q b) by order. +apply div_le_mono; trivial. now rewrite mul_comm. +Qed. + +(** A division respects opposite monotonicity for the divisor *) + +Lemma div_le_compat_l: forall p q r, 0<=p -> 0<q<=r -> p/r <= p/q. +Proof. exact div_le_compat_l. Qed. + +(** * Relations between usual operations and mod and div *) + +(** Unlike with other division conventions, some results here aren't + always valid, and need to be restricted. For instance + [(a+b*c) mod c <> a mod c] for [a=9,b=-5,c=2] *) + +Lemma mod_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a -> + (a + b * c) mod c == a mod c. +Proof. +assert (forall a b c, c~=0 -> 0<=a -> 0<=a+b*c -> (a+b*c) mod c == a mod c). + intros. pos_or_neg c. apply mod_add; order. + rewrite <- (mod_opp_r a), <- (mod_opp_r (a+b*c)) by order. + rewrite <- mul_opp_opp in *. + apply mod_add; order. +intros a b c Hc Habc. +destruct (le_0_mul _ _ Habc) as [(Habc',Ha)|(Habc',Ha)]. auto. +apply opp_inj. revert Ha Habc'. +rewrite <- 2 opp_nonneg_nonpos. +rewrite <- 2 mod_opp_l, opp_add_distr, <- mul_opp_l by order. auto. +Qed. + +Lemma div_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a -> + (a + b * c) / c == a / c + b. +Proof. +intros. +rewrite <- (mul_cancel_l _ _ c) by trivial. +rewrite <- (add_cancel_r _ _ ((a+b*c) mod c)). +rewrite <- div_mod, mod_add by trivial. +now rewrite mul_add_distr_l, add_shuffle0, <-div_mod, mul_comm. +Qed. + +Lemma div_add_l: forall a b c, b~=0 -> 0 <= (a*b+c)*c -> + (a * b + c) / b == a + c / b. +Proof. + intros a b c. rewrite add_comm, (add_comm a). now apply div_add. +Qed. + +(** Cancellations. *) + +Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> + (a*c)/(b*c) == a/b. +Proof. +assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a*c)/(b*c) == a/b). + intros. pos_or_neg c. apply div_mul_cancel_r; order. + rewrite <- div_opp_opp, <- 2 mul_opp_r. apply div_mul_cancel_r; order. + rewrite <- neq_mul_0; intuition order. +assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a*c)/(b*c) == a/b). + intros. pos_or_neg b. apply Aux1; order. + apply opp_inj. rewrite <- 2 div_opp_r, <- mul_opp_l; try order. apply Aux1; order. + rewrite <- neq_mul_0; intuition order. +intros. pos_or_neg a. apply Aux2; order. +apply opp_inj. rewrite <- 2 div_opp_l, <- mul_opp_l; try order. apply Aux2; order. +rewrite <- neq_mul_0; intuition order. +Qed. + +Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> + (c*a)/(c*b) == a/b. +Proof. +intros. rewrite !(mul_comm c); now apply div_mul_cancel_r. +Qed. + +Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 -> + (a*c) mod (b*c) == (a mod b) * c. +Proof. +intros. +assert (b*c ~= 0) by (rewrite <- neq_mul_0; tauto). +rewrite ! mod_eq by trivial. +rewrite div_mul_cancel_r by order. +now rewrite mul_sub_distr_r, <- !mul_assoc, (mul_comm (a/b) c). +Qed. + +Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 -> + (c*a) mod (c*b) == c * (a mod b). +Proof. +intros; rewrite !(mul_comm c); now apply mul_mod_distr_r. +Qed. + +(** Operations modulo. *) + +Theorem mod_mod: forall a n, n~=0 -> + (a mod n) mod n == a mod n. +Proof. +intros. pos_or_neg a; pos_or_neg n. apply mod_mod; order. +rewrite <- ! (mod_opp_r _ n) by trivial. apply mod_mod; order. +apply opp_inj. rewrite <- !mod_opp_l by order. apply mod_mod; order. +apply opp_inj. rewrite <- !mod_opp_opp by order. apply mod_mod; order. +Qed. + +Lemma mul_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)*b) mod n == (a*b) mod n. +Proof. +assert (Aux1 : forall a b n, 0<=a -> 0<=b -> n~=0 -> + ((a mod n)*b) mod n == (a*b) mod n). + intros. pos_or_neg n. apply mul_mod_idemp_l; order. + rewrite <- ! (mod_opp_r _ n) by order. apply mul_mod_idemp_l; order. +assert (Aux2 : forall a b n, 0<=a -> n~=0 -> + ((a mod n)*b) mod n == (a*b) mod n). + intros. pos_or_neg b. now apply Aux1. + apply opp_inj. rewrite <-2 mod_opp_l, <-2 mul_opp_r by order. + apply Aux1; order. +intros a b n Hn. pos_or_neg a. now apply Aux2. +apply opp_inj. rewrite <-2 mod_opp_l, <-2 mul_opp_l, <-mod_opp_l by order. +apply Aux2; order. +Qed. + +Lemma mul_mod_idemp_r : forall a b n, n~=0 -> + (a*(b mod n)) mod n == (a*b) mod n. +Proof. +intros. rewrite !(mul_comm a). now apply mul_mod_idemp_l. +Qed. + +Theorem mul_mod: forall a b n, n~=0 -> + (a * b) mod n == ((a mod n) * (b mod n)) mod n. +Proof. +intros. now rewrite mul_mod_idemp_l, mul_mod_idemp_r. +Qed. + +(** addition and modulo + + Generally speaking, unlike with other conventions, we don't have + [(a+b) mod n = (a mod n + b mod n) mod n] + for any a and b. + For instance, take (8 + (-10)) mod 3 = -2 whereas + (8 mod 3 + (-10 mod 3)) mod 3 = 1. +*) + +Lemma add_mod_idemp_l : forall a b n, n~=0 -> 0 <= a*b -> + ((a mod n)+b) mod n == (a+b) mod n. +Proof. +assert (Aux : forall a b n, 0<=a -> 0<=b -> n~=0 -> + ((a mod n)+b) mod n == (a+b) mod n). + intros. pos_or_neg n. apply add_mod_idemp_l; order. + rewrite <- ! (mod_opp_r _ n) by order. apply add_mod_idemp_l; order. +intros a b n Hn Hab. destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)]. +now apply Aux. +apply opp_inj. rewrite <-2 mod_opp_l, 2 opp_add_distr, <-mod_opp_l by order. +rewrite <- opp_nonneg_nonpos in *. +now apply Aux. +Qed. + +Lemma add_mod_idemp_r : forall a b n, n~=0 -> 0 <= a*b -> + (a+(b mod n)) mod n == (a+b) mod n. +Proof. +intros. rewrite !(add_comm a). apply add_mod_idemp_l; trivial. +now rewrite mul_comm. +Qed. + +Theorem add_mod: forall a b n, n~=0 -> 0 <= a*b -> + (a+b) mod n == (a mod n + b mod n) mod n. +Proof. +intros a b n Hn Hab. rewrite add_mod_idemp_l, add_mod_idemp_r; trivial. +reflexivity. +destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)]; + destruct (le_0_mul _ _ (mod_sign b n Hn)) as [(Hb',Hm)|(Hb',Hm)]; + auto using mul_nonneg_nonneg, mul_nonpos_nonpos. + setoid_replace b with 0 by order. rewrite mod_0_l by order. nzsimpl; order. + setoid_replace b with 0 by order. rewrite mod_0_l by order. nzsimpl; order. +Qed. + + +(** Conversely, the following result needs less restrictions here. *) + +Lemma div_div : forall a b c, b~=0 -> c~=0 -> + (a/b)/c == a/(b*c). +Proof. +assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a/b)/c == a/(b*c)). + intros. pos_or_neg c. apply div_div; order. + apply opp_inj. rewrite <- 2 div_opp_r, <- mul_opp_r; trivial. + apply div_div; order. + rewrite <- neq_mul_0; intuition order. +assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a/b)/c == a/(b*c)). + intros. pos_or_neg b. apply Aux1; order. + apply opp_inj. rewrite <- div_opp_l, <- 2 div_opp_r, <- mul_opp_l; trivial. + apply Aux1; trivial. + rewrite <- neq_mul_0; intuition order. +intros. pos_or_neg a. apply Aux2; order. +apply opp_inj. rewrite <- 3 div_opp_l; try order. apply Aux2; order. +rewrite <- neq_mul_0. tauto. +Qed. + +(** A last inequality: *) + +Theorem div_mul_le: + forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a/b) <= (c*a)/b. +Proof. exact div_mul_le. Qed. + +(** mod is related to divisibility *) + +Lemma mod_divides : forall a b, b~=0 -> + (a mod b == 0 <-> exists c, a == b*c). +Proof. + intros a b Hb. split. + intros Hab. exists (a/b). rewrite (div_mod a b Hb) at 1. + rewrite Hab; now nzsimpl. + intros (c,Hc). rewrite Hc, mul_comm. now apply mod_mul. +Qed. + +End ZDivPropFunct. + diff --git a/theories/Numbers/Integer/Abstract/ZDomain.v b/theories/Numbers/Integer/Abstract/ZDomain.v deleted file mode 100644 index 9a17e151..00000000 --- a/theories/Numbers/Integer/Abstract/ZDomain.v +++ /dev/null @@ -1,69 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(* Evgeny Makarov, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: ZDomain.v 11674 2008-12-12 19:48:40Z letouzey $ i*) - -Require Export NumPrelude. - -Module Type ZDomainSignature. - -Parameter Inline Z : Set. -Parameter Inline Zeq : Z -> Z -> Prop. -Parameter Inline e : Z -> Z -> bool. - -Axiom eq_equiv_e : forall x y : Z, Zeq x y <-> e x y. -Axiom eq_equiv : equiv Z Zeq. - -Add Relation Z Zeq - reflexivity proved by (proj1 eq_equiv) - symmetry proved by (proj2 (proj2 eq_equiv)) - transitivity proved by (proj1 (proj2 eq_equiv)) -as eq_rel. - -Delimit Scope IntScope with Int. -Bind Scope IntScope with Z. -Notation "x == y" := (Zeq x y) (at level 70) : IntScope. -Notation "x # y" := (~ Zeq x y) (at level 70) : IntScope. - -End ZDomainSignature. - -Module ZDomainProperties (Import ZDomainModule : ZDomainSignature). -Open Local Scope IntScope. - -Add Morphism e with signature Zeq ==> Zeq ==> eq_bool as e_wd. -Proof. -intros x x' Exx' y y' Eyy'. -case_eq (e x y); case_eq (e x' y'); intros H1 H2; trivial. -assert (x == y); [apply <- eq_equiv_e; now rewrite H2 | -assert (x' == y'); [rewrite <- Exx'; now rewrite <- Eyy' | -rewrite <- H1; assert (H3 : e x' y'); [now apply -> eq_equiv_e | now inversion H3]]]. -assert (x' == y'); [apply <- eq_equiv_e; now rewrite H1 | -assert (x == y); [rewrite Exx'; now rewrite Eyy' | -rewrite <- H2; assert (H3 : e x y); [now apply -> eq_equiv_e | now inversion H3]]]. -Qed. - -Theorem neq_sym : forall n m, n # m -> m # n. -Proof. -intros n m H1 H2; symmetry in H2; false_hyp H2 H1. -Qed. - -Theorem ZE_stepl : forall x y z : Z, x == y -> x == z -> z == y. -Proof. -intros x y z H1 H2; now rewrite <- H1. -Qed. - -Declare Left Step ZE_stepl. - -(* The right step lemma is just transitivity of Zeq *) -Declare Right Step (proj1 (proj2 eq_equiv)). - -End ZDomainProperties. - - diff --git a/theories/Numbers/Integer/Abstract/ZLt.v b/theories/Numbers/Integer/Abstract/ZLt.v index 2a88a535..849bf6b4 100644 --- a/theories/Numbers/Integer/Abstract/ZLt.v +++ b/theories/Numbers/Integer/Abstract/ZLt.v @@ -8,424 +8,126 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZLt.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export ZMul. -Module ZOrderPropFunct (Import ZAxiomsMod : ZAxiomsSig). -Module Export ZMulPropMod := ZMulPropFunct ZAxiomsMod. -Open Local Scope IntScope. +Module ZOrderPropFunct (Import Z : ZAxiomsSig'). +Include ZMulPropFunct Z. -(* Axioms *) +(** Instances of earlier theorems for m == 0 *) -Theorem Zlt_wd : - forall n1 n2 : Z, n1 == n2 -> forall m1 m2 : Z, m1 == m2 -> (n1 < m1 <-> n2 < m2). -Proof NZlt_wd. - -Theorem Zle_wd : - forall n1 n2 : Z, n1 == n2 -> forall m1 m2 : Z, m1 == m2 -> (n1 <= m1 <-> n2 <= m2). -Proof NZle_wd. - -Theorem Zmin_wd : - forall n1 n2 : Z, n1 == n2 -> forall m1 m2 : Z, m1 == m2 -> Zmin n1 m1 == Zmin n2 m2. -Proof NZmin_wd. - -Theorem Zmax_wd : - forall n1 n2 : Z, n1 == n2 -> forall m1 m2 : Z, m1 == m2 -> Zmax n1 m1 == Zmax n2 m2. -Proof NZmax_wd. - -Theorem Zlt_eq_cases : forall n m : Z, n <= m <-> n < m \/ n == m. -Proof NZlt_eq_cases. - -Theorem Zlt_irrefl : forall n : Z, ~ n < n. -Proof NZlt_irrefl. - -Theorem Zlt_succ_r : forall n m : Z, n < S m <-> n <= m. -Proof NZlt_succ_r. - -Theorem Zmin_l : forall n m : Z, n <= m -> Zmin n m == n. -Proof NZmin_l. - -Theorem Zmin_r : forall n m : Z, m <= n -> Zmin n m == m. -Proof NZmin_r. - -Theorem Zmax_l : forall n m : Z, m <= n -> Zmax n m == n. -Proof NZmax_l. - -Theorem Zmax_r : forall n m : Z, n <= m -> Zmax n m == m. -Proof NZmax_r. - -(* Renaming theorems from NZOrder.v *) - -Theorem Zlt_le_incl : forall n m : Z, n < m -> n <= m. -Proof NZlt_le_incl. - -Theorem Zlt_neq : forall n m : Z, n < m -> n ~= m. -Proof NZlt_neq. - -Theorem Zle_neq : forall n m : Z, n < m <-> n <= m /\ n ~= m. -Proof NZle_neq. - -Theorem Zle_refl : forall n : Z, n <= n. -Proof NZle_refl. - -Theorem Zlt_succ_diag_r : forall n : Z, n < S n. -Proof NZlt_succ_diag_r. - -Theorem Zle_succ_diag_r : forall n : Z, n <= S n. -Proof NZle_succ_diag_r. - -Theorem Zlt_0_1 : 0 < 1. -Proof NZlt_0_1. - -Theorem Zle_0_1 : 0 <= 1. -Proof NZle_0_1. - -Theorem Zlt_lt_succ_r : forall n m : Z, n < m -> n < S m. -Proof NZlt_lt_succ_r. - -Theorem Zle_le_succ_r : forall n m : Z, n <= m -> n <= S m. -Proof NZle_le_succ_r. - -Theorem Zle_succ_r : forall n m : Z, n <= S m <-> n <= m \/ n == S m. -Proof NZle_succ_r. - -Theorem Zneq_succ_diag_l : forall n : Z, S n ~= n. -Proof NZneq_succ_diag_l. - -Theorem Zneq_succ_diag_r : forall n : Z, n ~= S n. -Proof NZneq_succ_diag_r. - -Theorem Znlt_succ_diag_l : forall n : Z, ~ S n < n. -Proof NZnlt_succ_diag_l. - -Theorem Znle_succ_diag_l : forall n : Z, ~ S n <= n. -Proof NZnle_succ_diag_l. - -Theorem Zle_succ_l : forall n m : Z, S n <= m <-> n < m. -Proof NZle_succ_l. - -Theorem Zlt_succ_l : forall n m : Z, S n < m -> n < m. -Proof NZlt_succ_l. - -Theorem Zsucc_lt_mono : forall n m : Z, n < m <-> S n < S m. -Proof NZsucc_lt_mono. - -Theorem Zsucc_le_mono : forall n m : Z, n <= m <-> S n <= S m. -Proof NZsucc_le_mono. - -Theorem Zlt_asymm : forall n m, n < m -> ~ m < n. -Proof NZlt_asymm. - -Notation Zlt_ngt := Zlt_asymm (only parsing). - -Theorem Zlt_trans : forall n m p : Z, n < m -> m < p -> n < p. -Proof NZlt_trans. - -Theorem Zle_trans : forall n m p : Z, n <= m -> m <= p -> n <= p. -Proof NZle_trans. - -Theorem Zle_lt_trans : forall n m p : Z, n <= m -> m < p -> n < p. -Proof NZle_lt_trans. - -Theorem Zlt_le_trans : forall n m p : Z, n < m -> m <= p -> n < p. -Proof NZlt_le_trans. - -Theorem Zle_antisymm : forall n m : Z, n <= m -> m <= n -> n == m. -Proof NZle_antisymm. - -Theorem Zlt_1_l : forall n m : Z, 0 < n -> n < m -> 1 < m. -Proof NZlt_1_l. - -(** Trichotomy, decidability, and double negation elimination *) - -Theorem Zlt_trichotomy : forall n m : Z, n < m \/ n == m \/ m < n. -Proof NZlt_trichotomy. - -Notation Zlt_eq_gt_cases := Zlt_trichotomy (only parsing). - -Theorem Zlt_gt_cases : forall n m : Z, n ~= m <-> n < m \/ n > m. -Proof NZlt_gt_cases. - -Theorem Zle_gt_cases : forall n m : Z, n <= m \/ n > m. -Proof NZle_gt_cases. - -Theorem Zlt_ge_cases : forall n m : Z, n < m \/ n >= m. -Proof NZlt_ge_cases. - -Theorem Zle_ge_cases : forall n m : Z, n <= m \/ n >= m. -Proof NZle_ge_cases. - -(** Instances of the previous theorems for m == 0 *) - -Theorem Zneg_pos_cases : forall n : Z, n ~= 0 <-> n < 0 \/ n > 0. +Theorem neg_pos_cases : forall n, n ~= 0 <-> n < 0 \/ n > 0. Proof. -intro; apply Zlt_gt_cases. +intro; apply lt_gt_cases. Qed. -Theorem Znonpos_pos_cases : forall n : Z, n <= 0 \/ n > 0. +Theorem nonpos_pos_cases : forall n, n <= 0 \/ n > 0. Proof. -intro; apply Zle_gt_cases. +intro; apply le_gt_cases. Qed. -Theorem Zneg_nonneg_cases : forall n : Z, n < 0 \/ n >= 0. +Theorem neg_nonneg_cases : forall n, n < 0 \/ n >= 0. Proof. -intro; apply Zlt_ge_cases. +intro; apply lt_ge_cases. Qed. -Theorem Znonpos_nonneg_cases : forall n : Z, n <= 0 \/ n >= 0. +Theorem nonpos_nonneg_cases : forall n, n <= 0 \/ n >= 0. Proof. -intro; apply Zle_ge_cases. +intro; apply le_ge_cases. Qed. -Theorem Zle_ngt : forall n m : Z, n <= m <-> ~ n > m. -Proof NZle_ngt. - -Theorem Znlt_ge : forall n m : Z, ~ n < m <-> n >= m. -Proof NZnlt_ge. - -Theorem Zlt_dec : forall n m : Z, decidable (n < m). -Proof NZlt_dec. - -Theorem Zlt_dne : forall n m, ~ ~ n < m <-> n < m. -Proof NZlt_dne. - -Theorem Znle_gt : forall n m : Z, ~ n <= m <-> n > m. -Proof NZnle_gt. - -Theorem Zlt_nge : forall n m : Z, n < m <-> ~ n >= m. -Proof NZlt_nge. - -Theorem Zle_dec : forall n m : Z, decidable (n <= m). -Proof NZle_dec. - -Theorem Zle_dne : forall n m : Z, ~ ~ n <= m <-> n <= m. -Proof NZle_dne. - -Theorem Znlt_succ_r : forall n m : Z, ~ m < S n <-> n < m. -Proof NZnlt_succ_r. - -Theorem Zlt_exists_pred : - forall z n : Z, z < n -> exists k : Z, n == S k /\ z <= k. -Proof NZlt_exists_pred. - -Theorem Zlt_succ_iter_r : - forall (n : nat) (m : Z), m < NZsucc_iter (Datatypes.S n) m. -Proof NZlt_succ_iter_r. - -Theorem Zneq_succ_iter_l : - forall (n : nat) (m : Z), NZsucc_iter (Datatypes.S n) m ~= m. -Proof NZneq_succ_iter_l. - -(** Stronger variant of induction with assumptions n >= 0 (n < 0) -in the induction step *) - -Theorem Zright_induction : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, A z -> - (forall n : Z, z <= n -> A n -> A (S n)) -> - forall n : Z, z <= n -> A n. -Proof NZright_induction. - -Theorem Zleft_induction : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, A z -> - (forall n : Z, n < z -> A (S n) -> A n) -> - forall n : Z, n <= z -> A n. -Proof NZleft_induction. - -Theorem Zright_induction' : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, - (forall n : Z, n <= z -> A n) -> - (forall n : Z, z <= n -> A n -> A (S n)) -> - forall n : Z, A n. -Proof NZright_induction'. - -Theorem Zleft_induction' : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, - (forall n : Z, z <= n -> A n) -> - (forall n : Z, n < z -> A (S n) -> A n) -> - forall n : Z, A n. -Proof NZleft_induction'. - -Theorem Zstrong_right_induction : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, - (forall n : Z, z <= n -> (forall m : Z, z <= m -> m < n -> A m) -> A n) -> - forall n : Z, z <= n -> A n. -Proof NZstrong_right_induction. - -Theorem Zstrong_left_induction : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, - (forall n : Z, n <= z -> (forall m : Z, m <= z -> S n <= m -> A m) -> A n) -> - forall n : Z, n <= z -> A n. -Proof NZstrong_left_induction. - -Theorem Zstrong_right_induction' : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, - (forall n : Z, n <= z -> A n) -> - (forall n : Z, z <= n -> (forall m : Z, z <= m -> m < n -> A m) -> A n) -> - forall n : Z, A n. -Proof NZstrong_right_induction'. - -Theorem Zstrong_left_induction' : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, - (forall n : Z, z <= n -> A n) -> - (forall n : Z, n <= z -> (forall m : Z, m <= z -> S n <= m -> A m) -> A n) -> - forall n : Z, A n. -Proof NZstrong_left_induction'. - -Theorem Zorder_induction : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, A z -> - (forall n : Z, z <= n -> A n -> A (S n)) -> - (forall n : Z, n < z -> A (S n) -> A n) -> - forall n : Z, A n. -Proof NZorder_induction. - -Theorem Zorder_induction' : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall z : Z, A z -> - (forall n : Z, z <= n -> A n -> A (S n)) -> - (forall n : Z, n <= z -> A n -> A (P n)) -> - forall n : Z, A n. -Proof NZorder_induction'. - -Theorem Zorder_induction_0 : - forall A : Z -> Prop, predicate_wd Zeq A -> - A 0 -> - (forall n : Z, 0 <= n -> A n -> A (S n)) -> - (forall n : Z, n < 0 -> A (S n) -> A n) -> - forall n : Z, A n. -Proof NZorder_induction_0. - -Theorem Zorder_induction'_0 : - forall A : Z -> Prop, predicate_wd Zeq A -> - A 0 -> - (forall n : Z, 0 <= n -> A n -> A (S n)) -> - (forall n : Z, n <= 0 -> A n -> A (P n)) -> - forall n : Z, A n. -Proof NZorder_induction'_0. - -Ltac Zinduct n := induction_maker n ltac:(apply Zorder_induction_0). - -(** Elimintation principle for < *) - -Theorem Zlt_ind : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall n : Z, A (S n) -> - (forall m : Z, n < m -> A m -> A (S m)) -> forall m : Z, n < m -> A m. -Proof NZlt_ind. - -(** Elimintation principle for <= *) - -Theorem Zle_ind : - forall A : Z -> Prop, predicate_wd Zeq A -> - forall n : Z, A n -> - (forall m : Z, n <= m -> A m -> A (S m)) -> forall m : Z, n <= m -> A m. -Proof NZle_ind. - -(** Well-founded relations *) - -Theorem Zlt_wf : forall z : Z, well_founded (fun n m : Z => z <= n /\ n < m). -Proof NZlt_wf. - -Theorem Zgt_wf : forall z : Z, well_founded (fun n m : Z => m < n /\ n <= z). -Proof NZgt_wf. +Ltac zinduct n := induction_maker n ltac:(apply order_induction_0). -(* Theorems that are either not valid on N or have different proofs on N and Z *) +(** Theorems that are either not valid on N or have different proofs + on N and Z *) -Theorem Zlt_pred_l : forall n : Z, P n < n. +Theorem lt_pred_l : forall n, P n < n. Proof. -intro n; rewrite <- (Zsucc_pred n) at 2; apply Zlt_succ_diag_r. +intro n; rewrite <- (succ_pred n) at 2; apply lt_succ_diag_r. Qed. -Theorem Zle_pred_l : forall n : Z, P n <= n. +Theorem le_pred_l : forall n, P n <= n. Proof. -intro; apply Zlt_le_incl; apply Zlt_pred_l. +intro; apply lt_le_incl; apply lt_pred_l. Qed. -Theorem Zlt_le_pred : forall n m : Z, n < m <-> n <= P m. +Theorem lt_le_pred : forall n m, n < m <-> n <= P m. Proof. -intros n m; rewrite <- (Zsucc_pred m); rewrite Zpred_succ. apply Zlt_succ_r. +intros n m; rewrite <- (succ_pred m); rewrite pred_succ. apply lt_succ_r. Qed. -Theorem Znle_pred_r : forall n : Z, ~ n <= P n. +Theorem nle_pred_r : forall n, ~ n <= P n. Proof. -intro; rewrite <- Zlt_le_pred; apply Zlt_irrefl. +intro; rewrite <- lt_le_pred; apply lt_irrefl. Qed. -Theorem Zlt_pred_le : forall n m : Z, P n < m <-> n <= m. +Theorem lt_pred_le : forall n m, P n < m <-> n <= m. Proof. -intros n m; rewrite <- (Zsucc_pred n) at 2. -symmetry; apply Zle_succ_l. +intros n m; rewrite <- (succ_pred n) at 2. +symmetry; apply le_succ_l. Qed. -Theorem Zlt_lt_pred : forall n m : Z, n < m -> P n < m. +Theorem lt_lt_pred : forall n m, n < m -> P n < m. Proof. -intros; apply <- Zlt_pred_le; now apply Zlt_le_incl. +intros; apply <- lt_pred_le; now apply lt_le_incl. Qed. -Theorem Zle_le_pred : forall n m : Z, n <= m -> P n <= m. +Theorem le_le_pred : forall n m, n <= m -> P n <= m. Proof. -intros; apply Zlt_le_incl; now apply <- Zlt_pred_le. +intros; apply lt_le_incl; now apply <- lt_pred_le. Qed. -Theorem Zlt_pred_lt : forall n m : Z, n < P m -> n < m. +Theorem lt_pred_lt : forall n m, n < P m -> n < m. Proof. -intros n m H; apply Zlt_trans with (P m); [assumption | apply Zlt_pred_l]. +intros n m H; apply lt_trans with (P m); [assumption | apply lt_pred_l]. Qed. -Theorem Zle_pred_lt : forall n m : Z, n <= P m -> n <= m. +Theorem le_pred_lt : forall n m, n <= P m -> n <= m. Proof. -intros; apply Zlt_le_incl; now apply <- Zlt_le_pred. +intros; apply lt_le_incl; now apply <- lt_le_pred. Qed. -Theorem Zpred_lt_mono : forall n m : Z, n < m <-> P n < P m. +Theorem pred_lt_mono : forall n m, n < m <-> P n < P m. Proof. -intros; rewrite Zlt_le_pred; symmetry; apply Zlt_pred_le. +intros; rewrite lt_le_pred; symmetry; apply lt_pred_le. Qed. -Theorem Zpred_le_mono : forall n m : Z, n <= m <-> P n <= P m. +Theorem pred_le_mono : forall n m, n <= m <-> P n <= P m. Proof. -intros; rewrite <- Zlt_pred_le; now rewrite Zlt_le_pred. +intros; rewrite <- lt_pred_le; now rewrite lt_le_pred. Qed. -Theorem Zlt_succ_lt_pred : forall n m : Z, S n < m <-> n < P m. +Theorem lt_succ_lt_pred : forall n m, S n < m <-> n < P m. Proof. -intros n m; now rewrite (Zpred_lt_mono (S n) m), Zpred_succ. +intros n m; now rewrite (pred_lt_mono (S n) m), pred_succ. Qed. -Theorem Zle_succ_le_pred : forall n m : Z, S n <= m <-> n <= P m. +Theorem le_succ_le_pred : forall n m, S n <= m <-> n <= P m. Proof. -intros n m; now rewrite (Zpred_le_mono (S n) m), Zpred_succ. +intros n m; now rewrite (pred_le_mono (S n) m), pred_succ. Qed. -Theorem Zlt_pred_lt_succ : forall n m : Z, P n < m <-> n < S m. +Theorem lt_pred_lt_succ : forall n m, P n < m <-> n < S m. Proof. -intros; rewrite Zlt_pred_le; symmetry; apply Zlt_succ_r. +intros; rewrite lt_pred_le; symmetry; apply lt_succ_r. Qed. -Theorem Zle_pred_lt_succ : forall n m : Z, P n <= m <-> n <= S m. +Theorem le_pred_lt_succ : forall n m, P n <= m <-> n <= S m. Proof. -intros n m; now rewrite (Zpred_le_mono n (S m)), Zpred_succ. +intros n m; now rewrite (pred_le_mono n (S m)), pred_succ. Qed. -Theorem Zneq_pred_l : forall n : Z, P n ~= n. +Theorem neq_pred_l : forall n, P n ~= n. Proof. -intro; apply Zlt_neq; apply Zlt_pred_l. +intro; apply lt_neq; apply lt_pred_l. Qed. -Theorem Zlt_n1_r : forall n m : Z, n < m -> m < 0 -> n < -1. +Theorem lt_n1_r : forall n m, n < m -> m < 0 -> n < -(1). Proof. -intros n m H1 H2. apply -> Zlt_le_pred in H2. -setoid_replace (P 0) with (-1) in H2. now apply NZlt_le_trans with m. -apply <- Zeq_opp_r. now rewrite Zopp_pred, Zopp_0. +intros n m H1 H2. apply -> lt_le_pred in H2. +setoid_replace (P 0) with (-(1)) in H2. now apply lt_le_trans with m. +apply <- eq_opp_r. now rewrite opp_pred, opp_0. Qed. End ZOrderPropFunct. diff --git a/theories/Numbers/Integer/Abstract/ZMul.v b/theories/Numbers/Integer/Abstract/ZMul.v index c48d1b4c..84d840ad 100644 --- a/theories/Numbers/Integer/Abstract/ZMul.v +++ b/theories/Numbers/Integer/Abstract/ZMul.v @@ -8,106 +8,63 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZMul.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export ZAdd. -Module ZMulPropFunct (Import ZAxiomsMod : ZAxiomsSig). -Module Export ZAddPropMod := ZAddPropFunct ZAxiomsMod. -Open Local Scope IntScope. +Module ZMulPropFunct (Import Z : ZAxiomsSig'). +Include ZAddPropFunct Z. -Theorem Zmul_wd : - forall n1 n2 : Z, n1 == n2 -> forall m1 m2 : Z, m1 == m2 -> n1 * m1 == n2 * m2. -Proof NZmul_wd. +(** A note on naming: right (correspondingly, left) distributivity + happens when the sum is multiplied by a number on the right + (left), not when the sum itself is the right (left) factor in the + product (see planetmath.org and mathworld.wolfram.com). In the old + library BinInt, distributivity over subtraction was named + correctly, but distributivity over addition was named + incorrectly. The names in Isabelle/HOL library are also + incorrect. *) -Theorem Zmul_0_l : forall n : Z, 0 * n == 0. -Proof NZmul_0_l. +(** Theorems that are either not valid on N or have different proofs + on N and Z *) -Theorem Zmul_succ_l : forall n m : Z, (S n) * m == n * m + m. -Proof NZmul_succ_l. - -(* Theorems that are valid for both natural numbers and integers *) - -Theorem Zmul_0_r : forall n : Z, n * 0 == 0. -Proof NZmul_0_r. - -Theorem Zmul_succ_r : forall n m : Z, n * (S m) == n * m + n. -Proof NZmul_succ_r. - -Theorem Zmul_comm : forall n m : Z, n * m == m * n. -Proof NZmul_comm. - -Theorem Zmul_add_distr_r : forall n m p : Z, (n + m) * p == n * p + m * p. -Proof NZmul_add_distr_r. - -Theorem Zmul_add_distr_l : forall n m p : Z, n * (m + p) == n * m + n * p. -Proof NZmul_add_distr_l. - -(* A note on naming: right (correspondingly, left) distributivity happens -when the sum is multiplied by a number on the right (left), not when the -sum itself is the right (left) factor in the product (see planetmath.org -and mathworld.wolfram.com). In the old library BinInt, distributivity over -subtraction was named correctly, but distributivity over addition was named -incorrectly. The names in Isabelle/HOL library are also incorrect. *) - -Theorem Zmul_assoc : forall n m p : Z, n * (m * p) == (n * m) * p. -Proof NZmul_assoc. - -Theorem Zmul_1_l : forall n : Z, 1 * n == n. -Proof NZmul_1_l. - -Theorem Zmul_1_r : forall n : Z, n * 1 == n. -Proof NZmul_1_r. - -(* The following two theorems are true in an ordered ring, -but since they don't mention order, we'll put them here *) - -Theorem Zeq_mul_0 : forall n m : Z, n * m == 0 <-> n == 0 \/ m == 0. -Proof NZeq_mul_0. - -Theorem Zneq_mul_0 : forall n m : Z, n ~= 0 /\ m ~= 0 <-> n * m ~= 0. -Proof NZneq_mul_0. - -(* Theorems that are either not valid on N or have different proofs on N and Z *) - -Theorem Zmul_pred_r : forall n m : Z, n * (P m) == n * m - n. +Theorem mul_pred_r : forall n m, n * (P m) == n * m - n. Proof. intros n m. -rewrite <- (Zsucc_pred m) at 2. -now rewrite Zmul_succ_r, <- Zadd_sub_assoc, Zsub_diag, Zadd_0_r. +rewrite <- (succ_pred m) at 2. +now rewrite mul_succ_r, <- add_sub_assoc, sub_diag, add_0_r. Qed. -Theorem Zmul_pred_l : forall n m : Z, (P n) * m == n * m - m. +Theorem mul_pred_l : forall n m, (P n) * m == n * m - m. Proof. -intros n m; rewrite (Zmul_comm (P n) m), (Zmul_comm n m). apply Zmul_pred_r. +intros n m; rewrite (mul_comm (P n) m), (mul_comm n m). apply mul_pred_r. Qed. -Theorem Zmul_opp_l : forall n m : Z, (- n) * m == - (n * m). +Theorem mul_opp_l : forall n m, (- n) * m == - (n * m). Proof. -intros n m. apply -> Zadd_move_0_r. -now rewrite <- Zmul_add_distr_r, Zadd_opp_diag_l, Zmul_0_l. +intros n m. apply -> add_move_0_r. +now rewrite <- mul_add_distr_r, add_opp_diag_l, mul_0_l. Qed. -Theorem Zmul_opp_r : forall n m : Z, n * (- m) == - (n * m). +Theorem mul_opp_r : forall n m, n * (- m) == - (n * m). Proof. -intros n m; rewrite (Zmul_comm n (- m)), (Zmul_comm n m); apply Zmul_opp_l. +intros n m; rewrite (mul_comm n (- m)), (mul_comm n m); apply mul_opp_l. Qed. -Theorem Zmul_opp_opp : forall n m : Z, (- n) * (- m) == n * m. +Theorem mul_opp_opp : forall n m, (- n) * (- m) == n * m. Proof. -intros n m; now rewrite Zmul_opp_l, Zmul_opp_r, Zopp_involutive. +intros n m; now rewrite mul_opp_l, mul_opp_r, opp_involutive. Qed. -Theorem Zmul_sub_distr_l : forall n m p : Z, n * (m - p) == n * m - n * p. +Theorem mul_sub_distr_l : forall n m p, n * (m - p) == n * m - n * p. Proof. -intros n m p. do 2 rewrite <- Zadd_opp_r. rewrite Zmul_add_distr_l. -now rewrite Zmul_opp_r. +intros n m p. do 2 rewrite <- add_opp_r. rewrite mul_add_distr_l. +now rewrite mul_opp_r. Qed. -Theorem Zmul_sub_distr_r : forall n m p : Z, (n - m) * p == n * p - m * p. +Theorem mul_sub_distr_r : forall n m p, (n - m) * p == n * p - m * p. Proof. -intros n m p; rewrite (Zmul_comm (n - m) p), (Zmul_comm n p), (Zmul_comm m p); -now apply Zmul_sub_distr_l. +intros n m p; rewrite (mul_comm (n - m) p), (mul_comm n p), (mul_comm m p); +now apply mul_sub_distr_l. Qed. End ZMulPropFunct. diff --git a/theories/Numbers/Integer/Abstract/ZMulOrder.v b/theories/Numbers/Integer/Abstract/ZMulOrder.v index c7996ffd..99be58eb 100644 --- a/theories/Numbers/Integer/Abstract/ZMulOrder.v +++ b/theories/Numbers/Integer/Abstract/ZMulOrder.v @@ -8,335 +8,225 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZMulOrder.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Export ZAddOrder. -Module ZMulOrderPropFunct (Import ZAxiomsMod : ZAxiomsSig). -Module Export ZAddOrderPropMod := ZAddOrderPropFunct ZAxiomsMod. -Open Local Scope IntScope. +Module Type ZMulOrderPropFunct (Import Z : ZAxiomsSig'). +Include ZAddOrderPropFunct Z. -Theorem Zmul_lt_pred : - forall p q n m : Z, S p == q -> (p * n < p * m <-> q * n + m < q * m + n). -Proof NZmul_lt_pred. +Local Notation "- 1" := (-(1)). -Theorem Zmul_lt_mono_pos_l : forall p n m : Z, 0 < p -> (n < m <-> p * n < p * m). -Proof NZmul_lt_mono_pos_l. - -Theorem Zmul_lt_mono_pos_r : forall p n m : Z, 0 < p -> (n < m <-> n * p < m * p). -Proof NZmul_lt_mono_pos_r. - -Theorem Zmul_lt_mono_neg_l : forall p n m : Z, p < 0 -> (n < m <-> p * m < p * n). -Proof NZmul_lt_mono_neg_l. - -Theorem Zmul_lt_mono_neg_r : forall p n m : Z, p < 0 -> (n < m <-> m * p < n * p). -Proof NZmul_lt_mono_neg_r. - -Theorem Zmul_le_mono_nonneg_l : forall n m p : Z, 0 <= p -> n <= m -> p * n <= p * m. -Proof NZmul_le_mono_nonneg_l. - -Theorem Zmul_le_mono_nonpos_l : forall n m p : Z, p <= 0 -> n <= m -> p * m <= p * n. -Proof NZmul_le_mono_nonpos_l. - -Theorem Zmul_le_mono_nonneg_r : forall n m p : Z, 0 <= p -> n <= m -> n * p <= m * p. -Proof NZmul_le_mono_nonneg_r. - -Theorem Zmul_le_mono_nonpos_r : forall n m p : Z, p <= 0 -> n <= m -> m * p <= n * p. -Proof NZmul_le_mono_nonpos_r. - -Theorem Zmul_cancel_l : forall n m p : Z, p ~= 0 -> (p * n == p * m <-> n == m). -Proof NZmul_cancel_l. - -Theorem Zmul_cancel_r : forall n m p : Z, p ~= 0 -> (n * p == m * p <-> n == m). -Proof NZmul_cancel_r. - -Theorem Zmul_id_l : forall n m : Z, m ~= 0 -> (n * m == m <-> n == 1). -Proof NZmul_id_l. - -Theorem Zmul_id_r : forall n m : Z, n ~= 0 -> (n * m == n <-> m == 1). -Proof NZmul_id_r. - -Theorem Zmul_le_mono_pos_l : forall n m p : Z, 0 < p -> (n <= m <-> p * n <= p * m). -Proof NZmul_le_mono_pos_l. - -Theorem Zmul_le_mono_pos_r : forall n m p : Z, 0 < p -> (n <= m <-> n * p <= m * p). -Proof NZmul_le_mono_pos_r. - -Theorem Zmul_le_mono_neg_l : forall n m p : Z, p < 0 -> (n <= m <-> p * m <= p * n). -Proof NZmul_le_mono_neg_l. - -Theorem Zmul_le_mono_neg_r : forall n m p : Z, p < 0 -> (n <= m <-> m * p <= n * p). -Proof NZmul_le_mono_neg_r. - -Theorem Zmul_lt_mono_nonneg : - forall n m p q : Z, 0 <= n -> n < m -> 0 <= p -> p < q -> n * p < m * q. -Proof NZmul_lt_mono_nonneg. - -Theorem Zmul_lt_mono_nonpos : - forall n m p q : Z, m <= 0 -> n < m -> q <= 0 -> p < q -> m * q < n * p. +Theorem mul_lt_mono_nonpos : + forall n m p q, m <= 0 -> n < m -> q <= 0 -> p < q -> m * q < n * p. Proof. intros n m p q H1 H2 H3 H4. -apply Zle_lt_trans with (m * p). -apply Zmul_le_mono_nonpos_l; [assumption | now apply Zlt_le_incl]. -apply -> Zmul_lt_mono_neg_r; [assumption | now apply Zlt_le_trans with q]. +apply le_lt_trans with (m * p). +apply mul_le_mono_nonpos_l; [assumption | now apply lt_le_incl]. +apply -> mul_lt_mono_neg_r; [assumption | now apply lt_le_trans with q]. Qed. -Theorem Zmul_le_mono_nonneg : - forall n m p q : Z, 0 <= n -> n <= m -> 0 <= p -> p <= q -> n * p <= m * q. -Proof NZmul_le_mono_nonneg. - -Theorem Zmul_le_mono_nonpos : - forall n m p q : Z, m <= 0 -> n <= m -> q <= 0 -> p <= q -> m * q <= n * p. +Theorem mul_le_mono_nonpos : + forall n m p q, m <= 0 -> n <= m -> q <= 0 -> p <= q -> m * q <= n * p. Proof. intros n m p q H1 H2 H3 H4. -apply Zle_trans with (m * p). -now apply Zmul_le_mono_nonpos_l. -apply Zmul_le_mono_nonpos_r; [now apply Zle_trans with q | assumption]. -Qed. - -Theorem Zmul_pos_pos : forall n m : Z, 0 < n -> 0 < m -> 0 < n * m. -Proof NZmul_pos_pos. - -Theorem Zmul_neg_neg : forall n m : Z, n < 0 -> m < 0 -> 0 < n * m. -Proof NZmul_neg_neg. - -Theorem Zmul_pos_neg : forall n m : Z, 0 < n -> m < 0 -> n * m < 0. -Proof NZmul_pos_neg. - -Theorem Zmul_neg_pos : forall n m : Z, n < 0 -> 0 < m -> n * m < 0. -Proof NZmul_neg_pos. - -Theorem Zmul_nonneg_nonneg : forall n m : Z, 0 <= n -> 0 <= m -> 0 <= n * m. -Proof. -intros n m H1 H2. -rewrite <- (Zmul_0_l m). now apply Zmul_le_mono_nonneg_r. +apply le_trans with (m * p). +now apply mul_le_mono_nonpos_l. +apply mul_le_mono_nonpos_r; [now apply le_trans with q | assumption]. Qed. -Theorem Zmul_nonpos_nonpos : forall n m : Z, n <= 0 -> m <= 0 -> 0 <= n * m. +Theorem mul_nonpos_nonpos : forall n m, n <= 0 -> m <= 0 -> 0 <= n * m. Proof. intros n m H1 H2. -rewrite <- (Zmul_0_l m). now apply Zmul_le_mono_nonpos_r. +rewrite <- (mul_0_l m). now apply mul_le_mono_nonpos_r. Qed. -Theorem Zmul_nonneg_nonpos : forall n m : Z, 0 <= n -> m <= 0 -> n * m <= 0. +Theorem mul_nonneg_nonpos : forall n m, 0 <= n -> m <= 0 -> n * m <= 0. Proof. intros n m H1 H2. -rewrite <- (Zmul_0_l m). now apply Zmul_le_mono_nonpos_r. +rewrite <- (mul_0_l m). now apply mul_le_mono_nonpos_r. Qed. -Theorem Zmul_nonpos_nonneg : forall n m : Z, n <= 0 -> 0 <= m -> n * m <= 0. +Theorem mul_nonpos_nonneg : forall n m, n <= 0 -> 0 <= m -> n * m <= 0. Proof. -intros; rewrite Zmul_comm; now apply Zmul_nonneg_nonpos. +intros; rewrite mul_comm; now apply mul_nonneg_nonpos. Qed. -Theorem Zlt_1_mul_pos : forall n m : Z, 1 < n -> 0 < m -> 1 < n * m. -Proof NZlt_1_mul_pos. - -Theorem Zeq_mul_0 : forall n m : Z, n * m == 0 <-> n == 0 \/ m == 0. -Proof NZeq_mul_0. - -Theorem Zneq_mul_0 : forall n m : Z, n ~= 0 /\ m ~= 0 <-> n * m ~= 0. -Proof NZneq_mul_0. - -Theorem Zeq_square_0 : forall n : Z, n * n == 0 <-> n == 0. -Proof NZeq_square_0. +Notation mul_pos := lt_0_mul (only parsing). -Theorem Zeq_mul_0_l : forall n m : Z, n * m == 0 -> m ~= 0 -> n == 0. -Proof NZeq_mul_0_l. - -Theorem Zeq_mul_0_r : forall n m : Z, n * m == 0 -> n ~= 0 -> m == 0. -Proof NZeq_mul_0_r. - -Theorem Zlt_0_mul : forall n m : Z, 0 < n * m <-> 0 < n /\ 0 < m \/ m < 0 /\ n < 0. -Proof NZlt_0_mul. - -Notation Zmul_pos := Zlt_0_mul (only parsing). - -Theorem Zlt_mul_0 : - forall n m : Z, n * m < 0 <-> n < 0 /\ m > 0 \/ n > 0 /\ m < 0. +Theorem lt_mul_0 : + forall n m, n * m < 0 <-> n < 0 /\ m > 0 \/ n > 0 /\ m < 0. Proof. intros n m; split; [intro H | intros [[H1 H2] | [H1 H2]]]. -destruct (Zlt_trichotomy n 0) as [H1 | [H1 | H1]]; -[| rewrite H1 in H; rewrite Zmul_0_l in H; false_hyp H Zlt_irrefl |]; -(destruct (Zlt_trichotomy m 0) as [H2 | [H2 | H2]]; -[| rewrite H2 in H; rewrite Zmul_0_r in H; false_hyp H Zlt_irrefl |]); +destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]]; +[| rewrite H1 in H; rewrite mul_0_l in H; false_hyp H lt_irrefl |]; +(destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]]; +[| rewrite H2 in H; rewrite mul_0_r in H; false_hyp H lt_irrefl |]); try (left; now split); try (right; now split). -assert (H3 : n * m > 0) by now apply Zmul_neg_neg. -elimtype False; now apply (Zlt_asymm (n * m) 0). -assert (H3 : n * m > 0) by now apply Zmul_pos_pos. -elimtype False; now apply (Zlt_asymm (n * m) 0). -now apply Zmul_neg_pos. now apply Zmul_pos_neg. +assert (H3 : n * m > 0) by now apply mul_neg_neg. +exfalso; now apply (lt_asymm (n * m) 0). +assert (H3 : n * m > 0) by now apply mul_pos_pos. +exfalso; now apply (lt_asymm (n * m) 0). +now apply mul_neg_pos. now apply mul_pos_neg. Qed. -Notation Zmul_neg := Zlt_mul_0 (only parsing). +Notation mul_neg := lt_mul_0 (only parsing). -Theorem Zle_0_mul : - forall n m : Z, 0 <= n * m -> 0 <= n /\ 0 <= m \/ n <= 0 /\ m <= 0. +Theorem le_0_mul : + forall n m, 0 <= n * m -> 0 <= n /\ 0 <= m \/ n <= 0 /\ m <= 0. Proof. -assert (R : forall n : Z, 0 == n <-> n == 0) by (intros; split; apply Zeq_sym). -intros n m. repeat rewrite Zlt_eq_cases. repeat rewrite R. -rewrite Zlt_0_mul, Zeq_mul_0. -pose proof (Zlt_trichotomy n 0); pose proof (Zlt_trichotomy m 0). tauto. +assert (R : forall n, 0 == n <-> n == 0) by (intros; split; apply eq_sym). +intros n m. repeat rewrite lt_eq_cases. repeat rewrite R. +rewrite lt_0_mul, eq_mul_0. +pose proof (lt_trichotomy n 0); pose proof (lt_trichotomy m 0). tauto. Qed. -Notation Zmul_nonneg := Zle_0_mul (only parsing). +Notation mul_nonneg := le_0_mul (only parsing). -Theorem Zle_mul_0 : - forall n m : Z, n * m <= 0 -> 0 <= n /\ m <= 0 \/ n <= 0 /\ 0 <= m. +Theorem le_mul_0 : + forall n m, n * m <= 0 -> 0 <= n /\ m <= 0 \/ n <= 0 /\ 0 <= m. Proof. -assert (R : forall n : Z, 0 == n <-> n == 0) by (intros; split; apply Zeq_sym). -intros n m. repeat rewrite Zlt_eq_cases. repeat rewrite R. -rewrite Zlt_mul_0, Zeq_mul_0. -pose proof (Zlt_trichotomy n 0); pose proof (Zlt_trichotomy m 0). tauto. +assert (R : forall n, 0 == n <-> n == 0) by (intros; split; apply eq_sym). +intros n m. repeat rewrite lt_eq_cases. repeat rewrite R. +rewrite lt_mul_0, eq_mul_0. +pose proof (lt_trichotomy n 0); pose proof (lt_trichotomy m 0). tauto. Qed. -Notation Zmul_nonpos := Zle_mul_0 (only parsing). +Notation mul_nonpos := le_mul_0 (only parsing). -Theorem Zle_0_square : forall n : Z, 0 <= n * n. +Theorem le_0_square : forall n, 0 <= n * n. Proof. -intro n; destruct (Zneg_nonneg_cases n). -apply Zlt_le_incl; now apply Zmul_neg_neg. -now apply Zmul_nonneg_nonneg. +intro n; destruct (neg_nonneg_cases n). +apply lt_le_incl; now apply mul_neg_neg. +now apply mul_nonneg_nonneg. Qed. -Notation Zsquare_nonneg := Zle_0_square (only parsing). +Notation square_nonneg := le_0_square (only parsing). -Theorem Znlt_square_0 : forall n : Z, ~ n * n < 0. +Theorem nlt_square_0 : forall n, ~ n * n < 0. Proof. -intros n H. apply -> Zlt_nge in H. apply H. apply Zsquare_nonneg. +intros n H. apply -> lt_nge in H. apply H. apply square_nonneg. Qed. -Theorem Zsquare_lt_mono_nonneg : forall n m : Z, 0 <= n -> n < m -> n * n < m * m. -Proof NZsquare_lt_mono_nonneg. - -Theorem Zsquare_lt_mono_nonpos : forall n m : Z, n <= 0 -> m < n -> n * n < m * m. +Theorem square_lt_mono_nonpos : forall n m, n <= 0 -> m < n -> n * n < m * m. Proof. -intros n m H1 H2. now apply Zmul_lt_mono_nonpos. +intros n m H1 H2. now apply mul_lt_mono_nonpos. Qed. -Theorem Zsquare_le_mono_nonneg : forall n m : Z, 0 <= n -> n <= m -> n * n <= m * m. -Proof NZsquare_le_mono_nonneg. - -Theorem Zsquare_le_mono_nonpos : forall n m : Z, n <= 0 -> m <= n -> n * n <= m * m. +Theorem square_le_mono_nonpos : forall n m, n <= 0 -> m <= n -> n * n <= m * m. Proof. -intros n m H1 H2. now apply Zmul_le_mono_nonpos. +intros n m H1 H2. now apply mul_le_mono_nonpos. Qed. -Theorem Zsquare_lt_simpl_nonneg : forall n m : Z, 0 <= m -> n * n < m * m -> n < m. -Proof NZsquare_lt_simpl_nonneg. - -Theorem Zsquare_le_simpl_nonneg : forall n m : Z, 0 <= m -> n * n <= m * m -> n <= m. -Proof NZsquare_le_simpl_nonneg. - -Theorem Zsquare_lt_simpl_nonpos : forall n m : Z, m <= 0 -> n * n < m * m -> m < n. +Theorem square_lt_simpl_nonpos : forall n m, m <= 0 -> n * n < m * m -> m < n. Proof. -intros n m H1 H2. destruct (Zle_gt_cases n 0). -destruct (NZlt_ge_cases m n). -assumption. assert (F : m * m <= n * n) by now apply Zsquare_le_mono_nonpos. -apply -> NZle_ngt in F. false_hyp H2 F. -now apply Zle_lt_trans with 0. +intros n m H1 H2. destruct (le_gt_cases n 0). +destruct (lt_ge_cases m n). +assumption. assert (F : m * m <= n * n) by now apply square_le_mono_nonpos. +apply -> le_ngt in F. false_hyp H2 F. +now apply le_lt_trans with 0. Qed. -Theorem Zsquare_le_simpl_nonpos : forall n m : NZ, m <= 0 -> n * n <= m * m -> m <= n. +Theorem square_le_simpl_nonpos : forall n m, m <= 0 -> n * n <= m * m -> m <= n. Proof. -intros n m H1 H2. destruct (NZle_gt_cases n 0). -destruct (NZle_gt_cases m n). -assumption. assert (F : m * m < n * n) by now apply Zsquare_lt_mono_nonpos. -apply -> NZlt_nge in F. false_hyp H2 F. -apply Zlt_le_incl; now apply NZle_lt_trans with 0. +intros n m H1 H2. destruct (le_gt_cases n 0). +destruct (le_gt_cases m n). +assumption. assert (F : m * m < n * n) by now apply square_lt_mono_nonpos. +apply -> lt_nge in F. false_hyp H2 F. +apply lt_le_incl; now apply le_lt_trans with 0. Qed. -Theorem Zmul_2_mono_l : forall n m : Z, n < m -> 1 + (1 + 1) * n < (1 + 1) * m. -Proof NZmul_2_mono_l. - -Theorem Zlt_1_mul_neg : forall n m : Z, n < -1 -> m < 0 -> 1 < n * m. +Theorem lt_1_mul_neg : forall n m, n < -1 -> m < 0 -> 1 < n * m. Proof. -intros n m H1 H2. apply -> (NZmul_lt_mono_neg_r m) in H1. -apply <- Zopp_pos_neg in H2. rewrite Zmul_opp_l, Zmul_1_l in H1. -now apply Zlt_1_l with (- m). +intros n m H1 H2. apply -> (mul_lt_mono_neg_r m) in H1. +apply <- opp_pos_neg in H2. rewrite mul_opp_l, mul_1_l in H1. +now apply lt_1_l with (- m). assumption. Qed. -Theorem Zlt_mul_n1_neg : forall n m : Z, 1 < n -> m < 0 -> n * m < -1. +Theorem lt_mul_n1_neg : forall n m, 1 < n -> m < 0 -> n * m < -1. Proof. -intros n m H1 H2. apply -> (NZmul_lt_mono_neg_r m) in H1. -rewrite Zmul_1_l in H1. now apply Zlt_n1_r with m. +intros n m H1 H2. apply -> (mul_lt_mono_neg_r m) in H1. +rewrite mul_1_l in H1. now apply lt_n1_r with m. assumption. Qed. -Theorem Zlt_mul_n1_pos : forall n m : Z, n < -1 -> 0 < m -> n * m < -1. +Theorem lt_mul_n1_pos : forall n m, n < -1 -> 0 < m -> n * m < -1. Proof. -intros n m H1 H2. apply -> (NZmul_lt_mono_pos_r m) in H1. -rewrite Zmul_opp_l, Zmul_1_l in H1. -apply <- Zopp_neg_pos in H2. now apply Zlt_n1_r with (- m). +intros n m H1 H2. apply -> (mul_lt_mono_pos_r m) in H1. +rewrite mul_opp_l, mul_1_l in H1. +apply <- opp_neg_pos in H2. now apply lt_n1_r with (- m). assumption. Qed. -Theorem Zlt_1_mul_l : forall n m : Z, 1 < n -> n * m < -1 \/ n * m == 0 \/ 1 < n * m. +Theorem lt_1_mul_l : forall n m, 1 < n -> + n * m < -1 \/ n * m == 0 \/ 1 < n * m. Proof. -intros n m H; destruct (Zlt_trichotomy m 0) as [H1 | [H1 | H1]]. -left. now apply Zlt_mul_n1_neg. -right; left; now rewrite H1, Zmul_0_r. -right; right; now apply Zlt_1_mul_pos. +intros n m H; destruct (lt_trichotomy m 0) as [H1 | [H1 | H1]]. +left. now apply lt_mul_n1_neg. +right; left; now rewrite H1, mul_0_r. +right; right; now apply lt_1_mul_pos. Qed. -Theorem Zlt_n1_mul_r : forall n m : Z, n < -1 -> n * m < -1 \/ n * m == 0 \/ 1 < n * m. +Theorem lt_n1_mul_r : forall n m, n < -1 -> + n * m < -1 \/ n * m == 0 \/ 1 < n * m. Proof. -intros n m H; destruct (Zlt_trichotomy m 0) as [H1 | [H1 | H1]]. -right; right. now apply Zlt_1_mul_neg. -right; left; now rewrite H1, Zmul_0_r. -left. now apply Zlt_mul_n1_pos. +intros n m H; destruct (lt_trichotomy m 0) as [H1 | [H1 | H1]]. +right; right. now apply lt_1_mul_neg. +right; left; now rewrite H1, mul_0_r. +left. now apply lt_mul_n1_pos. Qed. -Theorem Zeq_mul_1 : forall n m : Z, n * m == 1 -> n == 1 \/ n == -1. +Theorem eq_mul_1 : forall n m, n * m == 1 -> n == 1 \/ n == -1. Proof. assert (F : ~ 1 < -1). intro H. -assert (H1 : -1 < 0). apply <- Zopp_neg_pos. apply Zlt_succ_diag_r. -assert (H2 : 1 < 0) by now apply Zlt_trans with (-1). false_hyp H2 Znlt_succ_diag_l. -Z0_pos_neg n. -intros m H; rewrite Zmul_0_l in H; false_hyp H Zneq_succ_diag_r. -intros n H; split; apply <- Zle_succ_l in H; le_elim H. -intros m H1; apply (Zlt_1_mul_l n m) in H. +assert (H1 : -1 < 0). apply <- opp_neg_pos. apply lt_succ_diag_r. +assert (H2 : 1 < 0) by now apply lt_trans with (-1). +false_hyp H2 nlt_succ_diag_l. +zero_pos_neg n. +intros m H; rewrite mul_0_l in H; false_hyp H neq_succ_diag_r. +intros n H; split; apply <- le_succ_l in H; le_elim H. +intros m H1; apply (lt_1_mul_l n m) in H. rewrite H1 in H; destruct H as [H | [H | H]]. -false_hyp H F. false_hyp H Zneq_succ_diag_l. false_hyp H Zlt_irrefl. +false_hyp H F. false_hyp H neq_succ_diag_l. false_hyp H lt_irrefl. intros; now left. -intros m H1; apply (Zlt_1_mul_l n m) in H. rewrite Zmul_opp_l in H1; -apply -> Zeq_opp_l in H1. rewrite H1 in H; destruct H as [H | [H | H]]. -false_hyp H Zlt_irrefl. apply -> Zeq_opp_l in H. rewrite Zopp_0 in H. -false_hyp H Zneq_succ_diag_l. false_hyp H F. -intros; right; symmetry; now apply Zopp_wd. +intros m H1; apply (lt_1_mul_l n m) in H. rewrite mul_opp_l in H1; +apply -> eq_opp_l in H1. rewrite H1 in H; destruct H as [H | [H | H]]. +false_hyp H lt_irrefl. apply -> eq_opp_l in H. rewrite opp_0 in H. +false_hyp H neq_succ_diag_l. false_hyp H F. +intros; right; symmetry; now apply opp_wd. Qed. -Theorem Zlt_mul_diag_l : forall n m : Z, n < 0 -> (1 < m <-> n * m < n). +Theorem lt_mul_diag_l : forall n m, n < 0 -> (1 < m <-> n * m < n). Proof. -intros n m H. stepr (n * m < n * 1) by now rewrite Zmul_1_r. -now apply Zmul_lt_mono_neg_l. +intros n m H. stepr (n * m < n * 1) by now rewrite mul_1_r. +now apply mul_lt_mono_neg_l. Qed. -Theorem Zlt_mul_diag_r : forall n m : Z, 0 < n -> (1 < m <-> n < n * m). +Theorem lt_mul_diag_r : forall n m, 0 < n -> (1 < m <-> n < n * m). Proof. -intros n m H. stepr (n * 1 < n * m) by now rewrite Zmul_1_r. -now apply Zmul_lt_mono_pos_l. +intros n m H. stepr (n * 1 < n * m) by now rewrite mul_1_r. +now apply mul_lt_mono_pos_l. Qed. -Theorem Zle_mul_diag_l : forall n m : Z, n < 0 -> (1 <= m <-> n * m <= n). +Theorem le_mul_diag_l : forall n m, n < 0 -> (1 <= m <-> n * m <= n). Proof. -intros n m H. stepr (n * m <= n * 1) by now rewrite Zmul_1_r. -now apply Zmul_le_mono_neg_l. +intros n m H. stepr (n * m <= n * 1) by now rewrite mul_1_r. +now apply mul_le_mono_neg_l. Qed. -Theorem Zle_mul_diag_r : forall n m : Z, 0 < n -> (1 <= m <-> n <= n * m). +Theorem le_mul_diag_r : forall n m, 0 < n -> (1 <= m <-> n <= n * m). Proof. -intros n m H. stepr (n * 1 <= n * m) by now rewrite Zmul_1_r. -now apply Zmul_le_mono_pos_l. +intros n m H. stepr (n * 1 <= n * m) by now rewrite mul_1_r. +now apply mul_le_mono_pos_l. Qed. -Theorem Zlt_mul_r : forall n m p : Z, 0 < n -> 1 < p -> n < m -> n < m * p. +Theorem lt_mul_r : forall n m p, 0 < n -> 1 < p -> n < m -> n < m * p. Proof. -intros. stepl (n * 1) by now rewrite Zmul_1_r. -apply Zmul_lt_mono_nonneg. -now apply Zlt_le_incl. assumption. apply Zle_0_1. assumption. +intros. stepl (n * 1) by now rewrite mul_1_r. +apply mul_lt_mono_nonneg. +now apply lt_le_incl. assumption. apply le_0_1. assumption. Qed. End ZMulOrderPropFunct. diff --git a/theories/Numbers/Integer/Abstract/ZProperties.v b/theories/Numbers/Integer/Abstract/ZProperties.v new file mode 100644 index 00000000..dc46edda --- /dev/null +++ b/theories/Numbers/Integer/Abstract/ZProperties.v @@ -0,0 +1,24 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id$ i*) + +Require Export ZAxioms ZMulOrder ZSgnAbs. + +(** This functor summarizes all known facts about Z. + For the moment it is only an alias to [ZMulOrderPropFunct], which + subsumes all others, plus properties of [sgn] and [abs]. +*) + +Module Type ZPropSig (Z:ZAxiomsExtSig) := + ZMulOrderPropFunct Z <+ ZSgnAbsPropSig Z. + +Module ZPropFunct (Z:ZAxiomsExtSig) <: ZPropSig Z. + Include ZPropSig Z. +End ZPropFunct. + diff --git a/theories/Numbers/Integer/Abstract/ZSgnAbs.v b/theories/Numbers/Integer/Abstract/ZSgnAbs.v new file mode 100644 index 00000000..8b191613 --- /dev/null +++ b/theories/Numbers/Integer/Abstract/ZSgnAbs.v @@ -0,0 +1,348 @@ +(************************************************************************) +(* 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 *) +(************************************************************************) + +Require Export ZMulOrder. + +(** An axiomatization of [abs]. *) + +Module Type HasAbs(Import Z : ZAxiomsSig'). + Parameter Inline abs : t -> t. + Axiom abs_eq : forall n, 0<=n -> abs n == n. + Axiom abs_neq : forall n, n<=0 -> abs n == -n. +End HasAbs. + +(** Since we already have [max], we could have defined [abs]. *) + +Module GenericAbs (Import Z : ZAxiomsSig') + (Import ZP : ZMulOrderPropFunct Z) <: HasAbs Z. + Definition abs n := max n (-n). + Lemma abs_eq : forall n, 0<=n -> abs n == n. + Proof. + intros. unfold abs. apply max_l. + apply le_trans with 0; auto. + rewrite opp_nonpos_nonneg; auto. + Qed. + Lemma abs_neq : forall n, n<=0 -> abs n == -n. + Proof. + intros. unfold abs. apply max_r. + apply le_trans with 0; auto. + rewrite opp_nonneg_nonpos; auto. + Qed. +End GenericAbs. + +(** An Axiomatization of [sgn]. *) + +Module Type HasSgn (Import Z : ZAxiomsSig'). + Parameter Inline sgn : t -> t. + Axiom sgn_null : forall n, n==0 -> sgn n == 0. + Axiom sgn_pos : forall n, 0<n -> sgn n == 1. + Axiom sgn_neg : forall n, n<0 -> sgn n == -(1). +End HasSgn. + +(** We can deduce a [sgn] function from a [compare] function *) + +Module Type ZDecAxiomsSig := ZAxiomsSig <+ HasCompare. +Module Type ZDecAxiomsSig' := ZAxiomsSig' <+ HasCompare. + +Module Type GenericSgn (Import Z : ZDecAxiomsSig') + (Import ZP : ZMulOrderPropFunct Z) <: HasSgn Z. + Definition sgn n := + match compare 0 n with Eq => 0 | Lt => 1 | Gt => -(1) end. + Lemma sgn_null : forall n, n==0 -> sgn n == 0. + Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. + Lemma sgn_pos : forall n, 0<n -> sgn n == 1. + Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. + Lemma sgn_neg : forall n, n<0 -> sgn n == -(1). + Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. +End GenericSgn. + +Module Type ZAxiomsExtSig := ZAxiomsSig <+ HasAbs <+ HasSgn. +Module Type ZAxiomsExtSig' := ZAxiomsSig' <+ HasAbs <+ HasSgn. + +Module Type ZSgnAbsPropSig (Import Z : ZAxiomsExtSig') + (Import ZP : ZMulOrderPropFunct Z). + +Ltac destruct_max n := + destruct (le_ge_cases 0 n); + [rewrite (abs_eq n) by auto | rewrite (abs_neq n) by auto]. + +Instance abs_wd : Proper (eq==>eq) abs. +Proof. + intros x y EQ. destruct_max x. + rewrite abs_eq; trivial. now rewrite <- EQ. + rewrite abs_neq; try order. now rewrite opp_inj_wd. +Qed. + +Lemma abs_max : forall n, abs n == max n (-n). +Proof. + intros n. destruct_max n. + rewrite max_l; auto with relations. + apply le_trans with 0; auto. + rewrite opp_nonpos_nonneg; auto. + rewrite max_r; auto with relations. + apply le_trans with 0; auto. + rewrite opp_nonneg_nonpos; auto. +Qed. + +Lemma abs_neq' : forall n, 0<=-n -> abs n == -n. +Proof. + intros. apply abs_neq. now rewrite <- opp_nonneg_nonpos. +Qed. + +Lemma abs_nonneg : forall n, 0 <= abs n. +Proof. + intros n. destruct_max n; auto. + now rewrite opp_nonneg_nonpos. +Qed. + +Lemma abs_eq_iff : forall n, abs n == n <-> 0<=n. +Proof. + split; try apply abs_eq. intros EQ. + rewrite <- EQ. apply abs_nonneg. +Qed. + +Lemma abs_neq_iff : forall n, abs n == -n <-> n<=0. +Proof. + split; try apply abs_neq. intros EQ. + rewrite <- opp_nonneg_nonpos, <- EQ. apply abs_nonneg. +Qed. + +Lemma abs_opp : forall n, abs (-n) == abs n. +Proof. + intros. destruct_max n. + rewrite (abs_neq (-n)), opp_involutive. reflexivity. + now rewrite opp_nonpos_nonneg. + rewrite (abs_eq (-n)). reflexivity. + now rewrite opp_nonneg_nonpos. +Qed. + +Lemma abs_0 : abs 0 == 0. +Proof. + apply abs_eq. apply le_refl. +Qed. + +Lemma abs_0_iff : forall n, abs n == 0 <-> n==0. +Proof. + split. destruct_max n; auto. + now rewrite eq_opp_l, opp_0. + intros EQ; rewrite EQ. rewrite abs_eq; auto using eq_refl, le_refl. +Qed. + +Lemma abs_pos : forall n, 0 < abs n <-> n~=0. +Proof. + intros. rewrite <- abs_0_iff. split; [intros LT| intros NEQ]. + intro EQ. rewrite EQ in LT. now elim (lt_irrefl 0). + assert (LE : 0 <= abs n) by apply abs_nonneg. + rewrite lt_eq_cases in LE; destruct LE; auto. + elim NEQ; auto with relations. +Qed. + +Lemma abs_eq_or_opp : forall n, abs n == n \/ abs n == -n. +Proof. + intros. destruct_max n; auto with relations. +Qed. + +Lemma abs_or_opp_abs : forall n, n == abs n \/ n == - abs n. +Proof. + intros. destruct_max n; rewrite ? opp_involutive; auto with relations. +Qed. + +Lemma abs_involutive : forall n, abs (abs n) == abs n. +Proof. + intros. apply abs_eq. apply abs_nonneg. +Qed. + +Lemma abs_spec : forall n, + (0 <= n /\ abs n == n) \/ (n < 0 /\ abs n == -n). +Proof. + intros. destruct (le_gt_cases 0 n). + left; split; auto. now apply abs_eq. + right; split; auto. apply abs_neq. now apply lt_le_incl. +Qed. + +Lemma abs_case_strong : + forall (P:t->Prop) n, Proper (eq==>iff) P -> + (0<=n -> P n) -> (n<=0 -> P (-n)) -> P (abs n). +Proof. + intros. destruct_max n; auto. +Qed. + +Lemma abs_case : forall (P:t->Prop) n, Proper (eq==>iff) P -> + P n -> P (-n) -> P (abs n). +Proof. intros. now apply abs_case_strong. Qed. + +Lemma abs_eq_cases : forall n m, abs n == abs m -> n == m \/ n == - m. +Proof. + intros n m EQ. destruct (abs_or_opp_abs n) as [EQn|EQn]. + rewrite EQn, EQ. apply abs_eq_or_opp. + rewrite EQn, EQ, opp_inj_wd, eq_opp_l, or_comm. apply abs_eq_or_opp. +Qed. + +(** Triangular inequality *) + +Lemma abs_triangle : forall n m, abs (n + m) <= abs n + abs m. +Proof. + intros. destruct_max n; destruct_max m. + rewrite abs_eq. apply le_refl. now apply add_nonneg_nonneg. + destruct_max (n+m); try rewrite opp_add_distr; + apply add_le_mono_l || apply add_le_mono_r. + apply le_trans with 0; auto. now rewrite opp_nonneg_nonpos. + apply le_trans with 0; auto. now rewrite opp_nonpos_nonneg. + destruct_max (n+m); try rewrite opp_add_distr; + apply add_le_mono_l || apply add_le_mono_r. + apply le_trans with 0; auto. now rewrite opp_nonneg_nonpos. + apply le_trans with 0; auto. now rewrite opp_nonpos_nonneg. + rewrite abs_neq, opp_add_distr. apply le_refl. + now apply add_nonpos_nonpos. +Qed. + +Lemma abs_sub_triangle : forall n m, abs n - abs m <= abs (n-m). +Proof. + intros. + rewrite le_sub_le_add_l, add_comm. + rewrite <- (sub_simpl_r n m) at 1. + apply abs_triangle. +Qed. + +(** Absolute value and multiplication *) + +Lemma abs_mul : forall n m, abs (n * m) == abs n * abs m. +Proof. + assert (H : forall n m, 0<=n -> abs (n*m) == n * abs m). + intros. destruct_max m. + rewrite abs_eq. apply eq_refl. now apply mul_nonneg_nonneg. + rewrite abs_neq, mul_opp_r. reflexivity. now apply mul_nonneg_nonpos . + intros. destruct_max n. now apply H. + rewrite <- mul_opp_opp, H, abs_opp. reflexivity. + now apply opp_nonneg_nonpos. +Qed. + +Lemma abs_square : forall n, abs n * abs n == n * n. +Proof. + intros. rewrite <- abs_mul. apply abs_eq. apply le_0_square. +Qed. + +(** Some results about the sign function. *) + +Ltac destruct_sgn n := + let LT := fresh "LT" in + let EQ := fresh "EQ" in + let GT := fresh "GT" in + destruct (lt_trichotomy 0 n) as [LT|[EQ|GT]]; + [rewrite (sgn_pos n) by auto| + rewrite (sgn_null n) by auto with relations| + rewrite (sgn_neg n) by auto]. + +Instance sgn_wd : Proper (eq==>eq) sgn. +Proof. + intros x y Hxy. destruct_sgn x. + rewrite sgn_pos; auto with relations. rewrite <- Hxy; auto. + rewrite sgn_null; auto with relations. rewrite <- Hxy; auto with relations. + rewrite sgn_neg; auto with relations. rewrite <- Hxy; auto. +Qed. + +Lemma sgn_spec : forall n, + 0 < n /\ sgn n == 1 \/ + 0 == n /\ sgn n == 0 \/ + 0 > n /\ sgn n == -(1). +Proof. + intros n. + destruct_sgn n; [left|right;left|right;right]; auto with relations. +Qed. + +Lemma sgn_0 : sgn 0 == 0. +Proof. + now apply sgn_null. +Qed. + +Lemma sgn_pos_iff : forall n, sgn n == 1 <-> 0<n. +Proof. + split; try apply sgn_pos. destruct_sgn n; auto. + intros. elim (lt_neq 0 1); auto. apply lt_0_1. + intros. elim (lt_neq (-(1)) 1); auto. + apply lt_trans with 0. rewrite opp_neg_pos. apply lt_0_1. apply lt_0_1. +Qed. + +Lemma sgn_null_iff : forall n, sgn n == 0 <-> n==0. +Proof. + split; try apply sgn_null. destruct_sgn n; auto with relations. + intros. elim (lt_neq 0 1); auto with relations. apply lt_0_1. + intros. elim (lt_neq (-(1)) 0); auto. + rewrite opp_neg_pos. apply lt_0_1. +Qed. + +Lemma sgn_neg_iff : forall n, sgn n == -(1) <-> n<0. +Proof. + split; try apply sgn_neg. destruct_sgn n; auto with relations. + intros. elim (lt_neq (-(1)) 1); auto with relations. + apply lt_trans with 0. rewrite opp_neg_pos. apply lt_0_1. apply lt_0_1. + intros. elim (lt_neq (-(1)) 0); auto with relations. + rewrite opp_neg_pos. apply lt_0_1. +Qed. + +Lemma sgn_opp : forall n, sgn (-n) == - sgn n. +Proof. + intros. destruct_sgn n. + apply sgn_neg. now rewrite opp_neg_pos. + setoid_replace n with 0 by auto with relations. + rewrite opp_0. apply sgn_0. + rewrite opp_involutive. apply sgn_pos. now rewrite opp_pos_neg. +Qed. + +Lemma sgn_nonneg : forall n, 0 <= sgn n <-> 0 <= n. +Proof. + split. + destruct_sgn n; intros. + now apply lt_le_incl. + order. + elim (lt_irrefl 0). apply lt_le_trans with 1; auto using lt_0_1. + now rewrite <- opp_nonneg_nonpos. + rewrite lt_eq_cases; destruct 1. + rewrite sgn_pos by auto. apply lt_le_incl, lt_0_1. + rewrite sgn_null by auto with relations. apply le_refl. +Qed. + +Lemma sgn_nonpos : forall n, sgn n <= 0 <-> n <= 0. +Proof. + intros. rewrite <- 2 opp_nonneg_nonpos, <- sgn_opp. apply sgn_nonneg. +Qed. + +Lemma sgn_mul : forall n m, sgn (n*m) == sgn n * sgn m. +Proof. + intros. destruct_sgn n; nzsimpl. + destruct_sgn m. + apply sgn_pos. now apply mul_pos_pos. + apply sgn_null. rewrite eq_mul_0; auto with relations. + apply sgn_neg. now apply mul_pos_neg. + apply sgn_null. rewrite eq_mul_0; auto with relations. + destruct_sgn m; try rewrite mul_opp_opp; nzsimpl. + apply sgn_neg. now apply mul_neg_pos. + apply sgn_null. rewrite eq_mul_0; auto with relations. + apply sgn_pos. now apply mul_neg_neg. +Qed. + +Lemma sgn_abs : forall n, n * sgn n == abs n. +Proof. + intros. symmetry. + destruct_sgn n; try rewrite mul_opp_r; nzsimpl. + apply abs_eq. now apply lt_le_incl. + rewrite abs_0_iff; auto with relations. + apply abs_neq. now apply lt_le_incl. +Qed. + +Lemma abs_sgn : forall n, abs n * sgn n == n. +Proof. + intros. + destruct_sgn n; try rewrite mul_opp_r; nzsimpl; auto. + apply abs_eq. now apply lt_le_incl. + rewrite eq_opp_l. apply abs_neq. now apply lt_le_incl. +Qed. + +End ZSgnAbsPropSig. + + diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v index e5e950ac..4e024c02 100644 --- a/theories/Numbers/Integer/BigZ/BigZ.v +++ b/theories/Numbers/Integer/BigZ/BigZ.v @@ -8,20 +8,31 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: BigZ.v 11576 2008-11-10 19:13:15Z msozeau $ i*) +(*i $Id$ i*) Require Export BigN. -Require Import ZMulOrder. -Require Import ZSig. -Require Import ZSigZAxioms. -Require Import ZMake. +Require Import ZProperties ZDivFloor ZSig ZSigZAxioms ZMake. -Module BigZ <: ZType := ZMake.Make BigN. +(** * [BigZ] : arbitrary large efficient integers. -(** Module [BigZ] implements [ZAxiomsSig] *) + The following [BigZ] module regroups both the operations and + all the abstract properties: -Module Export BigZAxiomsMod := ZSig_ZAxioms BigZ. -Module Export BigZMulOrderPropMod := ZMulOrderPropFunct BigZAxiomsMod. + - [ZMake.Make BigN] provides the operations and basic specs w.r.t. ZArith + - [ZTypeIsZAxioms] shows (mainly) that these operations implement + the interface [ZAxioms] + - [ZPropSig] adds all generic properties derived from [ZAxioms] + - [ZDivPropFunct] provides generic properties of [div] and [mod] + ("Floor" variant) + - [MinMax*Properties] provides properties of [min] and [max] + +*) + + +Module BigZ <: ZType <: OrderedTypeFull <: TotalOrder := + ZMake.Make BigN <+ ZTypeIsZAxioms + <+ !ZPropSig <+ !ZDivPropFunct <+ HasEqBool2Dec + <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties. (** Notations about [BigZ] *) @@ -31,26 +42,60 @@ Delimit Scope bigZ_scope with bigZ. Bind Scope bigZ_scope with bigZ. Bind Scope bigZ_scope with BigZ.t. Bind Scope bigZ_scope with BigZ.t_. - -Notation Local "0" := BigZ.zero : bigZ_scope. +(* Bind Scope has no retroactive effect, let's declare scopes by hand. *) +Arguments Scope BigZ.Pos [bigN_scope]. +Arguments Scope BigZ.Neg [bigN_scope]. +Arguments Scope BigZ.to_Z [bigZ_scope]. +Arguments Scope BigZ.succ [bigZ_scope]. +Arguments Scope BigZ.pred [bigZ_scope]. +Arguments Scope BigZ.opp [bigZ_scope]. +Arguments Scope BigZ.square [bigZ_scope]. +Arguments Scope BigZ.add [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.sub [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.mul [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.div [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.eq [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.lt [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.le [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.eq [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.compare [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.min [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.max [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.eq_bool [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.power_pos [bigZ_scope positive_scope]. +Arguments Scope BigZ.power [bigZ_scope N_scope]. +Arguments Scope BigZ.sqrt [bigZ_scope]. +Arguments Scope BigZ.div_eucl [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.modulo [bigZ_scope bigZ_scope]. +Arguments Scope BigZ.gcd [bigZ_scope bigZ_scope]. + +Local Notation "0" := BigZ.zero : bigZ_scope. +Local Notation "1" := BigZ.one : bigZ_scope. Infix "+" := BigZ.add : bigZ_scope. Infix "-" := BigZ.sub : bigZ_scope. Notation "- x" := (BigZ.opp x) : bigZ_scope. Infix "*" := BigZ.mul : bigZ_scope. Infix "/" := BigZ.div : bigZ_scope. +Infix "^" := BigZ.power : bigZ_scope. Infix "?=" := BigZ.compare : bigZ_scope. Infix "==" := BigZ.eq (at level 70, no associativity) : bigZ_scope. +Notation "x != y" := (~x==y)%bigZ (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 "x < y < z" := (x<y /\ y<z)%bigZ : bigZ_scope. +Notation "x < y <= z" := (x<y /\ y<=z)%bigZ : bigZ_scope. +Notation "x <= y < z" := (x<=y /\ y<z)%bigZ : bigZ_scope. +Notation "x <= y <= z" := (x<=y /\ y<=z)%bigZ : bigZ_scope. Notation "[ i ]" := (BigZ.to_Z i) : bigZ_scope. +Infix "mod" := BigZ.modulo (at level 40, no associativity) : bigN_scope. -Open Scope bigZ_scope. +Local 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; @@ -62,7 +107,7 @@ Qed. Theorem spec_to_N n: ([n] = Zsgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z. Proof. -intros n; case n; simpl; intros p; +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. @@ -77,35 +122,97 @@ intros p1 _ H1; case H1; auto. intros p1 H1; case H1; auto. Qed. -Lemma sub_opp : forall x y : bigZ, x - y == x + (- y). +(** [BigZ] is a ring *) + +Lemma BigZring : + ring_theory 0 1 BigZ.add BigZ.mul BigZ.sub BigZ.opp BigZ.eq. Proof. -red; intros; zsimpl; auto. +constructor. +exact BigZ.add_0_l. exact BigZ.add_comm. exact BigZ.add_assoc. +exact BigZ.mul_1_l. exact BigZ.mul_comm. exact BigZ.mul_assoc. +exact BigZ.mul_add_distr_r. +symmetry. apply BigZ.add_opp_r. +exact BigZ.add_opp_diag_r. Qed. -Lemma add_opp : forall x : bigZ, x + (- x) == 0. +Lemma BigZeqb_correct : forall x y, BigZ.eq_bool x y = true -> x==y. +Proof. now apply BigZ.eqb_eq. Qed. + +Lemma BigZpower : power_theory 1 BigZ.mul BigZ.eq (@id N) BigZ.power. Proof. -red; intros; zsimpl; auto with zarith. +constructor. +intros. red. rewrite BigZ.spec_power. unfold id. +destruct Zpower_theory as [EQ]. rewrite EQ. +destruct n; simpl. reflexivity. +induction p; simpl; intros; BigZ.zify; rewrite ?IHp; auto. Qed. -(** [BigZ] is a ring *) +Lemma BigZdiv : div_theory BigZ.eq BigZ.add BigZ.mul (@id _) + (fun a b => if BigZ.eq_bool b 0 then (0,a) else BigZ.div_eucl a b). +Proof. +constructor. unfold id. intros a b. +BigZ.zify. +generalize (Zeq_bool_if [b] 0); destruct (Zeq_bool [b] 0). +BigZ.zify. auto with zarith. +intros NEQ. +generalize (BigZ.spec_div_eucl a b). +generalize (Z_div_mod_full [a] [b] NEQ). +destruct BigZ.div_eucl as (q,r), Zdiv_eucl as (q',r'). +intros (EQ,_). injection 1. intros EQr EQq. +BigZ.zify. rewrite EQr, EQq; auto. +Qed. -Lemma BigZring : - ring_theory BigZ.zero BigZ.one BigZ.add BigZ.mul BigZ.sub BigZ.opp BigZ.eq. +(** Detection of constants *) + +Ltac isBigZcst t := + match t with + | BigZ.Pos ?t => isBigNcst t + | BigZ.Neg ?t => isBigNcst t + | BigZ.zero => constr:true + | BigZ.one => constr:true + | BigZ.minus_one => constr:true + | _ => constr:false + end. + +Ltac BigZcst t := + match isBigZcst t with + | true => constr:t + | false => constr:NotConstant + end. + +(** Registration for the "ring" tactic *) + +Add Ring BigZr : BigZring + (decidable BigZeqb_correct, + constants [BigZcst], + power_tac BigZpower [Ncst], + div BigZdiv). + +Section TestRing. +Let test : forall x y, 1 + x*y + x^2 + 1 == 1*1 + 1 + y*x + 1*x*x. Proof. -constructor. -exact Zadd_0_l. -exact Zadd_comm. -exact Zadd_assoc. -exact Zmul_1_l. -exact Zmul_comm. -exact Zmul_assoc. -exact Zmul_add_distr_r. -exact sub_opp. -exact add_opp. +intros. ring_simplify. reflexivity. Qed. +Let test' : forall x y, 1 + x*y + x^2 - 1*1 - y*x + 1*(-x)*x == 0. +Proof. +intros. ring_simplify. reflexivity. +Qed. +End TestRing. + +(** [BigZ] also benefits from an "order" tactic *) + +Ltac bigZ_order := BigZ.order. + +Section TestOrder. +Let test : forall x y : bigZ, x<=y -> y<=x -> x==y. +Proof. bigZ_order. Qed. +End TestOrder. -Add Ring BigZr : BigZring. +(** We can use at least a bit of (r)omega by translating to [Z]. *) -(** Todo: tactic translating from [BigZ] to [Z] + omega *) +Section TestOmega. +Let test : forall x y : bigZ, x<=y -> y<=x -> x==y. +Proof. intros x y. BigZ.zify. omega. Qed. +End TestOmega. (** Todo: micromega *) diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v index 98ad4c64..3196f11e 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 11576 2008-11-10 19:13:15Z msozeau $ i*) +(*i $Id$ i*) Require Import ZArith. Require Import BigNumPrelude. @@ -17,31 +17,31 @@ Require Import ZSig. Open Scope Z_scope. -(** * ZMake - - A generic transformation from a structure of natural numbers +(** * ZMake + + A generic transformation from a structure of natural numbers [NSig.NType] to a structure of integers [ZSig.ZType]. *) Module Make (N:NType) <: ZType. - - Inductive t_ := + + Inductive t_ := | Pos : N.t -> t_ | Neg : N.t -> t_. - + Definition t := t_. Definition zero := Pos N.zero. Definition one := Pos N.one. Definition minus_one := Neg N.one. - Definition of_Z x := + Definition of_Z x := match x with | Zpos x => Pos (N.of_N (Npos x)) | Z0 => zero | Zneg x => Neg (N.of_N (Npos x)) end. - + Definition to_Z x := match x with | Pos nx => N.to_Z nx @@ -49,6 +49,7 @@ Module Make (N:NType) <: ZType. end. Theorem spec_of_Z: forall x, to_Z (of_Z x) = x. + Proof. intros x; case x; unfold to_Z, of_Z, zero. exact N.spec_0. intros; rewrite N.spec_of_N; auto. @@ -85,72 +86,52 @@ Module Make (N:NType) <: ZType. | Neg nx, Neg ny => N.compare ny nx end. - Definition lt n m := compare n m = Lt. - Definition le n m := compare n m <> Gt. - Definition min n m := match compare n m with Gt => m | _ => n end. - Definition max n m := match compare n m with Lt => m | _ => n end. + Theorem spec_compare : + forall x y, compare x y = Zcompare (to_Z x) (to_Z y). + Proof. + unfold compare, to_Z. + destruct x as [x|x], y as [y|y]; + rewrite ?N.spec_compare, ?N.spec_0, <-?Zcompare_opp; auto; + assert (Hx:=N.spec_pos x); assert (Hy:=N.spec_pos y); + set (X:=N.to_Z x) in *; set (Y:=N.to_Z y) in *; clearbody X Y. + destruct (Zcompare_spec X 0) as [EQ|LT|GT]. + rewrite EQ. rewrite <- Zopp_0 at 2. apply Zcompare_opp. + exfalso. omega. + symmetry. change (X > -Y). omega. + destruct (Zcompare_spec 0 X) as [EQ|LT|GT]. + rewrite <- EQ. rewrite Zopp_0; auto. + symmetry. change (-X < Y). omega. + exfalso. omega. + Qed. - Theorem spec_compare: forall x y, - match compare x y with - Eq => to_Z x = to_Z y - | Lt => to_Z x < to_Z y - | Gt => to_Z x > to_Z y - end. - unfold compare, to_Z; intros x y; case x; case y; clear x y; - intros x y; auto; generalize (N.spec_pos x) (N.spec_pos y). - generalize (N.spec_compare y x); case N.compare; auto with zarith. - generalize (N.spec_compare y N.zero); case N.compare; - try rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare x N.zero); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare x N.zero); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare N.zero y); case N.compare; - try rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare x y); case N.compare; auto with zarith. - Qed. - - Definition eq_bool x y := + Definition eq_bool x y := match compare x y with | Eq => true | _ => false end. - Theorem spec_eq_bool: forall x y, - if eq_bool x y then to_Z x = to_Z y else to_Z x <> to_Z y. - intros x y; unfold eq_bool; - generalize (spec_compare x y); case compare; auto with zarith. + Theorem spec_eq_bool: + forall x y, eq_bool x y = Zeq_bool (to_Z x) (to_Z y). + Proof. + unfold eq_bool, Zeq_bool; intros; rewrite spec_compare; reflexivity. Qed. - Definition cmp_sign x y := - match x, y with - | Pos nx, Neg ny => - if N.eq_bool ny N.zero then Eq else Gt - | Neg nx, Pos ny => - if N.eq_bool nx N.zero then Eq else Lt - | _, _ => Eq - end. + Definition lt n m := to_Z n < to_Z m. + Definition le n m := to_Z n <= to_Z m. + + Definition min n m := match compare n m with Gt => m | _ => n end. + Definition max n m := match compare n m with Lt => m | _ => n end. + + Theorem spec_min : forall n m, to_Z (min n m) = Zmin (to_Z n) (to_Z m). + Proof. + unfold min, Zmin. intros. rewrite spec_compare. destruct Zcompare; auto. + Qed. + + Theorem spec_max : forall n m, to_Z (max n m) = Zmax (to_Z n) (to_Z m). + Proof. + unfold max, Zmax. intros. rewrite spec_compare. destruct Zcompare; auto. + Qed. - Theorem spec_cmp_sign: forall x y, - match cmp_sign x y with - | Gt => 0 <= to_Z x /\ to_Z y < 0 - | Lt => to_Z x < 0 /\ 0 <= to_Z y - | Eq => True - end. - Proof. - intros [x | x] [y | y]; unfold cmp_sign; auto. - generalize (N.spec_eq_bool y N.zero); case N.eq_bool; auto. - rewrite N.spec_0; unfold to_Z. - generalize (N.spec_pos x) (N.spec_pos y); auto with zarith. - generalize (N.spec_eq_bool x N.zero); case N.eq_bool; auto. - rewrite N.spec_0; unfold to_Z. - generalize (N.spec_pos x) (N.spec_pos y); auto with zarith. - Qed. - Definition to_N x := match x with | Pos nx => nx @@ -160,21 +141,23 @@ Module Make (N:NType) <: ZType. Definition abs x := Pos (to_N x). Theorem spec_abs: forall x, to_Z (abs x) = Zabs (to_Z x). + Proof. intros x; case x; clear x; intros x; assert (F:=N.spec_pos x). simpl; rewrite Zabs_eq; auto. simpl; rewrite Zabs_non_eq; simpl; auto with zarith. Qed. - - Definition opp x := - match x with + + Definition opp x := + match x with | Pos nx => Neg nx | Neg nx => Pos nx end. Theorem spec_opp: forall x, to_Z (opp x) = - to_Z x. + Proof. intros x; case x; simpl; auto with zarith. Qed. - + Definition succ x := match x with | Pos n => Pos (N.succ n) @@ -186,12 +169,12 @@ Module Make (N:NType) <: ZType. end. Theorem spec_succ: forall n, to_Z (succ n) = to_Z n + 1. + Proof. intros x; case x; clear x; intros x. exact (N.spec_succ x). - simpl; generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; simpl. + simpl. rewrite N.spec_compare. case Zcompare_spec; rewrite ?N.spec_0; simpl. intros HH; rewrite <- HH; rewrite N.spec_1; ring. - intros HH; rewrite N.spec_pred; auto with zarith. + intros HH; rewrite N.spec_pred, Zmax_r; auto with zarith. generalize (N.spec_pos x); auto with zarith. Qed. @@ -212,19 +195,13 @@ Module Make (N:NType) <: ZType. end | Neg nx, Neg ny => Neg (N.add nx ny) end. - + Theorem spec_add: forall x y, to_Z (add x y) = to_Z x + to_Z y. - unfold add, to_Z; intros [x | x] [y | y]. - exact (N.spec_add x y). - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_add; try ring; auto with zarith. + Proof. + unfold add, to_Z; intros [x | x] [y | y]; + try (rewrite N.spec_add; auto with zarith); + rewrite N.spec_compare; case Zcompare_spec; + unfold zero; rewrite ?N.spec_0, ?N.spec_sub; omega with *. Qed. Definition pred x := @@ -238,17 +215,17 @@ Module Make (N:NType) <: ZType. end. Theorem spec_pred: forall x, to_Z (pred x) = to_Z x - 1. - unfold pred, to_Z, minus_one; intros [x | x]. - generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; try rewrite N.spec_1; auto with zarith. - intros H; exact (N.spec_pred _ H). - generalize (N.spec_pos x); auto with zarith. - rewrite N.spec_succ; ring. + Proof. + unfold pred, to_Z, minus_one; intros [x | x]; + try (rewrite N.spec_succ; ring). + rewrite N.spec_compare; case Zcompare_spec; + rewrite ?N.spec_0, ?N.spec_1, ?N.spec_pred; + generalize (N.spec_pos x); omega with *. Qed. Definition sub x y := match x, y with - | Pos nx, Pos ny => + | Pos nx, Pos ny => match N.compare nx ny with | Gt => Pos (N.sub nx ny) | Eq => zero @@ -256,7 +233,7 @@ Module Make (N:NType) <: ZType. end | Pos nx, Neg ny => Pos (N.add nx ny) | Neg nx, Pos ny => Neg (N.add nx ny) - | Neg nx, Neg ny => + | Neg nx, Neg ny => match N.compare nx ny with | Gt => Neg (N.sub nx ny) | Eq => zero @@ -265,20 +242,14 @@ Module Make (N:NType) <: ZType. end. Theorem spec_sub: forall x y, to_Z (sub x y) = to_Z x - to_Z y. - unfold sub, to_Z; intros [x | x] [y | y]. - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - rewrite N.spec_add; ring. - rewrite N.spec_add; ring. - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. + Proof. + unfold sub, to_Z; intros [x | x] [y | y]; + try (rewrite N.spec_add; auto with zarith); + rewrite N.spec_compare; case Zcompare_spec; + unfold zero; rewrite ?N.spec_0, ?N.spec_sub; omega with *. Qed. - Definition mul x y := + Definition mul x y := match x, y with | Pos nx, Pos ny => Pos (N.mul nx ny) | Pos nx, Neg ny => Neg (N.mul nx ny) @@ -286,25 +257,26 @@ Module Make (N:NType) <: ZType. | Neg nx, Neg ny => Pos (N.mul nx ny) end. - Theorem spec_mul: forall x y, to_Z (mul x y) = to_Z x * to_Z y. + Proof. unfold mul, to_Z; intros [x | x] [y | y]; rewrite N.spec_mul; ring. Qed. - Definition square x := + Definition square x := match x with | Pos nx => Pos (N.square nx) | Neg nx => Pos (N.square nx) end. Theorem spec_square: forall x, to_Z (square x) = to_Z x * to_Z x. + Proof. unfold square, to_Z; intros [x | x]; rewrite N.spec_square; ring. Qed. Definition power_pos x p := match x with | Pos nx => Pos (N.power_pos nx p) - | Neg nx => + | Neg nx => match p with | xH => x | xO _ => Pos (N.power_pos nx p) @@ -313,9 +285,10 @@ Module Make (N:NType) <: ZType. end. Theorem spec_power_pos: forall x n, to_Z (power_pos x n) = to_Z x ^ Zpos n. + Proof. assert (F0: forall x, (-x)^2 = x^2). intros x; rewrite Zpower_2; ring. - unfold power_pos, to_Z; intros [x | x] [p | p |]; + unfold power_pos, to_Z; intros [x | x] [p | p |]; try rewrite N.spec_power_pos; try ring. assert (F: 0 <= 2 * Zpos p). assert (0 <= Zpos p); auto with zarith. @@ -329,15 +302,28 @@ Module Make (N:NType) <: ZType. rewrite F0; ring. Qed. + Definition power x n := + match n with + | N0 => one + | Npos p => power_pos x p + end. + + Theorem spec_power: forall x n, to_Z (power x n) = to_Z x ^ Z_of_N n. + Proof. + destruct n; simpl. rewrite N.spec_1; reflexivity. + apply spec_power_pos. + Qed. + + Definition sqrt x := match x with | Pos nx => Pos (N.sqrt nx) | Neg nx => Neg N.zero end. - - Theorem spec_sqrt: forall x, 0 <= to_Z x -> + Theorem spec_sqrt: forall x, 0 <= to_Z x -> to_Z (sqrt x) ^ 2 <= to_Z x < (to_Z (sqrt x) + 1) ^ 2. + Proof. unfold to_Z, sqrt; intros [x | x] H. exact (N.spec_sqrt x). replace (N.to_Z x) with 0. @@ -353,113 +339,75 @@ Module Make (N:NType) <: ZType. (Pos q, Pos r) | Pos nx, Neg ny => let (q, r) := N.div_eucl nx ny in - match N.compare N.zero r with - | Eq => (Neg q, zero) - | _ => (Neg (N.succ q), Neg (N.sub ny r)) - end + if N.eq_bool N.zero r + then (Neg q, zero) + else (Neg (N.succ q), Neg (N.sub ny r)) | Neg nx, Pos ny => let (q, r) := N.div_eucl nx ny in - match N.compare N.zero r with - | Eq => (Neg q, zero) - | _ => (Neg (N.succ q), Pos (N.sub ny r)) - end + if N.eq_bool N.zero r + then (Neg q, zero) + else (Neg (N.succ q), Pos (N.sub ny r)) | Neg nx, Neg ny => let (q, r) := N.div_eucl nx ny in (Pos q, Neg r) end. + Ltac break_nonneg x px EQx := + let H := fresh "H" in + assert (H:=N.spec_pos x); + destruct (N.to_Z x) as [|px|px]_eqn:EQx; + [clear H|clear H|elim H; reflexivity]. Theorem spec_div_eucl: forall x y, - to_Z y <> 0 -> - let (q,r) := div_eucl x y in - (to_Z q, to_Z r) = Zdiv_eucl (to_Z x) (to_Z y). - unfold div_eucl, to_Z; intros [x | x] [y | y] H. - assert (H1: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y H1); case N.div_eucl; auto. - assert (HH: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y HH); case N.div_eucl; auto. - intros q r; generalize (N.spec_pos x) HH; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); - try (intros; apply False_ind; auto with zarith; fail). - intros p He1 He2 _ _ H1; injection H1; intros H2 H3. - generalize (N.spec_compare N.zero r); case N.compare; - unfold zero; rewrite N.spec_0; try rewrite H3; auto. - rewrite H2; intros; apply False_ind; auto with zarith. - rewrite H2; intros; apply False_ind; auto with zarith. - intros p _ _ _ H1; discriminate H1. - intros p He p1 He1 H1 _. - generalize (N.spec_compare N.zero r); case N.compare. - change (- Zpos p) with (Zneg p). - unfold zero; lazy zeta. - rewrite N.spec_0; intros H2; rewrite <- H2. - intros H3; rewrite <- H3; auto. - rewrite N.spec_0; intros H2. - change (- Zpos p) with (Zneg p); lazy iota beta. - intros H3; rewrite <- H3; auto. - rewrite N.spec_succ; rewrite N.spec_sub. - generalize H2; case (N.to_Z r). - intros; apply False_ind; auto with zarith. - intros p2 _; rewrite He; auto with zarith. - change (Zneg p) with (- (Zpos p)); apply f_equal2 with (f := @pair Z Z); ring. - intros p2 H4; discriminate H4. - assert (N.to_Z r = (Zpos p1 mod (Zpos p))). - unfold Zmod, Zdiv_eucl; rewrite <- H3; auto. - case (Z_mod_lt (Zpos p1) (Zpos p)); auto with zarith. - rewrite N.spec_0; intros H2; generalize (N.spec_pos r); - intros; apply False_ind; auto with zarith. - assert (HH: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y HH); case N.div_eucl; auto. - intros q r; generalize (N.spec_pos x) HH; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); - try (intros; apply False_ind; auto with zarith; fail). - intros p He1 He2 _ _ H1; injection H1; intros H2 H3. - generalize (N.spec_compare N.zero r); case N.compare; - unfold zero; rewrite N.spec_0; try rewrite H3; auto. - rewrite H2; intros; apply False_ind; auto with zarith. - rewrite H2; intros; apply False_ind; auto with zarith. - intros p _ _ _ H1; discriminate H1. - intros p He p1 He1 H1 _. - generalize (N.spec_compare N.zero r); case N.compare. - change (- Zpos p1) with (Zneg p1). - unfold zero; lazy zeta. - rewrite N.spec_0; intros H2; rewrite <- H2. - intros H3; rewrite <- H3; auto. - rewrite N.spec_0; intros H2. - change (- Zpos p1) with (Zneg p1); lazy iota beta. - intros H3; rewrite <- H3; auto. - rewrite N.spec_succ; rewrite N.spec_sub. - generalize H2; case (N.to_Z r). - intros; apply False_ind; auto with zarith. - intros p2 _; rewrite He; auto with zarith. - intros p2 H4; discriminate H4. - assert (N.to_Z r = (Zpos p1 mod (Zpos p))). - unfold Zmod, Zdiv_eucl; rewrite <- H3; auto. - case (Z_mod_lt (Zpos p1) (Zpos p)); auto with zarith. - rewrite N.spec_0; generalize (N.spec_pos r); intros; apply False_ind; auto with zarith. - assert (H1: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y H1); case N.div_eucl; auto. - intros q r; generalize (N.spec_pos x) H1; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); - try (intros; apply False_ind; auto with zarith; fail). - change (-0) with 0; lazy iota beta; auto. - intros p _ _ _ _ H2; injection H2. - intros H3 H4; rewrite H3; rewrite H4; auto. - intros p _ _ _ H2; discriminate H2. - intros p He p1 He1 _ _ H2. - change (- Zpos p1) with (Zneg p1); lazy iota beta. - change (- Zpos p) with (Zneg p); lazy iota beta. - rewrite <- H2; auto. + let (q,r) := div_eucl x y in + (to_Z q, to_Z r) = Zdiv_eucl (to_Z x) (to_Z y). + Proof. + unfold div_eucl, to_Z. intros [x | x] [y | y]. + (* Pos Pos *) + generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y); auto. + (* Pos Neg *) + generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r). + break_nonneg x px EQx; break_nonneg y py EQy; + try (injection 1; intros Hr Hq; rewrite N.spec_eq_bool, N.spec_0, Hr; + simpl; rewrite Hq, N.spec_0; auto). + change (- Zpos py) with (Zneg py). + assert (GT : Zpos py > 0) by (compute; auto). + generalize (Z_div_mod (Zpos px) (Zpos py) GT). + unfold Zdiv_eucl. destruct (Zdiv_eucl_POS px (Zpos py)) as (q',r'). + intros (EQ,MOD). injection 1. intros Hr' Hq'. + rewrite N.spec_eq_bool, N.spec_0, Hr'. + break_nonneg r pr EQr. + subst; simpl. rewrite N.spec_0; auto. + subst. lazy iota beta delta [Zeq_bool Zcompare]. + rewrite N.spec_sub, N.spec_succ, EQy, EQr. f_equal. omega with *. + (* Neg Pos *) + generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r). + break_nonneg x px EQx; break_nonneg y py EQy; + try (injection 1; intros Hr Hq; rewrite N.spec_eq_bool, N.spec_0, Hr; + simpl; rewrite Hq, N.spec_0; auto). + change (- Zpos px) with (Zneg px). + assert (GT : Zpos py > 0) by (compute; auto). + generalize (Z_div_mod (Zpos px) (Zpos py) GT). + unfold Zdiv_eucl. destruct (Zdiv_eucl_POS px (Zpos py)) as (q',r'). + intros (EQ,MOD). injection 1. intros Hr' Hq'. + rewrite N.spec_eq_bool, N.spec_0, Hr'. + break_nonneg r pr EQr. + subst; simpl. rewrite N.spec_0; auto. + subst. lazy iota beta delta [Zeq_bool Zcompare]. + rewrite N.spec_sub, N.spec_succ, EQy, EQr. f_equal. omega with *. + (* Neg Neg *) + generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r). + break_nonneg x px EQx; break_nonneg y py EQy; + try (injection 1; intros Hr Hq; rewrite Hr, Hq; auto). + simpl. intros <-; auto. Qed. Definition div x y := fst (div_eucl x y). Definition spec_div: forall x y, - to_Z y <> 0 -> to_Z (div x y) = to_Z x / to_Z y. - intros x y H1; generalize (spec_div_eucl x y H1); unfold div, Zdiv. + to_Z (div x y) = to_Z x / to_Z y. + Proof. + intros x y; generalize (spec_div_eucl x y); unfold div, Zdiv. case div_eucl; case Zdiv_eucl; simpl; auto. intros q r q11 r1 H; injection H; auto. Qed. @@ -467,8 +415,9 @@ Module Make (N:NType) <: ZType. Definition modulo x y := snd (div_eucl x y). Theorem spec_modulo: - forall x y, to_Z y <> 0 -> to_Z (modulo x y) = to_Z x mod to_Z y. - intros x y H1; generalize (spec_div_eucl x y H1); unfold modulo, Zmod. + forall x y, to_Z (modulo x y) = to_Z x mod to_Z y. + Proof. + intros x y; generalize (spec_div_eucl x y); unfold modulo, Zmod. case div_eucl; case Zdiv_eucl; simpl; auto. intros q r q11 r1 H; injection H; auto. Qed. @@ -478,14 +427,30 @@ Module Make (N:NType) <: ZType. | Pos nx, Pos ny => Pos (N.gcd nx ny) | Pos nx, Neg ny => Pos (N.gcd nx ny) | Neg nx, Pos ny => Pos (N.gcd nx ny) - | Neg nx, Neg ny => Pos (N.gcd nx ny) + | Neg nx, Neg ny => Pos (N.gcd nx ny) end. Theorem spec_gcd: forall a b, to_Z (gcd a b) = Zgcd (to_Z a) (to_Z b). + Proof. unfold gcd, Zgcd, to_Z; intros [x | x] [y | y]; rewrite N.spec_gcd; unfold Zgcd; auto; case N.to_Z; simpl; auto with zarith; try rewrite Zabs_Zopp; auto; case N.to_Z; simpl; auto with zarith. Qed. + Definition sgn x := + match compare zero x with + | Lt => one + | Eq => zero + | Gt => minus_one + end. + + Lemma spec_sgn : forall x, to_Z (sgn x) = Zsgn (to_Z x). + Proof. + intros. unfold sgn. rewrite spec_compare. case Zcompare_spec. + rewrite spec_0. intros <-; auto. + rewrite spec_0, spec_1. symmetry. rewrite Zsgn_pos; auto. + rewrite spec_0, spec_m1. symmetry. rewrite Zsgn_neg; auto with zarith. + Qed. + End Make. diff --git a/theories/Numbers/Integer/Binary/ZBinary.v b/theories/Numbers/Integer/Binary/ZBinary.v index 66d2a96a..835f7958 100644 --- a/theories/Numbers/Integer/Binary/ZBinary.v +++ b/theories/Numbers/Integer/Binary/ZBinary.v @@ -8,212 +8,103 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZBinary.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) -Require Import ZMulOrder. -Require Import ZArith. -Open Local Scope Z_scope. +Require Import ZAxioms ZProperties. +Require Import ZArith_base. -Module ZBinAxiomsMod <: ZAxiomsSig. -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. +Local Open Scope Z_scope. -Definition NZ := Z. -Definition NZeq := (@eq Z). -Definition NZ0 := 0. -Definition NZsucc := Zsucc'. -Definition NZpred := Zpred'. -Definition NZadd := Zplus. -Definition NZsub := Zminus. -Definition NZmul := Zmult. +(** * Implementation of [ZAxiomsSig] by [BinInt.Z] *) -Theorem NZeq_equiv : equiv Z NZeq. -Proof. -exact (@eq_equiv Z). -Qed. - -Add Relation Z NZeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. - -Add Morphism NZsucc with signature NZeq ==> NZeq as NZsucc_wd. -Proof. -congruence. -Qed. +Module ZBinAxiomsMod <: ZAxiomsExtSig. -Add Morphism NZpred with signature NZeq ==> NZeq as NZpred_wd. -Proof. -congruence. -Qed. - -Add Morphism NZadd with signature NZeq ==> NZeq ==> NZeq as NZadd_wd. -Proof. -congruence. -Qed. +(** Bi-directional induction. *) -Add Morphism NZsub with signature NZeq ==> NZeq ==> NZeq as NZsub_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmul with signature NZeq ==> NZeq ==> NZeq as NZmul_wd. -Proof. -congruence. -Qed. - -Theorem NZpred_succ : forall n : Z, NZpred (NZsucc n) = n. -Proof. -exact Zpred'_succ'. -Qed. - -Theorem NZinduction : - forall A : Z -> Prop, predicate_wd NZeq A -> - A 0 -> (forall n : Z, A n <-> A (NZsucc n)) -> forall n : Z, A n. +Theorem bi_induction : + forall A : Z -> Prop, Proper (eq ==> iff) A -> + A 0 -> (forall n : Z, A n <-> A (Zsucc n)) -> forall n : Z, A n. Proof. intros A A_wd A0 AS n; apply Zind; clear n. assumption. -intros; now apply -> AS. -intros n H. rewrite <- (Zsucc'_pred' n) in H. now apply <- AS. -Qed. - -Theorem NZadd_0_l : forall n : Z, 0 + n = n. -Proof. -exact Zplus_0_l. -Qed. - -Theorem NZadd_succ_l : forall n m : Z, (NZsucc n) + m = NZsucc (n + m). -Proof. -intros; do 2 rewrite <- Zsucc_succ'; apply Zplus_succ_l. -Qed. - -Theorem NZsub_0_r : forall n : Z, n - 0 = n. -Proof. -exact Zminus_0_r. -Qed. - -Theorem NZsub_succ_r : forall n m : Z, n - (NZsucc m) = NZpred (n - m). -Proof. -intros; rewrite <- Zsucc_succ'; rewrite <- Zpred_pred'; -apply Zminus_succ_r. -Qed. - -Theorem NZmul_0_l : forall n : Z, 0 * n = 0. -Proof. -reflexivity. -Qed. - -Theorem NZmul_succ_l : forall n m : Z, (NZsucc n) * m = n * m + m. -Proof. -intros; rewrite <- Zsucc_succ'; apply Zmult_succ_l. -Qed. - -End NZAxiomsMod. - -Definition NZlt := Zlt. -Definition NZle := Zle. -Definition NZmin := Zmin. -Definition NZmax := Zmax. - -Add Morphism NZlt with signature NZeq ==> NZeq ==> iff as NZlt_wd. -Proof. -unfold NZeq. intros n1 n2 H1 m1 m2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZle with signature NZeq ==> NZeq ==> iff as NZle_wd. -Proof. -unfold NZeq. intros n1 n2 H1 m1 m2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZmin with signature NZeq ==> NZeq ==> NZeq as NZmin_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmax with signature NZeq ==> NZeq ==> NZeq as NZmax_wd. -Proof. -congruence. -Qed. - -Theorem NZlt_eq_cases : forall n m : Z, n <= m <-> n < m \/ n = m. -Proof. -intros n m; split. apply Zle_lt_or_eq. -intro H; destruct H as [H | H]. now apply Zlt_le_weak. rewrite H; apply Zle_refl. -Qed. - -Theorem NZlt_irrefl : forall n : Z, ~ n < n. -Proof. -exact Zlt_irrefl. -Qed. - -Theorem NZlt_succ_r : forall n m : Z, n < (NZsucc m) <-> n <= m. -Proof. -intros; unfold NZsucc; rewrite <- Zsucc_succ'; split; -[apply Zlt_succ_le | apply Zle_lt_succ]. -Qed. - -Theorem NZmin_l : forall n m : NZ, n <= m -> NZmin n m = n. -Proof. -unfold NZmin, Zmin, Zle; intros n m H. -destruct (n ?= m); try reflexivity. now elim H. -Qed. - -Theorem NZmin_r : forall n m : NZ, m <= n -> NZmin n m = m. -Proof. -unfold NZmin, Zmin, Zle; intros n m H. -case_eq (n ?= m); intro H1; try reflexivity. -now apply Zcompare_Eq_eq. -apply <- Zcompare_Gt_Lt_antisym in H1. now elim H. -Qed. - -Theorem NZmax_l : forall n m : NZ, m <= n -> NZmax n m = n. -Proof. -unfold NZmax, Zmax, Zle; intros n m H. -case_eq (n ?= m); intro H1; try reflexivity. -apply <- Zcompare_Gt_Lt_antisym in H1. now elim H. -Qed. - -Theorem NZmax_r : forall n m : NZ, n <= m -> NZmax n m = m. -Proof. -unfold NZmax, Zmax, Zle; intros n m H. -case_eq (n ?= m); intro H1. -now apply Zcompare_Eq_eq. reflexivity. now elim H. -Qed. - -End NZOrdAxiomsMod. - -Definition Zopp (x : Z) := -match x with -| Z0 => Z0 -| Zpos x => Zneg x -| Zneg x => Zpos x -end. - -Add Morphism Zopp with signature NZeq ==> NZeq as Zopp_wd. -Proof. -congruence. -Qed. - -Theorem Zsucc_pred : forall n : Z, NZsucc (NZpred n) = n. -Proof. -exact Zsucc'_pred'. -Qed. - -Theorem Zopp_0 : - 0 = 0. -Proof. -reflexivity. -Qed. - -Theorem Zopp_succ : forall n : Z, - (NZsucc n) = NZpred (- n). -Proof. -intro; rewrite <- Zsucc_succ'; rewrite <- Zpred_pred'. apply Zopp_succ. -Qed. +intros; rewrite <- Zsucc_succ'. now apply -> AS. +intros n H. rewrite <- Zpred_pred'. rewrite Zsucc_pred in H. now apply <- AS. +Qed. + +(** Basic operations. *) + +Definition eq_equiv : Equivalence (@eq Z) := eq_equivalence. +Local Obligation Tactic := simpl_relation. +Program Instance succ_wd : Proper (eq==>eq) Zsucc. +Program Instance pred_wd : Proper (eq==>eq) Zpred. +Program Instance add_wd : Proper (eq==>eq==>eq) Zplus. +Program Instance sub_wd : Proper (eq==>eq==>eq) Zminus. +Program Instance mul_wd : Proper (eq==>eq==>eq) Zmult. + +Definition pred_succ n := eq_sym (Zpred_succ n). +Definition add_0_l := Zplus_0_l. +Definition add_succ_l := Zplus_succ_l. +Definition sub_0_r := Zminus_0_r. +Definition sub_succ_r := Zminus_succ_r. +Definition mul_0_l := Zmult_0_l. +Definition mul_succ_l := Zmult_succ_l. + +(** Order *) + +Program Instance lt_wd : Proper (eq==>eq==>iff) Zlt. + +Definition lt_eq_cases := Zle_lt_or_eq_iff. +Definition lt_irrefl := Zlt_irrefl. +Definition lt_succ_r := Zlt_succ_r. + +Definition min_l := Zmin_l. +Definition min_r := Zmin_r. +Definition max_l := Zmax_l. +Definition max_r := Zmax_r. + +(** Properties specific to integers, not natural numbers. *) + +Program Instance opp_wd : Proper (eq==>eq) Zopp. + +Definition succ_pred n := eq_sym (Zsucc_pred n). +Definition opp_0 := Zopp_0. +Definition opp_succ := Zopp_succ. + +(** Absolute value and sign *) + +Definition abs_eq := Zabs_eq. +Definition abs_neq := Zabs_non_eq. + +Lemma sgn_null : forall x, x = 0 -> Zsgn x = 0. +Proof. intros. apply <- Zsgn_null; auto. Qed. +Lemma sgn_pos : forall x, 0 < x -> Zsgn x = 1. +Proof. intros. apply <- Zsgn_pos; auto. Qed. +Lemma sgn_neg : forall x, x < 0 -> Zsgn x = -1. +Proof. intros. apply <- Zsgn_neg; auto. Qed. + +(** The instantiation of operations. + Placing them at the very end avoids having indirections in above lemmas. *) + +Definition t := Z. +Definition eq := (@eq Z). +Definition zero := 0. +Definition succ := Zsucc. +Definition pred := Zpred. +Definition add := Zplus. +Definition sub := Zminus. +Definition mul := Zmult. +Definition lt := Zlt. +Definition le := Zle. +Definition min := Zmin. +Definition max := Zmax. +Definition opp := Zopp. +Definition abs := Zabs. +Definition sgn := Zsgn. End ZBinAxiomsMod. -Module Export ZBinMulOrderPropMod := ZMulOrderPropFunct ZBinAxiomsMod. +Module Export ZBinPropMod := ZPropFunct ZBinAxiomsMod. (** Z forms a ring *) diff --git a/theories/Numbers/Integer/NatPairs/ZNatPairs.v b/theories/Numbers/Integer/NatPairs/ZNatPairs.v index 9427b37b..8b5624cd 100644 --- a/theories/Numbers/Integer/NatPairs/ZNatPairs.v +++ b/theories/Numbers/Integer/NatPairs/ZNatPairs.v @@ -8,400 +8,306 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZNatPairs.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) -Require Import NSub. (* The most complete file for natural numbers *) -Require Export ZMulOrder. (* The most complete file for integers *) +Require Import NProperties. (* The most complete file for N *) +Require Export ZProperties. (* The most complete file for Z *) Require Export Ring. -Module ZPairsAxiomsMod (Import NAxiomsMod : NAxiomsSig) <: ZAxiomsSig. -Module Import NPropMod := NSubPropFunct NAxiomsMod. (* Get all properties of natural numbers *) - -(* We do not declare ring in Natural/Abstract for two reasons. First, some -of the properties proved in NAdd and NMul are used in the new BinNat, -and it is in turn used in Ring. Using ring in Natural/Abstract would be -circular. It is possible, however, not to make BinNat dependent on -Numbers/Natural and prove the properties necessary for ring from scratch -(this is, of course, how it used to be). In addition, if we define semiring -structures in the implementation subdirectories of Natural, we are able to -specify binary natural numbers as the type of coefficients. For these -reasons we define an abstract semiring here. *) - -Open Local Scope NatScope. - -Lemma Nsemi_ring : semi_ring_theory 0 1 add mul Neq. -Proof. -constructor. -exact add_0_l. -exact add_comm. -exact add_assoc. -exact mul_1_l. -exact mul_0_l. -exact mul_comm. -exact mul_assoc. -exact mul_add_distr_r. -Qed. - -Add Ring NSR : Nsemi_ring. - -(* The definitios of functions (NZadd, NZmul, etc.) will be unfolded by -the properties functor. Since we don't want Zadd_comm to refer to unfolded -definitions of equality: fun p1 p2 : NZ => (fst p1 + snd p2) = (fst p2 + snd p1), -we will provide an extra layer of definitions. *) - -Definition Z := (N * N)%type. -Definition Z0 : Z := (0, 0). -Definition Zeq (p1 p2 : Z) := ((fst p1) + (snd p2) == (fst p2) + (snd p1)). -Definition Zsucc (n : Z) : Z := (S (fst n), snd n). -Definition Zpred (n : Z) : Z := (fst n, S (snd n)). - -(* We do not have Zpred (Zsucc n) = n but only Zpred (Zsucc n) == n. It -could be possible to consider as canonical only pairs where one of the -elements is 0, and make all operations convert canonical values into other -canonical values. In that case, we could get rid of setoids and arrive at -integers as signed natural numbers. *) - -Definition Zadd (n m : Z) : Z := ((fst n) + (fst m), (snd n) + (snd m)). -Definition Zsub (n m : Z) : Z := ((fst n) + (snd m), (snd n) + (fst m)). - -(* Unfortunately, the elements of the pair keep increasing, even during -subtraction *) - -Definition Zmul (n m : Z) : Z := - ((fst n) * (fst m) + (snd n) * (snd m), (fst n) * (snd m) + (snd n) * (fst m)). -Definition Zlt (n m : Z) := (fst n) + (snd m) < (fst m) + (snd n). -Definition Zle (n m : Z) := (fst n) + (snd m) <= (fst m) + (snd n). -Definition Zmin (n m : Z) := (min ((fst n) + (snd m)) ((fst m) + (snd n)), (snd n) + (snd m)). -Definition Zmax (n m : Z) := (max ((fst n) + (snd m)) ((fst m) + (snd n)), (snd n) + (snd m)). - -Delimit Scope IntScope with Int. -Bind Scope IntScope with Z. -Notation "x == y" := (Zeq x y) (at level 70) : IntScope. -Notation "x ~= y" := (~ Zeq x y) (at level 70) : IntScope. -Notation "0" := Z0 : IntScope. -Notation "1" := (Zsucc Z0) : IntScope. -Notation "x + y" := (Zadd x y) : IntScope. -Notation "x - y" := (Zsub x y) : IntScope. -Notation "x * y" := (Zmul x y) : IntScope. -Notation "x < y" := (Zlt x y) : IntScope. -Notation "x <= y" := (Zle x y) : IntScope. -Notation "x > y" := (Zlt y x) (only parsing) : IntScope. -Notation "x >= y" := (Zle y x) (only parsing) : IntScope. - -Notation Local N := NZ. -(* To remember N without having to use a long qualifying name. since NZ will be redefined *) -Notation Local NE := NZeq (only parsing). -Notation Local add_wd := NZadd_wd (only parsing). - -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. - -Definition NZ : Type := Z. -Definition NZeq := Zeq. -Definition NZ0 := Z0. -Definition NZsucc := Zsucc. -Definition NZpred := Zpred. -Definition NZadd := Zadd. -Definition NZsub := Zsub. -Definition NZmul := Zmul. - -Theorem ZE_refl : reflexive Z Zeq. -Proof. -unfold reflexive, Zeq. reflexivity. -Qed. - -Theorem ZE_sym : symmetric Z Zeq. -Proof. -unfold symmetric, Zeq; now symmetry. -Qed. - -Theorem ZE_trans : transitive Z Zeq. -Proof. -unfold transitive, Zeq. intros n m p H1 H2. -assert (H3 : (fst n + snd m) + (fst m + snd p) == (fst m + snd n) + (fst p + snd m)) -by now apply add_wd. -stepl ((fst n + snd p) + (fst m + snd m)) in H3 by ring. -stepr ((fst p + snd n) + (fst m + snd m)) in H3 by ring. -now apply -> add_cancel_r in H3. +Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope. +Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope. +Open Local Scope pair_scope. + +Module ZPairsAxiomsMod (Import N : NAxiomsSig) <: ZAxiomsSig. +Module Import NPropMod := NPropFunct N. (* Get all properties of N *) + +Delimit Scope NScope with N. +Bind Scope NScope with N.t. +Infix "==" := N.eq (at level 70) : NScope. +Notation "x ~= y" := (~ N.eq x y) (at level 70) : NScope. +Notation "0" := N.zero : NScope. +Notation "1" := (N.succ N.zero) : NScope. +Infix "+" := N.add : NScope. +Infix "-" := N.sub : NScope. +Infix "*" := N.mul : NScope. +Infix "<" := N.lt : NScope. +Infix "<=" := N.le : NScope. +Local Open Scope NScope. + +(** The definitions of functions ([add], [mul], etc.) will be unfolded + by the properties functor. Since we don't want [add_comm] to refer + to unfolded definitions of equality: [fun p1 p2 => (fst p1 + + snd p2) = (fst p2 + snd p1)], we will provide an extra layer of + definitions. *) + +Module Z. + +Definition t := (N.t * N.t)%type. +Definition zero : t := (0, 0). +Definition eq (p q : t) := (p#1 + q#2 == q#1 + p#2). +Definition succ (n : t) : t := (N.succ n#1, n#2). +Definition pred (n : t) : t := (n#1, N.succ n#2). +Definition opp (n : t) : t := (n#2, n#1). +Definition add (n m : t) : t := (n#1 + m#1, n#2 + m#2). +Definition sub (n m : t) : t := (n#1 + m#2, n#2 + m#1). +Definition mul (n m : t) : t := + (n#1 * m#1 + n#2 * m#2, n#1 * m#2 + n#2 * m#1). +Definition lt (n m : t) := n#1 + m#2 < m#1 + n#2. +Definition le (n m : t) := n#1 + m#2 <= m#1 + n#2. +Definition min (n m : t) : t := (min (n#1 + m#2) (m#1 + n#2), n#2 + m#2). +Definition max (n m : t) : t := (max (n#1 + m#2) (m#1 + n#2), n#2 + m#2). + +(** NB : We do not have [Zpred (Zsucc n) = n] but only [Zpred (Zsucc n) == n]. + It could be possible to consider as canonical only pairs where + one of the elements is 0, and make all operations convert + canonical values into other canonical values. In that case, we + could get rid of setoids and arrive at integers as signed natural + numbers. *) + +(** NB : Unfortunately, the elements of the pair keep increasing during + many operations, even during subtraction. *) + +End Z. + +Delimit Scope ZScope with Z. +Bind Scope ZScope with Z.t. +Infix "==" := Z.eq (at level 70) : ZScope. +Notation "x ~= y" := (~ Z.eq x y) (at level 70) : ZScope. +Notation "0" := Z.zero : ZScope. +Notation "1" := (Z.succ Z.zero) : ZScope. +Infix "+" := Z.add : ZScope. +Infix "-" := Z.sub : ZScope. +Infix "*" := Z.mul : ZScope. +Notation "- x" := (Z.opp x) : ZScope. +Infix "<" := Z.lt : ZScope. +Infix "<=" := Z.le : ZScope. +Local Open Scope ZScope. + +Lemma sub_add_opp : forall n m, Z.sub n m = Z.add n (Z.opp m). +Proof. reflexivity. Qed. + +Instance eq_equiv : Equivalence Z.eq. +Proof. +split. +unfold Reflexive, Z.eq. reflexivity. +unfold Symmetric, Z.eq; now symmetry. +unfold Transitive, Z.eq. intros (n1,n2) (m1,m2) (p1,p2) H1 H2; simpl in *. +apply (add_cancel_r _ _ (m1+m2)%N). +rewrite add_shuffle2, H1, add_shuffle1, H2. +now rewrite add_shuffle1, (add_comm m1). +Qed. + +Instance pair_wd : Proper (N.eq==>N.eq==>Z.eq) (@pair N.t N.t). +Proof. +intros n1 n2 H1 m1 m2 H2; unfold Z.eq; simpl; now rewrite H1, H2. +Qed. + +Instance succ_wd : Proper (Z.eq ==> Z.eq) Z.succ. +Proof. +unfold Z.succ, Z.eq; intros n m H; simpl. +do 2 rewrite add_succ_l; now rewrite H. Qed. -Theorem NZeq_equiv : equiv Z Zeq. +Instance pred_wd : Proper (Z.eq ==> Z.eq) Z.pred. Proof. -unfold equiv; repeat split; [apply ZE_refl | apply ZE_trans | apply ZE_sym]. -Qed. - -Add Relation Z Zeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. - -Add Morphism (@pair N N) with signature NE ==> NE ==> Zeq as Zpair_wd. -Proof. -intros n1 n2 H1 m1 m2 H2; unfold Zeq; simpl; rewrite H1; now rewrite H2. +unfold Z.pred, Z.eq; intros n m H; simpl. +do 2 rewrite add_succ_r; now rewrite H. Qed. -Add Morphism NZsucc with signature Zeq ==> Zeq as NZsucc_wd. +Instance add_wd : Proper (Z.eq ==> Z.eq ==> Z.eq) Z.add. Proof. -unfold NZsucc, Zeq; intros n m H; simpl. -do 2 rewrite add_succ_l; now rewrite H. +unfold Z.eq, Z.add; intros n1 m1 H1 n2 m2 H2; simpl. +now rewrite add_shuffle1, H1, H2, add_shuffle1. Qed. -Add Morphism NZpred with signature Zeq ==> Zeq as NZpred_wd. +Instance opp_wd : Proper (Z.eq ==> Z.eq) Z.opp. Proof. -unfold NZpred, Zeq; intros n m H; simpl. -do 2 rewrite add_succ_r; now rewrite H. +unfold Z.eq, Z.opp; intros (n1,n2) (m1,m2) H; simpl in *. +now rewrite (add_comm n2), (add_comm m2). Qed. -Add Morphism NZadd with signature Zeq ==> Zeq ==> Zeq as NZadd_wd. +Instance sub_wd : Proper (Z.eq ==> Z.eq ==> Z.eq) Z.sub. Proof. -unfold Zeq, NZadd; intros n1 m1 H1 n2 m2 H2; simpl. -assert (H3 : (fst n1 + snd m1) + (fst n2 + snd m2) == (fst m1 + snd n1) + (fst m2 + snd n2)) -by now apply add_wd. -stepl (fst n1 + snd m1 + (fst n2 + snd m2)) by ring. -now stepr (fst m1 + snd n1 + (fst m2 + snd n2)) by ring. +intros n1 m1 H1 n2 m2 H2. rewrite 2 sub_add_opp. +apply add_wd, opp_wd; auto. Qed. -Add Morphism NZsub with signature Zeq ==> Zeq ==> Zeq as NZsub_wd. +Lemma mul_comm : forall n m, n*m == m*n. Proof. -unfold Zeq, NZsub; intros n1 m1 H1 n2 m2 H2; simpl. -symmetry in H2. -assert (H3 : (fst n1 + snd m1) + (fst m2 + snd n2) == (fst m1 + snd n1) + (fst n2 + snd m2)) -by now apply add_wd. -stepl (fst n1 + snd m1 + (fst m2 + snd n2)) by ring. -now stepr (fst m1 + snd n1 + (fst n2 + snd m2)) by ring. +intros (n1,n2) (m1,m2); compute. +rewrite (add_comm (m1*n2)%N). +apply N.add_wd; apply N.add_wd; apply mul_comm. Qed. -Add Morphism NZmul with signature Zeq ==> Zeq ==> Zeq as NZmul_wd. +Instance mul_wd : Proper (Z.eq ==> Z.eq ==> Z.eq) Z.mul. Proof. -unfold NZmul, Zeq; intros n1 m1 H1 n2 m2 H2; simpl. -stepl (fst n1 * fst n2 + (snd n1 * snd n2 + fst m1 * snd m2 + snd m1 * fst m2)) by ring. -stepr (fst n1 * snd n2 + (fst m1 * fst m2 + snd m1 * snd m2 + snd n1 * fst n2)) by ring. -apply add_mul_repl_pair with (n := fst m2) (m := snd m2); [| now idtac]. -stepl (snd n1 * snd n2 + (fst n1 * fst m2 + fst m1 * snd m2 + snd m1 * fst m2)) by ring. -stepr (snd n1 * fst n2 + (fst n1 * snd m2 + fst m1 * fst m2 + snd m1 * snd m2)) by ring. -apply add_mul_repl_pair with (n := snd m2) (m := fst m2); -[| (stepl (fst n2 + snd m2) by ring); now stepr (fst m2 + snd n2) by ring]. -stepl (snd m2 * snd n1 + (fst n1 * fst m2 + fst m1 * snd m2 + snd m1 * fst m2)) by ring. -stepr (snd m2 * fst n1 + (snd n1 * fst m2 + fst m1 * fst m2 + snd m1 * snd m2)) by ring. -apply add_mul_repl_pair with (n := snd m1) (m := fst m1); -[ | (stepl (fst n1 + snd m1) by ring); now stepr (fst m1 + snd n1) by ring]. -stepl (fst m2 * fst n1 + (snd m2 * snd m1 + fst m1 * snd m2 + snd m1 * fst m2)) by ring. -stepr (fst m2 * snd n1 + (snd m2 * fst m1 + fst m1 * fst m2 + snd m1 * snd m2)) by ring. -apply add_mul_repl_pair with (n := fst m1) (m := snd m1); [| now idtac]. -ring. +assert (forall n, Proper (Z.eq ==> Z.eq) (Z.mul n)). + unfold Z.mul, Z.eq. intros (n1,n2) (p1,p2) (q1,q2) H; simpl in *. + rewrite add_shuffle1, (add_comm (n1*p1)%N). + symmetry. rewrite add_shuffle1. + rewrite <- ! mul_add_distr_l. + rewrite (add_comm p2), (add_comm q2), H. + reflexivity. +intros n n' Hn m m' Hm. +rewrite Hm, (mul_comm n), (mul_comm n'), Hn. +reflexivity. Qed. Section Induction. -Open Scope NatScope. (* automatically closes at the end of the section *) -Variable A : Z -> Prop. -Hypothesis A_wd : predicate_wd Zeq A. +Variable A : Z.t -> Prop. +Hypothesis A_wd : Proper (Z.eq==>iff) A. -Add Morphism A with signature Zeq ==> iff as A_morph. +Theorem bi_induction : + A 0 -> (forall n, A n <-> A (Z.succ n)) -> forall n, A n. Proof. -exact A_wd. -Qed. - -Theorem NZinduction : - A 0 -> (forall n : Z, A n <-> A (Zsucc n)) -> forall n : Z, A n. (* 0 is interpreted as in Z due to "Bind" directive *) -Proof. -intros A0 AS n; unfold NZ0, Zsucc, predicate_wd, fun_wd, Zeq in *. +intros A0 AS n; unfold Z.zero, Z.succ, Z.eq in *. destruct n as [n m]. -cut (forall p : N, A (p, 0)); [intro H1 |]. -cut (forall p : N, A (0, p)); [intro H2 |]. +cut (forall p, A (p, 0%N)); [intro H1 |]. +cut (forall p, A (0%N, p)); [intro H2 |]. destruct (add_dichotomy n m) as [[p H] | [p H]]. -rewrite (A_wd (n, m) (0, p)) by (rewrite add_0_l; now rewrite add_comm). +rewrite (A_wd (n, m) (0%N, p)) by (rewrite add_0_l; now rewrite add_comm). apply H2. -rewrite (A_wd (n, m) (p, 0)) by now rewrite add_0_r. apply H1. +rewrite (A_wd (n, m) (p, 0%N)) by now rewrite add_0_r. apply H1. induct p. assumption. intros p IH. -apply -> (A_wd (0, p) (1, S p)) in IH; [| now rewrite add_0_l, add_1_l]. +apply -> (A_wd (0%N, p) (1%N, N.succ p)) in IH; [| now rewrite add_0_l, add_1_l]. now apply <- AS. induct p. assumption. intros p IH. -replace 0 with (snd (p, 0)); [| reflexivity]. -replace (S p) with (S (fst (p, 0))); [| reflexivity]. now apply -> AS. +replace 0%N with (snd (p, 0%N)); [| reflexivity]. +replace (N.succ p) with (N.succ (fst (p, 0%N))); [| reflexivity]. now apply -> AS. Qed. End Induction. (* Time to prove theorems in the language of Z *) -Open Local Scope IntScope. - -Theorem NZpred_succ : forall n : Z, Zpred (Zsucc n) == n. +Theorem pred_succ : forall n, Z.pred (Z.succ n) == n. Proof. -unfold NZpred, NZsucc, Zeq; intro n; simpl. -rewrite add_succ_l; now rewrite add_succ_r. +unfold Z.pred, Z.succ, Z.eq; intro n; simpl; now nzsimpl. Qed. -Theorem NZadd_0_l : forall n : Z, 0 + n == n. +Theorem succ_pred : forall n, Z.succ (Z.pred n) == n. Proof. -intro n; unfold NZadd, Zeq; simpl. now do 2 rewrite add_0_l. +intro n; unfold Z.succ, Z.pred, Z.eq; simpl; now nzsimpl. Qed. -Theorem NZadd_succ_l : forall n m : Z, (Zsucc n) + m == Zsucc (n + m). +Theorem opp_0 : - 0 == 0. Proof. -intros n m; unfold NZadd, Zeq; simpl. now do 2 rewrite add_succ_l. +unfold Z.opp, Z.eq; simpl. now nzsimpl. Qed. -Theorem NZsub_0_r : forall n : Z, n - 0 == n. +Theorem opp_succ : forall n, - (Z.succ n) == Z.pred (- n). Proof. -intro n; unfold NZsub, Zeq; simpl. now do 2 rewrite add_0_r. -Qed. - -Theorem NZsub_succ_r : forall n m : Z, n - (Zsucc m) == Zpred (n - m). -Proof. -intros n m; unfold NZsub, Zeq; simpl. symmetry; now rewrite add_succ_r. +reflexivity. Qed. -Theorem NZmul_0_l : forall n : Z, 0 * n == 0. +Theorem add_0_l : forall n, 0 + n == n. Proof. -intro n; unfold NZmul, Zeq; simpl. -repeat rewrite mul_0_l. now rewrite add_assoc. +intro n; unfold Z.add, Z.eq; simpl. now nzsimpl. Qed. -Theorem NZmul_succ_l : forall n m : Z, (Zsucc n) * m == n * m + m. +Theorem add_succ_l : forall n m, (Z.succ n) + m == Z.succ (n + m). Proof. -intros n m; unfold NZmul, NZsucc, Zeq; simpl. -do 2 rewrite mul_succ_l. ring. +intros n m; unfold Z.add, Z.eq; simpl. now nzsimpl. Qed. -End NZAxiomsMod. - -Definition NZlt := Zlt. -Definition NZle := Zle. -Definition NZmin := Zmin. -Definition NZmax := Zmax. - -Add Morphism NZlt with signature Zeq ==> Zeq ==> iff as NZlt_wd. +Theorem sub_0_r : forall n, n - 0 == n. Proof. -unfold NZlt, Zlt, Zeq; intros n1 m1 H1 n2 m2 H2; simpl. split; intro H. -stepr (snd m1 + fst m2) by apply add_comm. -apply (add_lt_repl_pair (fst n1) (snd n1)); [| assumption]. -stepl (snd m2 + fst n1) by apply add_comm. -stepr (fst m2 + snd n1) by apply add_comm. -apply (add_lt_repl_pair (snd n2) (fst n2)). -now stepl (fst n1 + snd n2) by apply add_comm. -stepl (fst m2 + snd n2) by apply add_comm. now stepr (fst n2 + snd m2) by apply add_comm. -stepr (snd n1 + fst n2) by apply add_comm. -apply (add_lt_repl_pair (fst m1) (snd m1)); [| now symmetry]. -stepl (snd n2 + fst m1) by apply add_comm. -stepr (fst n2 + snd m1) by apply add_comm. -apply (add_lt_repl_pair (snd m2) (fst m2)). -now stepl (fst m1 + snd m2) by apply add_comm. -stepl (fst n2 + snd m2) by apply add_comm. now stepr (fst m2 + snd n2) by apply add_comm. +intro n; unfold Z.sub, Z.eq; simpl. now nzsimpl. Qed. -Add Morphism NZle with signature Zeq ==> Zeq ==> iff as NZle_wd. +Theorem sub_succ_r : forall n m, n - (Z.succ m) == Z.pred (n - m). Proof. -unfold NZle, Zle, Zeq; intros n1 m1 H1 n2 m2 H2; simpl. -do 2 rewrite lt_eq_cases. rewrite (NZlt_wd n1 m1 H1 n2 m2 H2). fold (m1 < m2)%Int. -fold (n1 == n2)%Int (m1 == m2)%Int; fold (n1 == m1)%Int in H1; fold (n2 == m2)%Int in H2. -now rewrite H1, H2. +intros n m; unfold Z.sub, Z.eq; simpl. symmetry; now rewrite add_succ_r. Qed. -Add Morphism NZmin with signature Zeq ==> Zeq ==> Zeq as NZmin_wd. +Theorem mul_0_l : forall n, 0 * n == 0. Proof. -intros n1 m1 H1 n2 m2 H2; unfold NZmin, Zeq; simpl. -destruct (le_ge_cases (fst n1 + snd n2) (fst n2 + snd n1)) as [H | H]. -rewrite (min_l (fst n1 + snd n2) (fst n2 + snd n1)) by assumption. -rewrite (min_l (fst m1 + snd m2) (fst m2 + snd m1)) by -now apply -> (NZle_wd n1 m1 H1 n2 m2 H2). -stepl ((fst n1 + snd m1) + (snd n2 + snd m2)) by ring. -unfold Zeq in H1. rewrite H1. ring. -rewrite (min_r (fst n1 + snd n2) (fst n2 + snd n1)) by assumption. -rewrite (min_r (fst m1 + snd m2) (fst m2 + snd m1)) by -now apply -> (NZle_wd n2 m2 H2 n1 m1 H1). -stepl ((fst n2 + snd m2) + (snd n1 + snd m1)) by ring. -unfold Zeq in H2. rewrite H2. ring. +intros (n1,n2); unfold Z.mul, Z.eq; simpl; now nzsimpl. Qed. -Add Morphism NZmax with signature Zeq ==> Zeq ==> Zeq as NZmax_wd. +Theorem mul_succ_l : forall n m, (Z.succ n) * m == n * m + m. Proof. -intros n1 m1 H1 n2 m2 H2; unfold NZmax, Zeq; simpl. -destruct (le_ge_cases (fst n1 + snd n2) (fst n2 + snd n1)) as [H | H]. -rewrite (max_r (fst n1 + snd n2) (fst n2 + snd n1)) by assumption. -rewrite (max_r (fst m1 + snd m2) (fst m2 + snd m1)) by -now apply -> (NZle_wd n1 m1 H1 n2 m2 H2). -stepl ((fst n2 + snd m2) + (snd n1 + snd m1)) by ring. -unfold Zeq in H2. rewrite H2. ring. -rewrite (max_l (fst n1 + snd n2) (fst n2 + snd n1)) by assumption. -rewrite (max_l (fst m1 + snd m2) (fst m2 + snd m1)) by -now apply -> (NZle_wd n2 m2 H2 n1 m1 H1). -stepl ((fst n1 + snd m1) + (snd n2 + snd m2)) by ring. -unfold Zeq in H1. rewrite H1. ring. +intros (n1,n2) (m1,m2); unfold Z.mul, Z.succ, Z.eq; simpl; nzsimpl. +rewrite <- (add_assoc _ m1), (add_comm m1), (add_assoc _ _ m1). +now rewrite <- (add_assoc _ m2), (add_comm m2), (add_assoc _ (n2*m1)%N m2). Qed. -Open Local Scope IntScope. +(** Order *) -Theorem NZlt_eq_cases : forall n m : Z, n <= m <-> n < m \/ n == m. +Lemma lt_eq_cases : forall n m, n<=m <-> n<m \/ n==m. Proof. -intros n m; unfold Zlt, Zle, Zeq; simpl. apply lt_eq_cases. +intros; apply N.lt_eq_cases. Qed. -Theorem NZlt_irrefl : forall n : Z, ~ (n < n). +Theorem lt_irrefl : forall n, ~ (n < n). Proof. -intros n; unfold Zlt, Zeq; simpl. apply lt_irrefl. +intros; apply N.lt_irrefl. Qed. -Theorem NZlt_succ_r : forall n m : Z, n < (Zsucc m) <-> n <= m. +Theorem lt_succ_r : forall n m, n < (Z.succ m) <-> n <= m. Proof. -intros n m; unfold Zlt, Zle, Zeq; simpl. rewrite add_succ_l; apply lt_succ_r. +intros n m; unfold Z.lt, Z.le, Z.eq; simpl; nzsimpl. apply lt_succ_r. Qed. -Theorem NZmin_l : forall n m : Z, n <= m -> Zmin n m == n. +Theorem min_l : forall n m, n <= m -> Z.min n m == n. Proof. -unfold Zmin, Zle, Zeq; simpl; intros n m H. -rewrite min_l by assumption. ring. +unfold Z.min, Z.le, Z.eq; simpl; intros (n1,n2) (m1,m2) H; simpl in *. +rewrite min_l by assumption. +now rewrite <- add_assoc, (add_comm m2). Qed. -Theorem NZmin_r : forall n m : Z, m <= n -> Zmin n m == m. +Theorem min_r : forall n m, m <= n -> Z.min n m == m. Proof. -unfold Zmin, Zle, Zeq; simpl; intros n m H. -rewrite min_r by assumption. ring. +unfold Z.min, Z.le, Z.eq; simpl; intros (n1,n2) (m1,m2) H; simpl in *. +rewrite min_r by assumption. +now rewrite add_assoc. Qed. -Theorem NZmax_l : forall n m : Z, m <= n -> Zmax n m == n. +Theorem max_l : forall n m, m <= n -> Z.max n m == n. Proof. -unfold Zmax, Zle, Zeq; simpl; intros n m H. -rewrite max_l by assumption. ring. +unfold Z.max, Z.le, Z.eq; simpl; intros (n1,n2) (m1,m2) H; simpl in *. +rewrite max_l by assumption. +now rewrite <- add_assoc, (add_comm m2). Qed. -Theorem NZmax_r : forall n m : Z, n <= m -> Zmax n m == m. +Theorem max_r : forall n m, n <= m -> Z.max n m == m. Proof. -unfold Zmax, Zle, Zeq; simpl; intros n m H. -rewrite max_r by assumption. ring. +unfold Z.max, Z.le, Z.eq; simpl; intros n m H. +rewrite max_r by assumption. +now rewrite add_assoc. Qed. -End NZOrdAxiomsMod. - -Definition Zopp (n : Z) : Z := (snd n, fst n). - -Notation "- x" := (Zopp x) : IntScope. - -Add Morphism Zopp with signature Zeq ==> Zeq as Zopp_wd. -Proof. -unfold Zeq; intros n m H; simpl. symmetry. -stepl (fst n + snd m) by apply add_comm. -now stepr (fst m + snd n) by apply add_comm. -Qed. - -Open Local Scope IntScope. - -Theorem Zsucc_pred : forall n : Z, Zsucc (Zpred n) == n. +Theorem lt_nge : forall n m, n < m <-> ~(m<=n). Proof. -intro n; unfold Zsucc, Zpred, Zeq; simpl. -rewrite add_succ_l; now rewrite add_succ_r. +intros. apply lt_nge. Qed. -Theorem Zopp_0 : - 0 == 0. +Instance lt_wd : Proper (Z.eq ==> Z.eq ==> iff) Z.lt. Proof. -unfold Zopp, Zeq; simpl. now rewrite add_0_l. +assert (forall n, Proper (Z.eq==>iff) (Z.lt n)). + intros (n1,n2). apply proper_sym_impl_iff; auto with *. + unfold Z.lt, Z.eq; intros (r1,r2) (s1,s2) Eq H; simpl in *. + apply le_lt_add_lt with (r1+r2)%N (r1+r2)%N; [apply le_refl; auto with *|]. + rewrite add_shuffle2, (add_comm s2), Eq. + rewrite (add_comm s1 n2), (add_shuffle1 n2), (add_comm n2 r1). + now rewrite <- add_lt_mono_r. +intros n n' Hn m m' Hm. +rewrite Hm. rewrite 2 lt_nge, 2 lt_eq_cases, Hn; auto with *. Qed. -Theorem Zopp_succ : forall n, - (Zsucc n) == Zpred (- n). -Proof. -reflexivity. -Qed. +Definition t := Z.t. +Definition eq := Z.eq. +Definition zero := Z.zero. +Definition succ := Z.succ. +Definition pred := Z.pred. +Definition add := Z.add. +Definition sub := Z.sub. +Definition mul := Z.mul. +Definition opp := Z.opp. +Definition lt := Z.lt. +Definition le := Z.le. +Definition min := Z.min. +Definition max := Z.max. End ZPairsAxiomsMod. @@ -413,9 +319,7 @@ and get their properties *) Require Import NPeano. Module Export ZPairsPeanoAxiomsMod := ZPairsAxiomsMod NPeanoAxiomsMod. -Module Export ZPairsMulOrderPropMod := ZMulOrderPropFunct ZPairsPeanoAxiomsMod. - -Open Local Scope IntScope. +Module Export ZPairsPropMod := ZPropFunct ZPairsPeanoAxiomsMod. Eval compute in (3, 5) * (4, 6). *) diff --git a/theories/Numbers/Integer/SpecViaZ/ZSig.v b/theories/Numbers/Integer/SpecViaZ/ZSig.v index 0af98c74..ffa91706 100644 --- a/theories/Numbers/Integer/SpecViaZ/ZSig.v +++ b/theories/Numbers/Integer/SpecViaZ/ZSig.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZSig.v 11027 2008-06-01 13:28:59Z letouzey $ i*) +(*i $Id$ i*) Require Import ZArith Znumtheory. @@ -25,93 +25,77 @@ Module Type ZType. Parameter t : Type. Parameter to_Z : t -> Z. - Notation "[ x ]" := (to_Z x). + Local Notation "[ x ]" := (to_Z x). - Definition eq x y := ([x] = [y]). + Definition eq x y := [x] = [y]. + Definition lt x y := [x] < [y]. + Definition le x y := [x] <= [y]. Parameter of_Z : Z -> t. Parameter spec_of_Z: forall x, to_Z (of_Z x) = x. + Parameter compare : t -> t -> comparison. + Parameter eq_bool : t -> t -> bool. + Parameter min : t -> t -> t. + Parameter max : t -> t -> t. Parameter zero : t. Parameter one : t. Parameter minus_one : t. - - Parameter spec_0: [zero] = 0. - Parameter spec_1: [one] = 1. - Parameter spec_m1: [minus_one] = -1. - - Parameter compare : t -> t -> comparison. - - Parameter spec_compare: forall x y, - match compare x y with - | Eq => [x] = [y] - | Lt => [x] < [y] - | Gt => [x] > [y] - end. - - Definition lt n m := compare n m = Lt. - Definition le n m := compare n m <> Gt. - Definition min n m := match compare n m with Gt => m | _ => n end. - Definition max n m := match compare n m with Lt => m | _ => n end. - - Parameter eq_bool : t -> t -> bool. - - Parameter spec_eq_bool: forall x y, - if eq_bool x y then [x] = [y] else [x] <> [y]. - Parameter succ : t -> t. - - Parameter spec_succ: forall n, [succ n] = [n] + 1. - Parameter add : t -> t -> t. - - Parameter spec_add: forall x y, [add x y] = [x] + [y]. - Parameter pred : t -> t. - - Parameter spec_pred: forall x, [pred x] = [x] - 1. - Parameter sub : t -> t -> t. - - Parameter spec_sub: forall x y, [sub x y] = [x] - [y]. - Parameter opp : t -> t. - - Parameter spec_opp: forall x, [opp x] = - [x]. - Parameter mul : t -> t -> t. - - Parameter spec_mul: forall x y, [mul x y] = [x] * [y]. - Parameter square : t -> t. - - Parameter spec_square: forall x, [square x] = [x] * [x]. - Parameter power_pos : t -> positive -> t. - - Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. - + Parameter power : t -> N -> t. Parameter sqrt : t -> t. - - Parameter spec_sqrt: forall x, 0 <= [x] -> - [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. - Parameter div_eucl : t -> t -> t * t. - - Parameter spec_div_eucl: forall x y, [y] <> 0 -> - let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. - Parameter div : t -> t -> t. - - Parameter spec_div: forall x y, [y] <> 0 -> [div x y] = [x] / [y]. - Parameter modulo : t -> t -> t. - - Parameter spec_modulo: forall x y, [y] <> 0 -> - [modulo x y] = [x] mod [y]. - Parameter gcd : t -> t -> t. + Parameter sgn : t -> t. + Parameter abs : t -> t. + Parameter spec_compare: forall x y, compare x y = Zcompare [x] [y]. + Parameter spec_eq_bool: forall x y, eq_bool x y = Zeq_bool [x] [y]. + Parameter spec_min : forall x y, [min x y] = Zmin [x] [y]. + Parameter spec_max : forall x y, [max x y] = Zmax [x] [y]. + Parameter spec_0: [zero] = 0. + Parameter spec_1: [one] = 1. + Parameter spec_m1: [minus_one] = -1. + Parameter spec_succ: forall n, [succ n] = [n] + 1. + Parameter spec_add: forall x y, [add x y] = [x] + [y]. + Parameter spec_pred: forall x, [pred x] = [x] - 1. + Parameter spec_sub: forall x y, [sub x y] = [x] - [y]. + Parameter spec_opp: forall x, [opp x] = - [x]. + Parameter spec_mul: forall x y, [mul x y] = [x] * [y]. + Parameter spec_square: forall x, [square x] = [x] * [x]. + Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. + Parameter spec_power: forall x n, [power x n] = [x] ^ Z_of_N n. + Parameter spec_sqrt: forall x, 0 <= [x] -> + [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. + Parameter spec_div_eucl: forall x y, + let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. + Parameter spec_div: forall x y, [div x y] = [x] / [y]. + Parameter spec_modulo: forall x y, [modulo x y] = [x] mod [y]. Parameter spec_gcd: forall a b, [gcd a b] = Zgcd (to_Z a) (to_Z b). + Parameter spec_sgn : forall x, [sgn x] = Zsgn [x]. + Parameter spec_abs : forall x, [abs x] = Zabs [x]. End ZType. + +Module Type ZType_Notation (Import Z:ZType). + Notation "[ x ]" := (to_Z x). + Infix "==" := eq (at level 70). + Notation "0" := zero. + Infix "+" := add. + Infix "-" := sub. + Infix "*" := mul. + Notation "- x" := (opp x). + Infix "<=" := le. + Infix "<" := lt. +End ZType_Notation. + +Module Type ZType' := ZType <+ ZType_Notation.
\ No newline at end of file diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v index aceb8984..bcecb6a8 100644 --- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v +++ b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v @@ -6,119 +6,74 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ZSigZAxioms.v 11282 2008-07-28 11:51:53Z msozeau $ i*) +(*i $Id$ i*) -Require Import ZArith. -Require Import ZAxioms. -Require Import ZSig. +Require Import ZArith ZAxioms ZDivFloor ZSig. -(** * The interface [ZSig.ZType] implies the interface [ZAxiomsSig] *) +(** * The interface [ZSig.ZType] implies the interface [ZAxiomsSig] -Module ZSig_ZAxioms (Z:ZType) <: ZAxiomsSig. + It also provides [sgn], [abs], [div], [mod] +*) -Delimit Scope IntScope with Int. -Bind Scope IntScope with Z.t. -Open Local Scope IntScope. -Notation "[ x ]" := (Z.to_Z x) : IntScope. -Infix "==" := Z.eq (at level 70) : IntScope. -Notation "0" := Z.zero : IntScope. -Infix "+" := Z.add : IntScope. -Infix "-" := Z.sub : IntScope. -Infix "*" := Z.mul : IntScope. -Notation "- x" := (Z.opp x) : IntScope. -Hint Rewrite - Z.spec_0 Z.spec_1 Z.spec_add Z.spec_sub Z.spec_pred Z.spec_succ - Z.spec_mul Z.spec_opp Z.spec_of_Z : Zspec. +Module ZTypeIsZAxioms (Import Z : ZType'). -Ltac zsimpl := unfold Z.eq in *; autorewrite with Zspec. +Hint Rewrite + spec_0 spec_1 spec_add spec_sub spec_pred spec_succ + spec_mul spec_opp spec_of_Z spec_div spec_modulo + spec_compare spec_eq_bool spec_max spec_min spec_abs spec_sgn + : zsimpl. -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. +Ltac zsimpl := autorewrite with zsimpl. +Ltac zcongruence := repeat red; intros; zsimpl; congruence. +Ltac zify := unfold eq, lt, le in *; zsimpl. -Definition NZ := Z.t. -Definition NZeq := Z.eq. -Definition NZ0 := Z.zero. -Definition NZsucc := Z.succ. -Definition NZpred := Z.pred. -Definition NZadd := Z.add. -Definition NZsub := Z.sub. -Definition NZmul := Z.mul. +Instance eq_equiv : Equivalence eq. +Proof. unfold eq. firstorder. Qed. -Theorem NZeq_equiv : equiv Z.t Z.eq. -Proof. -repeat split; repeat red; intros; auto; congruence. -Qed. - -Add Relation Z.t Z.eq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) - as NZeq_rel. - -Add Morphism NZsucc with signature Z.eq ==> Z.eq as NZsucc_wd. -Proof. -intros; zsimpl; f_equal; assumption. -Qed. - -Add Morphism NZpred with signature Z.eq ==> Z.eq as NZpred_wd. -Proof. -intros; zsimpl; f_equal; assumption. -Qed. +Local Obligation Tactic := zcongruence. -Add Morphism NZadd with signature Z.eq ==> Z.eq ==> Z.eq as NZadd_wd. -Proof. -intros; zsimpl; f_equal; assumption. -Qed. - -Add Morphism NZsub with signature Z.eq ==> Z.eq ==> Z.eq as NZsub_wd. -Proof. -intros; zsimpl; f_equal; assumption. -Qed. +Program Instance succ_wd : Proper (eq ==> eq) succ. +Program Instance pred_wd : Proper (eq ==> eq) pred. +Program Instance add_wd : Proper (eq ==> eq ==> eq) add. +Program Instance sub_wd : Proper (eq ==> eq ==> eq) sub. +Program Instance mul_wd : Proper (eq ==> eq ==> eq) mul. -Add Morphism NZmul with signature Z.eq ==> Z.eq ==> Z.eq as NZmul_wd. +Theorem pred_succ : forall n, pred (succ n) == n. Proof. -intros; zsimpl; f_equal; assumption. -Qed. - -Theorem NZpred_succ : forall n, Z.pred (Z.succ n) == n. -Proof. -intros; zsimpl; auto with zarith. +intros. zify. auto with zarith. Qed. Section Induction. Variable A : Z.t -> Prop. -Hypothesis A_wd : predicate_wd Z.eq A. +Hypothesis A_wd : Proper (eq==>iff) A. Hypothesis A0 : A 0. -Hypothesis AS : forall n, A n <-> A (Z.succ n). - -Add Morphism A with signature Z.eq ==> iff as A_morph. -Proof. apply A_wd. Qed. +Hypothesis AS : forall n, A n <-> A (succ n). -Let B (z : Z) := A (Z.of_Z z). +Let B (z : Z) := A (of_Z z). Lemma B0 : B 0. Proof. unfold B; simpl. rewrite <- (A_wd 0); auto. -zsimpl; auto. +zify. auto. Qed. Lemma BS : forall z : Z, B z -> B (z + 1). Proof. intros z H. unfold B in *. apply -> AS in H. -setoid_replace (Z.of_Z (z + 1)) with (Z.succ (Z.of_Z z)); auto. -zsimpl; auto. +setoid_replace (of_Z (z + 1)) with (succ (of_Z z)); auto. +zify. auto. Qed. Lemma BP : forall z : Z, B z -> B (z - 1). Proof. intros z H. unfold B in *. rewrite AS. -setoid_replace (Z.succ (Z.of_Z (z - 1))) with (Z.of_Z z); auto. -zsimpl; auto with zarith. +setoid_replace (succ (of_Z (z - 1))) with (of_Z z); auto. +zify. auto with zarith. Qed. Lemma B_holds : forall z : Z, B z. @@ -135,172 +90,170 @@ intros; rewrite Zopp_succ; unfold Zpred; apply BP; auto. subst z'; auto with zarith. Qed. -Theorem NZinduction : forall n, A n. +Theorem bi_induction : forall n, A n. Proof. -intro n. setoid_replace n with (Z.of_Z (Z.to_Z n)). +intro n. setoid_replace n with (of_Z (to_Z n)). apply B_holds. -zsimpl; auto. +zify. auto. Qed. End Induction. -Theorem NZadd_0_l : forall n, 0 + n == n. +Theorem add_0_l : forall n, 0 + n == n. Proof. -intros; zsimpl; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZadd_succ_l : forall n m, (Z.succ n) + m == Z.succ (n + m). +Theorem add_succ_l : forall n m, (succ n) + m == succ (n + m). Proof. -intros; zsimpl; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZsub_0_r : forall n, n - 0 == n. +Theorem sub_0_r : forall n, n - 0 == n. Proof. -intros; zsimpl; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZsub_succ_r : forall n m, n - (Z.succ m) == Z.pred (n - m). +Theorem sub_succ_r : forall n m, n - (succ m) == pred (n - m). Proof. -intros; zsimpl; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZmul_0_l : forall n, 0 * n == 0. +Theorem mul_0_l : forall n, 0 * n == 0. Proof. -intros; zsimpl; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZmul_succ_l : forall n m, (Z.succ n) * m == n * m + m. +Theorem mul_succ_l : forall n m, (succ n) * m == n * m + m. Proof. -intros; zsimpl; ring. +intros. zify. ring. Qed. -End NZAxiomsMod. +(** Order *) -Definition NZlt := Z.lt. -Definition NZle := Z.le. -Definition NZmin := Z.min. -Definition NZmax := Z.max. +Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). +Proof. + intros. zify. destruct (Zcompare_spec [x] [y]); auto. +Qed. -Infix "<=" := Z.le : IntScope. -Infix "<" := Z.lt : IntScope. +Definition eqb := eq_bool. -Lemma spec_compare_alt : forall x y, Z.compare x y = ([x] ?= [y])%Z. +Lemma eqb_eq : forall x y, eq_bool x y = true <-> x == y. Proof. - intros; generalize (Z.spec_compare x y). - destruct (Z.compare x y); auto. - intros H; rewrite H; symmetry; apply Zcompare_refl. + intros. zify. symmetry. apply Zeq_is_eq_bool. Qed. -Lemma spec_lt : forall x y, (x<y) <-> ([x]<[y])%Z. +Instance compare_wd : Proper (eq ==> eq ==> Logic.eq) compare. Proof. - intros; unfold Z.lt, Zlt; rewrite spec_compare_alt; intuition. +intros x x' Hx y y' Hy. rewrite 2 spec_compare, Hx, Hy; intuition. Qed. -Lemma spec_le : forall x y, (x<=y) <-> ([x]<=[y])%Z. +Instance lt_wd : Proper (eq ==> eq ==> iff) lt. Proof. - intros; unfold Z.le, Zle; rewrite spec_compare_alt; intuition. +intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition. Qed. -Lemma spec_min : forall x y, [Z.min x y] = Zmin [x] [y]. +Theorem lt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. Proof. - intros; unfold Z.min, Zmin. - rewrite spec_compare_alt; destruct Zcompare; auto. +intros. zify. omega. Qed. -Lemma spec_max : forall x y, [Z.max x y] = Zmax [x] [y]. +Theorem lt_irrefl : forall n, ~ n < n. Proof. - intros; unfold Z.max, Zmax. - rewrite spec_compare_alt; destruct Zcompare; auto. +intros. zify. omega. 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; unfold Z.eq in *; rewrite Hx, Hy; intuition. +Theorem lt_succ_r : forall n m, n < (succ m) <-> n <= m. +Proof. +intros. zify. omega. Qed. -Add Morphism Z.lt with signature Z.eq ==> Z.eq ==> iff as NZlt_wd. +Theorem min_l : forall n m, n <= m -> min n m == n. Proof. -intros x x' Hx y y' Hy; unfold Z.lt; rewrite Hx, Hy; intuition. +intros n m. zify. omega with *. Qed. -Add Morphism Z.le with signature Z.eq ==> Z.eq ==> iff as NZle_wd. +Theorem min_r : forall n m, m <= n -> min n m == m. Proof. -intros x x' Hx y y' Hy; unfold Z.le; rewrite Hx, Hy; intuition. +intros n m. zify. omega with *. Qed. -Add Morphism Z.min with signature Z.eq ==> Z.eq ==> Z.eq as NZmin_wd. +Theorem max_l : forall n m, m <= n -> max n m == n. Proof. -intros; red; rewrite 2 spec_min; congruence. +intros n m. zify. omega with *. Qed. -Add Morphism Z.max with signature Z.eq ==> Z.eq ==> Z.eq as NZmax_wd. +Theorem max_r : forall n m, n <= m -> max n m == m. Proof. -intros; red; rewrite 2 spec_max; congruence. +intros n m. zify. omega with *. Qed. -Theorem NZlt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. +(** Part specific to integers, not natural numbers *) + +Program Instance opp_wd : Proper (eq ==> eq) opp. + +Theorem succ_pred : forall n, succ (pred n) == n. Proof. -intros. -unfold Z.eq; rewrite spec_lt, spec_le; omega. +intros. zify. auto with zarith. Qed. -Theorem NZlt_irrefl : forall n, ~ n < n. +Theorem opp_0 : - 0 == 0. Proof. -intros; rewrite spec_lt; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZlt_succ_r : forall n m, n < (Z.succ m) <-> n <= m. +Theorem opp_succ : forall n, - (succ n) == pred (- n). Proof. -intros; rewrite spec_lt, spec_le, Z.spec_succ; omega. +intros. zify. auto with zarith. Qed. -Theorem NZmin_l : forall n m, n <= m -> Z.min n m == n. +Theorem abs_eq : forall n, 0 <= n -> abs n == n. Proof. -intros n m; unfold Z.eq; rewrite spec_le, spec_min. -generalize (Zmin_spec [n] [m]); omega. +intros n. zify. omega with *. Qed. -Theorem NZmin_r : forall n m, m <= n -> Z.min n m == m. +Theorem abs_neq : forall n, n <= 0 -> abs n == -n. Proof. -intros n m; unfold Z.eq; rewrite spec_le, spec_min. -generalize (Zmin_spec [n] [m]); omega. +intros n. zify. omega with *. Qed. -Theorem NZmax_l : forall n m, m <= n -> Z.max n m == n. +Theorem sgn_null : forall n, n==0 -> sgn n == 0. Proof. -intros n m; unfold Z.eq; rewrite spec_le, spec_max. -generalize (Zmax_spec [n] [m]); omega. +intros n. zify. omega with *. Qed. -Theorem NZmax_r : forall n m, n <= m -> Z.max n m == m. +Theorem sgn_pos : forall n, 0<n -> sgn n == succ 0. Proof. -intros n m; unfold Z.eq; rewrite spec_le, spec_max. -generalize (Zmax_spec [n] [m]); omega. +intros n. zify. omega with *. Qed. -End NZOrdAxiomsMod. - -Definition Zopp := Z.opp. - -Add Morphism Z.opp with signature Z.eq ==> Z.eq as Zopp_wd. +Theorem sgn_neg : forall n, n<0 -> sgn n == opp (succ 0). Proof. -intros; zsimpl; auto with zarith. +intros n. zify. omega with *. Qed. -Theorem Zsucc_pred : forall n, Z.succ (Z.pred n) == n. +Program Instance div_wd : Proper (eq==>eq==>eq) div. +Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. + +Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b). Proof. -red; intros; zsimpl; auto with zarith. +intros a b. zify. intros. apply Z_div_mod_eq_full; auto. Qed. -Theorem Zopp_0 : - 0 == 0. +Theorem mod_pos_bound : + forall a b, 0 < b -> 0 <= modulo a b /\ modulo a b < b. Proof. -red; intros; zsimpl; auto with zarith. +intros a b. zify. intros. apply Z_mod_lt; auto with zarith. Qed. -Theorem Zopp_succ : forall n, - (Z.succ n) == Z.pred (- n). +Theorem mod_neg_bound : + forall a b, b < 0 -> b < modulo a b /\ modulo a b <= 0. Proof. -intros; zsimpl; auto with zarith. +intros a b. zify. intros. apply Z_mod_neg; auto with zarith. Qed. -End ZSig_ZAxioms. +End ZTypeIsZAxioms. + +Module ZType_ZAxioms (Z : ZType) + <: ZAxiomsSig <: ZDivSig <: HasCompare Z <: HasEqBool Z <: HasMinMax Z + := Z <+ ZTypeIsZAxioms. diff --git a/theories/Numbers/NaryFunctions.v b/theories/Numbers/NaryFunctions.v index 04a48d51..417463eb 100644 --- a/theories/Numbers/NaryFunctions.v +++ b/theories/Numbers/NaryFunctions.v @@ -8,27 +8,27 @@ (* Pierre Letouzey, Jerome Vouillon, PPS, Paris 7, 2008 *) (************************************************************************) -(*i $Id: NaryFunctions.v 10967 2008-05-22 12:59:38Z letouzey $ i*) +(*i $Id$ i*) -Open Local Scope type_scope. +Local Open Scope type_scope. Require Import List. (** * Generic dependently-typed operators about [n]-ary functions *) -(** The type of [n]-ary function: [nfun A n B] is +(** The type of [n]-ary function: [nfun A n B] is [A -> ... -> A -> B] with [n] occurences of [A] in this type. *) -Fixpoint nfun A n B := +Fixpoint nfun A n B := match n with - | O => B + | O => B | S n => A -> (nfun A n B) - end. + end. Notation " A ^^ n --> B " := (nfun A n B) (at level 50, n at next level) : type_scope. -(** [napply_cst _ _ a n f] iterates [n] times the application of a +(** [napply_cst _ _ a n f] iterates [n] times the application of a particular constant [a] to the [n]-ary function [f]. *) Fixpoint napply_cst (A B:Type)(a:A) n : (A^^n-->B) -> B := @@ -40,47 +40,47 @@ Fixpoint napply_cst (A B:Type)(a:A) n : (A^^n-->B) -> B := (** A generic transformation from an n-ary function to another one.*) -Fixpoint nfun_to_nfun (A B C:Type)(f:B -> C) n : +Fixpoint nfun_to_nfun (A B C:Type)(f:B -> C) n : (A^^n-->B) -> (A^^n-->C) := - match n return (A^^n-->B) -> (A^^n-->C) with + match n return (A^^n-->B) -> (A^^n-->C) with | O => f | S n => fun g a => nfun_to_nfun _ _ _ f n (g a) end. -(** [napply_except_last _ _ n f] expects [n] arguments of type [A], - applies [n-1] of them to [f] and discard the last one. *) +(** [napply_except_last _ _ n f] expects [n] arguments of type [A], + applies [n-1] of them to [f] and discard the last one. *) -Definition napply_except_last (A B:Type) := +Definition napply_except_last (A B:Type) := nfun_to_nfun A B (A->B) (fun b a => b). -(** [napply_then_last _ _ a n f] expects [n] arguments of type [A], - applies them to [f] and then apply [a] to the result. *) +(** [napply_then_last _ _ a n f] expects [n] arguments of type [A], + applies them to [f] and then apply [a] to the result. *) -Definition napply_then_last (A B:Type)(a:A) := +Definition napply_then_last (A B:Type)(a:A) := nfun_to_nfun A (A->B) B (fun fab => fab a). -(** [napply_discard _ b n] expects [n] arguments, discards then, +(** [napply_discard _ b n] expects [n] arguments, discards then, and returns [b]. *) Fixpoint napply_discard (A B:Type)(b:B) n : A^^n-->B := - match n return A^^n-->B with + match n return A^^n-->B with | O => b | S n => fun _ => napply_discard _ _ b n end. (** A fold function *) -Fixpoint nfold A B (f:A->B->B)(b:B) n : (A^^n-->B) := - match n return (A^^n-->B) with +Fixpoint nfold A B (f:A->B->B)(b:B) n : (A^^n-->B) := + match n return (A^^n-->B) with | O => b | S n => fun a => (nfold _ _ f (f a b) n) end. -(** [n]-ary products : [nprod A n] is [A*...*A*unit], +(** [n]-ary products : [nprod A n] is [A*...*A*unit], with [n] occurrences of [A] in this type. *) -Fixpoint nprod A n : Type := match n with +Fixpoint nprod A n : Type := match n with | O => unit | S n => (A * nprod A n)%type end. @@ -89,54 +89,54 @@ Notation "A ^ n" := (nprod A n) : type_scope. (** [n]-ary curryfication / uncurryfication *) -Fixpoint ncurry (A B:Type) n : (A^n -> B) -> (A^^n-->B) := - match n return (A^n -> B) -> (A^^n-->B) with +Fixpoint ncurry (A B:Type) n : (A^n -> B) -> (A^^n-->B) := + match n return (A^n -> B) -> (A^^n-->B) with | O => fun x => x tt | S n => fun f a => ncurry _ _ n (fun p => f (a,p)) end. -Fixpoint nuncurry (A B:Type) n : (A^^n-->B) -> (A^n -> B) := +Fixpoint nuncurry (A B:Type) n : (A^^n-->B) -> (A^n -> B) := match n return (A^^n-->B) -> (A^n -> B) with | O => fun x _ => x | S n => fun f p => let (x,p) := p in nuncurry _ _ n (f x) p end. -(** Earlier functions can also be defined via [ncurry/nuncurry]. +(** Earlier functions can also be defined via [ncurry/nuncurry]. For instance : *) Definition nfun_to_nfun_bis A B C (f:B->C) n : - (A^^n-->B) -> (A^^n-->C) := + (A^^n-->B) -> (A^^n-->C) := fun anb => ncurry _ _ n (fun an => f ((nuncurry _ _ n anb) an)). -(** We can also us it to obtain another [fold] function, +(** We can also us it to obtain another [fold] function, equivalent to the previous one, but with a nicer expansion (see for instance Int31.iszero). *) -Fixpoint nfold_bis A B (f:A->B->B)(b:B) n : (A^^n-->B) := - match n return (A^^n-->B) with +Fixpoint nfold_bis A B (f:A->B->B)(b:B) n : (A^^n-->B) := + match n return (A^^n-->B) with | O => b - | S n => fun a => + | S n => fun a => nfun_to_nfun_bis _ _ _ (f a) n (nfold_bis _ _ f b n) end. (** From [nprod] to [list] *) -Fixpoint nprod_to_list (A:Type) n : A^n -> list A := - match n with +Fixpoint nprod_to_list (A:Type) n : A^n -> list A := + match n with | O => fun _ => nil | S n => fun p => let (x,p) := p in x::(nprod_to_list _ n p) end. (** From [list] to [nprod] *) -Fixpoint nprod_of_list (A:Type)(l:list A) : A^(length l) := - match l return A^(length l) with +Fixpoint nprod_of_list (A:Type)(l:list A) : A^(length l) := + match l return A^(length l) with | nil => tt | x::l => (x, nprod_of_list _ l) end. (** This gives an additional way to write the fold *) -Definition nfold_list (A B:Type)(f:A->B->B)(b:B) n : (A^^n-->B) := +Definition nfold_list (A B:Type)(f:A->B->B)(b:B) n : (A^^n-->B) := ncurry _ _ n (fun p => fold_right f b (nprod_to_list _ _ p)). diff --git a/theories/Numbers/NatInt/NZAdd.v b/theories/Numbers/NatInt/NZAdd.v index c9bb5c95..9535cfdb 100644 --- a/theories/Numbers/NatInt/NZAdd.v +++ b/theories/Numbers/NatInt/NZAdd.v @@ -8,84 +8,83 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NZAdd.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) -Require Import NZAxioms. -Require Import NZBase. +Require Import NZAxioms NZBase. -Module NZAddPropFunct (Import NZAxiomsMod : NZAxiomsSig). -Module Export NZBasePropMod := NZBasePropFunct NZAxiomsMod. -Open Local Scope NatIntScope. +Module Type NZAddPropSig + (Import NZ : NZAxiomsSig')(Import NZBase : NZBasePropSig NZ). -Theorem NZadd_0_r : forall n : NZ, n + 0 == n. +Hint Rewrite + pred_succ add_0_l add_succ_l mul_0_l mul_succ_l sub_0_r sub_succ_r : nz. +Ltac nzsimpl := autorewrite with nz. + +Theorem add_0_r : forall n, n + 0 == n. Proof. -NZinduct n. now rewrite NZadd_0_l. -intro. rewrite NZadd_succ_l. now rewrite NZsucc_inj_wd. +nzinduct n. now nzsimpl. +intro. nzsimpl. now rewrite succ_inj_wd. Qed. -Theorem NZadd_succ_r : forall n m : NZ, n + S m == S (n + m). +Theorem add_succ_r : forall n m, n + S m == S (n + m). Proof. -intros n m; NZinduct n. -now do 2 rewrite NZadd_0_l. -intro. repeat rewrite NZadd_succ_l. now rewrite NZsucc_inj_wd. +intros n m; nzinduct n. now nzsimpl. +intro. nzsimpl. now rewrite succ_inj_wd. Qed. -Theorem NZadd_comm : forall n m : NZ, n + m == m + n. +Hint Rewrite add_0_r add_succ_r : nz. + +Theorem add_comm : forall n m, n + m == m + n. Proof. -intros n m; NZinduct n. -rewrite NZadd_0_l; now rewrite NZadd_0_r. -intros n. rewrite NZadd_succ_l; rewrite NZadd_succ_r. now rewrite NZsucc_inj_wd. +intros n m; nzinduct n. now nzsimpl. +intro. nzsimpl. now rewrite succ_inj_wd. Qed. -Theorem NZadd_1_l : forall n : NZ, 1 + n == S n. +Theorem add_1_l : forall n, 1 + n == S n. Proof. -intro n; rewrite NZadd_succ_l; now rewrite NZadd_0_l. +intro n; now nzsimpl. Qed. -Theorem NZadd_1_r : forall n : NZ, n + 1 == S n. +Theorem add_1_r : forall n, n + 1 == S n. Proof. -intro n; rewrite NZadd_comm; apply NZadd_1_l. +intro n; now nzsimpl. Qed. -Theorem NZadd_assoc : forall n m p : NZ, n + (m + p) == (n + m) + p. +Theorem add_assoc : forall n m p, n + (m + p) == (n + m) + p. Proof. -intros n m p; NZinduct n. -now do 2 rewrite NZadd_0_l. -intro. do 3 rewrite NZadd_succ_l. now rewrite NZsucc_inj_wd. +intros n m p; nzinduct n. now nzsimpl. +intro. nzsimpl. now rewrite succ_inj_wd. Qed. -Theorem NZadd_shuffle1 : forall n m p q : NZ, (n + m) + (p + q) == (n + p) + (m + q). +Theorem add_cancel_l : forall n m p, p + n == p + m <-> n == m. Proof. -intros n m p q. -rewrite <- (NZadd_assoc n m (p + q)). rewrite (NZadd_comm m (p + q)). -rewrite <- (NZadd_assoc p q m). rewrite (NZadd_assoc n p (q + m)). -now rewrite (NZadd_comm q m). +intros n m p; nzinduct p. now nzsimpl. +intro p. nzsimpl. now rewrite succ_inj_wd. Qed. -Theorem NZadd_shuffle2 : forall n m p q : NZ, (n + m) + (p + q) == (n + q) + (m + p). +Theorem add_cancel_r : forall n m p, n + p == m + p <-> n == m. Proof. -intros n m p q. -rewrite <- (NZadd_assoc n m (p + q)). rewrite (NZadd_assoc m p q). -rewrite (NZadd_comm (m + p) q). now rewrite <- (NZadd_assoc n q (m + p)). +intros n m p. rewrite (add_comm n p), (add_comm m p). apply add_cancel_l. Qed. -Theorem NZadd_cancel_l : forall n m p : NZ, p + n == p + m <-> n == m. +Theorem add_shuffle0 : forall n m p, n+m+p == n+p+m. Proof. -intros n m p; NZinduct p. -now do 2 rewrite NZadd_0_l. -intro p. do 2 rewrite NZadd_succ_l. now rewrite NZsucc_inj_wd. +intros n m p. rewrite <- 2 add_assoc, add_cancel_l. apply add_comm. Qed. -Theorem NZadd_cancel_r : forall n m p : NZ, n + p == m + p <-> n == m. +Theorem add_shuffle1 : forall n m p q, (n + m) + (p + q) == (n + p) + (m + q). Proof. -intros n m p. rewrite (NZadd_comm n p); rewrite (NZadd_comm m p). -apply NZadd_cancel_l. +intros n m p q. rewrite 2 add_assoc, add_cancel_r. apply add_shuffle0. Qed. -Theorem NZsub_1_r : forall n : NZ, n - 1 == P n. +Theorem add_shuffle2 : forall n m p q, (n + m) + (p + q) == (n + q) + (m + p). Proof. -intro n; rewrite NZsub_succ_r; now rewrite NZsub_0_r. +intros n m p q. +rewrite 2 add_assoc, add_shuffle0, add_cancel_r. apply add_shuffle0. Qed. -End NZAddPropFunct. +Theorem sub_1_r : forall n, n - 1 == P n. +Proof. +intro n; now nzsimpl. +Qed. +End NZAddPropSig. diff --git a/theories/Numbers/NatInt/NZAddOrder.v b/theories/Numbers/NatInt/NZAddOrder.v index 50d1c42f..97c12202 100644 --- a/theories/Numbers/NatInt/NZAddOrder.v +++ b/theories/Numbers/NatInt/NZAddOrder.v @@ -8,159 +8,146 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NZAddOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) -Require Import NZAxioms. -Require Import NZOrder. +Require Import NZAxioms NZBase NZMul NZOrder. -Module NZAddOrderPropFunct (Import NZOrdAxiomsMod : NZOrdAxiomsSig). -Module Export NZOrderPropMod := NZOrderPropFunct NZOrdAxiomsMod. -Open Local Scope NatIntScope. +Module Type NZAddOrderPropSig (Import NZ : NZOrdAxiomsSig'). +Include NZBasePropSig NZ <+ NZMulPropSig NZ <+ NZOrderPropSig NZ. -Theorem NZadd_lt_mono_l : forall n m p : NZ, n < m <-> p + n < p + m. +Theorem add_lt_mono_l : forall n m p, n < m <-> p + n < p + m. Proof. -intros n m p; NZinduct p. -now do 2 rewrite NZadd_0_l. -intro p. do 2 rewrite NZadd_succ_l. now rewrite <- NZsucc_lt_mono. +intros n m p; nzinduct p. now nzsimpl. +intro p. nzsimpl. now rewrite <- succ_lt_mono. Qed. -Theorem NZadd_lt_mono_r : forall n m p : NZ, n < m <-> n + p < m + p. +Theorem add_lt_mono_r : forall n m p, n < m <-> n + p < m + p. Proof. -intros n m p. -rewrite (NZadd_comm n p); rewrite (NZadd_comm m p); apply NZadd_lt_mono_l. +intros n m p. rewrite (add_comm n p), (add_comm m p); apply add_lt_mono_l. Qed. -Theorem NZadd_lt_mono : forall n m p q : NZ, n < m -> p < q -> n + p < m + q. +Theorem add_lt_mono : forall n m p q, n < m -> p < q -> n + p < m + q. Proof. intros n m p q H1 H2. -apply NZlt_trans with (m + p); -[now apply -> NZadd_lt_mono_r | now apply -> NZadd_lt_mono_l]. +apply lt_trans with (m + p); +[now apply -> add_lt_mono_r | now apply -> add_lt_mono_l]. Qed. -Theorem NZadd_le_mono_l : forall n m p : NZ, n <= m <-> p + n <= p + m. +Theorem add_le_mono_l : forall n m p, n <= m <-> p + n <= p + m. Proof. -intros n m p; NZinduct p. -now do 2 rewrite NZadd_0_l. -intro p. do 2 rewrite NZadd_succ_l. now rewrite <- NZsucc_le_mono. +intros n m p; nzinduct p. now nzsimpl. +intro p. nzsimpl. now rewrite <- succ_le_mono. Qed. -Theorem NZadd_le_mono_r : forall n m p : NZ, n <= m <-> n + p <= m + p. +Theorem add_le_mono_r : forall n m p, n <= m <-> n + p <= m + p. Proof. -intros n m p. -rewrite (NZadd_comm n p); rewrite (NZadd_comm m p); apply NZadd_le_mono_l. +intros n m p. rewrite (add_comm n p), (add_comm m p); apply add_le_mono_l. Qed. -Theorem NZadd_le_mono : forall n m p q : NZ, n <= m -> p <= q -> n + p <= m + q. +Theorem add_le_mono : forall n m p q, n <= m -> p <= q -> n + p <= m + q. Proof. intros n m p q H1 H2. -apply NZle_trans with (m + p); -[now apply -> NZadd_le_mono_r | now apply -> NZadd_le_mono_l]. +apply le_trans with (m + p); +[now apply -> add_le_mono_r | now apply -> add_le_mono_l]. Qed. -Theorem NZadd_lt_le_mono : forall n m p q : NZ, n < m -> p <= q -> n + p < m + q. +Theorem add_lt_le_mono : forall n m p q, n < m -> p <= q -> n + p < m + q. Proof. intros n m p q H1 H2. -apply NZlt_le_trans with (m + p); -[now apply -> NZadd_lt_mono_r | now apply -> NZadd_le_mono_l]. +apply lt_le_trans with (m + p); +[now apply -> add_lt_mono_r | now apply -> add_le_mono_l]. Qed. -Theorem NZadd_le_lt_mono : forall n m p q : NZ, n <= m -> p < q -> n + p < m + q. +Theorem add_le_lt_mono : forall n m p q, n <= m -> p < q -> n + p < m + q. Proof. intros n m p q H1 H2. -apply NZle_lt_trans with (m + p); -[now apply -> NZadd_le_mono_r | now apply -> NZadd_lt_mono_l]. +apply le_lt_trans with (m + p); +[now apply -> add_le_mono_r | now apply -> add_lt_mono_l]. Qed. -Theorem NZadd_pos_pos : forall n m : NZ, 0 < n -> 0 < m -> 0 < n + m. +Theorem add_pos_pos : forall n m, 0 < n -> 0 < m -> 0 < n + m. Proof. -intros n m H1 H2. rewrite <- (NZadd_0_l 0). now apply NZadd_lt_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_mono. Qed. -Theorem NZadd_pos_nonneg : forall n m : NZ, 0 < n -> 0 <= m -> 0 < n + m. +Theorem add_pos_nonneg : forall n m, 0 < n -> 0 <= m -> 0 < n + m. Proof. -intros n m H1 H2. rewrite <- (NZadd_0_l 0). now apply NZadd_lt_le_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_le_mono. Qed. -Theorem NZadd_nonneg_pos : forall n m : NZ, 0 <= n -> 0 < m -> 0 < n + m. +Theorem add_nonneg_pos : forall n m, 0 <= n -> 0 < m -> 0 < n + m. Proof. -intros n m H1 H2. rewrite <- (NZadd_0_l 0). now apply NZadd_le_lt_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_lt_mono. Qed. -Theorem NZadd_nonneg_nonneg : forall n m : NZ, 0 <= n -> 0 <= m -> 0 <= n + m. +Theorem add_nonneg_nonneg : forall n m, 0 <= n -> 0 <= m -> 0 <= n + m. Proof. -intros n m H1 H2. rewrite <- (NZadd_0_l 0). now apply NZadd_le_mono. +intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_mono. Qed. -Theorem NZlt_add_pos_l : forall n m : NZ, 0 < n -> m < n + m. +Theorem lt_add_pos_l : forall n m, 0 < n -> m < n + m. Proof. -intros n m H. apply -> (NZadd_lt_mono_r 0 n m) in H. -now rewrite NZadd_0_l in H. +intros n m. rewrite (add_lt_mono_r 0 n m). now nzsimpl. Qed. -Theorem NZlt_add_pos_r : forall n m : NZ, 0 < n -> m < m + n. +Theorem lt_add_pos_r : forall n m, 0 < n -> m < m + n. Proof. -intros; rewrite NZadd_comm; now apply NZlt_add_pos_l. +intros; rewrite add_comm; now apply lt_add_pos_l. Qed. -Theorem NZle_lt_add_lt : forall n m p q : NZ, n <= m -> p + m < q + n -> p < q. +Theorem le_lt_add_lt : forall n m p q, n <= m -> p + m < q + n -> p < q. Proof. -intros n m p q H1 H2. destruct (NZle_gt_cases q p); [| assumption]. -pose proof (NZadd_le_mono q p n m H H1) as H3. apply <- NZnle_gt in H2. -false_hyp H3 H2. +intros n m p q H1 H2. destruct (le_gt_cases q p); [| assumption]. +contradict H2. rewrite nlt_ge. now apply add_le_mono. Qed. -Theorem NZlt_le_add_lt : forall n m p q : NZ, n < m -> p + m <= q + n -> p < q. +Theorem lt_le_add_lt : forall n m p q, n < m -> p + m <= q + n -> p < q. Proof. -intros n m p q H1 H2. destruct (NZle_gt_cases q p); [| assumption]. -pose proof (NZadd_le_lt_mono q p n m H H1) as H3. apply <- NZnle_gt in H3. -false_hyp H2 H3. +intros n m p q H1 H2. destruct (le_gt_cases q p); [| assumption]. +contradict H2. rewrite nle_gt. now apply add_le_lt_mono. Qed. -Theorem NZle_le_add_le : forall n m p q : NZ, n <= m -> p + m <= q + n -> p <= q. +Theorem le_le_add_le : forall n m p q, n <= m -> p + m <= q + n -> p <= q. Proof. -intros n m p q H1 H2. destruct (NZle_gt_cases p q); [assumption |]. -pose proof (NZadd_lt_le_mono q p n m H H1) as H3. apply <- NZnle_gt in H3. -false_hyp H2 H3. +intros n m p q H1 H2. destruct (le_gt_cases p q); [assumption |]. +contradict H2. rewrite nle_gt. now apply add_lt_le_mono. Qed. -Theorem NZadd_lt_cases : forall n m p q : NZ, n + m < p + q -> n < p \/ m < q. +Theorem add_lt_cases : forall n m p q, n + m < p + q -> n < p \/ m < q. Proof. intros n m p q H; -destruct (NZle_gt_cases p n) as [H1 | H1]. -destruct (NZle_gt_cases q m) as [H2 | H2]. -pose proof (NZadd_le_mono p n q m H1 H2) as H3. apply -> NZle_ngt in H3. -false_hyp H H3. -now right. now left. +destruct (le_gt_cases p n) as [H1 | H1]; [| now left]. +destruct (le_gt_cases q m) as [H2 | H2]; [| now right]. +contradict H; rewrite nlt_ge. now apply add_le_mono. Qed. -Theorem NZadd_le_cases : forall n m p q : NZ, n + m <= p + q -> n <= p \/ m <= q. +Theorem add_le_cases : forall n m p q, n + m <= p + q -> n <= p \/ m <= q. Proof. intros n m p q H. -destruct (NZle_gt_cases n p) as [H1 | H1]. now left. -destruct (NZle_gt_cases m q) as [H2 | H2]. now right. -assert (H3 : p + q < n + m) by now apply NZadd_lt_mono. -apply -> NZle_ngt in H. false_hyp H3 H. +destruct (le_gt_cases n p) as [H1 | H1]. now left. +destruct (le_gt_cases m q) as [H2 | H2]. now right. +contradict H; rewrite nle_gt. now apply add_lt_mono. Qed. -Theorem NZadd_neg_cases : forall n m : NZ, n + m < 0 -> n < 0 \/ m < 0. +Theorem add_neg_cases : forall n m, n + m < 0 -> n < 0 \/ m < 0. Proof. -intros n m H; apply NZadd_lt_cases; now rewrite NZadd_0_l. +intros n m H; apply add_lt_cases; now nzsimpl. Qed. -Theorem NZadd_pos_cases : forall n m : NZ, 0 < n + m -> 0 < n \/ 0 < m. +Theorem add_pos_cases : forall n m, 0 < n + m -> 0 < n \/ 0 < m. Proof. -intros n m H; apply NZadd_lt_cases; now rewrite NZadd_0_l. +intros n m H; apply add_lt_cases; now nzsimpl. Qed. -Theorem NZadd_nonpos_cases : forall n m : NZ, n + m <= 0 -> n <= 0 \/ m <= 0. +Theorem add_nonpos_cases : forall n m, n + m <= 0 -> n <= 0 \/ m <= 0. Proof. -intros n m H; apply NZadd_le_cases; now rewrite NZadd_0_l. +intros n m H; apply add_le_cases; now nzsimpl. Qed. -Theorem NZadd_nonneg_cases : forall n m : NZ, 0 <= n + m -> 0 <= n \/ 0 <= m. +Theorem add_nonneg_cases : forall n m, 0 <= n + m -> 0 <= n \/ 0 <= m. Proof. -intros n m H; apply NZadd_le_cases; now rewrite NZadd_0_l. +intros n m H; apply add_le_cases; now nzsimpl. Qed. -End NZAddOrderPropFunct. +End NZAddOrderPropSig. diff --git a/theories/Numbers/NatInt/NZAxioms.v b/theories/Numbers/NatInt/NZAxioms.v index 26933646..ee7ee159 100644 --- a/theories/Numbers/NatInt/NZAxioms.v +++ b/theories/Numbers/NatInt/NZAxioms.v @@ -5,95 +5,115 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* Evgeny Makarov, INRIA, 2007 *) -(************************************************************************) -(*i $Id: NZAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*) - -Require Export NumPrelude. - -Module Type NZAxiomsSig. - -Parameter Inline NZ : Type. -Parameter Inline NZeq : NZ -> NZ -> Prop. -Parameter Inline NZ0 : NZ. -Parameter Inline NZsucc : NZ -> NZ. -Parameter Inline NZpred : NZ -> NZ. -Parameter Inline NZadd : NZ -> NZ -> NZ. -Parameter Inline NZsub : NZ -> NZ -> NZ. -Parameter Inline NZmul : NZ -> NZ -> NZ. - -(* Unary subtraction (opp) is not defined on natural numbers, so we have - it for integers only *) - -Axiom NZeq_equiv : equiv NZ NZeq. -Add Relation NZ NZeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. - -Add Morphism NZsucc with signature NZeq ==> NZeq as NZsucc_wd. -Add Morphism NZpred with signature NZeq ==> NZeq as NZpred_wd. -Add Morphism NZadd with signature NZeq ==> NZeq ==> NZeq as NZadd_wd. -Add Morphism NZsub with signature NZeq ==> NZeq ==> NZeq as NZsub_wd. -Add Morphism NZmul with signature NZeq ==> NZeq ==> NZeq as NZmul_wd. - -Delimit Scope NatIntScope with NatInt. -Open Local Scope NatIntScope. -Notation "x == y" := (NZeq x y) (at level 70) : NatIntScope. -Notation "x ~= y" := (~ NZeq x y) (at level 70) : NatIntScope. -Notation "0" := NZ0 : NatIntScope. -Notation S := NZsucc. -Notation P := NZpred. -Notation "1" := (S 0) : NatIntScope. -Notation "x + y" := (NZadd x y) : NatIntScope. -Notation "x - y" := (NZsub x y) : NatIntScope. -Notation "x * y" := (NZmul x y) : NatIntScope. - -Axiom NZpred_succ : forall n : NZ, P (S n) == n. - -Axiom NZinduction : - forall A : NZ -> Prop, predicate_wd NZeq A -> - A 0 -> (forall n : NZ, A n <-> A (S n)) -> forall n : NZ, A n. - -Axiom NZadd_0_l : forall n : NZ, 0 + n == n. -Axiom NZadd_succ_l : forall n m : NZ, (S n) + m == S (n + m). - -Axiom NZsub_0_r : forall n : NZ, n - 0 == n. -Axiom NZsub_succ_r : forall n m : NZ, n - (S m) == P (n - m). - -Axiom NZmul_0_l : forall n : NZ, 0 * n == 0. -Axiom NZmul_succ_l : forall n m : NZ, S n * m == n * m + m. - -End NZAxiomsSig. - -Module Type NZOrdAxiomsSig. -Declare Module Export NZAxiomsMod : NZAxiomsSig. -Open Local Scope NatIntScope. - -Parameter Inline NZlt : NZ -> NZ -> Prop. -Parameter Inline NZle : NZ -> NZ -> Prop. -Parameter Inline NZmin : NZ -> NZ -> NZ. -Parameter Inline NZmax : NZ -> NZ -> NZ. - -Add Morphism NZlt with signature NZeq ==> NZeq ==> iff as NZlt_wd. -Add Morphism NZle with signature NZeq ==> NZeq ==> iff as NZle_wd. -Add Morphism NZmin with signature NZeq ==> NZeq ==> NZeq as NZmin_wd. -Add Morphism NZmax with signature NZeq ==> NZeq ==> NZeq as NZmax_wd. - -Notation "x < y" := (NZlt x y) : NatIntScope. -Notation "x <= y" := (NZle x y) : NatIntScope. -Notation "x > y" := (NZlt y x) (only parsing) : NatIntScope. -Notation "x >= y" := (NZle y x) (only parsing) : NatIntScope. - -Axiom NZlt_eq_cases : forall n m : NZ, n <= m <-> n < m \/ n == m. -Axiom NZlt_irrefl : forall n : NZ, ~ (n < n). -Axiom NZlt_succ_r : forall n m : NZ, n < S m <-> n <= m. - -Axiom NZmin_l : forall n m : NZ, n <= m -> NZmin n m == n. -Axiom NZmin_r : forall n m : NZ, m <= n -> NZmin n m == m. -Axiom NZmax_l : forall n m : NZ, m <= n -> NZmax n m == n. -Axiom NZmax_r : forall n m : NZ, n <= m -> NZmax n m == m. - -End NZOrdAxiomsSig. +(** Initial Author : Evgeny Makarov, INRIA, 2007 *) + +(*i $Id$ i*) + +Require Export Equalities Orders NumPrelude GenericMinMax. + +(** Axiomatization of a domain with zero, successor, predecessor, + and a bi-directional induction principle. We require [P (S n) = n] + but not the other way around, since this domain is meant + to be either N or Z. In fact it can be a few other things, + for instance [Z/nZ] (See file [NZDomain] for a study of that). +*) + +Module Type ZeroSuccPred (Import T:Typ). + Parameter Inline zero : t. + Parameters Inline succ pred : t -> t. +End ZeroSuccPred. + +Module Type ZeroSuccPredNotation (T:Typ)(Import NZ:ZeroSuccPred T). + Notation "0" := zero. + Notation S := succ. + Notation P := pred. + Notation "1" := (S 0). + Notation "2" := (S 1). +End ZeroSuccPredNotation. + +Module Type ZeroSuccPred' (T:Typ) := + ZeroSuccPred T <+ ZeroSuccPredNotation T. + +Module Type IsNZDomain (Import E:Eq')(Import NZ:ZeroSuccPred' E). + Declare Instance succ_wd : Proper (eq ==> eq) S. + Declare Instance pred_wd : Proper (eq ==> eq) P. + Axiom pred_succ : forall n, P (S n) == n. + Axiom bi_induction : + forall A : t -> Prop, Proper (eq==>iff) A -> + A 0 -> (forall n, A n <-> A (S n)) -> forall n, A n. +End IsNZDomain. + +Module Type NZDomainSig := EqualityType <+ ZeroSuccPred <+ IsNZDomain. +Module Type NZDomainSig' := EqualityType' <+ ZeroSuccPred' <+ IsNZDomain. + + +(** Axiomatization of basic operations : [+] [-] [*] *) + +Module Type AddSubMul (Import T:Typ). + Parameters Inline add sub mul : t -> t -> t. +End AddSubMul. + +Module Type AddSubMulNotation (T:Typ)(Import NZ:AddSubMul T). + Notation "x + y" := (add x y). + Notation "x - y" := (sub x y). + Notation "x * y" := (mul x y). +End AddSubMulNotation. + +Module Type AddSubMul' (T:Typ) := AddSubMul T <+ AddSubMulNotation T. + +Module Type IsAddSubMul (Import E:NZDomainSig')(Import NZ:AddSubMul' E). + Declare Instance add_wd : Proper (eq ==> eq ==> eq) add. + Declare Instance sub_wd : Proper (eq ==> eq ==> eq) sub. + Declare Instance mul_wd : Proper (eq ==> eq ==> eq) mul. + Axiom add_0_l : forall n, 0 + n == n. + Axiom add_succ_l : forall n m, (S n) + m == S (n + m). + Axiom sub_0_r : forall n, n - 0 == n. + Axiom sub_succ_r : forall n m, n - (S m) == P (n - m). + Axiom mul_0_l : forall n, 0 * n == 0. + Axiom mul_succ_l : forall n m, S n * m == n * m + m. +End IsAddSubMul. + +Module Type NZBasicFunsSig := NZDomainSig <+ AddSubMul <+ IsAddSubMul. +Module Type NZBasicFunsSig' := NZDomainSig' <+ AddSubMul' <+IsAddSubMul. + +(** Old name for the same interface: *) + +Module Type NZAxiomsSig := NZBasicFunsSig. +Module Type NZAxiomsSig' := NZBasicFunsSig'. + +(** Axiomatization of order *) + +Module Type NZOrd := NZDomainSig <+ HasLt <+ HasLe. +Module Type NZOrd' := NZDomainSig' <+ HasLt <+ HasLe <+ + LtNotation <+ LeNotation <+ LtLeNotation. + +Module Type IsNZOrd (Import NZ : NZOrd'). + Declare Instance lt_wd : Proper (eq ==> eq ==> iff) lt. + Axiom lt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. + Axiom lt_irrefl : forall n, ~ (n < n). + Axiom lt_succ_r : forall n m, n < S m <-> n <= m. +End IsNZOrd. + +(** NB: the compatibility of [le] can be proved later from [lt_wd] + and [lt_eq_cases] *) + +Module Type NZOrdSig := NZOrd <+ IsNZOrd. +Module Type NZOrdSig' := NZOrd' <+ IsNZOrd. + +(** Everything together : *) + +Module Type NZOrdAxiomsSig <: NZBasicFunsSig <: NZOrdSig + := NZOrdSig <+ AddSubMul <+ IsAddSubMul <+ HasMinMax. +Module Type NZOrdAxiomsSig' <: NZOrdAxiomsSig + := NZOrdSig' <+ AddSubMul' <+ IsAddSubMul <+ HasMinMax. + + +(** Same, plus a comparison function. *) + +Module Type NZDecOrdSig := NZOrdSig <+ HasCompare. +Module Type NZDecOrdSig' := NZOrdSig' <+ HasCompare. + +Module Type NZDecOrdAxiomsSig := NZOrdAxiomsSig <+ HasCompare. +Module Type NZDecOrdAxiomsSig' := NZOrdAxiomsSig' <+ HasCompare. + diff --git a/theories/Numbers/NatInt/NZBase.v b/theories/Numbers/NatInt/NZBase.v index bd4d6232..18e3b9b9 100644 --- a/theories/Numbers/NatInt/NZBase.v +++ b/theories/Numbers/NatInt/NZBase.v @@ -8,45 +8,54 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NZBase.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Import NZAxioms. -Module NZBasePropFunct (Import NZAxiomsMod : NZAxiomsSig). -Open Local Scope NatIntScope. +Module Type NZBasePropSig (Import NZ : NZDomainSig'). -Theorem NZneq_sym : forall n m : NZ, n ~= m -> m ~= n. +Include BackportEq NZ NZ. (** eq_refl, eq_sym, eq_trans *) + +Lemma eq_sym_iff : forall x y, x==y <-> y==x. +Proof. +intros; split; symmetry; auto. +Qed. + +(* TODO: how register ~= (which is just a notation) as a Symmetric relation, + hence allowing "symmetry" tac ? *) + +Theorem neq_sym : forall n m, n ~= m -> m ~= n. Proof. intros n m H1 H2; symmetry in H2; false_hyp H2 H1. Qed. -Theorem NZE_stepl : forall x y z : NZ, x == y -> x == z -> z == y. +Theorem eq_stepl : forall x y z, x == y -> x == z -> z == y. Proof. intros x y z H1 H2; now rewrite <- H1. Qed. -Declare Left Step NZE_stepl. -(* The right step lemma is just the transitivity of NZeq *) -Declare Right Step (proj1 (proj2 NZeq_equiv)). +Declare Left Step eq_stepl. +(* The right step lemma is just the transitivity of eq *) +Declare Right Step (@Equivalence_Transitive _ _ eq_equiv). -Theorem NZsucc_inj : forall n1 n2 : NZ, S n1 == S n2 -> n1 == n2. +Theorem succ_inj : forall n1 n2, S n1 == S n2 -> n1 == n2. Proof. intros n1 n2 H. -apply NZpred_wd in H. now do 2 rewrite NZpred_succ in H. +apply pred_wd in H. now do 2 rewrite pred_succ in H. Qed. (* The following theorem is useful as an equivalence for proving bidirectional induction steps *) -Theorem NZsucc_inj_wd : forall n1 n2 : NZ, S n1 == S n2 <-> n1 == n2. +Theorem succ_inj_wd : forall n1 n2, S n1 == S n2 <-> n1 == n2. Proof. intros; split. -apply NZsucc_inj. -apply NZsucc_wd. +apply succ_inj. +apply succ_wd. Qed. -Theorem NZsucc_inj_wd_neg : forall n m : NZ, S n ~= S m <-> n ~= m. +Theorem succ_inj_wd_neg : forall n m, S n ~= S m <-> n ~= m. Proof. -intros; now rewrite NZsucc_inj_wd. +intros; now rewrite succ_inj_wd. Qed. (* We cannot prove that the predecessor is injective, nor that it is @@ -54,31 +63,27 @@ left-inverse to the successor at this point *) Section CentralInduction. -Variable A : predicate NZ. - -Hypothesis A_wd : predicate_wd NZeq A. - -Add Morphism A with signature NZeq ==> iff as A_morph. -Proof. apply A_wd. Qed. +Variable A : predicate t. +Hypothesis A_wd : Proper (eq==>iff) A. -Theorem NZcentral_induction : - forall z : NZ, A z -> - (forall n : NZ, A n <-> A (S n)) -> - forall n : NZ, A n. +Theorem central_induction : + forall z, A z -> + (forall n, A n <-> A (S n)) -> + forall n, A n. Proof. -intros z Base Step; revert Base; pattern z; apply NZinduction. +intros z Base Step; revert Base; pattern z; apply bi_induction. solve_predicate_wd. -intro; now apply NZinduction. +intro; now apply bi_induction. intro; pose proof (Step n); tauto. Qed. End CentralInduction. -Tactic Notation "NZinduct" ident(n) := - induction_maker n ltac:(apply NZinduction). +Tactic Notation "nzinduct" ident(n) := + induction_maker n ltac:(apply bi_induction). -Tactic Notation "NZinduct" ident(n) constr(u) := - induction_maker n ltac:(apply NZcentral_induction with (z := u)). +Tactic Notation "nzinduct" ident(n) constr(u) := + induction_maker n ltac:(apply central_induction with (z := u)). -End NZBasePropFunct. +End NZBasePropSig. diff --git a/theories/Numbers/NatInt/NZDiv.v b/theories/Numbers/NatInt/NZDiv.v new file mode 100644 index 00000000..1f6c615b --- /dev/null +++ b/theories/Numbers/NatInt/NZDiv.v @@ -0,0 +1,542 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(** Euclidean Division *) + +Require Import NZAxioms NZMulOrder. + +(** The first signatures will be common to all divisions over NZ, N and Z *) + +Module Type DivMod (Import T:Typ). + Parameters Inline div modulo : t -> t -> t. +End DivMod. + +Module Type DivModNotation (T:Typ)(Import NZ:DivMod T). + Infix "/" := div. + Infix "mod" := modulo (at level 40, no associativity). +End DivModNotation. + +Module Type DivMod' (T:Typ) := DivMod T <+ DivModNotation T. + +Module Type NZDivCommon (Import NZ : NZAxiomsSig')(Import DM : DivMod' NZ). + Declare Instance div_wd : Proper (eq==>eq==>eq) div. + Declare Instance mod_wd : Proper (eq==>eq==>eq) modulo. + Axiom div_mod : forall a b, b ~= 0 -> a == b*(a/b) + (a mod b). +End NZDivCommon. + +(** The different divisions will only differ in the conditions + they impose on [modulo]. For NZ, we only describe behavior + on positive numbers. + + NB: This axiom would also be true for N and Z, but redundant. +*) + +Module Type NZDivSpecific (Import NZ : NZOrdAxiomsSig')(Import DM : DivMod' NZ). + Axiom mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b. +End NZDivSpecific. + +Module Type NZDiv (NZ:NZOrdAxiomsSig) + := DivMod NZ <+ NZDivCommon NZ <+ NZDivSpecific NZ. + +Module Type NZDiv' (NZ:NZOrdAxiomsSig) := NZDiv NZ <+ DivModNotation NZ. + +Module NZDivPropFunct + (Import NZ : NZOrdAxiomsSig') + (Import NZP : NZMulOrderPropSig NZ) + (Import NZD : NZDiv' NZ) +. + +(** Uniqueness theorems *) + +Theorem div_mod_unique : + forall b q1 q2 r1 r2, 0<=r1<b -> 0<=r2<b -> + b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. +Proof. +intros b. +assert (U : forall q1 q2 r1 r2, + b*q1+r1 == b*q2+r2 -> 0<=r1<b -> 0<=r2 -> q1<q2 -> False). + intros q1 q2 r1 r2 EQ LT Hr1 Hr2. + contradict EQ. + apply lt_neq. + apply lt_le_trans with (b*q1+b). + rewrite <- add_lt_mono_l. tauto. + apply le_trans with (b*q2). + rewrite mul_comm, <- mul_succ_l, mul_comm. + apply mul_le_mono_nonneg_l; intuition; try order. + rewrite le_succ_l; auto. + rewrite <- (add_0_r (b*q2)) at 1. + rewrite <- add_le_mono_l. tauto. + +intros q1 q2 r1 r2 Hr1 Hr2 EQ; destruct (lt_trichotomy q1 q2) as [LT|[EQ'|GT]]. +elim (U q1 q2 r1 r2); intuition. +split; auto. rewrite EQ' in EQ. rewrite add_cancel_l in EQ; auto. +elim (U q2 q1 r2 r1); intuition. +Qed. + +Theorem div_unique: + forall a b q r, 0<=a -> 0<=r<b -> + a == b*q + r -> q == a/b. +Proof. +intros a b q r Ha (Hb,Hr) EQ. +destruct (div_mod_unique b q (a/b) r (a mod b)); auto. +apply mod_bound; order. +rewrite <- div_mod; order. +Qed. + +Theorem mod_unique: + forall a b q r, 0<=a -> 0<=r<b -> + a == b*q + r -> r == a mod b. +Proof. +intros a b q r Ha (Hb,Hr) EQ. +destruct (div_mod_unique b q (a/b) r (a mod b)); auto. +apply mod_bound; order. +rewrite <- div_mod; order. +Qed. + + +(** A division by itself returns 1 *) + +Lemma div_same : forall a, 0<a -> a/a == 1. +Proof. +intros. symmetry. +apply div_unique with 0; intuition; try order. +now nzsimpl. +Qed. + +Lemma mod_same : forall a, 0<a -> a mod a == 0. +Proof. +intros. symmetry. +apply mod_unique with 1; intuition; try order. +now nzsimpl. +Qed. + +(** A division of a small number by a bigger one yields zero. *) + +Theorem div_small: forall a b, 0<=a<b -> a/b == 0. +Proof. +intros. symmetry. +apply div_unique with a; intuition; try order. +now nzsimpl. +Qed. + +(** Same situation, in term of modulo: *) + +Theorem mod_small: forall a b, 0<=a<b -> a mod b == a. +Proof. +intros. symmetry. +apply mod_unique with 0; intuition; try order. +now nzsimpl. +Qed. + +(** * Basic values of divisions and modulo. *) + +Lemma div_0_l: forall a, 0<a -> 0/a == 0. +Proof. +intros; apply div_small; split; order. +Qed. + +Lemma mod_0_l: forall a, 0<a -> 0 mod a == 0. +Proof. +intros; apply mod_small; split; order. +Qed. + +Lemma div_1_r: forall a, 0<=a -> a/1 == a. +Proof. +intros. symmetry. +apply div_unique with 0; try split; try order; try apply lt_0_1. +now nzsimpl. +Qed. + +Lemma mod_1_r: forall a, 0<=a -> a mod 1 == 0. +Proof. +intros. symmetry. +apply mod_unique with a; try split; try order; try apply lt_0_1. +now nzsimpl. +Qed. + +Lemma div_1_l: forall a, 1<a -> 1/a == 0. +Proof. +intros; apply div_small; split; auto. apply le_succ_diag_r. +Qed. + +Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1. +Proof. +intros; apply mod_small; split; auto. apply le_succ_diag_r. +Qed. + +Lemma div_mul : forall a b, 0<=a -> 0<b -> (a*b)/b == a. +Proof. +intros; symmetry. +apply div_unique with 0; try split; try order. +apply mul_nonneg_nonneg; order. +nzsimpl; apply mul_comm. +Qed. + +Lemma mod_mul : forall a b, 0<=a -> 0<b -> (a*b) mod b == 0. +Proof. +intros; symmetry. +apply mod_unique with a; try split; try order. +apply mul_nonneg_nonneg; order. +nzsimpl; apply mul_comm. +Qed. + + +(** * Order results about mod and div *) + +(** A modulo cannot grow beyond its starting point. *) + +Theorem mod_le: forall a b, 0<=a -> 0<b -> a mod b <= a. +Proof. +intros. destruct (le_gt_cases b a). +apply le_trans with b; auto. +apply lt_le_incl. destruct (mod_bound a b); auto. +rewrite lt_eq_cases; right. +apply mod_small; auto. +Qed. + + +(* Division of positive numbers is positive. *) + +Lemma div_pos: forall a b, 0<=a -> 0<b -> 0 <= a/b. +Proof. +intros. +rewrite (mul_le_mono_pos_l _ _ b); auto; nzsimpl. +rewrite (add_le_mono_r _ _ (a mod b)). +rewrite <- div_mod by order. +nzsimpl. +apply mod_le; auto. +Qed. + +Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b. +Proof. +intros a b (Hb,Hab). +assert (LE : 0 <= a/b) by (apply div_pos; order). +assert (MOD : a mod b < b) by (destruct (mod_bound a b); order). +rewrite lt_eq_cases in LE; destruct LE as [LT|EQ]; auto. +exfalso; revert Hab. +rewrite (div_mod a b), <-EQ; nzsimpl; order. +Qed. + +Lemma div_small_iff : forall a b, 0<=a -> 0<b -> (a/b==0 <-> a<b). +Proof. +intros a b Ha Hb; split; intros Hab. +destruct (lt_ge_cases a b); auto. +symmetry in Hab. contradict Hab. apply lt_neq, div_str_pos; auto. +apply div_small; auto. +Qed. + +Lemma mod_small_iff : forall a b, 0<=a -> 0<b -> (a mod b == a <-> a<b). +Proof. +intros a b Ha Hb. split; intros H; auto using mod_small. +rewrite <- div_small_iff; auto. +rewrite <- (mul_cancel_l _ _ b) by order. +rewrite <- (add_cancel_r _ _ (a mod b)). +rewrite <- div_mod, H by order. now nzsimpl. +Qed. + +Lemma div_str_pos_iff : forall a b, 0<=a -> 0<b -> (0<a/b <-> b<=a). +Proof. +intros a b Ha Hb; split; intros Hab. +destruct (lt_ge_cases a b) as [LT|LE]; auto. +rewrite <- div_small_iff in LT; order. +apply div_str_pos; auto. +Qed. + + +(** As soon as the divisor is strictly greater than 1, + the division is strictly decreasing. *) + +Lemma div_lt : forall a b, 0<a -> 1<b -> a/b < a. +Proof. +intros. +assert (0 < b) by (apply lt_trans with 1; auto using lt_0_1). +destruct (lt_ge_cases a b). +rewrite div_small; try split; order. +rewrite (div_mod a b) at 2 by order. +apply lt_le_trans with (b*(a/b)). +rewrite <- (mul_1_l (a/b)) at 1. +rewrite <- mul_lt_mono_pos_r; auto. +apply div_str_pos; auto. +rewrite <- (add_0_r (b*(a/b))) at 1. +rewrite <- add_le_mono_l. destruct (mod_bound a b); order. +Qed. + +(** [le] is compatible with a positive division. *) + +Lemma div_le_mono : forall a b c, 0<c -> 0<=a<=b -> a/c <= b/c. +Proof. +intros a b c Hc (Ha,Hab). +rewrite lt_eq_cases in Hab. destruct Hab as [LT|EQ]; + [|rewrite EQ; order]. +rewrite <- lt_succ_r. +rewrite (mul_lt_mono_pos_l c) by order. +nzsimpl. +rewrite (add_lt_mono_r _ _ (a mod c)). +rewrite <- div_mod by order. +apply lt_le_trans with b; auto. +rewrite (div_mod b c) at 1 by order. +rewrite <- add_assoc, <- add_le_mono_l. +apply le_trans with (c+0). +nzsimpl; destruct (mod_bound b c); order. +rewrite <- add_le_mono_l. destruct (mod_bound a c); order. +Qed. + +(** The following two properties could be used as specification of div *) + +Lemma mul_div_le : forall a b, 0<=a -> 0<b -> b*(a/b) <= a. +Proof. +intros. +rewrite (add_le_mono_r _ _ (a mod b)), <- div_mod by order. +rewrite <- (add_0_r a) at 1. +rewrite <- add_le_mono_l. destruct (mod_bound a b); order. +Qed. + +Lemma mul_succ_div_gt : forall a b, 0<=a -> 0<b -> a < b*(S (a/b)). +Proof. +intros. +rewrite (div_mod a b) at 1 by order. +rewrite (mul_succ_r). +rewrite <- add_lt_mono_l. +destruct (mod_bound a b); auto. +Qed. + + +(** The previous inequality is exact iff the modulo is zero. *) + +Lemma div_exact : forall a b, 0<=a -> 0<b -> (a == b*(a/b) <-> a mod b == 0). +Proof. +intros. rewrite (div_mod a b) at 1 by order. +rewrite <- (add_0_r (b*(a/b))) at 2. +apply add_cancel_l. +Qed. + +(** Some additionnal inequalities about div. *) + +Theorem div_lt_upper_bound: + forall a b q, 0<=a -> 0<b -> a < b*q -> a/b < q. +Proof. +intros. +rewrite (mul_lt_mono_pos_l b) by order. +apply le_lt_trans with a; auto. +apply mul_div_le; auto. +Qed. + +Theorem div_le_upper_bound: + forall a b q, 0<=a -> 0<b -> a <= b*q -> a/b <= q. +Proof. +intros. +rewrite (mul_le_mono_pos_l _ _ b) by order. +apply le_trans with a; auto. +apply mul_div_le; auto. +Qed. + +Theorem div_le_lower_bound: + forall a b q, 0<=a -> 0<b -> b*q <= a -> q <= a/b. +Proof. +intros a b q Ha Hb H. +destruct (lt_ge_cases 0 q). +rewrite <- (div_mul q b); try order. +apply div_le_mono; auto. +rewrite mul_comm; split; auto. +apply lt_le_incl, mul_pos_pos; auto. +apply le_trans with 0; auto; apply div_pos; auto. +Qed. + +(** A division respects opposite monotonicity for the divisor *) + +Lemma div_le_compat_l: forall p q r, 0<=p -> 0<q<=r -> + p/r <= p/q. +Proof. + intros p q r Hp (Hq,Hqr). + apply div_le_lower_bound; auto. + rewrite (div_mod p r) at 2 by order. + apply le_trans with (r*(p/r)). + apply mul_le_mono_nonneg_r; try order. + apply div_pos; order. + rewrite <- (add_0_r (r*(p/r))) at 1. + rewrite <- add_le_mono_l. destruct (mod_bound p r); order. +Qed. + + +(** * Relations between usual operations and mod and div *) + +Lemma mod_add : forall a b c, 0<=a -> 0<=a+b*c -> 0<c -> + (a + b * c) mod c == a mod c. +Proof. + intros. + symmetry. + apply mod_unique with (a/c+b); auto. + apply mod_bound; auto. + rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. + now rewrite mul_comm. +Qed. + +Lemma div_add : forall a b c, 0<=a -> 0<=a+b*c -> 0<c -> + (a + b * c) / c == a / c + b. +Proof. + intros. + apply (mul_cancel_l _ _ c); try order. + apply (add_cancel_r _ _ ((a+b*c) mod c)). + rewrite <- div_mod, mod_add by order. + rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. + now rewrite mul_comm. +Qed. + +Lemma div_add_l: forall a b c, 0<=c -> 0<=a*b+c -> 0<b -> + (a * b + c) / b == a + c / b. +Proof. + intros a b c. rewrite (add_comm _ c), (add_comm a). + intros. apply div_add; auto. +Qed. + +(** Cancellations. *) + +Lemma div_mul_cancel_r : forall a b c, 0<=a -> 0<b -> 0<c -> + (a*c)/(b*c) == a/b. +Proof. + intros. + symmetry. + apply div_unique with ((a mod b)*c). + apply mul_nonneg_nonneg; order. + split. + apply mul_nonneg_nonneg; destruct (mod_bound a b); order. + rewrite <- mul_lt_mono_pos_r; auto. destruct (mod_bound a b); auto. + rewrite (div_mod a b) at 1 by order. + rewrite mul_add_distr_r. + rewrite add_cancel_r. + rewrite <- 2 mul_assoc. now rewrite (mul_comm c). +Qed. + +Lemma div_mul_cancel_l : forall a b c, 0<=a -> 0<b -> 0<c -> + (c*a)/(c*b) == a/b. +Proof. + intros. rewrite !(mul_comm c); apply div_mul_cancel_r; auto. +Qed. + +Lemma mul_mod_distr_l: forall a b c, 0<=a -> 0<b -> 0<c -> + (c*a) mod (c*b) == c * (a mod b). +Proof. + intros. + rewrite <- (add_cancel_l _ _ ((c*b)* ((c*a)/(c*b)))). + rewrite <- div_mod. + rewrite div_mul_cancel_l; auto. + rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. + apply div_mod; order. + rewrite <- neq_mul_0; intuition; order. +Qed. + +Lemma mul_mod_distr_r: forall a b c, 0<=a -> 0<b -> 0<c -> + (a*c) mod (b*c) == (a mod b) * c. +Proof. + intros. rewrite !(mul_comm _ c); now rewrite mul_mod_distr_l. +Qed. + +(** Operations modulo. *) + +Theorem mod_mod: forall a n, 0<=a -> 0<n -> + (a mod n) mod n == a mod n. +Proof. + intros. destruct (mod_bound a n); auto. now rewrite mod_small_iff. +Qed. + +Lemma mul_mod_idemp_l : forall a b n, 0<=a -> 0<=b -> 0<n -> + ((a mod n)*b) mod n == (a*b) mod n. +Proof. + intros a b n Ha Hb Hn. symmetry. + generalize (mul_nonneg_nonneg _ _ Ha Hb). + rewrite (div_mod a n) at 1 2 by order. + rewrite add_comm, (mul_comm n), (mul_comm _ b). + rewrite mul_add_distr_l, mul_assoc. + intros. rewrite mod_add; auto. + now rewrite mul_comm. + apply mul_nonneg_nonneg; destruct (mod_bound a n); auto. +Qed. + +Lemma mul_mod_idemp_r : forall a b n, 0<=a -> 0<=b -> 0<n -> + (a*(b mod n)) mod n == (a*b) mod n. +Proof. + intros. rewrite !(mul_comm a). apply mul_mod_idemp_l; auto. +Qed. + +Theorem mul_mod: forall a b n, 0<=a -> 0<=b -> 0<n -> + (a * b) mod n == ((a mod n) * (b mod n)) mod n. +Proof. + intros. rewrite mul_mod_idemp_l, mul_mod_idemp_r; trivial. reflexivity. + now destruct (mod_bound b n). +Qed. + +Lemma add_mod_idemp_l : forall a b n, 0<=a -> 0<=b -> 0<n -> + ((a mod n)+b) mod n == (a+b) mod n. +Proof. + intros a b n Ha Hb Hn. symmetry. + generalize (add_nonneg_nonneg _ _ Ha Hb). + rewrite (div_mod a n) at 1 2 by order. + rewrite <- add_assoc, add_comm, mul_comm. + intros. rewrite mod_add; trivial. reflexivity. + apply add_nonneg_nonneg; auto. destruct (mod_bound a n); auto. +Qed. + +Lemma add_mod_idemp_r : forall a b n, 0<=a -> 0<=b -> 0<n -> + (a+(b mod n)) mod n == (a+b) mod n. +Proof. + intros. rewrite !(add_comm a). apply add_mod_idemp_l; auto. +Qed. + +Theorem add_mod: forall a b n, 0<=a -> 0<=b -> 0<n -> + (a+b) mod n == (a mod n + b mod n) mod n. +Proof. + intros. rewrite add_mod_idemp_l, add_mod_idemp_r; trivial. reflexivity. + now destruct (mod_bound b n). +Qed. + +Lemma div_div : forall a b c, 0<=a -> 0<b -> 0<c -> + (a/b)/c == a/(b*c). +Proof. + intros a b c Ha Hb Hc. + apply div_unique with (b*((a/b) mod c) + a mod b); trivial. + (* begin 0<= ... <b*c *) + destruct (mod_bound (a/b) c), (mod_bound a b); auto using div_pos. + split. + apply add_nonneg_nonneg; auto. + apply mul_nonneg_nonneg; order. + apply lt_le_trans with (b*((a/b) mod c) + b). + rewrite <- add_lt_mono_l; auto. + rewrite <- mul_succ_r, <- mul_le_mono_pos_l, le_succ_l; auto. + (* end 0<= ... < b*c *) + rewrite (div_mod a b) at 1 by order. + rewrite add_assoc, add_cancel_r. + rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. + apply div_mod; order. +Qed. + +(** A last inequality: *) + +Theorem div_mul_le: + forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a/b) <= (c*a)/b. +Proof. + intros. + apply div_le_lower_bound; auto. + apply mul_nonneg_nonneg; auto. + rewrite mul_assoc, (mul_comm b c), <- mul_assoc. + apply mul_le_mono_nonneg_l; auto. + apply mul_div_le; auto. +Qed. + +(** mod is related to divisibility *) + +Lemma mod_divides : forall a b, 0<=a -> 0<b -> + (a mod b == 0 <-> exists c, a == b*c). +Proof. + split. + intros. exists (a/b). rewrite div_exact; auto. + intros (c,Hc). rewrite Hc, mul_comm. apply mod_mul; auto. + rewrite (mul_le_mono_pos_l _ _ b); auto. nzsimpl. order. +Qed. + +End NZDivPropFunct. + diff --git a/theories/Numbers/NatInt/NZDomain.v b/theories/Numbers/NatInt/NZDomain.v new file mode 100644 index 00000000..8c3c7937 --- /dev/null +++ b/theories/Numbers/NatInt/NZDomain.v @@ -0,0 +1,417 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id$ i*) + +Require Export NumPrelude NZAxioms. +Require Import NZBase NZOrder NZAddOrder Plus Minus. + +(** In this file, we investigate the shape of domains satisfying + the [NZDomainSig] interface. In particular, we define a + translation from Peano numbers [nat] into NZ. +*) + +(** First, a section about iterating a function. *) + +Section Iter. +Variable A : Type. +Fixpoint iter (f:A->A)(n:nat) : A -> A := fun a => + match n with + | O => a + | S n => f (iter f n a) + end. +Infix "^" := iter. + +Lemma iter_alt : forall f n m, (f^(Datatypes.S n)) m = (f^n) (f m). +Proof. +induction n; simpl; auto. +intros; rewrite <- IHn; auto. +Qed. + +Lemma iter_plus : forall f n n' m, (f^(n+n')) m = (f^n) ((f^n') m). +Proof. +induction n; simpl; auto. +intros; rewrite IHn; auto. +Qed. + +Lemma iter_plus_bis : forall f n n' m, (f^(n+n')) m = (f^n') ((f^n) m). +Proof. +induction n; simpl; auto. +intros. rewrite <- iter_alt, IHn; auto. +Qed. + +Global Instance iter_wd (R:relation A) : Proper ((R==>R)==>eq==>R==>R) iter. +Proof. +intros f f' Hf n n' Hn; subst n'. induction n; simpl; red; auto. +Qed. + +End Iter. +Implicit Arguments iter [A]. +Local Infix "^" := iter. + + +Module NZDomainProp (Import NZ:NZDomainSig'). + +(** * Relationship between points thanks to [succ] and [pred]. *) + +(** We prove that any points in NZ have a common descendant by [succ] *) + +Definition common_descendant n m := exists k, exists l, (S^k) n == (S^l) m. + +Instance common_descendant_wd : Proper (eq==>eq==>iff) common_descendant. +Proof. +unfold common_descendant. intros n n' Hn m m' Hm. +setoid_rewrite Hn. setoid_rewrite Hm. auto with *. +Qed. + +Instance common_descendant_equiv : Equivalence common_descendant. +Proof. +split; red. +intros x. exists O; exists O. simpl; auto with *. +intros x y (p & q & H); exists q; exists p; auto with *. +intros x y z (p & q & Hpq) (r & s & Hrs). +exists (r+p)%nat. exists (q+s)%nat. +rewrite !iter_plus. rewrite Hpq, <-Hrs, <-iter_plus, <- iter_plus_bis. +auto with *. +Qed. + +Lemma common_descendant_with_0 : forall n, common_descendant n 0. +Proof. +apply bi_induction. +intros n n' Hn. rewrite Hn; auto with *. +reflexivity. +split; intros (p & q & H). +exists p; exists (Datatypes.S q). rewrite <- iter_alt; simpl. + apply succ_wd; auto. +exists (Datatypes.S p); exists q. rewrite iter_alt; auto. +Qed. + +Lemma common_descendant_always : forall n m, common_descendant n m. +Proof. +intros. transitivity 0; [|symmetry]; apply common_descendant_with_0. +Qed. + +(** Thanks to [succ] being injective, we can then deduce that for any two + points, one is an iterated successor of the other. *) + +Lemma itersucc_or_itersucc : forall n m, exists k, n == (S^k) m \/ m == (S^k) n. +Proof. +intros n m. destruct (common_descendant_always n m) as (k & l & H). +revert l H. induction k. +simpl. intros; exists l; left; auto with *. +intros. destruct l. +simpl in *. exists (Datatypes.S k); right; auto with *. +simpl in *. apply pred_wd in H; rewrite !pred_succ in H. eauto. +Qed. + +(** Generalized version of [pred_succ] when iterating *) + +Lemma succ_swap_pred : forall k n m, n == (S^k) m -> m == (P^k) n. +Proof. +induction k. +simpl; auto with *. +simpl; intros. apply pred_wd in H. rewrite pred_succ in H. apply IHk in H; auto. +rewrite <- iter_alt in H; auto. +Qed. + +(** From a given point, all others are iterated successors + or iterated predecessors. *) + +Lemma itersucc_or_iterpred : forall n m, exists k, n == (S^k) m \/ n == (P^k) m. +Proof. +intros n m. destruct (itersucc_or_itersucc n m) as (k,[H|H]). +exists k; left; auto. +exists k; right. apply succ_swap_pred; auto. +Qed. + +(** In particular, all points are either iterated successors of [0] + or iterated predecessors of [0] (or both). *) + +Lemma itersucc0_or_iterpred0 : + forall n, exists p:nat, n == (S^p) 0 \/ n == (P^p) 0. +Proof. + intros n. exact (itersucc_or_iterpred n 0). +Qed. + +(** * Study of initial point w.r.t. [succ] (if any). *) + +Definition initial n := forall m, n ~= S m. + +Lemma initial_alt : forall n, initial n <-> S (P n) ~= n. +Proof. +split. intros Bn EQ. symmetry in EQ. destruct (Bn _ EQ). +intros NEQ m EQ. apply NEQ. rewrite EQ, pred_succ; auto with *. +Qed. + +Lemma initial_alt2 : forall n, initial n <-> ~exists m, n == S m. +Proof. firstorder. Qed. + +(** First case: let's assume such an initial point exists + (i.e. [S] isn't surjective)... *) + +Section InitialExists. +Hypothesis init : t. +Hypothesis Initial : initial init. + +(** ... then we have unicity of this initial point. *) + +Lemma initial_unique : forall m, initial m -> m == init. +Proof. +intros m Im. destruct (itersucc_or_itersucc init m) as (p,[H|H]). +destruct p. now simpl in *. destruct (Initial _ H). +destruct p. now simpl in *. destruct (Im _ H). +Qed. + +(** ... then all other points are descendant of it. *) + +Lemma initial_ancestor : forall m, exists p, m == (S^p) init. +Proof. +intros m. destruct (itersucc_or_itersucc init m) as (p,[H|H]). +destruct p; simpl in *; auto. exists O; auto with *. destruct (Initial _ H). +exists p; auto. +Qed. + +(** NB : We would like to have [pred n == n] for the initial element, + but nothing forces that. For instance we can have -3 as initial point, + and P(-3) = 2. A bit odd indeed, but legal according to [NZDomainSig]. + We can hence have [n == (P^k) m] without [exists k', m == (S^k') n]. +*) + +(** We need decidability of [eq] (or classical reasoning) for this: *) + +Section SuccPred. +Hypothesis eq_decidable : forall n m, n==m \/ n~=m. +Lemma succ_pred_approx : forall n, ~initial n -> S (P n) == n. +Proof. +intros n NB. rewrite initial_alt in NB. +destruct (eq_decidable (S (P n)) n); auto. +elim NB; auto. +Qed. +End SuccPred. +End InitialExists. + +(** Second case : let's suppose now [S] surjective, i.e. no initial point. *) + +Section InitialDontExists. + +Hypothesis succ_onto : forall n, exists m, n == S m. + +Lemma succ_onto_gives_succ_pred : forall n, S (P n) == n. +Proof. +intros n. destruct (succ_onto n) as (m,H). rewrite H, pred_succ; auto with *. +Qed. + +Lemma succ_onto_pred_injective : forall n m, P n == P m -> n == m. +Proof. +intros n m. intros H; apply succ_wd in H. +rewrite !succ_onto_gives_succ_pred in H; auto. +Qed. + +End InitialDontExists. + + +(** To summarize: + + S is always injective, P is always surjective (thanks to [pred_succ]). + + I) If S is not surjective, we have an initial point, which is unique. + This bottom is below zero: we have N shifted (or not) to the left. + P cannot be injective: P init = P (S (P init)). + (P init) can be arbitrary. + + II) If S is surjective, we have [forall n, S (P n) = n], S and P are + bijective and reciprocal. + + IIa) if [exists k<>O, 0 == S^k 0], then we have a cyclic structure Z/nZ + IIb) otherwise, we have Z +*) + + +(** * An alternative induction principle using [S] and [P]. *) + +(** It is weaker than [bi_induction]. For instance it cannot prove that + we can go from one point by many [S] _or_ many [P], but only by many + [S] mixed with many [P]. Think of a model with two copies of N: + + 0, 1=S 0, 2=S 1, ... + 0', 1'=S 0', 2'=S 1', ... + + and P 0 = 0' and P 0' = 0. +*) + +Lemma bi_induction_pred : + forall A : t -> Prop, Proper (eq==>iff) A -> + A 0 -> (forall n, A n -> A (S n)) -> (forall n, A n -> A (P n)) -> + forall n, A n. +Proof. +intros. apply bi_induction; auto. +clear n. intros n; split; auto. +intros G; apply H2 in G. rewrite pred_succ in G; auto. +Qed. + +Lemma central_induction_pred : + forall A : t -> Prop, Proper (eq==>iff) A -> forall n0, + A n0 -> (forall n, A n -> A (S n)) -> (forall n, A n -> A (P n)) -> + forall n, A n. +Proof. +intros. +assert (A 0). +destruct (itersucc_or_iterpred 0 n0) as (k,[Hk|Hk]); rewrite Hk; clear Hk. + clear H2. induction k; simpl in *; auto. + clear H1. induction k; simpl in *; auto. +apply bi_induction_pred; auto. +Qed. + +End NZDomainProp. + +(** We now focus on the translation from [nat] into [NZ]. + First, relationship with [0], [succ], [pred]. +*) + +Module NZOfNat (Import NZ:NZDomainSig'). + +Definition ofnat (n : nat) : t := (S^n) 0. +Notation "[ n ]" := (ofnat n) (at level 7) : ofnat. +Local Open Scope ofnat. + +Lemma ofnat_zero : [O] == 0. +Proof. +reflexivity. +Qed. + +Lemma ofnat_succ : forall n, [Datatypes.S n] == succ [n]. +Proof. + now unfold ofnat. +Qed. + +Lemma ofnat_pred : forall n, n<>O -> [Peano.pred n] == P [n]. +Proof. + unfold ofnat. destruct n. destruct 1; auto. + intros _. simpl. symmetry. apply pred_succ. +Qed. + +(** Since [P 0] can be anything in NZ (either [-1], [0], or even other + numbers, we cannot state previous lemma for [n=O]. *) + +End NZOfNat. + + +(** If we require in addition a strict order on NZ, we can prove that + [ofnat] is injective, and hence that NZ is infinite + (i.e. we ban Z/nZ models) *) + +Module NZOfNatOrd (Import NZ:NZOrdSig'). +Include NZOfNat NZ. +Include NZOrderPropFunct NZ. +Local Open Scope ofnat. + +Theorem ofnat_S_gt_0 : + forall n : nat, 0 < [Datatypes.S n]. +Proof. +unfold ofnat. +intros n; induction n as [| n IH]; simpl in *. +apply lt_0_1. +apply lt_trans with 1. apply lt_0_1. now rewrite <- succ_lt_mono. +Qed. + +Theorem ofnat_S_neq_0 : + forall n : nat, 0 ~= [Datatypes.S n]. +Proof. +intros. apply lt_neq, ofnat_S_gt_0. +Qed. + +Lemma ofnat_injective : forall n m, [n]==[m] -> n = m. +Proof. +induction n as [|n IH]; destruct m; auto. +intros H; elim (ofnat_S_neq_0 _ H). +intros H; symmetry in H; elim (ofnat_S_neq_0 _ H). +intros. f_equal. apply IH. now rewrite <- succ_inj_wd. +Qed. + +Lemma ofnat_eq : forall n m, [n]==[m] <-> n = m. +Proof. +split. apply ofnat_injective. intros; now subst. +Qed. + +(* In addition, we can prove that [ofnat] preserves order. *) + +Lemma ofnat_lt : forall n m : nat, [n]<[m] <-> (n<m)%nat. +Proof. +induction n as [|n IH]; destruct m; repeat rewrite ofnat_zero; split. +intro H; elim (lt_irrefl _ H). +inversion 1. +auto with arith. +intros; apply ofnat_S_gt_0. +intro H; elim (lt_asymm _ _ H); apply ofnat_S_gt_0. +inversion 1. +rewrite !ofnat_succ, <- succ_lt_mono, IH; auto with arith. +rewrite !ofnat_succ, <- succ_lt_mono, IH; auto with arith. +Qed. + +Lemma ofnat_le : forall n m : nat, [n]<=[m] <-> (n<=m)%nat. +Proof. +intros. rewrite lt_eq_cases, ofnat_lt, ofnat_eq. +split. +destruct 1; subst; auto with arith. +apply Lt.le_lt_or_eq. +Qed. + +End NZOfNatOrd. + + +(** For basic operations, we can prove correspondance with + their counterpart in [nat]. *) + +Module NZOfNatOps (Import NZ:NZAxiomsSig'). +Include NZOfNat NZ. +Local Open Scope ofnat. + +Lemma ofnat_add_l : forall n m, [n]+m == (S^n) m. +Proof. + induction n; intros. + apply add_0_l. + rewrite ofnat_succ, add_succ_l. simpl; apply succ_wd; auto. +Qed. + +Lemma ofnat_add : forall n m, [n+m] == [n]+[m]. +Proof. + intros. rewrite ofnat_add_l. + induction n; simpl. reflexivity. + rewrite ofnat_succ. now apply succ_wd. +Qed. + +Lemma ofnat_mul : forall n m, [n*m] == [n]*[m]. +Proof. + induction n; simpl; intros. + symmetry. apply mul_0_l. + rewrite plus_comm. + rewrite ofnat_succ, ofnat_add, mul_succ_l. + now apply add_wd. +Qed. + +Lemma ofnat_sub_r : forall n m, n-[m] == (P^m) n. +Proof. + induction m; simpl; intros. + rewrite ofnat_zero. apply sub_0_r. + rewrite ofnat_succ, sub_succ_r. now apply pred_wd. +Qed. + +Lemma ofnat_sub : forall n m, m<=n -> [n-m] == [n]-[m]. +Proof. + intros n m H. rewrite ofnat_sub_r. + revert n H. induction m. intros. + rewrite <- minus_n_O. now simpl. + intros. + destruct n. + inversion H. + rewrite iter_alt. + simpl. + rewrite ofnat_succ, pred_succ; auto with arith. +Qed. + +End NZOfNatOps. diff --git a/theories/Numbers/NatInt/NZMul.v b/theories/Numbers/NatInt/NZMul.v index fda8b7a3..296bd095 100644 --- a/theories/Numbers/NatInt/NZMul.v +++ b/theories/Numbers/NatInt/NZMul.v @@ -8,73 +8,63 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NZMul.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) -Require Import NZAxioms. -Require Import NZAdd. +Require Import NZAxioms NZBase NZAdd. -Module NZMulPropFunct (Import NZAxiomsMod : NZAxiomsSig). -Module Export NZAddPropMod := NZAddPropFunct NZAxiomsMod. -Open Local Scope NatIntScope. +Module Type NZMulPropSig + (Import NZ : NZAxiomsSig')(Import NZBase : NZBasePropSig NZ). +Include NZAddPropSig NZ NZBase. -Theorem NZmul_0_r : forall n : NZ, n * 0 == 0. +Theorem mul_0_r : forall n, n * 0 == 0. Proof. -NZinduct n. -now rewrite NZmul_0_l. -intro. rewrite NZmul_succ_l. now rewrite NZadd_0_r. +nzinduct n; intros; now nzsimpl. Qed. -Theorem NZmul_succ_r : forall n m : NZ, n * (S m) == n * m + n. +Theorem mul_succ_r : forall n m, n * (S m) == n * m + n. Proof. -intros n m; NZinduct n. -do 2 rewrite NZmul_0_l; now rewrite NZadd_0_l. -intro n. do 2 rewrite NZmul_succ_l. do 2 rewrite NZadd_succ_r. -rewrite NZsucc_inj_wd. rewrite <- (NZadd_assoc (n * m) m n). -rewrite (NZadd_comm m n). rewrite NZadd_assoc. -now rewrite NZadd_cancel_r. +intros n m; nzinduct n. now nzsimpl. +intro n. nzsimpl. rewrite succ_inj_wd, <- add_assoc, (add_comm m n), add_assoc. +now rewrite add_cancel_r. Qed. -Theorem NZmul_comm : forall n m : NZ, n * m == m * n. +Hint Rewrite mul_0_r mul_succ_r : nz. + +Theorem mul_comm : forall n m, n * m == m * n. Proof. -intros n m; NZinduct n. -rewrite NZmul_0_l; now rewrite NZmul_0_r. -intro. rewrite NZmul_succ_l; rewrite NZmul_succ_r. now rewrite NZadd_cancel_r. +intros n m; nzinduct n. now nzsimpl. +intro. nzsimpl. now rewrite add_cancel_r. Qed. -Theorem NZmul_add_distr_r : forall n m p : NZ, (n + m) * p == n * p + m * p. +Theorem mul_add_distr_r : forall n m p, (n + m) * p == n * p + m * p. Proof. -intros n m p; NZinduct n. -rewrite NZmul_0_l. now do 2 rewrite NZadd_0_l. -intro n. rewrite NZadd_succ_l. do 2 rewrite NZmul_succ_l. -rewrite <- (NZadd_assoc (n * p) p (m * p)). -rewrite (NZadd_comm p (m * p)). rewrite (NZadd_assoc (n * p) (m * p) p). -now rewrite NZadd_cancel_r. +intros n m p; nzinduct n. now nzsimpl. +intro n. nzsimpl. rewrite <- add_assoc, (add_comm p (m*p)), add_assoc. +now rewrite add_cancel_r. Qed. -Theorem NZmul_add_distr_l : forall n m p : NZ, n * (m + p) == n * m + n * p. +Theorem mul_add_distr_l : forall n m p, n * (m + p) == n * m + n * p. Proof. intros n m p. -rewrite (NZmul_comm n (m + p)). rewrite (NZmul_comm n m). -rewrite (NZmul_comm n p). apply NZmul_add_distr_r. +rewrite (mul_comm n (m + p)), (mul_comm n m), (mul_comm n p). +apply mul_add_distr_r. Qed. -Theorem NZmul_assoc : forall n m p : NZ, n * (m * p) == (n * m) * p. +Theorem mul_assoc : forall n m p, n * (m * p) == (n * m) * p. Proof. -intros n m p; NZinduct n. -now do 3 rewrite NZmul_0_l. -intro n. do 2 rewrite NZmul_succ_l. rewrite NZmul_add_distr_r. -now rewrite NZadd_cancel_r. +intros n m p; nzinduct n. now nzsimpl. +intro n. nzsimpl. rewrite mul_add_distr_r. +now rewrite add_cancel_r. Qed. -Theorem NZmul_1_l : forall n : NZ, 1 * n == n. +Theorem mul_1_l : forall n, 1 * n == n. Proof. -intro n. rewrite NZmul_succ_l; rewrite NZmul_0_l. now rewrite NZadd_0_l. +intro n. now nzsimpl. Qed. -Theorem NZmul_1_r : forall n : NZ, n * 1 == n. +Theorem mul_1_r : forall n, n * 1 == n. Proof. -intro n; rewrite NZmul_comm; apply NZmul_1_l. +intro n. now nzsimpl. Qed. -End NZMulPropFunct. - +End NZMulPropSig. diff --git a/theories/Numbers/NatInt/NZMulOrder.v b/theories/Numbers/NatInt/NZMulOrder.v index c707bf73..7b64a698 100644 --- a/theories/Numbers/NatInt/NZMulOrder.v +++ b/theories/Numbers/NatInt/NZMulOrder.v @@ -8,303 +8,300 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NZMulOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Import NZAxioms. Require Import NZAddOrder. -Module NZMulOrderPropFunct (Import NZOrdAxiomsMod : NZOrdAxiomsSig). -Module Export NZAddOrderPropMod := NZAddOrderPropFunct NZOrdAxiomsMod. -Open Local Scope NatIntScope. +Module Type NZMulOrderPropSig (Import NZ : NZOrdAxiomsSig'). +Include NZAddOrderPropSig NZ. -Theorem NZmul_lt_pred : - forall p q n m : NZ, S p == q -> (p * n < p * m <-> q * n + m < q * m + n). +Theorem mul_lt_pred : + forall p q n m, S p == q -> (p * n < p * m <-> q * n + m < q * m + n). Proof. -intros p q n m H. rewrite <- H. do 2 rewrite NZmul_succ_l. -rewrite <- (NZadd_assoc (p * n) n m). -rewrite <- (NZadd_assoc (p * m) m n). -rewrite (NZadd_comm n m). now rewrite <- NZadd_lt_mono_r. +intros p q n m H. rewrite <- H. nzsimpl. +rewrite <- ! add_assoc, (add_comm n m). +now rewrite <- add_lt_mono_r. Qed. -Theorem NZmul_lt_mono_pos_l : forall p n m : NZ, 0 < p -> (n < m <-> p * n < p * m). +Theorem mul_lt_mono_pos_l : forall p n m, 0 < p -> (n < m <-> p * n < p * m). Proof. -NZord_induct p. -intros n m H; false_hyp H NZlt_irrefl. -intros p H IH n m H1. do 2 rewrite NZmul_succ_l. -le_elim H. assert (LR : forall n m : NZ, n < m -> p * n + n < p * m + m). -intros n1 m1 H2. apply NZadd_lt_mono; [now apply -> IH | assumption]. -split; [apply LR |]. intro H2. apply -> NZlt_dne; intro H3. -apply <- NZle_ngt in H3. le_elim H3. -apply NZlt_asymm in H2. apply H2. now apply LR. -rewrite H3 in H2; false_hyp H2 NZlt_irrefl. -rewrite <- H; do 2 rewrite NZmul_0_l; now do 2 rewrite NZadd_0_l. -intros p H1 _ n m H2. apply NZlt_asymm in H1. false_hyp H2 H1. +nzord_induct p. +intros n m H; false_hyp H lt_irrefl. +intros p H IH n m H1. nzsimpl. +le_elim H. assert (LR : forall n m, n < m -> p * n + n < p * m + m). +intros n1 m1 H2. apply add_lt_mono; [now apply -> IH | assumption]. +split; [apply LR |]. intro H2. apply -> lt_dne; intro H3. +apply <- le_ngt in H3. le_elim H3. +apply lt_asymm in H2. apply H2. now apply LR. +rewrite H3 in H2; false_hyp H2 lt_irrefl. +rewrite <- H; now nzsimpl. +intros p H1 _ n m H2. destruct (lt_asymm _ _ H1 H2). Qed. -Theorem NZmul_lt_mono_pos_r : forall p n m : NZ, 0 < p -> (n < m <-> n * p < m * p). +Theorem mul_lt_mono_pos_r : forall p n m, 0 < p -> (n < m <-> n * p < m * p). Proof. intros p n m. -rewrite (NZmul_comm n p); rewrite (NZmul_comm m p). now apply NZmul_lt_mono_pos_l. +rewrite (mul_comm n p), (mul_comm m p). now apply mul_lt_mono_pos_l. Qed. -Theorem NZmul_lt_mono_neg_l : forall p n m : NZ, p < 0 -> (n < m <-> p * m < p * n). +Theorem mul_lt_mono_neg_l : forall p n m, p < 0 -> (n < m <-> p * m < p * n). Proof. -NZord_induct p. -intros n m H; false_hyp H NZlt_irrefl. -intros p H1 _ n m H2. apply NZlt_succ_l in H2. apply <- NZnle_gt in H2. false_hyp H1 H2. -intros p H IH n m H1. apply <- NZle_succ_l in H. -le_elim H. assert (LR : forall n m : NZ, n < m -> p * m < p * n). -intros n1 m1 H2. apply (NZle_lt_add_lt n1 m1). -now apply NZlt_le_incl. do 2 rewrite <- NZmul_succ_l. now apply -> IH. -split; [apply LR |]. intro H2. apply -> NZlt_dne; intro H3. -apply <- NZle_ngt in H3. le_elim H3. -apply NZlt_asymm in H2. apply H2. now apply LR. -rewrite H3 in H2; false_hyp H2 NZlt_irrefl. -rewrite (NZmul_lt_pred p (S p)) by reflexivity. -rewrite H; do 2 rewrite NZmul_0_l; now do 2 rewrite NZadd_0_l. +nzord_induct p. +intros n m H; false_hyp H lt_irrefl. +intros p H1 _ n m H2. apply lt_succ_l in H2. apply <- nle_gt in H2. +false_hyp H1 H2. +intros p H IH n m H1. apply <- le_succ_l in H. +le_elim H. assert (LR : forall n m, n < m -> p * m < p * n). +intros n1 m1 H2. apply (le_lt_add_lt n1 m1). +now apply lt_le_incl. rewrite <- 2 mul_succ_l. now apply -> IH. +split; [apply LR |]. intro H2. apply -> lt_dne; intro H3. +apply <- le_ngt in H3. le_elim H3. +apply lt_asymm in H2. apply H2. now apply LR. +rewrite H3 in H2; false_hyp H2 lt_irrefl. +rewrite (mul_lt_pred p (S p)) by reflexivity. +rewrite H; do 2 rewrite mul_0_l; now do 2 rewrite add_0_l. Qed. -Theorem NZmul_lt_mono_neg_r : forall p n m : NZ, p < 0 -> (n < m <-> m * p < n * p). +Theorem mul_lt_mono_neg_r : forall p n m, p < 0 -> (n < m <-> m * p < n * p). Proof. intros p n m. -rewrite (NZmul_comm n p); rewrite (NZmul_comm m p). now apply NZmul_lt_mono_neg_l. +rewrite (mul_comm n p), (mul_comm m p). now apply mul_lt_mono_neg_l. Qed. -Theorem NZmul_le_mono_nonneg_l : forall n m p : NZ, 0 <= p -> n <= m -> p * n <= p * m. +Theorem mul_le_mono_nonneg_l : forall n m p, 0 <= p -> n <= m -> p * n <= p * m. Proof. intros n m p H1 H2. le_elim H1. -le_elim H2. apply NZlt_le_incl. now apply -> NZmul_lt_mono_pos_l. -apply NZeq_le_incl; now rewrite H2. -apply NZeq_le_incl; rewrite <- H1; now do 2 rewrite NZmul_0_l. +le_elim H2. apply lt_le_incl. now apply -> mul_lt_mono_pos_l. +apply eq_le_incl; now rewrite H2. +apply eq_le_incl; rewrite <- H1; now do 2 rewrite mul_0_l. Qed. -Theorem NZmul_le_mono_nonpos_l : forall n m p : NZ, p <= 0 -> n <= m -> p * m <= p * n. +Theorem mul_le_mono_nonpos_l : forall n m p, p <= 0 -> n <= m -> p * m <= p * n. Proof. intros n m p H1 H2. le_elim H1. -le_elim H2. apply NZlt_le_incl. now apply -> NZmul_lt_mono_neg_l. -apply NZeq_le_incl; now rewrite H2. -apply NZeq_le_incl; rewrite H1; now do 2 rewrite NZmul_0_l. +le_elim H2. apply lt_le_incl. now apply -> mul_lt_mono_neg_l. +apply eq_le_incl; now rewrite H2. +apply eq_le_incl; rewrite H1; now do 2 rewrite mul_0_l. Qed. -Theorem NZmul_le_mono_nonneg_r : forall n m p : NZ, 0 <= p -> n <= m -> n * p <= m * p. +Theorem mul_le_mono_nonneg_r : forall n m p, 0 <= p -> n <= m -> n * p <= m * p. Proof. -intros n m p H1 H2; rewrite (NZmul_comm n p); rewrite (NZmul_comm m p); -now apply NZmul_le_mono_nonneg_l. +intros n m p H1 H2; +rewrite (mul_comm n p), (mul_comm m p); now apply mul_le_mono_nonneg_l. Qed. -Theorem NZmul_le_mono_nonpos_r : forall n m p : NZ, p <= 0 -> n <= m -> m * p <= n * p. +Theorem mul_le_mono_nonpos_r : forall n m p, p <= 0 -> n <= m -> m * p <= n * p. Proof. -intros n m p H1 H2; rewrite (NZmul_comm n p); rewrite (NZmul_comm m p); -now apply NZmul_le_mono_nonpos_l. +intros n m p H1 H2; +rewrite (mul_comm n p), (mul_comm m p); now apply mul_le_mono_nonpos_l. Qed. -Theorem NZmul_cancel_l : forall n m p : NZ, p ~= 0 -> (p * n == p * m <-> n == m). +Theorem mul_cancel_l : forall n m p, p ~= 0 -> (p * n == p * m <-> n == m). Proof. intros n m p H; split; intro H1. -destruct (NZlt_trichotomy p 0) as [H2 | [H2 | H2]]. -apply -> NZeq_dne; intro H3. apply -> NZlt_gt_cases in H3. destruct H3 as [H3 | H3]. -assert (H4 : p * m < p * n); [now apply -> NZmul_lt_mono_neg_l |]. -rewrite H1 in H4; false_hyp H4 NZlt_irrefl. -assert (H4 : p * n < p * m); [now apply -> NZmul_lt_mono_neg_l |]. -rewrite H1 in H4; false_hyp H4 NZlt_irrefl. +destruct (lt_trichotomy p 0) as [H2 | [H2 | H2]]. +apply -> eq_dne; intro H3. apply -> lt_gt_cases in H3. destruct H3 as [H3 | H3]. +assert (H4 : p * m < p * n); [now apply -> mul_lt_mono_neg_l |]. +rewrite H1 in H4; false_hyp H4 lt_irrefl. +assert (H4 : p * n < p * m); [now apply -> mul_lt_mono_neg_l |]. +rewrite H1 in H4; false_hyp H4 lt_irrefl. false_hyp H2 H. -apply -> NZeq_dne; intro H3. apply -> NZlt_gt_cases in H3. destruct H3 as [H3 | H3]. -assert (H4 : p * n < p * m) by (now apply -> NZmul_lt_mono_pos_l). -rewrite H1 in H4; false_hyp H4 NZlt_irrefl. -assert (H4 : p * m < p * n) by (now apply -> NZmul_lt_mono_pos_l). -rewrite H1 in H4; false_hyp H4 NZlt_irrefl. +apply -> eq_dne; intro H3. apply -> lt_gt_cases in H3. destruct H3 as [H3 | H3]. +assert (H4 : p * n < p * m) by (now apply -> mul_lt_mono_pos_l). +rewrite H1 in H4; false_hyp H4 lt_irrefl. +assert (H4 : p * m < p * n) by (now apply -> mul_lt_mono_pos_l). +rewrite H1 in H4; false_hyp H4 lt_irrefl. now rewrite H1. Qed. -Theorem NZmul_cancel_r : forall n m p : NZ, p ~= 0 -> (n * p == m * p <-> n == m). +Theorem mul_cancel_r : forall n m p, p ~= 0 -> (n * p == m * p <-> n == m). Proof. -intros n m p. rewrite (NZmul_comm n p), (NZmul_comm m p); apply NZmul_cancel_l. +intros n m p. rewrite (mul_comm n p), (mul_comm m p); apply mul_cancel_l. Qed. -Theorem NZmul_id_l : forall n m : NZ, m ~= 0 -> (n * m == m <-> n == 1). +Theorem mul_id_l : forall n m, m ~= 0 -> (n * m == m <-> n == 1). Proof. intros n m H. -stepl (n * m == 1 * m) by now rewrite NZmul_1_l. now apply NZmul_cancel_r. +stepl (n * m == 1 * m) by now rewrite mul_1_l. now apply mul_cancel_r. Qed. -Theorem NZmul_id_r : forall n m : NZ, n ~= 0 -> (n * m == n <-> m == 1). +Theorem mul_id_r : forall n m, n ~= 0 -> (n * m == n <-> m == 1). Proof. -intros n m; rewrite NZmul_comm; apply NZmul_id_l. +intros n m; rewrite mul_comm; apply mul_id_l. Qed. -Theorem NZmul_le_mono_pos_l : forall n m p : NZ, 0 < p -> (n <= m <-> p * n <= p * m). +Theorem mul_le_mono_pos_l : forall n m p, 0 < p -> (n <= m <-> p * n <= p * m). Proof. -intros n m p H; do 2 rewrite NZlt_eq_cases. -rewrite (NZmul_lt_mono_pos_l p n m) by assumption. -now rewrite -> (NZmul_cancel_l n m p) by -(intro H1; rewrite H1 in H; false_hyp H NZlt_irrefl). +intros n m p H; do 2 rewrite lt_eq_cases. +rewrite (mul_lt_mono_pos_l p n m) by assumption. +now rewrite -> (mul_cancel_l n m p) by +(intro H1; rewrite H1 in H; false_hyp H lt_irrefl). Qed. -Theorem NZmul_le_mono_pos_r : forall n m p : NZ, 0 < p -> (n <= m <-> n * p <= m * p). +Theorem mul_le_mono_pos_r : forall n m p, 0 < p -> (n <= m <-> n * p <= m * p). Proof. -intros n m p. rewrite (NZmul_comm n p); rewrite (NZmul_comm m p); -apply NZmul_le_mono_pos_l. +intros n m p. rewrite (mul_comm n p), (mul_comm m p); apply mul_le_mono_pos_l. Qed. -Theorem NZmul_le_mono_neg_l : forall n m p : NZ, p < 0 -> (n <= m <-> p * m <= p * n). +Theorem mul_le_mono_neg_l : forall n m p, p < 0 -> (n <= m <-> p * m <= p * n). Proof. -intros n m p H; do 2 rewrite NZlt_eq_cases. -rewrite (NZmul_lt_mono_neg_l p n m); [| assumption]. -rewrite -> (NZmul_cancel_l m n p) by (intro H1; rewrite H1 in H; false_hyp H NZlt_irrefl). -now setoid_replace (n == m) with (m == n) using relation iff by (split; now intro). +intros n m p H; do 2 rewrite lt_eq_cases. +rewrite (mul_lt_mono_neg_l p n m); [| assumption]. +rewrite -> (mul_cancel_l m n p) + by (intro H1; rewrite H1 in H; false_hyp H lt_irrefl). +now setoid_replace (n == m) with (m == n) by (split; now intro). Qed. -Theorem NZmul_le_mono_neg_r : forall n m p : NZ, p < 0 -> (n <= m <-> m * p <= n * p). +Theorem mul_le_mono_neg_r : forall n m p, p < 0 -> (n <= m <-> m * p <= n * p). Proof. -intros n m p. rewrite (NZmul_comm n p); rewrite (NZmul_comm m p); -apply NZmul_le_mono_neg_l. +intros n m p. rewrite (mul_comm n p), (mul_comm m p); apply mul_le_mono_neg_l. Qed. -Theorem NZmul_lt_mono_nonneg : - forall n m p q : NZ, 0 <= n -> n < m -> 0 <= p -> p < q -> n * p < m * q. +Theorem mul_lt_mono_nonneg : + forall n m p q, 0 <= n -> n < m -> 0 <= p -> p < q -> n * p < m * q. Proof. intros n m p q H1 H2 H3 H4. -apply NZle_lt_trans with (m * p). -apply NZmul_le_mono_nonneg_r; [assumption | now apply NZlt_le_incl]. -apply -> NZmul_lt_mono_pos_l; [assumption | now apply NZle_lt_trans with n]. +apply le_lt_trans with (m * p). +apply mul_le_mono_nonneg_r; [assumption | now apply lt_le_incl]. +apply -> mul_lt_mono_pos_l; [assumption | now apply le_lt_trans with n]. Qed. (* There are still many variants of the theorem above. One can assume 0 < n or 0 < p or n <= m or p <= q. *) -Theorem NZmul_le_mono_nonneg : - forall n m p q : NZ, 0 <= n -> n <= m -> 0 <= p -> p <= q -> n * p <= m * q. +Theorem mul_le_mono_nonneg : + forall n m p q, 0 <= n -> n <= m -> 0 <= p -> p <= q -> n * p <= m * q. Proof. intros n m p q H1 H2 H3 H4. le_elim H2; le_elim H4. -apply NZlt_le_incl; now apply NZmul_lt_mono_nonneg. -rewrite <- H4; apply NZmul_le_mono_nonneg_r; [assumption | now apply NZlt_le_incl]. -rewrite <- H2; apply NZmul_le_mono_nonneg_l; [assumption | now apply NZlt_le_incl]. -rewrite H2; rewrite H4; now apply NZeq_le_incl. +apply lt_le_incl; now apply mul_lt_mono_nonneg. +rewrite <- H4; apply mul_le_mono_nonneg_r; [assumption | now apply lt_le_incl]. +rewrite <- H2; apply mul_le_mono_nonneg_l; [assumption | now apply lt_le_incl]. +rewrite H2; rewrite H4; now apply eq_le_incl. Qed. -Theorem NZmul_pos_pos : forall n m : NZ, 0 < n -> 0 < m -> 0 < n * m. +Theorem mul_pos_pos : forall n m, 0 < n -> 0 < m -> 0 < n * m. Proof. -intros n m H1 H2. -rewrite <- (NZmul_0_l m). now apply -> NZmul_lt_mono_pos_r. +intros n m H1 H2. rewrite <- (mul_0_l m). now apply -> mul_lt_mono_pos_r. Qed. -Theorem NZmul_neg_neg : forall n m : NZ, n < 0 -> m < 0 -> 0 < n * m. +Theorem mul_neg_neg : forall n m, n < 0 -> m < 0 -> 0 < n * m. Proof. -intros n m H1 H2. -rewrite <- (NZmul_0_l m). now apply -> NZmul_lt_mono_neg_r. +intros n m H1 H2. rewrite <- (mul_0_l m). now apply -> mul_lt_mono_neg_r. Qed. -Theorem NZmul_pos_neg : forall n m : NZ, 0 < n -> m < 0 -> n * m < 0. +Theorem mul_pos_neg : forall n m, 0 < n -> m < 0 -> n * m < 0. Proof. -intros n m H1 H2. -rewrite <- (NZmul_0_l m). now apply -> NZmul_lt_mono_neg_r. +intros n m H1 H2. rewrite <- (mul_0_l m). now apply -> mul_lt_mono_neg_r. Qed. -Theorem NZmul_neg_pos : forall n m : NZ, n < 0 -> 0 < m -> n * m < 0. +Theorem mul_neg_pos : forall n m, n < 0 -> 0 < m -> n * m < 0. Proof. -intros; rewrite NZmul_comm; now apply NZmul_pos_neg. +intros; rewrite mul_comm; now apply mul_pos_neg. Qed. -Theorem NZlt_1_mul_pos : forall n m : NZ, 1 < n -> 0 < m -> 1 < n * m. +Theorem mul_nonneg_nonneg : forall n m, 0 <= n -> 0 <= m -> 0 <= n*m. Proof. -intros n m H1 H2. apply -> (NZmul_lt_mono_pos_r m) in H1. -rewrite NZmul_1_l in H1. now apply NZlt_1_l with m. +intros. rewrite <- (mul_0_l m). apply mul_le_mono_nonneg; order. +Qed. + +Theorem lt_1_mul_pos : forall n m, 1 < n -> 0 < m -> 1 < n * m. +Proof. +intros n m H1 H2. apply -> (mul_lt_mono_pos_r m) in H1. +rewrite mul_1_l in H1. now apply lt_1_l with m. assumption. Qed. -Theorem NZeq_mul_0 : forall n m : NZ, n * m == 0 <-> n == 0 \/ m == 0. +Theorem eq_mul_0 : forall n m, n * m == 0 <-> n == 0 \/ m == 0. Proof. intros n m; split. -intro H; destruct (NZlt_trichotomy n 0) as [H1 | [H1 | H1]]; -destruct (NZlt_trichotomy m 0) as [H2 | [H2 | H2]]; +intro H; destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]]; +destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]]; try (now right); try (now left). -elimtype False; now apply (NZlt_neq 0 (n * m)); [apply NZmul_neg_neg |]. -elimtype False; now apply (NZlt_neq (n * m) 0); [apply NZmul_neg_pos |]. -elimtype False; now apply (NZlt_neq (n * m) 0); [apply NZmul_pos_neg |]. -elimtype False; now apply (NZlt_neq 0 (n * m)); [apply NZmul_pos_pos |]. -intros [H | H]. now rewrite H, NZmul_0_l. now rewrite H, NZmul_0_r. +exfalso; now apply (lt_neq 0 (n * m)); [apply mul_neg_neg |]. +exfalso; now apply (lt_neq (n * m) 0); [apply mul_neg_pos |]. +exfalso; now apply (lt_neq (n * m) 0); [apply mul_pos_neg |]. +exfalso; now apply (lt_neq 0 (n * m)); [apply mul_pos_pos |]. +intros [H | H]. now rewrite H, mul_0_l. now rewrite H, mul_0_r. Qed. -Theorem NZneq_mul_0 : forall n m : NZ, n ~= 0 /\ m ~= 0 <-> n * m ~= 0. +Theorem neq_mul_0 : forall n m, n ~= 0 /\ m ~= 0 <-> n * m ~= 0. Proof. intros n m; split; intro H. -intro H1; apply -> NZeq_mul_0 in H1. tauto. +intro H1; apply -> eq_mul_0 in H1. tauto. split; intro H1; rewrite H1 in H; -(rewrite NZmul_0_l in H || rewrite NZmul_0_r in H); now apply H. +(rewrite mul_0_l in H || rewrite mul_0_r in H); now apply H. Qed. -Theorem NZeq_square_0 : forall n : NZ, n * n == 0 <-> n == 0. +Theorem eq_square_0 : forall n, n * n == 0 <-> n == 0. Proof. -intro n; rewrite NZeq_mul_0; tauto. +intro n; rewrite eq_mul_0; tauto. Qed. -Theorem NZeq_mul_0_l : forall n m : NZ, n * m == 0 -> m ~= 0 -> n == 0. +Theorem eq_mul_0_l : forall n m, n * m == 0 -> m ~= 0 -> n == 0. Proof. -intros n m H1 H2. apply -> NZeq_mul_0 in H1. destruct H1 as [H1 | H1]. +intros n m H1 H2. apply -> eq_mul_0 in H1. destruct H1 as [H1 | H1]. assumption. false_hyp H1 H2. Qed. -Theorem NZeq_mul_0_r : forall n m : NZ, n * m == 0 -> n ~= 0 -> m == 0. +Theorem eq_mul_0_r : forall n m, n * m == 0 -> n ~= 0 -> m == 0. Proof. -intros n m H1 H2; apply -> NZeq_mul_0 in H1. destruct H1 as [H1 | H1]. +intros n m H1 H2; apply -> eq_mul_0 in H1. destruct H1 as [H1 | H1]. false_hyp H1 H2. assumption. Qed. -Theorem NZlt_0_mul : forall n m : NZ, 0 < n * m <-> (0 < n /\ 0 < m) \/ (m < 0 /\ n < 0). +Theorem lt_0_mul : forall n m, 0 < n * m <-> (0 < n /\ 0 < m) \/ (m < 0 /\ n < 0). Proof. intros n m; split; [intro H | intros [[H1 H2] | [H1 H2]]]. -destruct (NZlt_trichotomy n 0) as [H1 | [H1 | H1]]; -[| rewrite H1 in H; rewrite NZmul_0_l in H; false_hyp H NZlt_irrefl |]; -(destruct (NZlt_trichotomy m 0) as [H2 | [H2 | H2]]; -[| rewrite H2 in H; rewrite NZmul_0_r in H; false_hyp H NZlt_irrefl |]); +destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]]; +[| rewrite H1 in H; rewrite mul_0_l in H; false_hyp H lt_irrefl |]; +(destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]]; +[| rewrite H2 in H; rewrite mul_0_r in H; false_hyp H lt_irrefl |]); try (left; now split); try (right; now split). -assert (H3 : n * m < 0) by now apply NZmul_neg_pos. -elimtype False; now apply (NZlt_asymm (n * m) 0). -assert (H3 : n * m < 0) by now apply NZmul_pos_neg. -elimtype False; now apply (NZlt_asymm (n * m) 0). -now apply NZmul_pos_pos. now apply NZmul_neg_neg. +assert (H3 : n * m < 0) by now apply mul_neg_pos. +exfalso; now apply (lt_asymm (n * m) 0). +assert (H3 : n * m < 0) by now apply mul_pos_neg. +exfalso; now apply (lt_asymm (n * m) 0). +now apply mul_pos_pos. now apply mul_neg_neg. Qed. -Theorem NZsquare_lt_mono_nonneg : forall n m : NZ, 0 <= n -> n < m -> n * n < m * m. +Theorem square_lt_mono_nonneg : forall n m, 0 <= n -> n < m -> n * n < m * m. Proof. -intros n m H1 H2. now apply NZmul_lt_mono_nonneg. +intros n m H1 H2. now apply mul_lt_mono_nonneg. Qed. -Theorem NZsquare_le_mono_nonneg : forall n m : NZ, 0 <= n -> n <= m -> n * n <= m * m. +Theorem square_le_mono_nonneg : forall n m, 0 <= n -> n <= m -> n * n <= m * m. Proof. -intros n m H1 H2. now apply NZmul_le_mono_nonneg. +intros n m H1 H2. now apply mul_le_mono_nonneg. Qed. (* The converse theorems require nonnegativity (or nonpositivity) of the other variable *) -Theorem NZsquare_lt_simpl_nonneg : forall n m : NZ, 0 <= m -> n * n < m * m -> n < m. +Theorem square_lt_simpl_nonneg : forall n m, 0 <= m -> n * n < m * m -> n < m. Proof. -intros n m H1 H2. destruct (NZlt_ge_cases n 0). -now apply NZlt_le_trans with 0. -destruct (NZlt_ge_cases n m). -assumption. assert (F : m * m <= n * n) by now apply NZsquare_le_mono_nonneg. -apply -> NZle_ngt in F. false_hyp H2 F. +intros n m H1 H2. destruct (lt_ge_cases n 0). +now apply lt_le_trans with 0. +destruct (lt_ge_cases n m). +assumption. assert (F : m * m <= n * n) by now apply square_le_mono_nonneg. +apply -> le_ngt in F. false_hyp H2 F. Qed. -Theorem NZsquare_le_simpl_nonneg : forall n m : NZ, 0 <= m -> n * n <= m * m -> n <= m. +Theorem square_le_simpl_nonneg : forall n m, 0 <= m -> n * n <= m * m -> n <= m. Proof. -intros n m H1 H2. destruct (NZlt_ge_cases n 0). -apply NZlt_le_incl; now apply NZlt_le_trans with 0. -destruct (NZle_gt_cases n m). -assumption. assert (F : m * m < n * n) by now apply NZsquare_lt_mono_nonneg. -apply -> NZlt_nge in F. false_hyp H2 F. +intros n m H1 H2. destruct (lt_ge_cases n 0). +apply lt_le_incl; now apply lt_le_trans with 0. +destruct (le_gt_cases n m). +assumption. assert (F : m * m < n * n) by now apply square_lt_mono_nonneg. +apply -> lt_nge in F. false_hyp H2 F. Qed. -Theorem NZmul_2_mono_l : forall n m : NZ, n < m -> 1 + (1 + 1) * n < (1 + 1) * m. +Theorem mul_2_mono_l : forall n m, n < m -> 1 + (1 + 1) * n < (1 + 1) * m. Proof. -intros n m H. apply <- NZle_succ_l in H. -apply -> (NZmul_le_mono_pos_l (S n) m (1 + 1)) in H. -repeat rewrite NZmul_add_distr_r in *; repeat rewrite NZmul_1_l in *. -repeat rewrite NZadd_succ_r in *. repeat rewrite NZadd_succ_l in *. rewrite NZadd_0_l. -now apply -> NZle_succ_l. -apply NZadd_pos_pos; now apply NZlt_succ_diag_r. +intros n m. rewrite <- le_succ_l, (mul_le_mono_pos_l (S n) m (1 + 1)). +rewrite !mul_add_distr_r; nzsimpl; now rewrite le_succ_l. +apply add_pos_pos; now apply lt_0_1. Qed. -End NZMulOrderPropFunct. +End NZMulOrderPropSig. diff --git a/theories/Numbers/NatInt/NZOrder.v b/theories/Numbers/NatInt/NZOrder.v index d0e2faf8..14fa0bfd 100644 --- a/theories/Numbers/NatInt/NZOrder.v +++ b/theories/Numbers/NatInt/NZOrder.v @@ -8,659 +8,637 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NZOrder.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) -Require Import NZAxioms. -Require Import NZMul. -Require Import Decidable. +Require Import NZAxioms NZBase Decidable OrdersTac. -Module NZOrderPropFunct (Import NZOrdAxiomsMod : NZOrdAxiomsSig). -Module Export NZMulPropMod := NZMulPropFunct NZAxiomsMod. -Open Local Scope NatIntScope. +Module Type NZOrderPropSig + (Import NZ : NZOrdSig')(Import NZBase : NZBasePropSig NZ). -Ltac le_elim H := rewrite NZlt_eq_cases in H; destruct H as [H | H]. - -Theorem NZlt_le_incl : forall n m : NZ, n < m -> n <= m. +Instance le_wd : Proper (eq==>eq==>iff) le. Proof. -intros; apply <- NZlt_eq_cases; now left. +intros n n' Hn m m' Hm. rewrite !lt_eq_cases, !Hn, !Hm; auto with *. Qed. -Theorem NZeq_le_incl : forall n m : NZ, n == m -> n <= m. -Proof. -intros; apply <- NZlt_eq_cases; now right. -Qed. +Ltac le_elim H := rewrite lt_eq_cases in H; destruct H as [H | H]. -Lemma NZlt_stepl : forall x y z : NZ, x < y -> x == z -> z < y. +Theorem lt_le_incl : forall n m, n < m -> n <= m. Proof. -intros x y z H1 H2; now rewrite <- H2. +intros; apply <- lt_eq_cases; now left. Qed. -Lemma NZlt_stepr : forall x y z : NZ, x < y -> y == z -> x < z. +Theorem le_refl : forall n, n <= n. Proof. -intros x y z H1 H2; now rewrite <- H2. +intro; apply <- lt_eq_cases; now right. Qed. -Lemma NZle_stepl : forall x y z : NZ, x <= y -> x == z -> z <= y. +Theorem lt_succ_diag_r : forall n, n < S n. Proof. -intros x y z H1 H2; now rewrite <- H2. +intro n. rewrite lt_succ_r. apply le_refl. Qed. -Lemma NZle_stepr : forall x y z : NZ, x <= y -> y == z -> x <= z. +Theorem le_succ_diag_r : forall n, n <= S n. Proof. -intros x y z H1 H2; now rewrite <- H2. +intro; apply lt_le_incl; apply lt_succ_diag_r. Qed. -Declare Left Step NZlt_stepl. -Declare Right Step NZlt_stepr. -Declare Left Step NZle_stepl. -Declare Right Step NZle_stepr. - -Theorem NZlt_neq : forall n m : NZ, n < m -> n ~= m. +Theorem neq_succ_diag_l : forall n, S n ~= n. Proof. -intros n m H1 H2; rewrite H2 in H1; false_hyp H1 NZlt_irrefl. +intros n H. apply (lt_irrefl n). rewrite <- H at 2. apply lt_succ_diag_r. Qed. -Theorem NZle_neq : forall n m : NZ, n < m <-> n <= m /\ n ~= m. +Theorem neq_succ_diag_r : forall n, n ~= S n. Proof. -intros n m; split; [intro H | intros [H1 H2]]. -split. now apply NZlt_le_incl. now apply NZlt_neq. -le_elim H1. assumption. false_hyp H1 H2. +intro n; apply neq_sym, neq_succ_diag_l. Qed. -Theorem NZle_refl : forall n : NZ, n <= n. +Theorem nlt_succ_diag_l : forall n, ~ S n < n. Proof. -intro; now apply NZeq_le_incl. +intros n H. apply (lt_irrefl (S n)). rewrite lt_succ_r. now apply lt_le_incl. Qed. -Theorem NZlt_succ_diag_r : forall n : NZ, n < S n. +Theorem nle_succ_diag_l : forall n, ~ S n <= n. Proof. -intro n. rewrite NZlt_succ_r. now apply NZeq_le_incl. +intros n H; le_elim H. +false_hyp H nlt_succ_diag_l. false_hyp H neq_succ_diag_l. Qed. -Theorem NZle_succ_diag_r : forall n : NZ, n <= S n. +Theorem le_succ_l : forall n m, S n <= m <-> n < m. Proof. -intro; apply NZlt_le_incl; apply NZlt_succ_diag_r. +intro n; nzinduct m n. +split; intro H. false_hyp H nle_succ_diag_l. false_hyp H lt_irrefl. +intro m. +rewrite (lt_eq_cases (S n) (S m)), !lt_succ_r, (lt_eq_cases n m), succ_inj_wd. +rewrite or_cancel_r. +reflexivity. +intros LE EQ; rewrite EQ in LE; false_hyp LE nle_succ_diag_l. +intros LT EQ; rewrite EQ in LT; false_hyp LT lt_irrefl. Qed. -Theorem NZlt_0_1 : 0 < 1. -Proof. -apply NZlt_succ_diag_r. -Qed. +(** Trichotomy *) -Theorem NZle_0_1 : 0 <= 1. +Theorem le_gt_cases : forall n m, n <= m \/ n > m. Proof. -apply NZle_succ_diag_r. +intros n m; nzinduct n m. +left; apply le_refl. +intro n. rewrite lt_succ_r, le_succ_l, !lt_eq_cases. intuition. Qed. -Theorem NZlt_lt_succ_r : forall n m : NZ, n < m -> n < S m. +Theorem lt_trichotomy : forall n m, n < m \/ n == m \/ m < n. Proof. -intros. rewrite NZlt_succ_r. now apply NZlt_le_incl. +intros n m. generalize (le_gt_cases n m); rewrite lt_eq_cases; tauto. Qed. -Theorem NZle_le_succ_r : forall n m : NZ, n <= m -> n <= S m. -Proof. -intros n m H. rewrite <- NZlt_succ_r in H. now apply NZlt_le_incl. -Qed. +Notation lt_eq_gt_cases := lt_trichotomy (only parsing). -Theorem NZle_succ_r : forall n m : NZ, n <= S m <-> n <= m \/ n == S m. +(** Asymmetry and transitivity. *) + +Theorem lt_asymm : forall n m, n < m -> ~ m < n. Proof. -intros n m; rewrite NZlt_eq_cases. now rewrite NZlt_succ_r. +intros n m; nzinduct n m. +intros H; false_hyp H lt_irrefl. +intro n; split; intros H H1 H2. +apply lt_succ_r in H2. le_elim H2. +apply H; auto. apply -> le_succ_l. now apply lt_le_incl. +rewrite H2 in H1. false_hyp H1 nlt_succ_diag_l. +apply le_succ_l in H1. le_elim H1. +apply H; auto. rewrite lt_succ_r. now apply lt_le_incl. +rewrite <- H1 in H2. false_hyp H2 nlt_succ_diag_l. Qed. -(* The following theorem is a special case of neq_succ_iter_l below, -but we prove it separately *) +Notation lt_ngt := lt_asymm (only parsing). -Theorem NZneq_succ_diag_l : forall n : NZ, S n ~= n. +Theorem lt_trans : forall n m p, n < m -> m < p -> n < p. Proof. -intros n H. pose proof (NZlt_succ_diag_r n) as H1. rewrite H in H1. -false_hyp H1 NZlt_irrefl. +intros n m p; nzinduct p m. +intros _ H; false_hyp H lt_irrefl. +intro p. rewrite 2 lt_succ_r. +split; intros H H1 H2. +apply lt_le_incl; le_elim H2; [now apply H | now rewrite H2 in H1]. +assert (n <= p) as H3 by (auto using lt_le_incl). +le_elim H3. assumption. rewrite <- H3 in H2. +elim (lt_asymm n m); auto. Qed. -Theorem NZneq_succ_diag_r : forall n : NZ, n ~= S n. +Theorem le_trans : forall n m p, n <= m -> m <= p -> n <= p. Proof. -intro n; apply NZneq_sym; apply NZneq_succ_diag_l. +intros n m p. rewrite 3 lt_eq_cases. +intros [LT|EQ] [LT'|EQ']; try rewrite EQ; try rewrite <- EQ'; + generalize (lt_trans n m p); auto with relations. Qed. -Theorem NZnlt_succ_diag_l : forall n : NZ, ~ S n < n. -Proof. -intros n H; apply NZlt_lt_succ_r in H. false_hyp H NZlt_irrefl. -Qed. +(** Some type classes about order *) -Theorem NZnle_succ_diag_l : forall n : NZ, ~ S n <= n. +Instance lt_strorder : StrictOrder lt. +Proof. split. exact lt_irrefl. exact lt_trans. Qed. + +Instance le_preorder : PreOrder le. +Proof. split. exact le_refl. exact le_trans. Qed. + +Instance le_partialorder : PartialOrder _ le. Proof. -intros n H; le_elim H. -false_hyp H NZnlt_succ_diag_l. false_hyp H NZneq_succ_diag_l. +intros x y. compute. split. +intro EQ; now rewrite EQ. +rewrite 2 lt_eq_cases. intuition. elim (lt_irrefl x). now transitivity y. Qed. -Theorem NZle_succ_l : forall n m : NZ, S n <= m <-> n < m. +(** We know enough now to benefit from the generic [order] tactic. *) + +Definition lt_compat := lt_wd. +Definition lt_total := lt_trichotomy. +Definition le_lteq := lt_eq_cases. + +Module OrderElts <: TotalOrder. + Definition t := t. + Definition eq := eq. + Definition lt := lt. + Definition le := le. + Definition eq_equiv := eq_equiv. + Definition lt_strorder := lt_strorder. + Definition lt_compat := lt_compat. + Definition lt_total := lt_total. + Definition le_lteq := le_lteq. +End OrderElts. +Module OrderTac := !MakeOrderTac OrderElts. +Ltac order := OrderTac.order. + +(** Some direct consequences of [order]. *) + +Theorem lt_neq : forall n m, n < m -> n ~= m. +Proof. order. Qed. + +Theorem le_neq : forall n m, n < m <-> n <= m /\ n ~= m. +Proof. intuition order. Qed. + +Theorem eq_le_incl : forall n m, n == m -> n <= m. +Proof. order. Qed. + +Lemma lt_stepl : forall x y z, x < y -> x == z -> z < y. +Proof. order. Qed. + +Lemma lt_stepr : forall x y z, x < y -> y == z -> x < z. +Proof. order. Qed. + +Lemma le_stepl : forall x y z, x <= y -> x == z -> z <= y. +Proof. order. Qed. + +Lemma le_stepr : forall x y z, x <= y -> y == z -> x <= z. +Proof. order. Qed. + +Declare Left Step lt_stepl. +Declare Right Step lt_stepr. +Declare Left Step le_stepl. +Declare Right Step le_stepr. + +Theorem le_lt_trans : forall n m p, n <= m -> m < p -> n < p. +Proof. order. Qed. + +Theorem lt_le_trans : forall n m p, n < m -> m <= p -> n < p. +Proof. order. Qed. + +Theorem le_antisymm : forall n m, n <= m -> m <= n -> n == m. +Proof. order. Qed. + +(** More properties of [<] and [<=] with respect to [S] and [0]. *) + +Theorem le_succ_r : forall n m, n <= S m <-> n <= m \/ n == S m. Proof. -intro n; NZinduct m n. -setoid_replace (n < n) with False using relation iff by - (apply -> neg_false; apply NZlt_irrefl). -now setoid_replace (S n <= n) with False using relation iff by - (apply -> neg_false; apply NZnle_succ_diag_l). -intro m. rewrite NZlt_succ_r. rewrite NZle_succ_r. -rewrite NZsucc_inj_wd. -rewrite (NZlt_eq_cases n m). -rewrite or_cancel_r. -reflexivity. -intros H1 H2; rewrite H2 in H1; false_hyp H1 NZnle_succ_diag_l. -apply NZlt_neq. +intros n m; rewrite lt_eq_cases. now rewrite lt_succ_r. Qed. -Theorem NZlt_succ_l : forall n m : NZ, S n < m -> n < m. +Theorem lt_succ_l : forall n m, S n < m -> n < m. Proof. -intros n m H; apply -> NZle_succ_l; now apply NZlt_le_incl. +intros n m H; apply -> le_succ_l; order. Qed. -Theorem NZsucc_lt_mono : forall n m : NZ, n < m <-> S n < S m. +Theorem le_le_succ_r : forall n m, n <= m -> n <= S m. Proof. -intros n m. rewrite <- NZle_succ_l. symmetry. apply NZlt_succ_r. +intros n m LE. rewrite <- lt_succ_r in LE. order. Qed. -Theorem NZsucc_le_mono : forall n m : NZ, n <= m <-> S n <= S m. +Theorem lt_lt_succ_r : forall n m, n < m -> n < S m. Proof. -intros n m. do 2 rewrite NZlt_eq_cases. -rewrite <- NZsucc_lt_mono; now rewrite NZsucc_inj_wd. +intros. rewrite lt_succ_r. order. Qed. -Theorem NZlt_asymm : forall n m, n < m -> ~ m < n. +Theorem succ_lt_mono : forall n m, n < m <-> S n < S m. Proof. -intros n m; NZinduct n m. -intros H _; false_hyp H NZlt_irrefl. -intro n; split; intros H H1 H2. -apply NZlt_succ_l in H1. apply -> NZlt_succ_r in H2. le_elim H2. -now apply H. rewrite H2 in H1; false_hyp H1 NZlt_irrefl. -apply NZlt_lt_succ_r in H2. apply <- NZle_succ_l in H1. le_elim H1. -now apply H. rewrite H1 in H2; false_hyp H2 NZlt_irrefl. +intros n m. rewrite <- le_succ_l. symmetry. apply lt_succ_r. Qed. -Theorem NZlt_trans : forall n m p : NZ, n < m -> m < p -> n < p. +Theorem succ_le_mono : forall n m, n <= m <-> S n <= S m. Proof. -intros n m p; NZinduct p m. -intros _ H; false_hyp H NZlt_irrefl. -intro p. do 2 rewrite NZlt_succ_r. -split; intros H H1 H2. -apply NZlt_le_incl; le_elim H2; [now apply H | now rewrite H2 in H1]. -assert (n <= p) as H3. apply H. assumption. now apply NZlt_le_incl. -le_elim H3. assumption. rewrite <- H3 in H2. -elimtype False; now apply (NZlt_asymm n m). +intros n m. now rewrite 2 lt_eq_cases, <- succ_lt_mono, succ_inj_wd. Qed. -Theorem NZle_trans : forall n m p : NZ, n <= m -> m <= p -> n <= p. +Theorem lt_0_1 : 0 < 1. Proof. -intros n m p H1 H2; le_elim H1. -le_elim H2. apply NZlt_le_incl; now apply NZlt_trans with (m := m). -apply NZlt_le_incl; now rewrite <- H2. now rewrite H1. +apply lt_succ_diag_r. Qed. -Theorem NZle_lt_trans : forall n m p : NZ, n <= m -> m < p -> n < p. +Theorem le_0_1 : 0 <= 1. Proof. -intros n m p H1 H2; le_elim H1. -now apply NZlt_trans with (m := m). now rewrite H1. +apply le_succ_diag_r. Qed. -Theorem NZlt_le_trans : forall n m p : NZ, n < m -> m <= p -> n < p. +Theorem lt_1_l : forall n m, 0 < n -> n < m -> 1 < m. Proof. -intros n m p H1 H2; le_elim H2. -now apply NZlt_trans with (m := m). now rewrite <- H2. +intros n m H1 H2. apply <- le_succ_l in H1. order. Qed. -Theorem NZle_antisymm : forall n m : NZ, n <= m -> m <= n -> n == m. + +(** More Trichotomy, decidability and double negation elimination. *) + +(** The following theorem is cleary redundant, but helps not to +remember whether one has to say le_gt_cases or lt_ge_cases *) + +Theorem lt_ge_cases : forall n m, n < m \/ n >= m. Proof. -intros n m H1 H2; now (le_elim H1; le_elim H2); -[elimtype False; apply (NZlt_asymm n m) | | |]. +intros n m; destruct (le_gt_cases m n); intuition order. Qed. -Theorem NZlt_1_l : forall n m : NZ, 0 < n -> n < m -> 1 < m. +Theorem le_ge_cases : forall n m, n <= m \/ n >= m. Proof. -intros n m H1 H2. apply <- NZle_succ_l in H1. now apply NZle_lt_trans with n. +intros n m; destruct (le_gt_cases n m); intuition order. Qed. -(** Trichotomy, decidability, and double negation elimination *) - -Theorem NZlt_trichotomy : forall n m : NZ, n < m \/ n == m \/ m < n. +Theorem lt_gt_cases : forall n m, n ~= m <-> n < m \/ n > m. Proof. -intros n m; NZinduct n m. -right; now left. -intro n; rewrite NZlt_succ_r. stepr ((S n < m \/ S n == m) \/ m <= n) by tauto. -rewrite <- (NZlt_eq_cases (S n) m). -setoid_replace (n == m) with (m == n) using relation iff by now split. -stepl (n < m \/ m < n \/ m == n) by tauto. rewrite <- NZlt_eq_cases. -apply or_iff_compat_r. symmetry; apply NZle_succ_l. +intros n m; destruct (lt_trichotomy n m); intuition order. Qed. -(* Decidability of equality, even though true in each finite ring, does not +(** Decidability of equality, even though true in each finite ring, does not have a uniform proof. Otherwise, the proof for two fixed numbers would reduce to a normal form that will say if the numbers are equal or not, which cannot be true in all finite rings. Therefore, we prove decidability in the presence of order. *) -Theorem NZeq_dec : forall n m : NZ, decidable (n == m). +Theorem eq_decidable : forall n m, decidable (n == m). Proof. -intros n m; destruct (NZlt_trichotomy n m) as [H | [H | H]]. -right; intro H1; rewrite H1 in H; false_hyp H NZlt_irrefl. -now left. -right; intro H1; rewrite H1 in H; false_hyp H NZlt_irrefl. +intros n m; destruct (lt_trichotomy n m) as [ | [ | ]]; + (right; order) || (left; order). Qed. -(* DNE stands for double-negation elimination *) +(** DNE stands for double-negation elimination *) -Theorem NZeq_dne : forall n m, ~ ~ n == m <-> n == m. +Theorem eq_dne : forall n m, ~ ~ n == m <-> n == m. Proof. intros n m; split; intro H. -destruct (NZeq_dec n m) as [H1 | H1]. +destruct (eq_decidable n m) as [H1 | H1]. assumption. false_hyp H1 H. intro H1; now apply H1. Qed. -Theorem NZlt_gt_cases : forall n m : NZ, n ~= m <-> n < m \/ n > m. -Proof. -intros n m; split. -pose proof (NZlt_trichotomy n m); tauto. -intros H H1; destruct H as [H | H]; rewrite H1 in H; false_hyp H NZlt_irrefl. -Qed. +Theorem le_ngt : forall n m, n <= m <-> ~ n > m. +Proof. intuition order. Qed. -Theorem NZle_gt_cases : forall n m : NZ, n <= m \/ n > m. -Proof. -intros n m; destruct (NZlt_trichotomy n m) as [H | [H | H]]. -left; now apply NZlt_le_incl. left; now apply NZeq_le_incl. now right. -Qed. - -(* The following theorem is cleary redundant, but helps not to -remember whether one has to say le_gt_cases or lt_ge_cases *) +(** Redundant but useful *) -Theorem NZlt_ge_cases : forall n m : NZ, n < m \/ n >= m. -Proof. -intros n m; destruct (NZle_gt_cases m n); try (now left); try (now right). -Qed. - -Theorem NZle_ge_cases : forall n m : NZ, n <= m \/ n >= m. -Proof. -intros n m; destruct (NZle_gt_cases n m) as [H | H]. -now left. right; now apply NZlt_le_incl. -Qed. - -Theorem NZle_ngt : forall n m : NZ, n <= m <-> ~ n > m. -Proof. -intros n m. split; intro H; [intro H1 |]. -eapply NZle_lt_trans in H; [| eassumption ..]. false_hyp H NZlt_irrefl. -destruct (NZle_gt_cases n m) as [H1 | H1]. -assumption. false_hyp H1 H. -Qed. - -(* Redundant but useful *) - -Theorem NZnlt_ge : forall n m : NZ, ~ n < m <-> n >= m. -Proof. -intros n m; symmetry; apply NZle_ngt. -Qed. +Theorem nlt_ge : forall n m, ~ n < m <-> n >= m. +Proof. intuition order. Qed. -Theorem NZlt_dec : forall n m : NZ, decidable (n < m). +Theorem lt_decidable : forall n m, decidable (n < m). Proof. -intros n m; destruct (NZle_gt_cases m n); -[right; now apply -> NZle_ngt | now left]. +intros n m; destruct (le_gt_cases m n); [right|left]; order. Qed. -Theorem NZlt_dne : forall n m, ~ ~ n < m <-> n < m. +Theorem lt_dne : forall n m, ~ ~ n < m <-> n < m. Proof. -intros n m; split; intro H; -[destruct (NZlt_dec n m) as [H1 | H1]; [assumption | false_hyp H1 H] | -intro H1; false_hyp H H1]. +intros n m; split; intro H. +destruct (lt_decidable n m) as [H1 | H1]; [assumption | false_hyp H1 H]. +intro H1; false_hyp H H1. Qed. -Theorem NZnle_gt : forall n m : NZ, ~ n <= m <-> n > m. -Proof. -intros n m. rewrite NZle_ngt. apply NZlt_dne. -Qed. +Theorem nle_gt : forall n m, ~ n <= m <-> n > m. +Proof. intuition order. Qed. -(* Redundant but useful *) +(** Redundant but useful *) -Theorem NZlt_nge : forall n m : NZ, n < m <-> ~ n >= m. -Proof. -intros n m; symmetry; apply NZnle_gt. -Qed. +Theorem lt_nge : forall n m, n < m <-> ~ n >= m. +Proof. intuition order. Qed. -Theorem NZle_dec : forall n m : NZ, decidable (n <= m). +Theorem le_decidable : forall n m, decidable (n <= m). Proof. -intros n m; destruct (NZle_gt_cases n m); -[now left | right; now apply <- NZnle_gt]. +intros n m; destruct (le_gt_cases n m); [left|right]; order. Qed. -Theorem NZle_dne : forall n m : NZ, ~ ~ n <= m <-> n <= m. +Theorem le_dne : forall n m, ~ ~ n <= m <-> n <= m. Proof. -intros n m; split; intro H; -[destruct (NZle_dec n m) as [H1 | H1]; [assumption | false_hyp H1 H] | -intro H1; false_hyp H H1]. +intros n m; split; intro H. +destruct (le_decidable n m) as [H1 | H1]; [assumption | false_hyp H1 H]. +intro H1; false_hyp H H1. Qed. -Theorem NZnlt_succ_r : forall n m : NZ, ~ m < S n <-> n < m. +Theorem nlt_succ_r : forall n m, ~ m < S n <-> n < m. Proof. -intros n m; rewrite NZlt_succ_r; apply NZnle_gt. +intros n m; rewrite lt_succ_r. intuition order. Qed. -(* The difference between integers and natural numbers is that for +(** The difference between integers and natural numbers is that for every integer there is a predecessor, which is not true for natural numbers. However, for both classes, every number that is bigger than some other number has a predecessor. The proof of this fact by regular induction does not go through, so we need to use strong (course-of-value) induction. *) -Lemma NZlt_exists_pred_strong : - forall z n m : NZ, z < m -> m <= n -> exists k : NZ, m == S k /\ z <= k. +Lemma lt_exists_pred_strong : + forall z n m, z < m -> m <= n -> exists k, m == S k /\ z <= k. Proof. -intro z; NZinduct n z. -intros m H1 H2; apply <- NZnle_gt in H1; false_hyp H2 H1. +intro z; nzinduct n z. +order. intro n; split; intros IH m H1 H2. -apply -> NZle_succ_r in H2; destruct H2 as [H2 | H2]. -now apply IH. exists n. now split; [| rewrite <- NZlt_succ_r; rewrite <- H2]. -apply IH. assumption. now apply NZle_le_succ_r. +apply -> le_succ_r in H2. destruct H2 as [H2 | H2]. +now apply IH. exists n. now split; [| rewrite <- lt_succ_r; rewrite <- H2]. +apply IH. assumption. now apply le_le_succ_r. Qed. -Theorem NZlt_exists_pred : - forall z n : NZ, z < n -> exists k : NZ, n == S k /\ z <= k. +Theorem lt_exists_pred : + forall z n, z < n -> exists k, n == S k /\ z <= k. Proof. -intros z n H; apply NZlt_exists_pred_strong with (z := z) (n := n). -assumption. apply NZle_refl. +intros z n H; apply lt_exists_pred_strong with (z := z) (n := n). +assumption. apply le_refl. Qed. -(** A corollary of having an order is that NZ is infinite *) - -(* This section about infinity of NZ relies on the type nat and can be -safely removed *) - -Definition NZsucc_iter (n : nat) (m : NZ) := - nat_rect (fun _ => NZ) m (fun _ l => S l) n. - -Theorem NZlt_succ_iter_r : - forall (n : nat) (m : NZ), m < NZsucc_iter (Datatypes.S n) m. -Proof. -intros n m; induction n as [| n IH]; simpl in *. -apply NZlt_succ_diag_r. now apply NZlt_lt_succ_r. -Qed. - -Theorem NZneq_succ_iter_l : - forall (n : nat) (m : NZ), NZsucc_iter (Datatypes.S n) m ~= m. -Proof. -intros n m H. pose proof (NZlt_succ_iter_r n m) as H1. rewrite H in H1. -false_hyp H1 NZlt_irrefl. -Qed. - -(* End of the section about the infinity of NZ *) - (** Stronger variant of induction with assumptions n >= 0 (n < 0) in the induction step *) Section Induction. -Variable A : NZ -> Prop. -Hypothesis A_wd : predicate_wd NZeq A. - -Add Morphism A with signature NZeq ==> iff as A_morph. -Proof. apply A_wd. Qed. +Variable A : t -> Prop. +Hypothesis A_wd : Proper (eq==>iff) A. Section Center. -Variable z : NZ. (* A z is the basis of induction *) +Variable z : t. (* A z is the basis of induction *) Section RightInduction. -Let A' (n : NZ) := forall m : NZ, z <= m -> m < n -> A m. -Let right_step := forall n : NZ, z <= n -> A n -> A (S n). -Let right_step' := forall n : NZ, z <= n -> A' n -> A n. -Let right_step'' := forall n : NZ, A' n <-> A' (S n). +Let A' (n : t) := forall m, z <= m -> m < n -> A m. +Let right_step := forall n, z <= n -> A n -> A (S n). +Let right_step' := forall n, z <= n -> A' n -> A n. +Let right_step'' := forall n, A' n <-> A' (S n). -Lemma NZrs_rs' : A z -> right_step -> right_step'. +Lemma rs_rs' : A z -> right_step -> right_step'. Proof. intros Az RS n H1 H2. -le_elim H1. apply NZlt_exists_pred in H1. destruct H1 as [k [H3 H4]]. -rewrite H3. apply RS; [assumption | apply H2; [assumption | rewrite H3; apply NZlt_succ_diag_r]]. +le_elim H1. apply lt_exists_pred in H1. destruct H1 as [k [H3 H4]]. +rewrite H3. apply RS; trivial. apply H2; trivial. +rewrite H3; apply lt_succ_diag_r. rewrite <- H1; apply Az. Qed. -Lemma NZrs'_rs'' : right_step' -> right_step''. +Lemma rs'_rs'' : right_step' -> right_step''. Proof. intros RS' n; split; intros H1 m H2 H3. -apply -> NZlt_succ_r in H3; le_elim H3; +apply -> lt_succ_r in H3; le_elim H3; [now apply H1 | rewrite H3 in *; now apply RS']. -apply H1; [assumption | now apply NZlt_lt_succ_r]. +apply H1; [assumption | now apply lt_lt_succ_r]. Qed. -Lemma NZrbase : A' z. +Lemma rbase : A' z. Proof. -intros m H1 H2. apply -> NZle_ngt in H1. false_hyp H2 H1. +intros m H1 H2. apply -> le_ngt in H1. false_hyp H2 H1. Qed. -Lemma NZA'A_right : (forall n : NZ, A' n) -> forall n : NZ, z <= n -> A n. +Lemma A'A_right : (forall n, A' n) -> forall n, z <= n -> A n. Proof. -intros H1 n H2. apply H1 with (n := S n); [assumption | apply NZlt_succ_diag_r]. +intros H1 n H2. apply H1 with (n := S n); [assumption | apply lt_succ_diag_r]. Qed. -Theorem NZstrong_right_induction: right_step' -> forall n : NZ, z <= n -> A n. +Theorem strong_right_induction: right_step' -> forall n, z <= n -> A n. Proof. -intro RS'; apply NZA'A_right; unfold A'; NZinduct n z; -[apply NZrbase | apply NZrs'_rs''; apply RS']. +intro RS'; apply A'A_right; unfold A'; nzinduct n z; +[apply rbase | apply rs'_rs''; apply RS']. Qed. -Theorem NZright_induction : A z -> right_step -> forall n : NZ, z <= n -> A n. +Theorem right_induction : A z -> right_step -> forall n, z <= n -> A n. Proof. -intros Az RS; apply NZstrong_right_induction; now apply NZrs_rs'. +intros Az RS; apply strong_right_induction; now apply rs_rs'. Qed. -Theorem NZright_induction' : - (forall n : NZ, n <= z -> A n) -> right_step -> forall n : NZ, A n. +Theorem right_induction' : + (forall n, n <= z -> A n) -> right_step -> forall n, A n. Proof. intros L R n. -destruct (NZlt_trichotomy n z) as [H | [H | H]]. -apply L; now apply NZlt_le_incl. -apply L; now apply NZeq_le_incl. -apply NZright_induction. apply L; now apply NZeq_le_incl. assumption. now apply NZlt_le_incl. +destruct (lt_trichotomy n z) as [H | [H | H]]. +apply L; now apply lt_le_incl. +apply L; now apply eq_le_incl. +apply right_induction. apply L; now apply eq_le_incl. assumption. +now apply lt_le_incl. Qed. -Theorem NZstrong_right_induction' : - (forall n : NZ, n <= z -> A n) -> right_step' -> forall n : NZ, A n. +Theorem strong_right_induction' : + (forall n, n <= z -> A n) -> right_step' -> forall n, A n. Proof. intros L R n. -destruct (NZlt_trichotomy n z) as [H | [H | H]]. -apply L; now apply NZlt_le_incl. -apply L; now apply NZeq_le_incl. -apply NZstrong_right_induction. assumption. now apply NZlt_le_incl. +destruct (lt_trichotomy n z) as [H | [H | H]]. +apply L; now apply lt_le_incl. +apply L; now apply eq_le_incl. +apply strong_right_induction. assumption. now apply lt_le_incl. Qed. End RightInduction. Section LeftInduction. -Let A' (n : NZ) := forall m : NZ, m <= z -> n <= m -> A m. -Let left_step := forall n : NZ, n < z -> A (S n) -> A n. -Let left_step' := forall n : NZ, n <= z -> A' (S n) -> A n. -Let left_step'' := forall n : NZ, A' n <-> A' (S n). +Let A' (n : t) := forall m, m <= z -> n <= m -> A m. +Let left_step := forall n, n < z -> A (S n) -> A n. +Let left_step' := forall n, n <= z -> A' (S n) -> A n. +Let left_step'' := forall n, A' n <-> A' (S n). -Lemma NZls_ls' : A z -> left_step -> left_step'. +Lemma ls_ls' : A z -> left_step -> left_step'. Proof. intros Az LS n H1 H2. le_elim H1. -apply LS; [assumption | apply H2; [now apply <- NZle_succ_l | now apply NZeq_le_incl]]. +apply LS; trivial. apply H2; [now apply <- le_succ_l | now apply eq_le_incl]. rewrite H1; apply Az. Qed. -Lemma NZls'_ls'' : left_step' -> left_step''. +Lemma ls'_ls'' : left_step' -> left_step''. Proof. intros LS' n; split; intros H1 m H2 H3. -apply -> NZle_succ_l in H3. apply NZlt_le_incl in H3. now apply H1. +apply -> le_succ_l in H3. apply lt_le_incl in H3. now apply H1. le_elim H3. -apply <- NZle_succ_l in H3. now apply H1. +apply <- le_succ_l in H3. now apply H1. rewrite <- H3 in *; now apply LS'. Qed. -Lemma NZlbase : A' (S z). +Lemma lbase : A' (S z). Proof. -intros m H1 H2. apply -> NZle_succ_l in H2. -apply -> NZle_ngt in H1. false_hyp H2 H1. +intros m H1 H2. apply -> le_succ_l in H2. +apply -> le_ngt in H1. false_hyp H2 H1. Qed. -Lemma NZA'A_left : (forall n : NZ, A' n) -> forall n : NZ, n <= z -> A n. +Lemma A'A_left : (forall n, A' n) -> forall n, n <= z -> A n. Proof. -intros H1 n H2. apply H1 with (n := n); [assumption | now apply NZeq_le_incl]. +intros H1 n H2. apply H1 with (n := n); [assumption | now apply eq_le_incl]. Qed. -Theorem NZstrong_left_induction: left_step' -> forall n : NZ, n <= z -> A n. +Theorem strong_left_induction: left_step' -> forall n, n <= z -> A n. Proof. -intro LS'; apply NZA'A_left; unfold A'; NZinduct n (S z); -[apply NZlbase | apply NZls'_ls''; apply LS']. +intro LS'; apply A'A_left; unfold A'; nzinduct n (S z); +[apply lbase | apply ls'_ls''; apply LS']. Qed. -Theorem NZleft_induction : A z -> left_step -> forall n : NZ, n <= z -> A n. +Theorem left_induction : A z -> left_step -> forall n, n <= z -> A n. Proof. -intros Az LS; apply NZstrong_left_induction; now apply NZls_ls'. +intros Az LS; apply strong_left_induction; now apply ls_ls'. Qed. -Theorem NZleft_induction' : - (forall n : NZ, z <= n -> A n) -> left_step -> forall n : NZ, A n. +Theorem left_induction' : + (forall n, z <= n -> A n) -> left_step -> forall n, A n. Proof. intros R L n. -destruct (NZlt_trichotomy n z) as [H | [H | H]]. -apply NZleft_induction. apply R. now apply NZeq_le_incl. assumption. now apply NZlt_le_incl. -rewrite H; apply R; now apply NZeq_le_incl. -apply R; now apply NZlt_le_incl. +destruct (lt_trichotomy n z) as [H | [H | H]]. +apply left_induction. apply R. now apply eq_le_incl. assumption. +now apply lt_le_incl. +rewrite H; apply R; now apply eq_le_incl. +apply R; now apply lt_le_incl. Qed. -Theorem NZstrong_left_induction' : - (forall n : NZ, z <= n -> A n) -> left_step' -> forall n : NZ, A n. +Theorem strong_left_induction' : + (forall n, z <= n -> A n) -> left_step' -> forall n, A n. Proof. intros R L n. -destruct (NZlt_trichotomy n z) as [H | [H | H]]. -apply NZstrong_left_induction; auto. now apply NZlt_le_incl. -rewrite H; apply R; now apply NZeq_le_incl. -apply R; now apply NZlt_le_incl. +destruct (lt_trichotomy n z) as [H | [H | H]]. +apply strong_left_induction; auto. now apply lt_le_incl. +rewrite H; apply R; now apply eq_le_incl. +apply R; now apply lt_le_incl. Qed. End LeftInduction. -Theorem NZorder_induction : +Theorem order_induction : A z -> - (forall n : NZ, z <= n -> A n -> A (S n)) -> - (forall n : NZ, n < z -> A (S n) -> A n) -> - forall n : NZ, A n. + (forall n, z <= n -> A n -> A (S n)) -> + (forall n, n < z -> A (S n) -> A n) -> + forall n, A n. Proof. intros Az RS LS n. -destruct (NZlt_trichotomy n z) as [H | [H | H]]. -now apply NZleft_induction; [| | apply NZlt_le_incl]. +destruct (lt_trichotomy n z) as [H | [H | H]]. +now apply left_induction; [| | apply lt_le_incl]. now rewrite H. -now apply NZright_induction; [| | apply NZlt_le_incl]. +now apply right_induction; [| | apply lt_le_incl]. Qed. -Theorem NZorder_induction' : +Theorem order_induction' : A z -> - (forall n : NZ, z <= n -> A n -> A (S n)) -> - (forall n : NZ, n <= z -> A n -> A (P n)) -> - forall n : NZ, A n. + (forall n, z <= n -> A n -> A (S n)) -> + (forall n, n <= z -> A n -> A (P n)) -> + forall n, A n. Proof. -intros Az AS AP n; apply NZorder_induction; try assumption. -intros m H1 H2. apply AP in H2; [| now apply <- NZle_succ_l]. -unfold predicate_wd, fun_wd in A_wd; apply -> (A_wd (P (S m)) m); -[assumption | apply NZpred_succ]. +intros Az AS AP n; apply order_induction; try assumption. +intros m H1 H2. apply AP in H2; [| now apply <- le_succ_l]. +apply -> (A_wd (P (S m)) m); [assumption | apply pred_succ]. Qed. End Center. -Theorem NZorder_induction_0 : +Theorem order_induction_0 : A 0 -> - (forall n : NZ, 0 <= n -> A n -> A (S n)) -> - (forall n : NZ, n < 0 -> A (S n) -> A n) -> - forall n : NZ, A n. -Proof (NZorder_induction 0). + (forall n, 0 <= n -> A n -> A (S n)) -> + (forall n, n < 0 -> A (S n) -> A n) -> + forall n, A n. +Proof (order_induction 0). -Theorem NZorder_induction'_0 : +Theorem order_induction'_0 : A 0 -> - (forall n : NZ, 0 <= n -> A n -> A (S n)) -> - (forall n : NZ, n <= 0 -> A n -> A (P n)) -> - forall n : NZ, A n. -Proof (NZorder_induction' 0). + (forall n, 0 <= n -> A n -> A (S n)) -> + (forall n, n <= 0 -> A n -> A (P n)) -> + forall n, A n. +Proof (order_induction' 0). (** Elimintation principle for < *) -Theorem NZlt_ind : forall (n : NZ), +Theorem lt_ind : forall (n : t), A (S n) -> - (forall m : NZ, n < m -> A m -> A (S m)) -> - forall m : NZ, n < m -> A m. + (forall m, n < m -> A m -> A (S m)) -> + forall m, n < m -> A m. Proof. intros n H1 H2 m H3. -apply NZright_induction with (S n); [assumption | | now apply <- NZle_succ_l]. -intros; apply H2; try assumption. now apply -> NZle_succ_l. +apply right_induction with (S n); [assumption | | now apply <- le_succ_l]. +intros; apply H2; try assumption. now apply -> le_succ_l. Qed. (** Elimintation principle for <= *) -Theorem NZle_ind : forall (n : NZ), +Theorem le_ind : forall (n : t), A n -> - (forall m : NZ, n <= m -> A m -> A (S m)) -> - forall m : NZ, n <= m -> A m. + (forall m, n <= m -> A m -> A (S m)) -> + forall m, n <= m -> A m. Proof. intros n H1 H2 m H3. -now apply NZright_induction with n. +now apply right_induction with n. Qed. End Induction. -Tactic Notation "NZord_induct" ident(n) := - induction_maker n ltac:(apply NZorder_induction_0). +Tactic Notation "nzord_induct" ident(n) := + induction_maker n ltac:(apply order_induction_0). -Tactic Notation "NZord_induct" ident(n) constr(z) := - induction_maker n ltac:(apply NZorder_induction with z). +Tactic Notation "nzord_induct" ident(n) constr(z) := + induction_maker n ltac:(apply order_induction with z). Section WF. -Variable z : NZ. +Variable z : t. -Let Rlt (n m : NZ) := z <= n /\ n < m. -Let Rgt (n m : NZ) := m < n /\ n <= z. +Let Rlt (n m : t) := z <= n /\ n < m. +Let Rgt (n m : t) := m < n /\ n <= z. -Add Morphism Rlt with signature NZeq ==> NZeq ==> iff as Rlt_wd. +Instance Rlt_wd : Proper (eq ==> eq ==> iff) Rlt. Proof. -intros x1 x2 H1 x3 x4 H2; unfold Rlt; rewrite H1; now rewrite H2. +intros x1 x2 H1 x3 x4 H2; unfold Rlt. rewrite H1; now rewrite H2. Qed. -Add Morphism Rgt with signature NZeq ==> NZeq ==> iff as Rgt_wd. +Instance Rgt_wd : Proper (eq ==> eq ==> iff) Rgt. Proof. intros x1 x2 H1 x3 x4 H2; unfold Rgt; rewrite H1; now rewrite H2. Qed. -Lemma NZAcc_lt_wd : predicate_wd NZeq (Acc Rlt). +Instance Acc_lt_wd : Proper (eq==>iff) (Acc Rlt). Proof. -unfold predicate_wd, fun_wd. intros x1 x2 H; split; intro H1; destruct H1 as [H2]; constructor; intros; apply H2; now (rewrite H || rewrite <- H). Qed. -Lemma NZAcc_gt_wd : predicate_wd NZeq (Acc Rgt). +Instance Acc_gt_wd : Proper (eq==>iff) (Acc Rgt). Proof. -unfold predicate_wd, fun_wd. intros x1 x2 H; split; intro H1; destruct H1 as [H2]; constructor; intros; apply H2; now (rewrite H || rewrite <- H). Qed. -Theorem NZlt_wf : well_founded Rlt. +Theorem lt_wf : well_founded Rlt. Proof. unfold well_founded. -apply NZstrong_right_induction' with (z := z). -apply NZAcc_lt_wd. +apply strong_right_induction' with (z := z). +apply Acc_lt_wd. intros n H; constructor; intros y [H1 H2]. -apply <- NZnle_gt in H2. elim H2. now apply NZle_trans with z. +apply <- nle_gt in H2. elim H2. now apply le_trans with z. intros n H1 H2; constructor; intros m [H3 H4]. now apply H2. Qed. -Theorem NZgt_wf : well_founded Rgt. +Theorem gt_wf : well_founded Rgt. Proof. unfold well_founded. -apply NZstrong_left_induction' with (z := z). -apply NZAcc_gt_wd. +apply strong_left_induction' with (z := z). +apply Acc_gt_wd. intros n H; constructor; intros y [H1 H2]. -apply <- NZnle_gt in H2. elim H2. now apply NZle_lt_trans with n. +apply <- nle_gt in H2. elim H2. now apply le_lt_trans with n. intros n H1 H2; constructor; intros m [H3 H4]. -apply H2. assumption. now apply <- NZle_succ_l. +apply H2. assumption. now apply <- le_succ_l. Qed. End WF. -End NZOrderPropFunct. +End NZOrderPropSig. + +Module NZOrderPropFunct (NZ : NZOrdSig) := + NZBasePropSig NZ <+ NZOrderPropSig NZ. + +(** If we have moreover a [compare] function, we can build + an [OrderedType] structure. *) + +Module NZOrderedTypeFunct (NZ : NZDecOrdSig') + <: DecidableTypeFull <: OrderedTypeFull := + NZ <+ NZOrderPropFunct <+ Compare2EqBool <+ HasEqBool2Dec. diff --git a/theories/Numbers/NatInt/NZProperties.v b/theories/Numbers/NatInt/NZProperties.v new file mode 100644 index 00000000..125b4f62 --- /dev/null +++ b/theories/Numbers/NatInt/NZProperties.v @@ -0,0 +1,20 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) +(* Evgeny Makarov, INRIA, 2007 *) +(************************************************************************) + +(*i $Id$ i*) + +Require Export NZAxioms NZMulOrder. + +(** This functor summarizes all known facts about NZ. + For the moment it is only an alias to [NZMulOrderPropFunct], which + subsumes all others. +*) + +Module Type NZPropFunct := NZMulOrderPropSig. diff --git a/theories/Numbers/Natural/Abstract/NAdd.v b/theories/Numbers/Natural/Abstract/NAdd.v index 91ae5b70..9f0b54a6 100644 --- a/theories/Numbers/Natural/Abstract/NAdd.v +++ b/theories/Numbers/Natural/Abstract/NAdd.v @@ -8,74 +8,30 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NAdd.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Export NBase. -Module NAddPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NBasePropMod := NBasePropFunct NAxiomsMod. +Module NAddPropFunct (Import N : NAxiomsSig'). +Include NBasePropFunct N. -Open Local Scope NatScope. +(** For theorems about [add] that are both valid for [N] and [Z], see [NZAdd] *) +(** Now comes theorems valid for natural numbers but not for Z *) -Theorem add_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> n1 + m1 == n2 + m2. -Proof NZadd_wd. - -Theorem add_0_l : forall n : N, 0 + n == n. -Proof NZadd_0_l. - -Theorem add_succ_l : forall n m : N, (S n) + m == S (n + m). -Proof NZadd_succ_l. - -(** Theorems that are valid for both natural numbers and integers *) - -Theorem add_0_r : forall n : N, n + 0 == n. -Proof NZadd_0_r. - -Theorem add_succ_r : forall n m : N, n + S m == S (n + m). -Proof NZadd_succ_r. - -Theorem add_comm : forall n m : N, n + m == m + n. -Proof NZadd_comm. - -Theorem add_assoc : forall n m p : N, n + (m + p) == (n + m) + p. -Proof NZadd_assoc. - -Theorem add_shuffle1 : forall n m p q : N, (n + m) + (p + q) == (n + p) + (m + q). -Proof NZadd_shuffle1. - -Theorem add_shuffle2 : forall n m p q : N, (n + m) + (p + q) == (n + q) + (m + p). -Proof NZadd_shuffle2. - -Theorem add_1_l : forall n : N, 1 + n == S n. -Proof NZadd_1_l. - -Theorem add_1_r : forall n : N, n + 1 == S n. -Proof NZadd_1_r. - -Theorem add_cancel_l : forall n m p : N, p + n == p + m <-> n == m. -Proof NZadd_cancel_l. - -Theorem add_cancel_r : forall n m p : N, n + p == m + p <-> n == m. -Proof NZadd_cancel_r. - -(* Theorems that are valid for natural numbers but cannot be proved for Z *) - -Theorem eq_add_0 : forall n m : N, n + m == 0 <-> n == 0 /\ m == 0. +Theorem eq_add_0 : forall n m, n + m == 0 <-> n == 0 /\ m == 0. Proof. intros n m; induct n. -(* The next command does not work with the axiom add_0_l from NAddSig *) -rewrite add_0_l. intuition reflexivity. -intros n IH. rewrite add_succ_l. -setoid_replace (S (n + m) == 0) with False using relation iff by +nzsimpl; intuition. +intros n IH. nzsimpl. +setoid_replace (S (n + m) == 0) with False by (apply -> neg_false; apply neq_succ_0). -setoid_replace (S n == 0) with False using relation iff by +setoid_replace (S n == 0) with False by (apply -> neg_false; apply neq_succ_0). tauto. Qed. Theorem eq_add_succ : - forall n m : N, (exists p : N, n + m == S p) <-> - (exists n' : N, n == S n') \/ (exists m' : N, m == S m'). + forall n m, (exists p, n + m == S p) <-> + (exists n', n == S n') \/ (exists m', m == S m'). Proof. intros n m; cases n. split; intro H. @@ -88,11 +44,11 @@ left; now exists n. exists (n + m); now rewrite add_succ_l. Qed. -Theorem eq_add_1 : forall n m : N, +Theorem eq_add_1 : forall n m, n + m == 1 -> n == 1 /\ m == 0 \/ n == 0 /\ m == 1. Proof. intros n m H. -assert (H1 : exists p : N, n + m == S p) by now exists 0. +assert (H1 : exists p, n + m == S p) by now exists 0. apply -> eq_add_succ in H1. destruct H1 as [[n' H1] | [m' H1]]. left. rewrite H1 in H; rewrite add_succ_l in H; apply succ_inj in H. apply -> eq_add_0 in H. destruct H as [H2 H3]; rewrite H2 in H1; now split. @@ -100,7 +56,7 @@ right. rewrite H1 in H; rewrite add_succ_r in H; apply succ_inj in H. apply -> eq_add_0 in H. destruct H as [H2 H3]; rewrite H3 in H1; now split. Qed. -Theorem succ_add_discr : forall n m : N, m ~= S (n + m). +Theorem succ_add_discr : forall n m, m ~= S (n + m). Proof. intro n; induct m. apply neq_sym. apply neq_succ_0. @@ -108,49 +64,18 @@ intros m IH H. apply succ_inj in H. rewrite add_succ_r in H. unfold not in IH; now apply IH. Qed. -Theorem add_pred_l : forall n m : N, n ~= 0 -> P n + m == P (n + m). +Theorem add_pred_l : forall n m, n ~= 0 -> P n + m == P (n + m). Proof. intros n m; cases n. intro H; now elim H. intros n IH; rewrite add_succ_l; now do 2 rewrite pred_succ. Qed. -Theorem add_pred_r : forall n m : N, m ~= 0 -> n + P m == P (n + m). +Theorem add_pred_r : forall n m, m ~= 0 -> n + P m == P (n + m). Proof. intros n m H; rewrite (add_comm n (P m)); rewrite (add_comm n m); now apply add_pred_l. Qed. -(* One could define n <= m as exists p : N, p + n == m. Then we have -dichotomy: - -forall n m : N, n <= m \/ m <= n, - -i.e., - -forall n m : N, (exists p : N, p + n == m) \/ (exists p : N, p + m == n) (1) - -We will need (1) in the proof of induction principle for integers -constructed as pairs of natural numbers. The formula (1) can be proved -using properties of order and truncated subtraction. Thus, p would be -m - n or n - m and (1) would hold by theorem sub_add from Sub.v -depending on whether n <= m or m <= n. However, in proving induction -for integers constructed from natural numbers we do not need to -require implementations of order and sub; it is enough to prove (1) -here. *) - -Theorem add_dichotomy : - forall n m : N, (exists p : N, p + n == m) \/ (exists p : N, p + m == n). -Proof. -intros n m; induct n. -left; exists m; apply add_0_r. -intros n IH. -destruct IH as [[p H] | [p H]]. -destruct (zero_or_succ p) as [H1 | [p' H1]]; rewrite H1 in H. -rewrite add_0_l in H. right; exists (S 0); rewrite H; rewrite add_succ_l; now rewrite add_0_l. -left; exists p'; rewrite add_succ_r; now rewrite add_succ_l in H. -right; exists (S p). rewrite add_succ_l; now rewrite H. -Qed. - End NAddPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NAddOrder.v b/theories/Numbers/Natural/Abstract/NAddOrder.v index 7024fd00..0ce04e54 100644 --- a/theories/Numbers/Natural/Abstract/NAddOrder.v +++ b/theories/Numbers/Natural/Abstract/NAddOrder.v @@ -8,107 +8,41 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NAddOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NOrder. -Module NAddOrderPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NOrderPropMod := NOrderPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NAddOrderPropFunct (Import N : NAxiomsSig'). +Include NOrderPropFunct N. -Theorem add_lt_mono_l : forall n m p : N, n < m <-> p + n < p + m. -Proof NZadd_lt_mono_l. +(** Theorems true for natural numbers, not for integers *) -Theorem add_lt_mono_r : forall n m p : N, n < m <-> n + p < m + p. -Proof NZadd_lt_mono_r. - -Theorem add_lt_mono : forall n m p q : N, n < m -> p < q -> n + p < m + q. -Proof NZadd_lt_mono. - -Theorem add_le_mono_l : forall n m p : N, n <= m <-> p + n <= p + m. -Proof NZadd_le_mono_l. - -Theorem add_le_mono_r : forall n m p : N, n <= m <-> n + p <= m + p. -Proof NZadd_le_mono_r. - -Theorem add_le_mono : forall n m p q : N, n <= m -> p <= q -> n + p <= m + q. -Proof NZadd_le_mono. - -Theorem add_lt_le_mono : forall n m p q : N, n < m -> p <= q -> n + p < m + q. -Proof NZadd_lt_le_mono. - -Theorem add_le_lt_mono : forall n m p q : N, n <= m -> p < q -> n + p < m + q. -Proof NZadd_le_lt_mono. - -Theorem add_pos_pos : forall n m : N, 0 < n -> 0 < m -> 0 < n + m. -Proof NZadd_pos_pos. - -Theorem lt_add_pos_l : forall n m : N, 0 < n -> m < n + m. -Proof NZlt_add_pos_l. - -Theorem lt_add_pos_r : forall n m : N, 0 < n -> m < m + n. -Proof NZlt_add_pos_r. - -Theorem le_lt_add_lt : forall n m p q : N, n <= m -> p + m < q + n -> p < q. -Proof NZle_lt_add_lt. - -Theorem lt_le_add_lt : forall n m p q : N, n < m -> p + m <= q + n -> p < q. -Proof NZlt_le_add_lt. - -Theorem le_le_add_le : forall n m p q : N, n <= m -> p + m <= q + n -> p <= q. -Proof NZle_le_add_le. - -Theorem add_lt_cases : forall n m p q : N, n + m < p + q -> n < p \/ m < q. -Proof NZadd_lt_cases. - -Theorem add_le_cases : forall n m p q : N, n + m <= p + q -> n <= p \/ m <= q. -Proof NZadd_le_cases. - -Theorem add_pos_cases : forall n m : N, 0 < n + m -> 0 < n \/ 0 < m. -Proof NZadd_pos_cases. - -(* Theorems true for natural numbers *) - -Theorem le_add_r : forall n m : N, n <= n + m. +Theorem le_add_r : forall n m, n <= n + m. Proof. intro n; induct m. rewrite add_0_r; now apply eq_le_incl. intros m IH. rewrite add_succ_r; now apply le_le_succ_r. Qed. -Theorem lt_lt_add_r : forall n m p : N, n < m -> n < m + p. +Theorem lt_lt_add_r : forall n m p, n < m -> n < m + p. Proof. intros n m p H; rewrite <- (add_0_r n). apply add_lt_le_mono; [assumption | apply le_0_l]. Qed. -Theorem lt_lt_add_l : forall n m p : N, n < m -> n < p + m. +Theorem lt_lt_add_l : forall n m p, n < m -> n < p + m. Proof. intros n m p; rewrite add_comm; apply lt_lt_add_r. Qed. -Theorem add_pos_l : forall n m : N, 0 < n -> 0 < n + m. +Theorem add_pos_l : forall n m, 0 < n -> 0 < n + m. Proof. -intros; apply NZadd_pos_nonneg. assumption. apply le_0_l. +intros; apply add_pos_nonneg. assumption. apply le_0_l. Qed. -Theorem add_pos_r : forall n m : N, 0 < m -> 0 < n + m. -Proof. -intros; apply NZadd_nonneg_pos. apply le_0_l. assumption. -Qed. - -(* The following property is used to prove the correctness of the -definition of order on integers constructed from pairs of natural numbers *) - -Theorem add_lt_repl_pair : forall n m n' m' u v : N, - n + u < m + v -> n + m' == n' + m -> n' + u < m' + v. +Theorem add_pos_r : forall n m, 0 < m -> 0 < n + m. Proof. -intros n m n' m' u v H1 H2. -symmetry in H2. assert (H3 : n' + m <= n + m') by now apply eq_le_incl. -pose proof (add_lt_le_mono _ _ _ _ H1 H3) as H4. -rewrite (add_shuffle2 n u), (add_shuffle1 m v), (add_comm m n) in H4. -do 2 rewrite <- add_assoc in H4. do 2 apply <- add_lt_mono_l in H4. -now rewrite (add_comm n' u), (add_comm m' v). +intros; apply add_nonneg_pos. apply le_0_l. assumption. Qed. End NAddOrderPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NAxioms.v b/theories/Numbers/Natural/Abstract/NAxioms.v index 750cc977..42016ab1 100644 --- a/theories/Numbers/Natural/Abstract/NAxioms.v +++ b/theories/Numbers/Natural/Abstract/NAxioms.v @@ -8,64 +8,32 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NZAxioms. Set Implicit Arguments. -Module Type NAxiomsSig. -Declare Module Export NZOrdAxiomsMod : NZOrdAxiomsSig. +Module Type NAxioms (Import NZ : NZDomainSig'). -Delimit Scope NatScope with Nat. -Notation N := NZ. -Notation Neq := NZeq. -Notation N0 := NZ0. -Notation N1 := (NZsucc NZ0). -Notation S := NZsucc. -Notation P := NZpred. -Notation add := NZadd. -Notation mul := NZmul. -Notation sub := NZsub. -Notation lt := NZlt. -Notation le := NZle. -Notation min := NZmin. -Notation max := NZmax. -Notation "x == y" := (Neq x y) (at level 70) : NatScope. -Notation "x ~= y" := (~ Neq x y) (at level 70) : NatScope. -Notation "0" := NZ0 : NatScope. -Notation "1" := (NZsucc NZ0) : NatScope. -Notation "x + y" := (NZadd x y) : NatScope. -Notation "x - y" := (NZsub x y) : NatScope. -Notation "x * y" := (NZmul x y) : NatScope. -Notation "x < y" := (NZlt x y) : NatScope. -Notation "x <= y" := (NZle x y) : NatScope. -Notation "x > y" := (NZlt y x) (only parsing) : NatScope. -Notation "x >= y" := (NZle y x) (only parsing) : NatScope. - -Open Local Scope NatScope. +Axiom pred_0 : P 0 == 0. -Parameter Inline recursion : forall A : Type, A -> (N -> A -> A) -> N -> A. +Parameter Inline recursion : forall A : Type, A -> (t -> A -> A) -> t -> A. Implicit Arguments recursion [A]. -Axiom pred_0 : P 0 == 0. - -Axiom recursion_wd : forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : N -> A -> A, fun2_eq Neq Aeq Aeq f f' -> - forall x x' : N, x == x' -> - Aeq (recursion a f x) (recursion a' f' x'). +Declare Instance recursion_wd (A : Type) (Aeq : relation A) : + Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A). Axiom recursion_0 : - forall (A : Type) (a : A) (f : N -> A -> A), recursion a f 0 = a. + forall (A : Type) (a : A) (f : t -> A -> A), recursion a f 0 = a. Axiom recursion_succ : - forall (A : Type) (Aeq : relation A) (a : A) (f : N -> A -> A), - Aeq a a -> fun2_wd Neq Aeq Aeq f -> - forall n : N, Aeq (recursion a f (S n)) (f n (recursion a f n)). + forall (A : Type) (Aeq : relation A) (a : A) (f : t -> A -> A), + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> + forall n, Aeq (recursion a f (S n)) (f n (recursion a f n)). -(*Axiom dep_rec : - forall A : N -> Type, A 0 -> (forall n : N, A n -> A (S n)) -> forall n : N, A n.*) +End NAxioms. -End NAxiomsSig. +Module Type NAxiomsSig := NZOrdAxiomsSig <+ NAxioms. +Module Type NAxiomsSig' := NZOrdAxiomsSig' <+ NAxioms. diff --git a/theories/Numbers/Natural/Abstract/NBase.v b/theories/Numbers/Natural/Abstract/NBase.v index 85e2c2ab..842f4bcf 100644 --- a/theories/Numbers/Natural/Abstract/NBase.v +++ b/theories/Numbers/Natural/Abstract/NBase.v @@ -8,135 +8,78 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NBase.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Export Decidable. Require Export NAxioms. -Require Import NZMulOrder. (* The last property functor on NZ, which subsumes all others *) +Require Import NZProperties. -Module NBasePropFunct (Import NAxiomsMod : NAxiomsSig). +Module NBasePropFunct (Import N : NAxiomsSig'). +(** First, we import all known facts about both natural numbers and integers. *) +Include NZPropFunct N. -Open Local Scope NatScope. - -(* We call the last property functor on NZ, which includes all the previous -ones, to get all properties of NZ at once. This way we will include them -only one time. *) - -Module Export NZMulOrderMod := NZMulOrderPropFunct NZOrdAxiomsMod. - -(* Here we probably need to re-prove all axioms declared in NAxioms.v to -make sure that the definitions like N, S and add are unfolded in them, -since unfolding is done only inside a functor. In fact, we'll do it in the -files that prove the corresponding properties. In those files, we will also -rename properties proved in NZ files by removing NZ from their names. In -this way, one only has to consult, for example, NAdd.v to see all -available properties for add, i.e., one does not have to go to NAxioms.v -for axioms and NZAdd.v for theorems. *) - -Theorem succ_wd : forall n1 n2 : N, n1 == n2 -> S n1 == S n2. -Proof NZsucc_wd. - -Theorem pred_wd : forall n1 n2 : N, n1 == n2 -> P n1 == P n2. -Proof NZpred_wd. - -Theorem pred_succ : forall n : N, P (S n) == n. -Proof NZpred_succ. - -Theorem pred_0 : P 0 == 0. -Proof pred_0. - -Theorem Neq_refl : forall n : N, n == n. -Proof (proj1 NZeq_equiv). - -Theorem Neq_sym : forall n m : N, n == m -> m == n. -Proof (proj2 (proj2 NZeq_equiv)). - -Theorem Neq_trans : forall n m p : N, n == m -> m == p -> n == p. -Proof (proj1 (proj2 NZeq_equiv)). - -Theorem neq_sym : forall n m : N, n ~= m -> m ~= n. -Proof NZneq_sym. - -Theorem succ_inj : forall n1 n2 : N, S n1 == S n2 -> n1 == n2. -Proof NZsucc_inj. - -Theorem succ_inj_wd : forall n1 n2 : N, S n1 == S n2 <-> n1 == n2. -Proof NZsucc_inj_wd. - -Theorem succ_inj_wd_neg : forall n m : N, S n ~= S m <-> n ~= m. -Proof NZsucc_inj_wd_neg. - -(* Decidability and stability of equality was proved only in NZOrder, but -since it does not mention order, we'll put it here *) - -Theorem eq_dec : forall n m : N, decidable (n == m). -Proof NZeq_dec. - -Theorem eq_dne : forall n m : N, ~ ~ n == m <-> n == m. -Proof NZeq_dne. - -(* Now we prove that the successor of a number is not zero by defining a +(** We prove that the successor of a number is not zero by defining a function (by recursion) that maps 0 to false and the successor to true *) -Definition if_zero (A : Set) (a b : A) (n : N) : A := +Definition if_zero (A : Type) (a b : A) (n : N.t) : A := recursion a (fun _ _ => b) n. -Add Parametric Morphism (A : Set) : (if_zero A) with signature (@eq _ ==> @eq _ ==> Neq ==> @eq _) as if_zero_wd. +Implicit Arguments if_zero [A]. + +Instance if_zero_wd (A : Type) : + Proper (Logic.eq ==> Logic.eq ==> N.eq ==> Logic.eq) (@if_zero A). Proof. -intros; unfold if_zero. apply recursion_wd with (Aeq := (@eq A)). -reflexivity. unfold fun2_eq; now intros. assumption. +intros; unfold if_zero. +repeat red; intros. apply recursion_wd; auto. repeat red; auto. Qed. -Theorem if_zero_0 : forall (A : Set) (a b : A), if_zero A a b 0 = a. +Theorem if_zero_0 : forall (A : Type) (a b : A), if_zero a b 0 = a. Proof. unfold if_zero; intros; now rewrite recursion_0. Qed. -Theorem if_zero_succ : forall (A : Set) (a b : A) (n : N), if_zero A a b (S n) = b. +Theorem if_zero_succ : + forall (A : Type) (a b : A) (n : N.t), if_zero a b (S n) = b. Proof. intros; unfold if_zero. -now rewrite (@recursion_succ A (@eq A)); [| | unfold fun2_wd; now intros]. +now rewrite recursion_succ. Qed. -Implicit Arguments if_zero [A]. - -Theorem neq_succ_0 : forall n : N, S n ~= 0. +Theorem neq_succ_0 : forall n, S n ~= 0. Proof. intros n H. -assert (true = false); [| discriminate]. -replace true with (if_zero false true (S n)) by apply if_zero_succ. -pattern false at 2; replace false with (if_zero false true 0) by apply if_zero_0. -now rewrite H. +generalize (Logic.eq_refl (if_zero false true 0)). +rewrite <- H at 1. rewrite if_zero_0, if_zero_succ; discriminate. Qed. -Theorem neq_0_succ : forall n : N, 0 ~= S n. +Theorem neq_0_succ : forall n, 0 ~= S n. Proof. intro n; apply neq_sym; apply neq_succ_0. Qed. -(* Next, we show that all numbers are nonnegative and recover regular induction -from the bidirectional induction on NZ *) +(** Next, we show that all numbers are nonnegative and recover regular + induction from the bidirectional induction on NZ *) -Theorem le_0_l : forall n : N, 0 <= n. +Theorem le_0_l : forall n, 0 <= n. Proof. -NZinduct n. -now apply NZeq_le_incl. +nzinduct n. +now apply eq_le_incl. intro n; split. -apply NZle_le_succ_r. -intro H; apply -> NZle_succ_r in H; destruct H as [H | H]. +apply le_le_succ_r. +intro H; apply -> le_succ_r in H; destruct H as [H | H]. assumption. symmetry in H; false_hyp H neq_succ_0. Qed. Theorem induction : - forall A : N -> Prop, predicate_wd Neq A -> - A 0 -> (forall n : N, A n -> A (S n)) -> forall n : N, A n. + forall A : N.t -> Prop, Proper (N.eq==>iff) A -> + A 0 -> (forall n, A n -> A (S n)) -> forall n, A n. Proof. -intros A A_wd A0 AS n; apply NZright_induction with 0; try assumption. +intros A A_wd A0 AS n; apply right_induction with 0; try assumption. intros; auto; apply le_0_l. apply le_0_l. Qed. -(* The theorems NZinduction, NZcentral_induction and the tactic NZinduct +(** The theorems [bi_induction], [central_induction] and the tactic [nzinduct] refer to bidirectional induction, which is not useful on natural numbers. Therefore, we define a new induction tactic for natural numbers. We do not have to call "Declare Left Step" and "Declare Right Step" @@ -146,8 +89,8 @@ from NZ. *) Ltac induct n := induction_maker n ltac:(apply induction). Theorem case_analysis : - forall A : N -> Prop, predicate_wd Neq A -> - A 0 -> (forall n : N, A (S n)) -> forall n : N, A n. + forall A : N.t -> Prop, Proper (N.eq==>iff) A -> + A 0 -> (forall n, A (S n)) -> forall n, A n. Proof. intros; apply induction; auto. Qed. @@ -173,7 +116,7 @@ now left. intro n; right; now exists n. Qed. -Theorem eq_pred_0 : forall n : N, P n == 0 <-> n == 0 \/ n == 1. +Theorem eq_pred_0 : forall n, P n == 0 <-> n == 0 \/ n == 1. Proof. cases n. rewrite pred_0. setoid_replace (0 == 1) with False using relation iff. tauto. @@ -184,34 +127,29 @@ setoid_replace (S n == 0) with False using relation iff by rewrite succ_inj_wd. tauto. Qed. -Theorem succ_pred : forall n : N, n ~= 0 -> S (P n) == n. +Theorem succ_pred : forall n, n ~= 0 -> S (P n) == n. Proof. cases n. -intro H; elimtype False; now apply H. +intro H; exfalso; now apply H. intros; now rewrite pred_succ. Qed. -Theorem pred_inj : forall n m : N, n ~= 0 -> m ~= 0 -> P n == P m -> n == m. +Theorem pred_inj : forall n m, n ~= 0 -> m ~= 0 -> P n == P m -> n == m. Proof. intros n m; cases n. -intros H; elimtype False; now apply H. +intros H; exfalso; now apply H. intros n _; cases m. -intros H; elimtype False; now apply H. +intros H; exfalso; now apply H. intros m H2 H3. do 2 rewrite pred_succ in H3. now rewrite H3. Qed. -(* The following induction principle is useful for reasoning about, e.g., +(** The following induction principle is useful for reasoning about, e.g., Fibonacci numbers *) Section PairInduction. -Variable A : N -> Prop. -Hypothesis A_wd : predicate_wd Neq A. - -Add Morphism A with signature Neq ==> iff as A_morph. -Proof. -exact A_wd. -Qed. +Variable A : N.t -> Prop. +Hypothesis A_wd : Proper (N.eq==>iff) A. Theorem pair_induction : A 0 -> A 1 -> @@ -224,18 +162,12 @@ Qed. End PairInduction. -(*Ltac pair_induct n := induction_maker n ltac:(apply pair_induction).*) +(** The following is useful for reasoning about, e.g., Ackermann function *) -(* The following is useful for reasoning about, e.g., Ackermann function *) Section TwoDimensionalInduction. -Variable R : N -> N -> Prop. -Hypothesis R_wd : relation_wd Neq Neq R. - -Add Morphism R with signature Neq ==> Neq ==> iff as R_morph. -Proof. -exact R_wd. -Qed. +Variable R : N.t -> N.t -> Prop. +Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem two_dim_induction : R 0 0 -> @@ -251,26 +183,16 @@ Qed. End TwoDimensionalInduction. -(*Ltac two_dim_induct n m := - try intros until n; - try intros until m; - pattern n, m; apply two_dim_induction; clear n m; - [solve_relation_wd | | | ].*) Section DoubleInduction. -Variable R : N -> N -> Prop. -Hypothesis R_wd : relation_wd Neq Neq R. - -Add Morphism R with signature Neq ==> Neq ==> iff as R_morph1. -Proof. -exact R_wd. -Qed. +Variable R : N.t -> N.t -> Prop. +Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem double_induction : - (forall m : N, R 0 m) -> - (forall n : N, R (S n) 0) -> - (forall n m : N, R n m -> R (S n) (S m)) -> forall n m : N, R n m. + (forall m, R 0 m) -> + (forall n, R (S n) 0) -> + (forall n m, R n m -> R (S n) (S m)) -> forall n m, R n m. Proof. intros H1 H2 H3; induct n; auto. intros n H; cases m; auto. diff --git a/theories/Numbers/Natural/Abstract/NDefOps.v b/theories/Numbers/Natural/Abstract/NDefOps.v index 0a8f5f1e..22eb2cb3 100644 --- a/theories/Numbers/Natural/Abstract/NDefOps.v +++ b/theories/Numbers/Natural/Abstract/NDefOps.v @@ -8,45 +8,47 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NDefOps.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) Require Import Bool. (* To get the orb and negb function *) +Require Import RelationPairs. Require Export NStrongRec. -Module NdefOpsPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NStrongRecPropMod := NStrongRecPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NdefOpsPropFunct (Import N : NAxiomsSig'). +Include NStrongRecPropFunct N. (*****************************************************) (** Addition *) -Definition def_add (x y : N) := recursion y (fun _ p => S p) x. +Definition def_add (x y : N.t) := recursion y (fun _ => S) x. -Infix Local "++" := def_add (at level 50, left associativity). +Local Infix "+++" := def_add (at level 50, left associativity). -Add Morphism def_add with signature Neq ==> Neq ==> Neq as def_add_wd. +Instance def_add_prewd : Proper (N.eq==>N.eq==>N.eq) (fun _ => S). Proof. -unfold def_add. -intros x x' Exx' y y' Eyy'. -apply recursion_wd with (Aeq := Neq). -assumption. -unfold fun2_eq; intros _ _ _ p p' Epp'; now rewrite Epp'. -assumption. +intros _ _ _ p p' Epp'; now rewrite Epp'. +Qed. + +Instance def_add_wd : Proper (N.eq ==> N.eq ==> N.eq) def_add. +Proof. +intros x x' Exx' y y' Eyy'. unfold def_add. +(* TODO: why rewrite Exx' don't work here (or verrrry slowly) ? *) +apply recursion_wd with (Aeq := N.eq); auto with *. +apply def_add_prewd. Qed. -Theorem def_add_0_l : forall y : N, 0 ++ y == y. +Theorem def_add_0_l : forall y, 0 +++ y == y. Proof. intro y. unfold def_add. now rewrite recursion_0. Qed. -Theorem def_add_succ_l : forall x y : N, S x ++ y == S (x ++ y). +Theorem def_add_succ_l : forall x y, S x +++ y == S (x +++ y). Proof. intros x y; unfold def_add. -rewrite (@recursion_succ N Neq); try reflexivity. -unfold fun2_wd. intros _ _ _ m1 m2 H2. now rewrite H2. +rewrite recursion_succ; auto with *. Qed. -Theorem def_add_add : forall n m : N, n ++ m == n + m. +Theorem def_add_add : forall n m, n +++ m == n + m. Proof. intros n m; induct n. now rewrite def_add_0_l, add_0_l. @@ -56,42 +58,37 @@ Qed. (*****************************************************) (** Multiplication *) -Definition def_mul (x y : N) := recursion 0 (fun _ p => p ++ x) y. +Definition def_mul (x y : N.t) := recursion 0 (fun _ p => p +++ x) y. -Infix Local "**" := def_mul (at level 40, left associativity). +Local Infix "**" := def_mul (at level 40, left associativity). -Lemma def_mul_step_wd : forall x : N, fun2_wd Neq Neq Neq (fun _ p => def_add p x). +Instance def_mul_prewd : + Proper (N.eq==>N.eq==>N.eq==>N.eq) (fun x _ p => p +++ x). Proof. -unfold fun2_wd. intros. now apply def_add_wd. +repeat red; intros; now apply def_add_wd. Qed. -Lemma def_mul_step_equal : - forall x x' : N, x == x' -> - fun2_eq Neq Neq Neq (fun _ p => def_add p x) (fun x p => def_add p x'). -Proof. -unfold fun2_eq; intros; apply def_add_wd; assumption. -Qed. - -Add Morphism def_mul with signature Neq ==> Neq ==> Neq as def_mul_wd. +Instance def_mul_wd : Proper (N.eq ==> N.eq ==> N.eq) def_mul. Proof. unfold def_mul. intros x x' Exx' y y' Eyy'. -apply recursion_wd with (Aeq := Neq). -reflexivity. apply def_mul_step_equal. assumption. assumption. +apply recursion_wd; auto with *. +now apply def_mul_prewd. Qed. -Theorem def_mul_0_r : forall x : N, x ** 0 == 0. +Theorem def_mul_0_r : forall x, x ** 0 == 0. Proof. intro. unfold def_mul. now rewrite recursion_0. Qed. -Theorem def_mul_succ_r : forall x y : N, x ** S y == x ** y ++ x. +Theorem def_mul_succ_r : forall x y, x ** S y == x ** y +++ x. Proof. intros x y; unfold def_mul. -now rewrite (@recursion_succ N Neq); [| apply def_mul_step_wd |]. +rewrite recursion_succ; auto with *. +now apply def_mul_prewd. Qed. -Theorem def_mul_mul : forall n m : N, n ** m == n * m. +Theorem def_mul_mul : forall n m, n ** m == n * m. Proof. intros n m; induct m. now rewrite def_mul_0_r, mul_0_r. @@ -101,120 +98,99 @@ Qed. (*****************************************************) (** Order *) -Definition def_ltb (m : N) : N -> bool := +Definition ltb (m : N.t) : N.t -> bool := recursion (if_zero false true) - (fun _ f => fun n => recursion false (fun n' _ => f n') n) + (fun _ f n => recursion false (fun n' _ => f n') n) m. -Infix Local "<<" := def_ltb (at level 70, no associativity). - -Lemma lt_base_wd : fun_wd Neq (@eq bool) (if_zero false true). -unfold fun_wd; intros; now apply if_zero_wd. -Qed. +Local Infix "<<" := ltb (at level 70, no associativity). -Lemma lt_step_wd : -fun2_wd Neq (fun_eq Neq (@eq bool)) (fun_eq Neq (@eq bool)) - (fun _ f => fun n => recursion false (fun n' _ => f n') n). +Instance ltb_prewd1 : Proper (N.eq==>Logic.eq) (if_zero false true). Proof. -unfold fun2_wd, fun_eq. -intros x x' Exx' f f' Eff' y y' Eyy'. -apply recursion_wd with (Aeq := @eq bool). -reflexivity. -unfold fun2_eq; intros; now apply Eff'. -assumption. +red; intros; apply if_zero_wd; auto. Qed. -Lemma lt_curry_wd : - forall m m' : N, m == m' -> fun_eq Neq (@eq bool) (def_ltb m) (def_ltb m'). +Instance ltb_prewd2 : Proper (N.eq==>(N.eq==>Logic.eq)==>N.eq==>Logic.eq) + (fun _ f n => recursion false (fun n' _ => f n') n). Proof. -unfold def_ltb. -intros m m' Emm'. -apply recursion_wd with (Aeq := fun_eq Neq (@eq bool)). -apply lt_base_wd. -apply lt_step_wd. -assumption. +repeat red; intros; simpl. +apply recursion_wd; auto with *. +repeat red; auto. Qed. -Add Morphism def_ltb with signature Neq ==> Neq ==> (@eq bool) as def_ltb_wd. +Instance ltb_wd : Proper (N.eq ==> N.eq ==> Logic.eq) ltb. Proof. -intros; now apply lt_curry_wd. +unfold ltb. +intros n n' Hn m m' Hm. +apply f_equiv; auto with *. +apply recursion_wd; auto; [ apply ltb_prewd1 | apply ltb_prewd2 ]. Qed. -Theorem def_ltb_base : forall n : N, 0 << n = if_zero false true n. +Theorem ltb_base : forall n, 0 << n = if_zero false true n. Proof. -intro n; unfold def_ltb; now rewrite recursion_0. +intro n; unfold ltb; now rewrite recursion_0. Qed. -Theorem def_ltb_step : - forall m n : N, S m << n = recursion false (fun n' _ => m << n') n. +Theorem ltb_step : + forall m n, S m << n = recursion false (fun n' _ => m << n') n. Proof. -intros m n; unfold def_ltb. -pose proof - (@recursion_succ - (N -> bool) - (fun_eq Neq (@eq bool)) - (if_zero false true) - (fun _ f => fun n => recursion false (fun n' _ => f n') n) - lt_base_wd - lt_step_wd - m n n) as H. -now rewrite H. +intros m n; unfold ltb at 1. +apply f_equiv; auto with *. +rewrite recursion_succ by (apply ltb_prewd1||apply ltb_prewd2). +fold (ltb m). +repeat red; intros. apply recursion_wd; auto. +repeat red; intros; now apply ltb_wd. Qed. (* Above, we rewrite applications of function. Is it possible to rewrite functions themselves, i.e., rewrite (recursion lt_base lt_step (S n)) to lt_step n (recursion lt_base lt_step n)? *) -Theorem def_ltb_0 : forall n : N, n << 0 = false. +Theorem ltb_0 : forall n, n << 0 = false. Proof. cases n. -rewrite def_ltb_base; now rewrite if_zero_0. -intro n; rewrite def_ltb_step. now rewrite recursion_0. +rewrite ltb_base; now rewrite if_zero_0. +intro n; rewrite ltb_step. now rewrite recursion_0. Qed. -Theorem def_ltb_0_succ : forall n : N, 0 << S n = true. +Theorem ltb_0_succ : forall n, 0 << S n = true. Proof. -intro n; rewrite def_ltb_base; now rewrite if_zero_succ. +intro n; rewrite ltb_base; now rewrite if_zero_succ. Qed. -Theorem succ_def_ltb_mono : forall n m : N, (S n << S m) = (n << m). +Theorem succ_ltb_mono : forall n m, (S n << S m) = (n << m). Proof. intros n m. -rewrite def_ltb_step. rewrite (@recursion_succ bool (@eq bool)); try reflexivity. -unfold fun2_wd; intros; now apply def_ltb_wd. +rewrite ltb_step. rewrite recursion_succ; try reflexivity. +repeat red; intros; now apply ltb_wd. Qed. -Theorem def_ltb_lt : forall n m : N, n << m = true <-> n < m. +Theorem ltb_lt : forall n m, n << m = true <-> n < m. Proof. double_induct n m. cases m. -rewrite def_ltb_0. split; intro H; [discriminate H | false_hyp H nlt_0_r]. -intro n. rewrite def_ltb_0_succ. split; intro; [apply lt_0_succ | reflexivity]. -intro n. rewrite def_ltb_0. split; intro H; [discriminate | false_hyp H nlt_0_r]. -intros n m. rewrite succ_def_ltb_mono. now rewrite <- succ_lt_mono. +rewrite ltb_0. split; intro H; [discriminate H | false_hyp H nlt_0_r]. +intro n. rewrite ltb_0_succ. split; intro; [apply lt_0_succ | reflexivity]. +intro n. rewrite ltb_0. split; intro H; [discriminate | false_hyp H nlt_0_r]. +intros n m. rewrite succ_ltb_mono. now rewrite <- succ_lt_mono. +Qed. + +Theorem ltb_ge : forall n m, n << m = false <-> n >= m. +Proof. +intros. rewrite <- not_true_iff_false, ltb_lt. apply nlt_ge. Qed. -(* (*****************************************************) (** Even *) -Definition even (x : N) := recursion true (fun _ p => negb p) x. - -Lemma even_step_wd : fun2_wd Neq (@eq bool) (@eq bool) (fun x p => if p then false else true). -Proof. -unfold fun2_wd. -intros x x' Exx' b b' Ebb'. -unfold eq_bool; destruct b; destruct b'; now simpl. -Qed. +Definition even (x : N.t) := recursion true (fun _ p => negb p) x. -Add Morphism even with signature Neq ==> (@eq bool) as even_wd. +Instance even_wd : Proper (N.eq==>Logic.eq) even. Proof. -unfold even; intros. -apply recursion_wd with (A := bool) (Aeq := (@eq bool)). -now unfold eq_bool. -unfold fun2_eq. intros _ _ _ b b' Ebb'. unfold eq_bool; destruct b; destruct b'; now simpl. -assumption. +intros n n' Hn. unfold even. +apply recursion_wd; auto. +congruence. Qed. Theorem even_0 : even 0 = true. @@ -223,76 +199,281 @@ unfold even. now rewrite recursion_0. Qed. -Theorem even_succ : forall x : N, even (S x) = negb (even x). +Theorem even_succ : forall x, even (S x) = negb (even x). Proof. unfold even. -intro x; rewrite (recursion_succ (@eq bool)); try reflexivity. -unfold fun2_wd. -intros _ _ _ b b' Ebb'. destruct b; destruct b'; now simpl. +intro x; rewrite recursion_succ; try reflexivity. +congruence. Qed. (*****************************************************) (** Division by 2 *) -Definition half_aux (x : N) : N * N := - recursion (0, 0) (fun _ p => let (x1, x2) := p in ((S x2, x1))) x. +Local Notation "a <= b <= c" := (a<=b /\ b<=c). +Local Notation "a <= b < c" := (a<=b /\ b<c). +Local Notation "a < b <= c" := (a<b /\ b<=c). +Local Notation "a < b < c" := (a<b /\ b<c). +Local Notation "2" := (S 1). -Definition half (x : N) := snd (half_aux x). +Definition half_aux (x : N.t) : N.t * N.t := + recursion (0, 0) (fun _ p => let (x1, x2) := p in (S x2, x1)) x. -Definition E2 := prod_rel Neq Neq. +Definition half (x : N.t) := snd (half_aux x). -Add Relation (prod N N) E2 -reflexivity proved by (prod_rel_refl N N Neq Neq E_equiv E_equiv) -symmetry proved by (prod_rel_sym N N Neq Neq E_equiv E_equiv) -transitivity proved by (prod_rel_trans N N Neq Neq E_equiv E_equiv) -as E2_rel. +Instance half_aux_wd : Proper (N.eq ==> N.eq*N.eq) half_aux. +Proof. +intros x x' Hx. unfold half_aux. +apply recursion_wd; auto with *. +intros y y' Hy (u,v) (u',v') (Hu,Hv). compute in *. +rewrite Hu, Hv; auto with *. +Qed. -Lemma half_step_wd: fun2_wd Neq E2 E2 (fun _ p => let (x1, x2) := p in ((S x2, x1))). +Instance half_wd : Proper (N.eq==>N.eq) half. Proof. -unfold fun2_wd, E2, prod_rel. -intros _ _ _ p1 p2 [H1 H2]. -destruct p1; destruct p2; simpl in *. -now split; [rewrite H2 |]. +intros x x' Hx. unfold half. rewrite Hx; auto with *. Qed. -Add Morphism half with signature Neq ==> Neq as half_wd. +Lemma half_aux_0 : half_aux 0 = (0,0). Proof. -unfold half. -assert (H: forall x y, x == y -> E2 (half_aux x) (half_aux y)). -intros x y Exy; unfold half_aux; apply recursion_wd with (Aeq := E2); unfold E2. -unfold E2. -unfold prod_rel; simpl; now split. -unfold fun2_eq, prod_rel; simpl. -intros _ _ _ p1 p2; destruct p1; destruct p2; simpl. -intros [H1 H2]; split; [rewrite H2 | assumption]. reflexivity. assumption. -unfold E2, prod_rel in H. intros x y Exy; apply H in Exy. -exact (proj2 Exy). +unfold half_aux. rewrite recursion_0; auto. Qed. +Lemma half_aux_succ : forall x, + half_aux (S x) = (S (snd (half_aux x)), fst (half_aux x)). +Proof. +intros. +remember (half_aux x) as h. +destruct h as (f,s); simpl in *. +unfold half_aux in *. +rewrite recursion_succ, <- Heqh; simpl; auto. +repeat red; intros; subst; auto. +Qed. + +Theorem half_aux_spec : forall n, + n == fst (half_aux n) + snd (half_aux n). +Proof. +apply induction. +intros x x' Hx. setoid_rewrite Hx; auto with *. +rewrite half_aux_0; simpl; rewrite add_0_l; auto with *. +intros. +rewrite half_aux_succ. simpl. +rewrite add_succ_l, add_comm; auto. +apply succ_wd; auto. +Qed. + +Theorem half_aux_spec2 : forall n, + fst (half_aux n) == snd (half_aux n) \/ + fst (half_aux n) == S (snd (half_aux n)). +Proof. +apply induction. +intros x x' Hx. setoid_rewrite Hx; auto with *. +rewrite half_aux_0; simpl. auto with *. +intros. +rewrite half_aux_succ; simpl. +destruct H; auto with *. +right; apply succ_wd; auto with *. +Qed. + +Theorem half_0 : half 0 == 0. +Proof. +unfold half. rewrite half_aux_0; simpl; auto with *. +Qed. + +Theorem half_1 : half 1 == 0. +Proof. +unfold half. rewrite half_aux_succ, half_aux_0; simpl; auto with *. +Qed. + +Theorem half_double : forall n, + n == 2 * half n \/ n == 1 + 2 * half n. +Proof. +intros. unfold half. +nzsimpl. +destruct (half_aux_spec2 n) as [H|H]; [left|right]. +rewrite <- H at 1. apply half_aux_spec. +rewrite <- add_succ_l. rewrite <- H at 1. apply half_aux_spec. +Qed. + +Theorem half_upper_bound : forall n, 2 * half n <= n. +Proof. +intros. +destruct (half_double n) as [E|E]; rewrite E at 2. +apply le_refl. +nzsimpl. +apply le_le_succ_r, le_refl. +Qed. + +Theorem half_lower_bound : forall n, n <= 1 + 2 * half n. +Proof. +intros. +destruct (half_double n) as [E|E]; rewrite E at 1. +nzsimpl. +apply le_le_succ_r, le_refl. +apply le_refl. +Qed. + +Theorem half_nz : forall n, 1 < n -> 0 < half n. +Proof. +intros n LT. +assert (LE : 0 <= half n) by apply le_0_l. +le_elim LE; auto. +destruct (half_double n) as [E|E]; + rewrite <- LE, mul_0_r, ?add_0_r in E; rewrite E in LT. +destruct (nlt_0_r _ LT). +rewrite <- succ_lt_mono in LT. +destruct (nlt_0_r _ LT). +Qed. + +Theorem half_decrease : forall n, 0 < n -> half n < n. +Proof. +intros n LT. +destruct (half_double n) as [E|E]; rewrite E at 2; + rewrite ?mul_succ_l, ?mul_0_l, ?add_0_l, ?add_assoc. +rewrite <- add_0_l at 1. +rewrite <- add_lt_mono_r. +assert (LE : 0 <= half n) by apply le_0_l. +le_elim LE; auto. +rewrite <- LE, mul_0_r in E. rewrite E in LT. destruct (nlt_0_r _ LT). +rewrite <- add_0_l at 1. +rewrite <- add_lt_mono_r. +rewrite add_succ_l. apply lt_0_succ. +Qed. + + +(*****************************************************) +(** Power *) + +Definition pow (n m : N.t) := recursion 1 (fun _ r => n*r) m. + +Local Infix "^^" := pow (at level 30, right associativity). + +Instance pow_prewd : + Proper (N.eq==>N.eq==>N.eq==>N.eq) (fun n _ r => n*r). +Proof. +intros n n' Hn x x' Hx y y' Hy. rewrite Hn, Hy; auto with *. +Qed. + +Instance pow_wd : Proper (N.eq==>N.eq==>N.eq) pow. +Proof. +intros n n' Hn m m' Hm. unfold pow. +apply recursion_wd; auto with *. +now apply pow_prewd. +Qed. + +Lemma pow_0 : forall n, n^^0 == 1. +Proof. +intros. unfold pow. rewrite recursion_0. auto with *. +Qed. + +Lemma pow_succ : forall n m, n^^(S m) == n*(n^^m). +Proof. +intros. unfold pow. rewrite recursion_succ; auto with *. +now apply pow_prewd. +Qed. + + (*****************************************************) (** Logarithm for the base 2 *) -Definition log (x : N) : N := +Definition log (x : N.t) : N.t := strong_rec 0 - (fun x g => - if (e x 0) then 0 - else if (e x 1) then 0 + (fun g x => + if x << 2 then 0 else S (g (half x))) x. -Add Morphism log with signature Neq ==> Neq as log_wd. +Instance log_prewd : + Proper ((N.eq==>N.eq)==>N.eq==>N.eq) + (fun g x => if x<<2 then 0 else S (g (half x))). +Proof. +intros g g' Hg n n' Hn. +rewrite Hn. +destruct (n' << 2); auto with *. +apply succ_wd. +apply Hg. rewrite Hn; auto with *. +Qed. + +Instance log_wd : Proper (N.eq==>N.eq) log. Proof. intros x x' Exx'. unfold log. -apply strong_rec_wd with (Aeq := Neq); try (reflexivity || assumption). -unfold fun2_eq. intros y y' Eyy' g g' Egg'. -assert (H : e y 0 = e y' 0); [now apply e_wd|]. -rewrite <- H; clear H. -assert (H : e y 1 = e y' 1); [now apply e_wd|]. -rewrite <- H; clear H. -assert (H : S (g (half y)) == S (g' (half y'))); -[apply succ_wd; apply Egg'; now apply half_wd|]. -now destruct (e y 0); destruct (e y 1). +apply strong_rec_wd; auto with *. +apply log_prewd. Qed. + +Lemma log_good_step : forall n h1 h2, + (forall m, m < n -> h1 m == h2 m) -> + (if n << 2 then 0 else S (h1 (half n))) == + (if n << 2 then 0 else S (h2 (half n))). +Proof. +intros n h1 h2 E. +destruct (n<<2) as [ ]_eqn:H. +auto with *. +apply succ_wd, E, half_decrease. +rewrite <- not_true_iff_false, ltb_lt, nlt_ge, le_succ_l in H. +apply lt_succ_l; auto. +Qed. +Hint Resolve log_good_step. + +Theorem log_init : forall n, n < 2 -> log n == 0. +Proof. +intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *. +replace (n << 2) with true; auto with *. +symmetry. now rewrite ltb_lt. +Qed. + +Theorem log_step : forall n, 2 <= n -> log n == S (log (half n)). +Proof. +intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *. +replace (n << 2) with false; auto with *. +symmetry. rewrite <- not_true_iff_false, ltb_lt, nlt_ge; auto. +Qed. + +Theorem pow2_log : forall n, 0 < n -> half n < 2^^(log n) <= n. +Proof. +intro n; generalize (le_refl n). set (k:=n) at -2. clearbody k. +revert k. pattern n. apply induction; clear n. +intros n n' Hn; setoid_rewrite Hn; auto with *. +intros k Hk1 Hk2. + le_elim Hk1. destruct (nlt_0_r _ Hk1). + rewrite Hk1 in Hk2. destruct (nlt_0_r _ Hk2). + +intros n IH k Hk1 Hk2. +destruct (lt_ge_cases k 2) as [LT|LE]. +(* base *) +rewrite log_init, pow_0 by auto. +rewrite <- le_succ_l in Hk2. +le_elim Hk2. +rewrite <- nle_gt, le_succ_l in LT. destruct LT; auto. +rewrite <- Hk2. +rewrite half_1; auto using lt_0_1, le_refl. +(* step *) +rewrite log_step, pow_succ by auto. +rewrite le_succ_l in LE. +destruct (IH (half k)) as (IH1,IH2). + rewrite <- lt_succ_r. apply lt_le_trans with k; auto. + now apply half_decrease. + apply half_nz; auto. +set (K:=2^^log (half k)) in *; clearbody K. +split. +rewrite <- le_succ_l in IH1. +apply mul_le_mono_l with (p:=2) in IH1. +eapply lt_le_trans; eauto. +nzsimpl. +rewrite lt_succ_r. +eapply le_trans; [ eapply half_lower_bound | ]. +nzsimpl; apply le_refl. +eapply le_trans; [ | eapply half_upper_bound ]. +apply mul_le_mono_l; auto. +Qed. + +(** Later: + +Theorem log_mul : forall n m, 0 < n -> 0 < m -> + log (n*m) == log n + log m. + +Theorem log_pow2 : forall n, log (2^^n) = n. + *) + End NdefOpsPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NDiv.v b/theories/Numbers/Natural/Abstract/NDiv.v new file mode 100644 index 00000000..0cb5665a --- /dev/null +++ b/theories/Numbers/Natural/Abstract/NDiv.v @@ -0,0 +1,239 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(** Euclidean Division *) + +Require Import NAxioms NProperties NZDiv. + +Module Type NDivSpecific (Import N : NAxiomsSig')(Import DM : DivMod' N). + Axiom mod_upper_bound : forall a b, b ~= 0 -> a mod b < b. +End NDivSpecific. + +Module Type NDivSig := NAxiomsSig <+ DivMod <+ NZDivCommon <+ NDivSpecific. +Module Type NDivSig' := NAxiomsSig' <+ DivMod' <+ NZDivCommon <+ NDivSpecific. + +Module NDivPropFunct (Import N : NDivSig')(Import NP : NPropSig N). + +(** We benefit from what already exists for NZ *) + + Module ND <: NZDiv N. + Definition div := div. + Definition modulo := modulo. + Definition div_wd := div_wd. + Definition mod_wd := mod_wd. + Definition div_mod := div_mod. + Lemma mod_bound : forall a b, 0<=a -> 0<b -> 0 <= a mod b < b. + Proof. split. apply le_0_l. apply mod_upper_bound. order. Qed. + End ND. + Module Import NZDivP := NZDivPropFunct N NP ND. + + Ltac auto' := try rewrite <- neq_0_lt_0; auto using le_0_l. + +(** Let's now state again theorems, but without useless hypothesis. *) + +(** Uniqueness theorems *) + +Theorem div_mod_unique : + forall b q1 q2 r1 r2, r1<b -> r2<b -> + b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. +Proof. intros. apply div_mod_unique with b; auto'. Qed. + +Theorem div_unique: + forall a b q r, r<b -> a == b*q + r -> q == a/b. +Proof. intros; apply div_unique with r; auto'. Qed. + +Theorem mod_unique: + forall a b q r, r<b -> a == b*q + r -> r == a mod b. +Proof. intros. apply mod_unique with q; auto'. Qed. + +(** A division by itself returns 1 *) + +Lemma div_same : forall a, a~=0 -> a/a == 1. +Proof. intros. apply div_same; auto'. Qed. + +Lemma mod_same : forall a, a~=0 -> a mod a == 0. +Proof. intros. apply mod_same; auto'. Qed. + +(** A division of a small number by a bigger one yields zero. *) + +Theorem div_small: forall a b, a<b -> a/b == 0. +Proof. intros. apply div_small; auto'. Qed. + +(** Same situation, in term of modulo: *) + +Theorem mod_small: forall a b, a<b -> a mod b == a. +Proof. intros. apply mod_small; auto'. Qed. + +(** * Basic values of divisions and modulo. *) + +Lemma div_0_l: forall a, a~=0 -> 0/a == 0. +Proof. intros. apply div_0_l; auto'. Qed. + +Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. +Proof. intros. apply mod_0_l; auto'. Qed. + +Lemma div_1_r: forall a, a/1 == a. +Proof. intros. apply div_1_r; auto'. Qed. + +Lemma mod_1_r: forall a, a mod 1 == 0. +Proof. intros. apply mod_1_r; auto'. Qed. + +Lemma div_1_l: forall a, 1<a -> 1/a == 0. +Proof. exact div_1_l. Qed. + +Lemma mod_1_l: forall a, 1<a -> 1 mod a == 1. +Proof. exact mod_1_l. Qed. + +Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. +Proof. intros. apply div_mul; auto'. Qed. + +Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. +Proof. intros. apply mod_mul; auto'. Qed. + + +(** * Order results about mod and div *) + +(** A modulo cannot grow beyond its starting point. *) + +Theorem mod_le: forall a b, b~=0 -> a mod b <= a. +Proof. intros. apply mod_le; auto'. Qed. + +Lemma div_str_pos : forall a b, 0<b<=a -> 0 < a/b. +Proof. exact div_str_pos. Qed. + +Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> a<b). +Proof. intros. apply div_small_iff; auto'. Qed. + +Lemma mod_small_iff : forall a b, b~=0 -> (a mod b == a <-> a<b). +Proof. intros. apply mod_small_iff; auto'. Qed. + +Lemma div_str_pos_iff : forall a b, b~=0 -> (0<a/b <-> b<=a). +Proof. intros. apply div_str_pos_iff; auto'. Qed. + + +(** As soon as the divisor is strictly greater than 1, + the division is strictly decreasing. *) + +Lemma div_lt : forall a b, 0<a -> 1<b -> a/b < a. +Proof. exact div_lt. Qed. + +(** [le] is compatible with a positive division. *) + +Lemma div_le_mono : forall a b c, c~=0 -> a<=b -> a/c <= b/c. +Proof. intros. apply div_le_mono; auto'. Qed. + +Lemma mul_div_le : forall a b, b~=0 -> b*(a/b) <= a. +Proof. intros. apply mul_div_le; auto'. Qed. + +Lemma mul_succ_div_gt: forall a b, b~=0 -> a < b*(S (a/b)). +Proof. intros; apply mul_succ_div_gt; auto'. Qed. + +(** The previous inequality is exact iff the modulo is zero. *) + +Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). +Proof. intros. apply div_exact; auto'. Qed. + +(** Some additionnal inequalities about div. *) + +Theorem div_lt_upper_bound: + forall a b q, b~=0 -> a < b*q -> a/b < q. +Proof. intros. apply div_lt_upper_bound; auto'. Qed. + +Theorem div_le_upper_bound: + forall a b q, b~=0 -> a <= b*q -> a/b <= q. +Proof. intros; apply div_le_upper_bound; auto'. Qed. + +Theorem div_le_lower_bound: + forall a b q, b~=0 -> b*q <= a -> q <= a/b. +Proof. intros; apply div_le_lower_bound; auto'. Qed. + +(** A division respects opposite monotonicity for the divisor *) + +Lemma div_le_compat_l: forall p q r, 0<q<=r -> p/r <= p/q. +Proof. intros. apply div_le_compat_l. auto'. auto. Qed. + +(** * Relations between usual operations and mod and div *) + +Lemma mod_add : forall a b c, c~=0 -> + (a + b * c) mod c == a mod c. +Proof. intros. apply mod_add; auto'. Qed. + +Lemma div_add : forall a b c, c~=0 -> + (a + b * c) / c == a / c + b. +Proof. intros. apply div_add; auto'. Qed. + +Lemma div_add_l: forall a b c, b~=0 -> + (a * b + c) / b == a + c / b. +Proof. intros. apply div_add_l; auto'. Qed. + +(** Cancellations. *) + +Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> + (a*c)/(b*c) == a/b. +Proof. intros. apply div_mul_cancel_r; auto'. Qed. + +Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> + (c*a)/(c*b) == a/b. +Proof. intros. apply div_mul_cancel_l; auto'. Qed. + +Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 -> + (a*c) mod (b*c) == (a mod b) * c. +Proof. intros. apply mul_mod_distr_r; auto'. Qed. + +Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 -> + (c*a) mod (c*b) == c * (a mod b). +Proof. intros. apply mul_mod_distr_l; auto'. Qed. + +(** Operations modulo. *) + +Theorem mod_mod: forall a n, n~=0 -> + (a mod n) mod n == a mod n. +Proof. intros. apply mod_mod; auto'. Qed. + +Lemma mul_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)*b) mod n == (a*b) mod n. +Proof. intros. apply mul_mod_idemp_l; auto'. Qed. + +Lemma mul_mod_idemp_r : forall a b n, n~=0 -> + (a*(b mod n)) mod n == (a*b) mod n. +Proof. intros. apply mul_mod_idemp_r; auto'. Qed. + +Theorem mul_mod: forall a b n, n~=0 -> + (a * b) mod n == ((a mod n) * (b mod n)) mod n. +Proof. intros. apply mul_mod; auto'. Qed. + +Lemma add_mod_idemp_l : forall a b n, n~=0 -> + ((a mod n)+b) mod n == (a+b) mod n. +Proof. intros. apply add_mod_idemp_l; auto'. Qed. + +Lemma add_mod_idemp_r : forall a b n, n~=0 -> + (a+(b mod n)) mod n == (a+b) mod n. +Proof. intros. apply add_mod_idemp_r; auto'. Qed. + +Theorem add_mod: forall a b n, n~=0 -> + (a+b) mod n == (a mod n + b mod n) mod n. +Proof. intros. apply add_mod; auto'. Qed. + +Lemma div_div : forall a b c, b~=0 -> c~=0 -> + (a/b)/c == a/(b*c). +Proof. intros. apply div_div; auto'. Qed. + +(** A last inequality: *) + +Theorem div_mul_le: + forall a b c, b~=0 -> c*(a/b) <= (c*a)/b. +Proof. intros. apply div_mul_le; auto'. Qed. + +(** mod is related to divisibility *) + +Lemma mod_divides : forall a b, b~=0 -> + (a mod b == 0 <-> exists c, a == b*c). +Proof. intros. apply mod_divides; auto'. Qed. + +End NDivPropFunct. + diff --git a/theories/Numbers/Natural/Abstract/NIso.v b/theories/Numbers/Natural/Abstract/NIso.v index f6ccf3db..47bf38cb 100644 --- a/theories/Numbers/Natural/Abstract/NIso.v +++ b/theories/Numbers/Natural/Abstract/NIso.v @@ -8,51 +8,41 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NIso.v 10934 2008-05-15 21:58:20Z letouzey $ i*) +(*i $Id$ i*) Require Import NBase. -Module Homomorphism (NAxiomsMod1 NAxiomsMod2 : NAxiomsSig). +Module Homomorphism (N1 N2 : NAxiomsSig). -Module NBasePropMod2 := NBasePropFunct NAxiomsMod2. +Local Notation "n == m" := (N2.eq n m) (at level 70, no associativity). -Notation Local N1 := NAxiomsMod1.N. -Notation Local N2 := NAxiomsMod2.N. -Notation Local Eq1 := NAxiomsMod1.Neq. -Notation Local Eq2 := NAxiomsMod2.Neq. -Notation Local O1 := NAxiomsMod1.N0. -Notation Local O2 := NAxiomsMod2.N0. -Notation Local S1 := NAxiomsMod1.S. -Notation Local S2 := NAxiomsMod2.S. -Notation Local "n == m" := (Eq2 n m) (at level 70, no associativity). +Definition homomorphism (f : N1.t -> N2.t) : Prop := + f N1.zero == N2.zero /\ forall n, f (N1.succ n) == N2.succ (f n). -Definition homomorphism (f : N1 -> N2) : Prop := - f O1 == O2 /\ forall n : N1, f (S1 n) == S2 (f n). +Definition natural_isomorphism : N1.t -> N2.t := + N1.recursion N2.zero (fun (n : N1.t) (p : N2.t) => N2.succ p). -Definition natural_isomorphism : N1 -> N2 := - NAxiomsMod1.recursion O2 (fun (n : N1) (p : N2) => S2 p). - -Add Morphism natural_isomorphism with signature Eq1 ==> Eq2 as natural_isomorphism_wd. +Instance natural_isomorphism_wd : Proper (N1.eq ==> N2.eq) natural_isomorphism. Proof. unfold natural_isomorphism. intros n m Eqxy. -apply NAxiomsMod1.recursion_wd with (Aeq := Eq2). +apply N1.recursion_wd. reflexivity. -unfold fun2_eq. intros _ _ _ y' y'' H. now apply NBasePropMod2.succ_wd. +intros _ _ _ y' y'' H. now apply N2.succ_wd. assumption. Qed. -Theorem natural_isomorphism_0 : natural_isomorphism O1 == O2. +Theorem natural_isomorphism_0 : natural_isomorphism N1.zero == N2.zero. Proof. -unfold natural_isomorphism; now rewrite NAxiomsMod1.recursion_0. +unfold natural_isomorphism; now rewrite N1.recursion_0. Qed. Theorem natural_isomorphism_succ : - forall n : N1, natural_isomorphism (S1 n) == S2 (natural_isomorphism n). + forall n : N1.t, natural_isomorphism (N1.succ n) == N2.succ (natural_isomorphism n). Proof. unfold natural_isomorphism. -intro n. now rewrite (@NAxiomsMod1.recursion_succ N2 NAxiomsMod2.Neq) ; -[ | | unfold fun2_wd; intros; apply NBasePropMod2.succ_wd]. +intro n. rewrite N1.recursion_succ; auto with *. +repeat red; intros. apply N2.succ_wd; auto. Qed. Theorem hom_nat_iso : homomorphism natural_isomorphism. @@ -63,23 +53,20 @@ Qed. End Homomorphism. -Module Inverse (NAxiomsMod1 NAxiomsMod2 : NAxiomsSig). +Module Inverse (N1 N2 : NAxiomsSig). -Module Import NBasePropMod1 := NBasePropFunct NAxiomsMod1. +Module Import NBasePropMod1 := NBasePropFunct N1. (* This makes the tactic induct available. Since it is taken from (NBasePropFunct NAxiomsMod1), it refers to induction on N1. *) -Module Hom12 := Homomorphism NAxiomsMod1 NAxiomsMod2. -Module Hom21 := Homomorphism NAxiomsMod2 NAxiomsMod1. - -Notation Local N1 := NAxiomsMod1.N. -Notation Local N2 := NAxiomsMod2.N. -Notation Local h12 := Hom12.natural_isomorphism. -Notation Local h21 := Hom21.natural_isomorphism. +Module Hom12 := Homomorphism N1 N2. +Module Hom21 := Homomorphism N2 N1. -Notation Local "n == m" := (NAxiomsMod1.Neq n m) (at level 70, no associativity). +Local Notation h12 := Hom12.natural_isomorphism. +Local Notation h21 := Hom21.natural_isomorphism. +Local Notation "n == m" := (N1.eq n m) (at level 70, no associativity). -Lemma inverse_nat_iso : forall n : N1, h21 (h12 n) == n. +Lemma inverse_nat_iso : forall n : N1.t, h21 (h12 n) == n. Proof. induct n. now rewrite Hom12.natural_isomorphism_0, Hom21.natural_isomorphism_0. @@ -89,25 +76,20 @@ Qed. End Inverse. -Module Isomorphism (NAxiomsMod1 NAxiomsMod2 : NAxiomsSig). - -Module Hom12 := Homomorphism NAxiomsMod1 NAxiomsMod2. -Module Hom21 := Homomorphism NAxiomsMod2 NAxiomsMod1. +Module Isomorphism (N1 N2 : NAxiomsSig). -Module Inverse12 := Inverse NAxiomsMod1 NAxiomsMod2. -Module Inverse21 := Inverse NAxiomsMod2 NAxiomsMod1. +Module Hom12 := Homomorphism N1 N2. +Module Hom21 := Homomorphism N2 N1. +Module Inverse12 := Inverse N1 N2. +Module Inverse21 := Inverse N2 N1. -Notation Local N1 := NAxiomsMod1.N. -Notation Local N2 := NAxiomsMod2.N. -Notation Local Eq1 := NAxiomsMod1.Neq. -Notation Local Eq2 := NAxiomsMod2.Neq. -Notation Local h12 := Hom12.natural_isomorphism. -Notation Local h21 := Hom21.natural_isomorphism. +Local Notation h12 := Hom12.natural_isomorphism. +Local Notation h21 := Hom21.natural_isomorphism. -Definition isomorphism (f1 : N1 -> N2) (f2 : N2 -> N1) : Prop := +Definition isomorphism (f1 : N1.t -> N2.t) (f2 : N2.t -> N1.t) : Prop := Hom12.homomorphism f1 /\ Hom21.homomorphism f2 /\ - forall n : N1, Eq1 (f2 (f1 n)) n /\ - forall n : N2, Eq2 (f1 (f2 n)) n. + forall n, N1.eq (f2 (f1 n)) n /\ + forall n, N2.eq (f1 (f2 n)) n. Theorem iso_nat_iso : isomorphism h12 h21. Proof. diff --git a/theories/Numbers/Natural/Abstract/NMul.v b/theories/Numbers/Natural/Abstract/NMul.v deleted file mode 100644 index 0b00f689..00000000 --- a/theories/Numbers/Natural/Abstract/NMul.v +++ /dev/null @@ -1,87 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(* Evgeny Makarov, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: NMul.v 11040 2008-06-03 00:04:16Z letouzey $ i*) - -Require Export NAdd. - -Module NMulPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NAddPropMod := NAddPropFunct NAxiomsMod. -Open Local Scope NatScope. - -Theorem mul_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> n1 * m1 == n2 * m2. -Proof NZmul_wd. - -Theorem mul_0_l : forall n : N, 0 * n == 0. -Proof NZmul_0_l. - -Theorem mul_succ_l : forall n m : N, (S n) * m == n * m + m. -Proof NZmul_succ_l. - -(** Theorems that are valid for both natural numbers and integers *) - -Theorem mul_0_r : forall n, n * 0 == 0. -Proof NZmul_0_r. - -Theorem mul_succ_r : forall n m, n * (S m) == n * m + n. -Proof NZmul_succ_r. - -Theorem mul_comm : forall n m : N, n * m == m * n. -Proof NZmul_comm. - -Theorem mul_add_distr_r : forall n m p : N, (n + m) * p == n * p + m * p. -Proof NZmul_add_distr_r. - -Theorem mul_add_distr_l : forall n m p : N, n * (m + p) == n * m + n * p. -Proof NZmul_add_distr_l. - -Theorem mul_assoc : forall n m p : N, n * (m * p) == (n * m) * p. -Proof NZmul_assoc. - -Theorem mul_1_l : forall n : N, 1 * n == n. -Proof NZmul_1_l. - -Theorem mul_1_r : forall n : N, n * 1 == n. -Proof NZmul_1_r. - -(* Theorems that cannot be proved in NZMul *) - -(* In proving the correctness of the definition of multiplication on -integers constructed from pairs of natural numbers, we'll need the -following fact about natural numbers: - -a * n + u == a * m + v -> n + m' == n' + m -> a * n' + u = a * m' + v - -Here n + m' == n' + m expresses equality of integers (n, m) and (n', m'), -since a pair (a, b) of natural numbers represents the integer a - b. On -integers, the formula above could be proved by moving a * m to the left, -factoring out a and replacing n - m by n' - m'. However, the formula is -required in the process of constructing integers, so it has to be proved -for natural numbers, where terms cannot be moved from one side of an -equation to the other. The proof uses the cancellation laws add_cancel_l -and add_cancel_r. *) - -Theorem add_mul_repl_pair : forall a n m n' m' u v : N, - a * n + u == a * m + v -> n + m' == n' + m -> a * n' + u == a * m' + v. -Proof. -intros a n m n' m' u v H1 H2. -apply (@NZmul_wd a a) in H2; [| reflexivity]. -do 2 rewrite mul_add_distr_l in H2. symmetry in H2. -pose proof (NZadd_wd _ _ H1 _ _ H2) as H3. -rewrite (add_shuffle1 (a * m)), (add_comm (a * m) (a * n)) in H3. -do 2 rewrite <- add_assoc in H3. apply -> add_cancel_l in H3. -rewrite (add_assoc u), (add_comm (a * m)) in H3. -apply -> add_cancel_r in H3. -now rewrite (add_comm (a * n') u), (add_comm (a * m') v). -Qed. - -End NMulPropFunct. - diff --git a/theories/Numbers/Natural/Abstract/NMulOrder.v b/theories/Numbers/Natural/Abstract/NMulOrder.v index aa21fb50..a2162b13 100644 --- a/theories/Numbers/Natural/Abstract/NMulOrder.v +++ b/theories/Numbers/Natural/Abstract/NMulOrder.v @@ -8,122 +8,71 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NMulOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NAddOrder. -Module NMulOrderPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NAddOrderPropMod := NAddOrderPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NMulOrderPropFunct (Import N : NAxiomsSig'). +Include NAddOrderPropFunct N. -Theorem mul_lt_pred : - forall p q n m : N, S p == q -> (p * n < p * m <-> q * n + m < q * m + n). -Proof NZmul_lt_pred. +(** Theorems that are either not valid on Z or have different proofs + on N and Z *) -Theorem mul_lt_mono_pos_l : forall p n m : N, 0 < p -> (n < m <-> p * n < p * m). -Proof NZmul_lt_mono_pos_l. - -Theorem mul_lt_mono_pos_r : forall p n m : N, 0 < p -> (n < m <-> n * p < m * p). -Proof NZmul_lt_mono_pos_r. - -Theorem mul_cancel_l : forall n m p : N, p ~= 0 -> (p * n == p * m <-> n == m). -Proof NZmul_cancel_l. - -Theorem mul_cancel_r : forall n m p : N, p ~= 0 -> (n * p == m * p <-> n == m). -Proof NZmul_cancel_r. - -Theorem mul_id_l : forall n m : N, m ~= 0 -> (n * m == m <-> n == 1). -Proof NZmul_id_l. - -Theorem mul_id_r : forall n m : N, n ~= 0 -> (n * m == n <-> m == 1). -Proof NZmul_id_r. - -Theorem mul_le_mono_pos_l : forall n m p : N, 0 < p -> (n <= m <-> p * n <= p * m). -Proof NZmul_le_mono_pos_l. - -Theorem mul_le_mono_pos_r : forall n m p : N, 0 < p -> (n <= m <-> n * p <= m * p). -Proof NZmul_le_mono_pos_r. - -Theorem mul_pos_pos : forall n m : N, 0 < n -> 0 < m -> 0 < n * m. -Proof NZmul_pos_pos. - -Theorem lt_1_mul_pos : forall n m : N, 1 < n -> 0 < m -> 1 < n * m. -Proof NZlt_1_mul_pos. - -Theorem eq_mul_0 : forall n m : N, n * m == 0 <-> n == 0 \/ m == 0. -Proof NZeq_mul_0. - -Theorem neq_mul_0 : forall n m : N, n ~= 0 /\ m ~= 0 <-> n * m ~= 0. -Proof NZneq_mul_0. - -Theorem eq_square_0 : forall n : N, n * n == 0 <-> n == 0. -Proof NZeq_square_0. - -Theorem eq_mul_0_l : forall n m : N, n * m == 0 -> m ~= 0 -> n == 0. -Proof NZeq_mul_0_l. - -Theorem eq_mul_0_r : forall n m : N, n * m == 0 -> n ~= 0 -> m == 0. -Proof NZeq_mul_0_r. - -Theorem square_lt_mono : forall n m : N, n < m <-> n * n < m * m. +Theorem square_lt_mono : forall n m, n < m <-> n * n < m * m. Proof. intros n m; split; intro; -[apply NZsquare_lt_mono_nonneg | apply NZsquare_lt_simpl_nonneg]; +[apply square_lt_mono_nonneg | apply square_lt_simpl_nonneg]; try assumption; apply le_0_l. Qed. -Theorem square_le_mono : forall n m : N, n <= m <-> n * n <= m * m. +Theorem square_le_mono : forall n m, n <= m <-> n * n <= m * m. Proof. intros n m; split; intro; -[apply NZsquare_le_mono_nonneg | apply NZsquare_le_simpl_nonneg]; +[apply square_le_mono_nonneg | apply square_le_simpl_nonneg]; try assumption; apply le_0_l. Qed. -Theorem mul_2_mono_l : forall n m : N, n < m -> 1 + (1 + 1) * n < (1 + 1) * m. -Proof NZmul_2_mono_l. - -(* Theorems that are either not valid on Z or have different proofs on N and Z *) - -Theorem mul_le_mono_l : forall n m p : N, n <= m -> p * n <= p * m. +Theorem mul_le_mono_l : forall n m p, n <= m -> p * n <= p * m. Proof. -intros; apply NZmul_le_mono_nonneg_l. apply le_0_l. assumption. +intros; apply mul_le_mono_nonneg_l. apply le_0_l. assumption. Qed. -Theorem mul_le_mono_r : forall n m p : N, n <= m -> n * p <= m * p. +Theorem mul_le_mono_r : forall n m p, n <= m -> n * p <= m * p. Proof. -intros; apply NZmul_le_mono_nonneg_r. apply le_0_l. assumption. +intros; apply mul_le_mono_nonneg_r. apply le_0_l. assumption. Qed. -Theorem mul_lt_mono : forall n m p q : N, n < m -> p < q -> n * p < m * q. +Theorem mul_lt_mono : forall n m p q, n < m -> p < q -> n * p < m * q. Proof. -intros; apply NZmul_lt_mono_nonneg; try assumption; apply le_0_l. +intros; apply mul_lt_mono_nonneg; try assumption; apply le_0_l. Qed. -Theorem mul_le_mono : forall n m p q : N, n <= m -> p <= q -> n * p <= m * q. +Theorem mul_le_mono : forall n m p q, n <= m -> p <= q -> n * p <= m * q. Proof. -intros; apply NZmul_le_mono_nonneg; try assumption; apply le_0_l. +intros; apply mul_le_mono_nonneg; try assumption; apply le_0_l. Qed. -Theorem lt_0_mul : forall n m : N, n * m > 0 <-> n > 0 /\ m > 0. +Theorem lt_0_mul' : forall n m, n * m > 0 <-> n > 0 /\ m > 0. Proof. intros n m; split; [intro H | intros [H1 H2]]. -apply -> NZlt_0_mul in H. destruct H as [[H1 H2] | [H1 H2]]. now split. false_hyp H1 nlt_0_r. -now apply NZmul_pos_pos. +apply -> lt_0_mul in H. destruct H as [[H1 H2] | [H1 H2]]. now split. + false_hyp H1 nlt_0_r. +now apply mul_pos_pos. Qed. -Notation mul_pos := lt_0_mul (only parsing). +Notation mul_pos := lt_0_mul' (only parsing). -Theorem eq_mul_1 : forall n m : N, n * m == 1 <-> n == 1 /\ m == 1. +Theorem eq_mul_1 : forall n m, n * m == 1 <-> n == 1 /\ m == 1. Proof. intros n m. split; [| intros [H1 H2]; now rewrite H1, H2, mul_1_l]. -intro H; destruct (NZlt_trichotomy n 1) as [H1 | [H1 | H1]]. +intro H; destruct (lt_trichotomy n 1) as [H1 | [H1 | H1]]. apply -> lt_1_r in H1. rewrite H1, mul_0_l in H. false_hyp H neq_0_succ. rewrite H1, mul_1_l in H; now split. destruct (eq_0_gt_0_cases m) as [H2 | H2]. rewrite H2, mul_0_r in H; false_hyp H neq_0_succ. apply -> (mul_lt_mono_pos_r m) in H1; [| assumption]. rewrite mul_1_l in H1. -assert (H3 : 1 < n * m) by now apply (lt_1_l 0 m). +assert (H3 : 1 < n * m) by now apply (lt_1_l m). rewrite H in H3; false_hyp H3 lt_irrefl. Qed. diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v index 15aed7ab..090c02ec 100644 --- a/theories/Numbers/Natural/Abstract/NOrder.v +++ b/theories/Numbers/Natural/Abstract/NOrder.v @@ -8,355 +8,62 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NOrder.v 11282 2008-07-28 11:51:53Z msozeau $ i*) +(*i $Id$ i*) -Require Export NMul. +Require Export NAdd. -Module NOrderPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NMulPropMod := NMulPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NOrderPropFunct (Import N : NAxiomsSig'). +Include NAddPropFunct N. -(* The tactics le_less, le_equal and le_elim are inherited from NZOrder.v *) - -(* Axioms *) - -Theorem lt_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> (n1 < m1 <-> n2 < m2). -Proof NZlt_wd. - -Theorem le_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> (n1 <= m1 <-> n2 <= m2). -Proof NZle_wd. - -Theorem min_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> min n1 m1 == min n2 m2. -Proof NZmin_wd. - -Theorem max_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> max n1 m1 == max n2 m2. -Proof NZmax_wd. - -Theorem lt_eq_cases : forall n m : N, n <= m <-> n < m \/ n == m. -Proof NZlt_eq_cases. - -Theorem lt_irrefl : forall n : N, ~ n < n. -Proof NZlt_irrefl. - -Theorem lt_succ_r : forall n m : N, n < S m <-> n <= m. -Proof NZlt_succ_r. - -Theorem min_l : forall n m : N, n <= m -> min n m == n. -Proof NZmin_l. - -Theorem min_r : forall n m : N, m <= n -> min n m == m. -Proof NZmin_r. - -Theorem max_l : forall n m : N, m <= n -> max n m == n. -Proof NZmax_l. - -Theorem max_r : forall n m : N, n <= m -> max n m == m. -Proof NZmax_r. - -(* Renaming theorems from NZOrder.v *) - -Theorem lt_le_incl : forall n m : N, n < m -> n <= m. -Proof NZlt_le_incl. - -Theorem eq_le_incl : forall n m : N, n == m -> n <= m. -Proof NZeq_le_incl. - -Theorem lt_neq : forall n m : N, n < m -> n ~= m. -Proof NZlt_neq. - -Theorem le_neq : forall n m : N, n < m <-> n <= m /\ n ~= m. -Proof NZle_neq. - -Theorem le_refl : forall n : N, n <= n. -Proof NZle_refl. - -Theorem lt_succ_diag_r : forall n : N, n < S n. -Proof NZlt_succ_diag_r. - -Theorem le_succ_diag_r : forall n : N, n <= S n. -Proof NZle_succ_diag_r. - -Theorem lt_0_1 : 0 < 1. -Proof NZlt_0_1. - -Theorem le_0_1 : 0 <= 1. -Proof NZle_0_1. - -Theorem lt_lt_succ_r : forall n m : N, n < m -> n < S m. -Proof NZlt_lt_succ_r. - -Theorem le_le_succ_r : forall n m : N, n <= m -> n <= S m. -Proof NZle_le_succ_r. - -Theorem le_succ_r : forall n m : N, n <= S m <-> n <= m \/ n == S m. -Proof NZle_succ_r. - -Theorem neq_succ_diag_l : forall n : N, S n ~= n. -Proof NZneq_succ_diag_l. - -Theorem neq_succ_diag_r : forall n : N, n ~= S n. -Proof NZneq_succ_diag_r. - -Theorem nlt_succ_diag_l : forall n : N, ~ S n < n. -Proof NZnlt_succ_diag_l. - -Theorem nle_succ_diag_l : forall n : N, ~ S n <= n. -Proof NZnle_succ_diag_l. - -Theorem le_succ_l : forall n m : N, S n <= m <-> n < m. -Proof NZle_succ_l. - -Theorem lt_succ_l : forall n m : N, S n < m -> n < m. -Proof NZlt_succ_l. - -Theorem succ_lt_mono : forall n m : N, n < m <-> S n < S m. -Proof NZsucc_lt_mono. - -Theorem succ_le_mono : forall n m : N, n <= m <-> S n <= S m. -Proof NZsucc_le_mono. - -Theorem lt_asymm : forall n m : N, n < m -> ~ m < n. -Proof NZlt_asymm. - -Notation lt_ngt := lt_asymm (only parsing). - -Theorem lt_trans : forall n m p : N, n < m -> m < p -> n < p. -Proof NZlt_trans. - -Theorem le_trans : forall n m p : N, n <= m -> m <= p -> n <= p. -Proof NZle_trans. - -Theorem le_lt_trans : forall n m p : N, n <= m -> m < p -> n < p. -Proof NZle_lt_trans. - -Theorem lt_le_trans : forall n m p : N, n < m -> m <= p -> n < p. -Proof NZlt_le_trans. - -Theorem le_antisymm : forall n m : N, n <= m -> m <= n -> n == m. -Proof NZle_antisymm. - -(** Trichotomy, decidability, and double negation elimination *) - -Theorem lt_trichotomy : forall n m : N, n < m \/ n == m \/ m < n. -Proof NZlt_trichotomy. - -Notation lt_eq_gt_cases := lt_trichotomy (only parsing). - -Theorem lt_gt_cases : forall n m : N, n ~= m <-> n < m \/ n > m. -Proof NZlt_gt_cases. - -Theorem le_gt_cases : forall n m : N, n <= m \/ n > m. -Proof NZle_gt_cases. - -Theorem lt_ge_cases : forall n m : N, n < m \/ n >= m. -Proof NZlt_ge_cases. - -Theorem le_ge_cases : forall n m : N, n <= m \/ n >= m. -Proof NZle_ge_cases. - -Theorem le_ngt : forall n m : N, n <= m <-> ~ n > m. -Proof NZle_ngt. - -Theorem nlt_ge : forall n m : N, ~ n < m <-> n >= m. -Proof NZnlt_ge. - -Theorem lt_dec : forall n m : N, decidable (n < m). -Proof NZlt_dec. - -Theorem lt_dne : forall n m : N, ~ ~ n < m <-> n < m. -Proof NZlt_dne. - -Theorem nle_gt : forall n m : N, ~ n <= m <-> n > m. -Proof NZnle_gt. - -Theorem lt_nge : forall n m : N, n < m <-> ~ n >= m. -Proof NZlt_nge. - -Theorem le_dec : forall n m : N, decidable (n <= m). -Proof NZle_dec. - -Theorem le_dne : forall n m : N, ~ ~ n <= m <-> n <= m. -Proof NZle_dne. - -Theorem nlt_succ_r : forall n m : N, ~ m < S n <-> n < m. -Proof NZnlt_succ_r. - -Theorem lt_exists_pred : - forall z n : N, z < n -> exists k : N, n == S k /\ z <= k. -Proof NZlt_exists_pred. - -Theorem lt_succ_iter_r : - forall (n : nat) (m : N), m < NZsucc_iter (Datatypes.S n) m. -Proof NZlt_succ_iter_r. - -Theorem neq_succ_iter_l : - forall (n : nat) (m : N), NZsucc_iter (Datatypes.S n) m ~= m. -Proof NZneq_succ_iter_l. - -(** Stronger variant of induction with assumptions n >= 0 (n < 0) -in the induction step *) - -Theorem right_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, z <= n -> A n -> A (S n)) -> - forall n : N, z <= n -> A n. -Proof NZright_induction. - -Theorem left_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, n < z -> A (S n) -> A n) -> - forall n : N, n <= z -> A n. -Proof NZleft_induction. - -Theorem right_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, n <= z -> A n) -> - (forall n : N, z <= n -> A n -> A (S n)) -> - forall n : N, A n. -Proof NZright_induction'. - -Theorem left_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, z <= n -> A n) -> - (forall n : N, n < z -> A (S n) -> A n) -> - forall n : N, A n. -Proof NZleft_induction'. - -Theorem strong_right_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, z <= n -> (forall m : N, z <= m -> m < n -> A m) -> A n) -> - forall n : N, z <= n -> A n. -Proof NZstrong_right_induction. - -Theorem strong_left_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, n <= z -> (forall m : N, m <= z -> S n <= m -> A m) -> A n) -> - forall n : N, n <= z -> A n. -Proof NZstrong_left_induction. - -Theorem strong_right_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, n <= z -> A n) -> - (forall n : N, z <= n -> (forall m : N, z <= m -> m < n -> A m) -> A n) -> - forall n : N, A n. -Proof NZstrong_right_induction'. - -Theorem strong_left_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, - (forall n : N, z <= n -> A n) -> - (forall n : N, n <= z -> (forall m : N, m <= z -> S n <= m -> A m) -> A n) -> - forall n : N, A n. -Proof NZstrong_left_induction'. - -Theorem order_induction : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, z <= n -> A n -> A (S n)) -> - (forall n : N, n < z -> A (S n) -> A n) -> - forall n : N, A n. -Proof NZorder_induction. - -Theorem order_induction' : - forall A : N -> Prop, predicate_wd Neq A -> - forall z : N, A z -> - (forall n : N, z <= n -> A n -> A (S n)) -> - (forall n : N, n <= z -> A n -> A (P n)) -> - forall n : N, A n. -Proof NZorder_induction'. - -(* We don't need order_induction_0 and order_induction'_0 (see NZOrder and -ZOrder) since they boil down to regular induction *) - -(** Elimintation principle for < *) - -Theorem lt_ind : - forall A : N -> Prop, predicate_wd Neq A -> - forall n : N, - A (S n) -> - (forall m : N, n < m -> A m -> A (S m)) -> - forall m : N, n < m -> A m. -Proof NZlt_ind. - -(** Elimintation principle for <= *) - -Theorem le_ind : - forall A : N -> Prop, predicate_wd Neq A -> - forall n : N, - A n -> - (forall m : N, n <= m -> A m -> A (S m)) -> - forall m : N, n <= m -> A m. -Proof NZle_ind. - -(** Well-founded relations *) - -Theorem lt_wf : forall z : N, well_founded (fun n m : N => z <= n /\ n < m). -Proof NZlt_wf. - -Theorem gt_wf : forall z : N, well_founded (fun n m : N => m < n /\ n <= z). -Proof NZgt_wf. +(* Theorems that are true for natural numbers but not for integers *) Theorem lt_wf_0 : well_founded lt. Proof. -setoid_replace lt with (fun n m : N => 0 <= n /\ n < m) - using relation (@relations_eq N N). +setoid_replace lt with (fun n m => 0 <= n /\ n < m). apply lt_wf. intros x y; split. intro H; split; [apply le_0_l | assumption]. now intros [_ H]. Defined. -(* Theorems that are true for natural numbers but not for integers *) - (* "le_0_l : forall n : N, 0 <= n" was proved in NBase.v *) -Theorem nlt_0_r : forall n : N, ~ n < 0. +Theorem nlt_0_r : forall n, ~ n < 0. Proof. intro n; apply -> le_ngt. apply le_0_l. Qed. -Theorem nle_succ_0 : forall n : N, ~ (S n <= 0). +Theorem nle_succ_0 : forall n, ~ (S n <= 0). Proof. intros n H; apply -> le_succ_l in H; false_hyp H nlt_0_r. Qed. -Theorem le_0_r : forall n : N, n <= 0 <-> n == 0. +Theorem le_0_r : forall n, n <= 0 <-> n == 0. Proof. intros n; split; intro H. le_elim H; [false_hyp H nlt_0_r | assumption]. now apply eq_le_incl. Qed. -Theorem lt_0_succ : forall n : N, 0 < S n. +Theorem lt_0_succ : forall n, 0 < S n. Proof. induct n; [apply lt_succ_diag_r | intros n H; now apply lt_lt_succ_r]. Qed. -Theorem neq_0_lt_0 : forall n : N, n ~= 0 <-> 0 < n. +Theorem neq_0_lt_0 : forall n, n ~= 0 <-> 0 < n. Proof. cases n. split; intro H; [now elim H | intro; now apply lt_irrefl with 0]. intro n; split; intro H; [apply lt_0_succ | apply neq_succ_0]. Qed. -Theorem eq_0_gt_0_cases : forall n : N, n == 0 \/ 0 < n. +Theorem eq_0_gt_0_cases : forall n, n == 0 \/ 0 < n. Proof. cases n. now left. intro; right; apply lt_0_succ. Qed. -Theorem zero_one : forall n : N, n == 0 \/ n == 1 \/ 1 < n. +Theorem zero_one : forall n, n == 0 \/ n == 1 \/ 1 < n. Proof. induct n. now left. cases n. intros; right; now left. @@ -366,7 +73,7 @@ right; right. rewrite H. apply lt_succ_diag_r. right; right. now apply lt_lt_succ_r. Qed. -Theorem lt_1_r : forall n : N, n < 1 <-> n == 0. +Theorem lt_1_r : forall n, n < 1 <-> n == 0. Proof. cases n. split; intro; [reflexivity | apply lt_succ_diag_r]. @@ -374,7 +81,7 @@ intros n. rewrite <- succ_lt_mono. split; intro H; [false_hyp H nlt_0_r | false_hyp H neq_succ_0]. Qed. -Theorem le_1_r : forall n : N, n <= 1 <-> n == 0 \/ n == 1. +Theorem le_1_r : forall n, n <= 1 <-> n == 0 \/ n == 1. Proof. cases n. split; intro; [now left | apply le_succ_diag_r]. @@ -382,36 +89,30 @@ intro n. rewrite <- succ_le_mono, le_0_r, succ_inj_wd. split; [intro; now right | intros [H | H]; [false_hyp H neq_succ_0 | assumption]]. Qed. -Theorem lt_lt_0 : forall n m : N, n < m -> 0 < m. +Theorem lt_lt_0 : forall n m, n < m -> 0 < m. Proof. intros n m; induct n. trivial. intros n IH H. apply IH; now apply lt_succ_l. Qed. -Theorem lt_1_l : forall n m p : N, n < m -> m < p -> 1 < p. +Theorem lt_1_l' : forall n m p, n < m -> m < p -> 1 < p. Proof. -intros n m p H1 H2. -apply le_lt_trans with m. apply <- le_succ_l. apply le_lt_trans with n. -apply le_0_l. assumption. assumption. +intros. apply lt_1_l with m; auto. +apply le_lt_trans with n; auto. now apply le_0_l. Qed. (** Elimination principlies for < and <= for relations *) Section RelElim. -(* FIXME: Variable R : relation N. -- does not work *) - -Variable R : N -> N -> Prop. -Hypothesis R_wd : relation_wd Neq Neq R. - -Add Morphism R with signature Neq ==> Neq ==> iff as R_morph2. -Proof. apply R_wd. Qed. +Variable R : relation N.t. +Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem le_ind_rel : - (forall m : N, R 0 m) -> - (forall n m : N, n <= m -> R n m -> R (S n) (S m)) -> - forall n m : N, n <= m -> R n m. + (forall m, R 0 m) -> + (forall n m, n <= m -> R n m -> R (S n) (S m)) -> + forall n m, n <= m -> R n m. Proof. intros Base Step; induct n. intros; apply Base. @@ -422,9 +123,9 @@ intros k H1 H2. apply -> le_succ_l in H1. apply lt_le_incl in H1. auto. Qed. Theorem lt_ind_rel : - (forall m : N, R 0 (S m)) -> - (forall n m : N, n < m -> R n m -> R (S n) (S m)) -> - forall n m : N, n < m -> R n m. + (forall m, R 0 (S m)) -> + (forall n m, n < m -> R n m -> R (S n) (S m)) -> + forall n m, n < m -> R n m. Proof. intros Base Step; induct n. intros m H. apply lt_exists_pred in H; destruct H as [m' [H _]]. @@ -439,61 +140,64 @@ End RelElim. (** Predecessor and order *) -Theorem succ_pred_pos : forall n : N, 0 < n -> S (P n) == n. +Theorem succ_pred_pos : forall n, 0 < n -> S (P n) == n. Proof. intros n H; apply succ_pred; intro H1; rewrite H1 in H. false_hyp H lt_irrefl. Qed. -Theorem le_pred_l : forall n : N, P n <= n. +Theorem le_pred_l : forall n, P n <= n. Proof. cases n. rewrite pred_0; now apply eq_le_incl. intros; rewrite pred_succ; apply le_succ_diag_r. Qed. -Theorem lt_pred_l : forall n : N, n ~= 0 -> P n < n. +Theorem lt_pred_l : forall n, n ~= 0 -> P n < n. Proof. cases n. -intro H; elimtype False; now apply H. +intro H; exfalso; now apply H. intros; rewrite pred_succ; apply lt_succ_diag_r. Qed. -Theorem le_le_pred : forall n m : N, n <= m -> P n <= m. +Theorem le_le_pred : forall n m, n <= m -> P n <= m. Proof. intros n m H; apply le_trans with n. apply le_pred_l. assumption. Qed. -Theorem lt_lt_pred : forall n m : N, n < m -> P n < m. +Theorem lt_lt_pred : forall n m, n < m -> P n < m. Proof. intros n m H; apply le_lt_trans with n. apply le_pred_l. assumption. Qed. -Theorem lt_le_pred : forall n m : N, n < m -> n <= P m. (* Converse is false for n == m == 0 *) +Theorem lt_le_pred : forall n m, n < m -> n <= P m. + (* Converse is false for n == m == 0 *) Proof. intro n; cases m. intro H; false_hyp H nlt_0_r. intros m IH. rewrite pred_succ; now apply -> lt_succ_r. Qed. -Theorem lt_pred_le : forall n m : N, P n < m -> n <= m. (* Converse is false for n == m == 0 *) +Theorem lt_pred_le : forall n m, P n < m -> n <= m. + (* Converse is false for n == m == 0 *) Proof. intros n m; cases n. rewrite pred_0; intro H; now apply lt_le_incl. intros n IH. rewrite pred_succ in IH. now apply <- le_succ_l. Qed. -Theorem lt_pred_lt : forall n m : N, n < P m -> n < m. +Theorem lt_pred_lt : forall n m, n < P m -> n < m. Proof. intros n m H; apply lt_le_trans with (P m); [assumption | apply le_pred_l]. Qed. -Theorem le_pred_le : forall n m : N, n <= P m -> n <= m. +Theorem le_pred_le : forall n m, n <= P m -> n <= m. Proof. intros n m H; apply le_trans with (P m); [assumption | apply le_pred_l]. Qed. -Theorem pred_le_mono : forall n m : N, n <= m -> P n <= P m. (* Converse is false for n == 1, m == 0 *) +Theorem pred_le_mono : forall n m, n <= m -> P n <= P m. + (* Converse is false for n == 1, m == 0 *) Proof. intros n m H; elim H using le_ind_rel. solve_relation_wd. @@ -501,7 +205,7 @@ intro; rewrite pred_0; apply le_0_l. intros p q H1 _; now do 2 rewrite pred_succ. Qed. -Theorem pred_lt_mono : forall n m : N, n ~= 0 -> (n < m <-> P n < P m). +Theorem pred_lt_mono : forall n m, n ~= 0 -> (n < m <-> P n < P m). Proof. intros n m H1; split; intro H2. assert (m ~= 0). apply <- neq_0_lt_0. now apply lt_lt_0 with n. @@ -512,22 +216,24 @@ apply lt_le_trans with (P m). assumption. apply le_pred_l. apply -> succ_lt_mono in H2. now do 2 rewrite succ_pred in H2. Qed. -Theorem lt_succ_lt_pred : forall n m : N, S n < m <-> n < P m. +Theorem lt_succ_lt_pred : forall n m, S n < m <-> n < P m. Proof. intros n m. rewrite pred_lt_mono by apply neq_succ_0. now rewrite pred_succ. Qed. -Theorem le_succ_le_pred : forall n m : N, S n <= m -> n <= P m. (* Converse is false for n == m == 0 *) +Theorem le_succ_le_pred : forall n m, S n <= m -> n <= P m. + (* Converse is false for n == m == 0 *) Proof. intros n m H. apply lt_le_pred. now apply -> le_succ_l. Qed. -Theorem lt_pred_lt_succ : forall n m : N, P n < m -> n < S m. (* Converse is false for n == m == 0 *) +Theorem lt_pred_lt_succ : forall n m, P n < m -> n < S m. + (* Converse is false for n == m == 0 *) Proof. intros n m H. apply <- lt_succ_r. now apply lt_pred_le. Qed. -Theorem le_pred_le_succ : forall n m : N, P n <= m <-> n <= S m. +Theorem le_pred_le_succ : forall n m, P n <= m <-> n <= S m. Proof. intros n m; cases n. rewrite pred_0. split; intro H; apply le_0_l. diff --git a/theories/Numbers/Natural/Abstract/NProperties.v b/theories/Numbers/Natural/Abstract/NProperties.v new file mode 100644 index 00000000..30262bd9 --- /dev/null +++ b/theories/Numbers/Natural/Abstract/NProperties.v @@ -0,0 +1,22 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id$ i*) + +Require Export NAxioms NSub. + +(** This functor summarizes all known facts about N. + For the moment it is only an alias to [NSubPropFunct], which + subsumes all others. +*) + +Module Type NPropSig := NSubPropFunct. + +Module NPropFunct (N:NAxiomsSig) <: NPropSig N. + Include NPropSig N. +End NPropFunct. diff --git a/theories/Numbers/Natural/Abstract/NStrongRec.v b/theories/Numbers/Natural/Abstract/NStrongRec.v index c6a6da48..cbbcdbff 100644 --- a/theories/Numbers/Natural/Abstract/NStrongRec.v +++ b/theories/Numbers/Natural/Abstract/NStrongRec.v @@ -8,123 +8,200 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NStrongRec.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) (** This file defined the strong (course-of-value, well-founded) recursion and proves its properties *) Require Export NSub. -Module NStrongRecPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NSubPropMod := NSubPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module NStrongRecPropFunct (Import N : NAxiomsSig'). +Include NSubPropFunct N. Section StrongRecursion. -Variable A : Set. +Variable A : Type. Variable Aeq : relation A. +Variable Aeq_equiv : Equivalence Aeq. + +(** [strong_rec] allows to define a recursive function [phi] given by + an equation [phi(n) = F(phi)(n)] where recursive calls to [phi] + in [F] are made on strictly lower numbers than [n]. + + For [strong_rec a F n]: + - Parameter [a:A] is a default value used internally, it has no + effect on the final result. + - Parameter [F:(N->A)->N->A] is the step function: + [F f n] should return [phi(n)] when [f] is a function + that coincide with [phi] for numbers strictly less than [n]. +*) -Notation Local "x ==A y" := (Aeq x y) (at level 70, no associativity). +Definition strong_rec (a : A) (f : (N.t -> A) -> N.t -> A) (n : N.t) : A := + recursion (fun _ => a) (fun _ => f) (S n) n. -Hypothesis Aeq_equiv : equiv A Aeq. +(** For convenience, we use in proofs an intermediate definition + between [recursion] and [strong_rec]. *) -Add Relation A Aeq - reflexivity proved by (proj1 Aeq_equiv) - symmetry proved by (proj2 (proj2 Aeq_equiv)) - transitivity proved by (proj1 (proj2 Aeq_equiv)) -as Aeq_rel. +Definition strong_rec0 (a : A) (f : (N.t -> A) -> N.t -> A) : N.t -> N.t -> A := + recursion (fun _ => a) (fun _ => f). -Definition strong_rec (a : A) (f : N -> (N -> A) -> A) (n : N) : A := -recursion - (fun _ : N => a) - (fun (m : N) (p : N -> A) (k : N) => f k p) - (S n) - n. +Lemma strong_rec_alt : forall a f n, + strong_rec a f n = strong_rec0 a f (S n) n. +Proof. +reflexivity. +Qed. -Theorem strong_rec_wd : -forall a a' : A, a ==A a' -> - forall f f', fun2_eq Neq (fun_eq Neq Aeq) Aeq f f' -> - forall n n', n == n' -> - strong_rec a f n ==A strong_rec a' f' n'. +(** We need a result similar to [f_equal], but for setoid equalities. *) +Lemma f_equiv : forall f g x y, + (N.eq==>Aeq)%signature f g -> N.eq x y -> Aeq (f x) (g y). +Proof. +auto. +Qed. + +Instance strong_rec0_wd : + Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> N.eq ==> Aeq) + strong_rec0. +Proof. +unfold strong_rec0. +repeat red; intros. +apply f_equiv; auto. +apply recursion_wd; try red; auto. +Qed. + +Instance strong_rec_wd : + Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> Aeq) strong_rec. Proof. intros a a' Eaa' f f' Eff' n n' Enn'. -(* First we prove that recursion (which is on type N -> A) returns -extensionally equal functions, and then we use the fact that n == n' *) -assert (H : fun_eq Neq Aeq - (recursion - (fun _ : N => a) - (fun (m : N) (p : N -> A) (k : N) => f k p) - (S n)) - (recursion - (fun _ : N => a') - (fun (m : N) (p : N -> A) (k : N) => f' k p) - (S n'))). -apply recursion_wd with (Aeq := fun_eq Neq Aeq). -unfold fun_eq; now intros. -unfold fun2_eq. intros y y' Eyy' p p' Epp'. unfold fun_eq. auto. +rewrite !strong_rec_alt. +apply strong_rec0_wd; auto. now rewrite Enn'. -unfold strong_rec. -now apply H. Qed. -(*Section FixPoint. - -Variable a : A. -Variable f : N -> (N -> A) -> A. +Section FixPoint. -Hypothesis f_wd : fun2_wd Neq (fun_eq Neq Aeq) Aeq f. +Variable f : (N.t -> A) -> N.t -> A. +Variable f_wd : Proper ((N.eq==>Aeq)==>N.eq==>Aeq) f. -Let g (n : N) : A := strong_rec a f n. +Lemma strong_rec0_0 : forall a m, + (strong_rec0 a f 0 m) = a. +Proof. +intros. unfold strong_rec0. rewrite recursion_0; auto. +Qed. -Add Morphism g with signature Neq ==> Aeq as g_wd. +Lemma strong_rec0_succ : forall a n m, + Aeq (strong_rec0 a f (S n) m) (f (strong_rec0 a f n) m). Proof. -intros n1 n2 H. unfold g. now apply strong_rec_wd. +intros. unfold strong_rec0. +apply f_equiv; auto with *. +rewrite recursion_succ; try (repeat red; auto with *; fail). +apply f_wd. +apply recursion_wd; try red; auto with *. Qed. -Theorem NtoA_eq_sym : symmetric (N -> A) (fun_eq Neq Aeq). +Lemma strong_rec_0 : forall a, + Aeq (strong_rec a f 0) (f (fun _ => a) 0). Proof. -apply fun_eq_sym. -exact (proj2 (proj2 NZeq_equiv)). -exact (proj2 (proj2 Aeq_equiv)). +intros. rewrite strong_rec_alt, strong_rec0_succ. +apply f_wd; auto with *. +red; intros; rewrite strong_rec0_0; auto with *. Qed. -Theorem NtoA_eq_trans : transitive (N -> A) (fun_eq Neq Aeq). +(* We need an assumption saying that for every n, the step function (f h n) +calls h only on the segment [0 ... n - 1]. This means that if h1 and h2 +coincide on values < n, then (f h1 n) coincides with (f h2 n) *) + +Hypothesis step_good : + forall (n : N.t) (h1 h2 : N.t -> A), + (forall m : N.t, m < n -> Aeq (h1 m) (h2 m)) -> Aeq (f h1 n) (f h2 n). + +Lemma strong_rec0_more_steps : forall a k n m, m < n -> + Aeq (strong_rec0 a f n m) (strong_rec0 a f (n+k) m). Proof. -apply fun_eq_trans. -exact (proj1 NZeq_equiv). -exact (proj1 (proj2 NZeq_equiv)). -exact (proj1 (proj2 Aeq_equiv)). + intros a k n. pattern n. + apply induction; clear n. + + intros n n' Hn; setoid_rewrite Hn; auto with *. + + intros m Hm. destruct (nlt_0_r _ Hm). + + intros n IH m Hm. + rewrite lt_succ_r in Hm. + rewrite add_succ_l. + rewrite 2 strong_rec0_succ. + apply step_good. + intros m' Hm'. + apply IH. + apply lt_le_trans with m; auto. Qed. -Add Relation (N -> A) (fun_eq Neq Aeq) - symmetry proved by NtoA_eq_sym - transitivity proved by NtoA_eq_trans -as NtoA_eq_rel. +Lemma strong_rec0_fixpoint : forall (a : A) (n : N.t), + Aeq (strong_rec0 a f (S n) n) (f (fun n => strong_rec0 a f (S n) n) n). +Proof. +intros. +rewrite strong_rec0_succ. +apply step_good. +intros m Hm. +symmetry. +setoid_replace n with (S m + (n - S m)). +apply strong_rec0_more_steps. +apply lt_succ_diag_r. +rewrite add_comm. +symmetry. +apply sub_add. +rewrite le_succ_l; auto. +Qed. -Add Morphism f with signature Neq ==> (fun_eq Neq Aeq) ==> Aeq as f_morph. +Theorem strong_rec_fixpoint : forall (a : A) (n : N.t), + Aeq (strong_rec a f n) (f (strong_rec a f) n). Proof. -apply f_wd. +intros. +transitivity (f (fun n => strong_rec0 a f (S n) n) n). +rewrite strong_rec_alt. +apply strong_rec0_fixpoint. +apply f_wd; auto with *. +intros x x' Hx; rewrite strong_rec_alt, Hx; auto with *. Qed. -(* We need an assumption saying that for every n, the step function (f n h) -calls h only on the segment [0 ... n - 1]. This means that if h1 and h2 -coincide on values < n, then (f n h1) coincides with (f n h2) *) +(** NB: without the [step_good] hypothesis, we have proved that + [strong_rec a f 0] is [f (fun _ => a) 0]. Now we can prove + that the first argument of [f] is arbitrary in this case... +*) -Hypothesis step_good : - forall (n : N) (h1 h2 : N -> A), - (forall m : N, m < n -> Aeq (h1 m) (h2 m)) -> Aeq (f n h1) (f n h2). +Theorem strong_rec_0_any : forall (a : A)(any : N.t->A), + Aeq (strong_rec a f 0) (f any 0). +Proof. +intros. +rewrite strong_rec_fixpoint. +apply step_good. +intros m Hm. destruct (nlt_0_r _ Hm). +Qed. -(* Todo: -Theorem strong_rec_fixpoint : forall n : N, Aeq (g n) (f n g). +(** ... and that first argument of [strong_rec] is always arbitrary. *) + +Lemma strong_rec_any_fst_arg : forall a a' n, + Aeq (strong_rec a f n) (strong_rec a' f n). Proof. -apply induction. -unfold predicate_wd, fun_wd. -intros x y H. rewrite H. unfold fun_eq; apply g_wd. -reflexivity. -unfold g, strong_rec. -*) +intros a a' n. +generalize (le_refl n). +set (k:=n) at -2. clearbody k. revert k. pattern n. +apply induction; clear n. +(* compat *) +intros n n' Hn. setoid_rewrite Hn; auto with *. +(* 0 *) +intros k Hk. rewrite le_0_r in Hk. +rewrite Hk, strong_rec_0. symmetry. apply strong_rec_0_any. +(* S *) +intros n IH k Hk. +rewrite 2 strong_rec_fixpoint. +apply step_good. +intros m Hm. +apply IH. +rewrite succ_le_mono. +apply le_trans with k; auto. +rewrite le_succ_l; auto. +Qed. -End FixPoint.*) +End FixPoint. End StrongRecursion. Implicit Arguments strong_rec [A]. diff --git a/theories/Numbers/Natural/Abstract/NSub.v b/theories/Numbers/Natural/Abstract/NSub.v index f67689dd..35d3b8aa 100644 --- a/theories/Numbers/Natural/Abstract/NSub.v +++ b/theories/Numbers/Natural/Abstract/NSub.v @@ -8,49 +8,33 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NSub.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) Require Export NMulOrder. -Module NSubPropFunct (Import NAxiomsMod : NAxiomsSig). -Module Export NMulOrderPropMod := NMulOrderPropFunct NAxiomsMod. -Open Local Scope NatScope. +Module Type NSubPropFunct (Import N : NAxiomsSig'). +Include NMulOrderPropFunct N. -Theorem sub_wd : - forall n1 n2 : N, n1 == n2 -> forall m1 m2 : N, m1 == m2 -> n1 - m1 == n2 - m2. -Proof NZsub_wd. - -Theorem sub_0_r : forall n : N, n - 0 == n. -Proof NZsub_0_r. - -Theorem sub_succ_r : forall n m : N, n - (S m) == P (n - m). -Proof NZsub_succ_r. - -Theorem sub_1_r : forall n : N, n - 1 == P n. -Proof. -intro n; rewrite sub_succ_r; now rewrite sub_0_r. -Qed. - -Theorem sub_0_l : forall n : N, 0 - n == 0. +Theorem sub_0_l : forall n, 0 - n == 0. Proof. induct n. apply sub_0_r. intros n IH; rewrite sub_succ_r; rewrite IH. now apply pred_0. Qed. -Theorem sub_succ : forall n m : N, S n - S m == n - m. +Theorem sub_succ : forall n m, S n - S m == n - m. Proof. intro n; induct m. rewrite sub_succ_r. do 2 rewrite sub_0_r. now rewrite pred_succ. intros m IH. rewrite sub_succ_r. rewrite IH. now rewrite sub_succ_r. Qed. -Theorem sub_diag : forall n : N, n - n == 0. +Theorem sub_diag : forall n, n - n == 0. Proof. induct n. apply sub_0_r. intros n IH; rewrite sub_succ; now rewrite IH. Qed. -Theorem sub_gt : forall n m : N, n > m -> n - m ~= 0. +Theorem sub_gt : forall n m, n > m -> n - m ~= 0. Proof. intros n m H; elim H using lt_ind_rel; clear n m H. solve_relation_wd. @@ -58,7 +42,7 @@ intro; rewrite sub_0_r; apply neq_succ_0. intros; now rewrite sub_succ. Qed. -Theorem add_sub_assoc : forall n m p : N, p <= m -> n + (m - p) == (n + m) - p. +Theorem add_sub_assoc : forall n m p, p <= m -> n + (m - p) == (n + m) - p. Proof. intros n m p; induct p. intro; now do 2 rewrite sub_0_r. @@ -68,32 +52,32 @@ rewrite add_pred_r by (apply sub_gt; now apply -> le_succ_l). reflexivity. Qed. -Theorem sub_succ_l : forall n m : N, n <= m -> S m - n == S (m - n). +Theorem sub_succ_l : forall n m, n <= m -> S m - n == S (m - n). Proof. intros n m H. rewrite <- (add_1_l m). rewrite <- (add_1_l (m - n)). symmetry; now apply add_sub_assoc. Qed. -Theorem add_sub : forall n m : N, (n + m) - m == n. +Theorem add_sub : forall n m, (n + m) - m == n. Proof. intros n m. rewrite <- add_sub_assoc by (apply le_refl). rewrite sub_diag; now rewrite add_0_r. Qed. -Theorem sub_add : forall n m : N, n <= m -> (m - n) + n == m. +Theorem sub_add : forall n m, n <= m -> (m - n) + n == m. Proof. intros n m H. rewrite add_comm. rewrite add_sub_assoc by assumption. rewrite add_comm. apply add_sub. Qed. -Theorem add_sub_eq_l : forall n m p : N, m + p == n -> n - m == p. +Theorem add_sub_eq_l : forall n m p, m + p == n -> n - m == p. Proof. intros n m p H. symmetry. assert (H1 : m + p - m == n - m) by now rewrite H. rewrite add_comm in H1. now rewrite add_sub in H1. Qed. -Theorem add_sub_eq_r : forall n m p : N, m + p == n -> n - p == m. +Theorem add_sub_eq_r : forall n m p, m + p == n -> n - p == m. Proof. intros n m p H; rewrite add_comm in H; now apply add_sub_eq_l. Qed. @@ -101,7 +85,7 @@ Qed. (* This could be proved by adding m to both sides. Then the proof would use add_sub_assoc and sub_0_le, which is proven below. *) -Theorem add_sub_eq_nz : forall n m p : N, p ~= 0 -> n - m == p -> m + p == n. +Theorem add_sub_eq_nz : forall n m p, p ~= 0 -> n - m == p -> m + p == n. Proof. intros n m p H; double_induct n m. intros m H1; rewrite sub_0_l in H1. symmetry in H1; false_hyp H1 H. @@ -110,14 +94,14 @@ intros n m IH H1. rewrite sub_succ in H1. apply IH in H1. rewrite add_succ_l; now rewrite H1. Qed. -Theorem sub_add_distr : forall n m p : N, n - (m + p) == (n - m) - p. +Theorem sub_add_distr : forall n m p, n - (m + p) == (n - m) - p. Proof. intros n m; induct p. rewrite add_0_r; now rewrite sub_0_r. intros p IH. rewrite add_succ_r; do 2 rewrite sub_succ_r. now rewrite IH. Qed. -Theorem add_sub_swap : forall n m p : N, p <= n -> n + m - p == n - p + m. +Theorem add_sub_swap : forall n m p, p <= n -> n + m - p == n - p + m. Proof. intros n m p H. rewrite (add_comm n m). @@ -127,7 +111,7 @@ Qed. (** Sub and order *) -Theorem le_sub_l : forall n m : N, n - m <= n. +Theorem le_sub_l : forall n m, n - m <= n. Proof. intro n; induct m. rewrite sub_0_r; now apply eq_le_incl. @@ -135,7 +119,7 @@ intros m IH. rewrite sub_succ_r. apply le_trans with (n - m); [apply le_pred_l | assumption]. Qed. -Theorem sub_0_le : forall n m : N, n - m == 0 <-> n <= m. +Theorem sub_0_le : forall n m, n - m == 0 <-> n <= m. Proof. double_induct n m. intro m; split; intro; [apply le_0_l | apply sub_0_l]. @@ -144,9 +128,86 @@ intro m; rewrite sub_0_r; split; intro H; intros n m H. rewrite <- succ_le_mono. now rewrite sub_succ. Qed. +Theorem sub_add_le : forall n m, n <= n - m + m. +Proof. +intros. +destruct (le_ge_cases n m) as [LE|GE]. +rewrite <- sub_0_le in LE. rewrite LE; nzsimpl. +now rewrite <- sub_0_le. +rewrite sub_add by assumption. apply le_refl. +Qed. + +Theorem le_sub_le_add_r : forall n m p, + n - p <= m <-> n <= m + p. +Proof. +intros n m p. +split; intros LE. +rewrite (add_le_mono_r _ _ p) in LE. +apply le_trans with (n-p+p); auto using sub_add_le. +destruct (le_ge_cases n p) as [LE'|GE]. +rewrite <- sub_0_le in LE'. rewrite LE'. apply le_0_l. +rewrite (add_le_mono_r _ _ p). now rewrite sub_add. +Qed. + +Theorem le_sub_le_add_l : forall n m p, n - m <= p <-> n <= m + p. +Proof. +intros n m p. rewrite add_comm; apply le_sub_le_add_r. +Qed. + +Theorem lt_sub_lt_add_r : forall n m p, + n - p < m -> n < m + p. +Proof. +intros n m p LT. +rewrite (add_lt_mono_r _ _ p) in LT. +apply le_lt_trans with (n-p+p); auto using sub_add_le. +Qed. + +(** Unfortunately, we do not have [n < m + p -> n - p < m]. + For instance [1<0+2] but not [1-2<0]. *) + +Theorem lt_sub_lt_add_l : forall n m p, n - m < p -> n < m + p. +Proof. +intros n m p. rewrite add_comm; apply lt_sub_lt_add_r. +Qed. + +Theorem le_add_le_sub_r : forall n m p, n + p <= m -> n <= m - p. +Proof. +intros n m p LE. +apply (add_le_mono_r _ _ p). +rewrite sub_add. assumption. +apply le_trans with (n+p); trivial. +rewrite <- (add_0_l p) at 1. rewrite <- add_le_mono_r. apply le_0_l. +Qed. + +(** Unfortunately, we do not have [n <= m - p -> n + p <= m]. + For instance [0<=1-2] but not [2+0<=1]. *) + +Theorem le_add_le_sub_l : forall n m p, n + p <= m -> p <= m - n. +Proof. +intros n m p. rewrite add_comm; apply le_add_le_sub_r. +Qed. + +Theorem lt_add_lt_sub_r : forall n m p, n + p < m <-> n < m - p. +Proof. +intros n m p. +destruct (le_ge_cases p m) as [LE|GE]. +rewrite <- (sub_add p m) at 1 by assumption. +now rewrite <- add_lt_mono_r. +assert (GE' := GE). rewrite <- sub_0_le in GE'; rewrite GE'. +split; intros LT. +elim (lt_irrefl m). apply le_lt_trans with (n+p); trivial. + rewrite <- (add_0_l m). apply add_le_mono. apply le_0_l. assumption. +now elim (nlt_0_r n). +Qed. + +Theorem lt_add_lt_sub_l : forall n m p, n + p < m <-> p < m - n. +Proof. +intros n m p. rewrite add_comm; apply lt_add_lt_sub_r. +Qed. + (** Sub and mul *) -Theorem mul_pred_r : forall n m : N, n * (P m) == n * m - n. +Theorem mul_pred_r : forall n m, n * (P m) == n * m - n. Proof. intros n m; cases m. now rewrite pred_0, mul_0_r, sub_0_l. @@ -155,7 +216,7 @@ now rewrite sub_diag, add_0_r. now apply eq_le_incl. Qed. -Theorem mul_sub_distr_r : forall n m p : N, (n - m) * p == n * p - m * p. +Theorem mul_sub_distr_r : forall n m p, (n - m) * p == n * p - m * p. Proof. intros n m p; induct n. now rewrite sub_0_l, mul_0_l, sub_0_l. @@ -170,11 +231,72 @@ setoid_replace ((S n * p) - m * p) with 0 by (apply <- sub_0_le; now apply mul_l apply mul_0_l. Qed. -Theorem mul_sub_distr_l : forall n m p : N, p * (n - m) == p * n - p * m. +Theorem mul_sub_distr_l : forall n m p, p * (n - m) == p * n - p * m. Proof. intros n m p; rewrite (mul_comm p (n - m)), (mul_comm p n), (mul_comm p m). apply mul_sub_distr_r. Qed. +(** Alternative definitions of [<=] and [<] based on [+] *) + +Definition le_alt n m := exists p, p + n == m. +Definition lt_alt n m := exists p, S p + n == m. + +Lemma le_equiv : forall n m, le_alt n m <-> n <= m. +Proof. +split. +intros (p,H). rewrite <- H, add_comm. apply le_add_r. +intro H. exists (m-n). now apply sub_add. +Qed. + +Lemma lt_equiv : forall n m, lt_alt n m <-> n < m. +Proof. +split. +intros (p,H). rewrite <- H, add_succ_l, lt_succ_r, add_comm. apply le_add_r. +intro H. exists (m-S n). rewrite add_succ_l, <- add_succ_r. +apply sub_add. now rewrite le_succ_l. +Qed. + +Instance le_alt_wd : Proper (eq==>eq==>iff) le_alt. +Proof. + intros x x' Hx y y' Hy; unfold le_alt. + setoid_rewrite Hx. setoid_rewrite Hy. auto with *. +Qed. + +Instance lt_alt_wd : Proper (eq==>eq==>iff) lt_alt. +Proof. + intros x x' Hx y y' Hy; unfold lt_alt. + setoid_rewrite Hx. setoid_rewrite Hy. auto with *. +Qed. + +(** With these alternative definition, the dichotomy: + +[forall n m, n <= m \/ m <= n] + +becomes: + +[forall n m, (exists p, p + n == m) \/ (exists p, p + m == n)] + +We will need this in the proof of induction principle for integers +constructed as pairs of natural numbers. This formula can be proved +from know properties of [<=]. However, it can also be done directly. *) + +Theorem le_alt_dichotomy : forall n m, le_alt n m \/ le_alt m n. +Proof. +intros n m; induct n. +left; exists m; apply add_0_r. +intros n IH. +destruct IH as [[p H] | [p H]]. +destruct (zero_or_succ p) as [H1 | [p' H1]]; rewrite H1 in H. +rewrite add_0_l in H. right; exists (S 0); rewrite H, add_succ_l; + now rewrite add_0_l. +left; exists p'; rewrite add_succ_r; now rewrite add_succ_l in H. +right; exists (S p). rewrite add_succ_l; now rewrite H. +Qed. + +Theorem add_dichotomy : + forall n m, (exists p, p + n == m) \/ (exists p, p + m == n). +Proof. exact le_alt_dichotomy. Qed. + End NSubPropFunct. diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v index 16007656..cab4b154 100644 --- a/theories/Numbers/Natural/BigN/BigN.v +++ b/theories/Numbers/Natural/BigN/BigN.v @@ -6,28 +6,32 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: BigN.v 11576 2008-11-10 19:13:15Z msozeau $ i*) +(** * Efficient arbitrary large natural numbers in base 2^31 *) -(** * Natural numbers in base 2^31 *) - -(** -Author: Arnaud Spiwack -*) +(** Initial Author: Arnaud Spiwack *) Require Export Int31. -Require Import CyclicAxioms. -Require Import Cyclic31. -Require Import NSig. -Require Import NSigNAxioms. -Require Import NMake. -Require Import NSub. +Require Import CyclicAxioms Cyclic31 Ring31 NSig NSigNAxioms NMake + NProperties NDiv GenericMinMax. + +(** The following [BigN] module regroups both the operations and + all the abstract properties: -Module BigN <: NType := NMake.Make Int31Cyclic. + - [NMake.Make Int31Cyclic] provides the operations and basic specs + w.r.t. ZArith + - [NTypeIsNAxioms] shows (mainly) that these operations implement + the interface [NAxioms] + - [NPropSig] adds all generic properties derived from [NAxioms] + - [NDivPropFunct] provides generic properties of [div] and [mod]. + - [MinMax*Properties] provides properties of [min] and [max]. + +*) -(** Module [BigN] implements [NAxiomsSig] *) +Module BigN <: NType <: OrderedTypeFull <: TotalOrder := + NMake.Make Int31Cyclic <+ NTypeIsNAxioms + <+ !NPropSig <+ !NDivPropFunct <+ HasEqBool2Dec + <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties. -Module Export BigNAxiomsMod := NSig_NAxioms BigN. -Module Export BigNSubPropMod := NSubPropFunct BigNAxiomsMod. (** Notations about [BigN] *) @@ -37,49 +41,171 @@ Delimit Scope bigN_scope with bigN. Bind Scope bigN_scope with bigN. Bind Scope bigN_scope with BigN.t. Bind Scope bigN_scope with BigN.t_. - -Notation Local "0" := BigN.zero : bigN_scope. (* temporary notation *) +(* Bind Scope has no retroactive effect, let's declare scopes by hand. *) +Arguments Scope BigN.to_Z [bigN_scope]. +Arguments Scope BigN.succ [bigN_scope]. +Arguments Scope BigN.pred [bigN_scope]. +Arguments Scope BigN.square [bigN_scope]. +Arguments Scope BigN.add [bigN_scope bigN_scope]. +Arguments Scope BigN.sub [bigN_scope bigN_scope]. +Arguments Scope BigN.mul [bigN_scope bigN_scope]. +Arguments Scope BigN.div [bigN_scope bigN_scope]. +Arguments Scope BigN.eq [bigN_scope bigN_scope]. +Arguments Scope BigN.lt [bigN_scope bigN_scope]. +Arguments Scope BigN.le [bigN_scope bigN_scope]. +Arguments Scope BigN.eq [bigN_scope bigN_scope]. +Arguments Scope BigN.compare [bigN_scope bigN_scope]. +Arguments Scope BigN.min [bigN_scope bigN_scope]. +Arguments Scope BigN.max [bigN_scope bigN_scope]. +Arguments Scope BigN.eq_bool [bigN_scope bigN_scope]. +Arguments Scope BigN.power_pos [bigN_scope positive_scope]. +Arguments Scope BigN.power [bigN_scope N_scope]. +Arguments Scope BigN.sqrt [bigN_scope]. +Arguments Scope BigN.div_eucl [bigN_scope bigN_scope]. +Arguments Scope BigN.modulo [bigN_scope bigN_scope]. +Arguments Scope BigN.gcd [bigN_scope bigN_scope]. + +Local Notation "0" := BigN.zero : bigN_scope. (* temporary notation *) +Local Notation "1" := BigN.one : bigN_scope. (* temporary notation *) Infix "+" := BigN.add : bigN_scope. Infix "-" := BigN.sub : bigN_scope. Infix "*" := BigN.mul : bigN_scope. Infix "/" := BigN.div : bigN_scope. +Infix "^" := BigN.power : bigN_scope. Infix "?=" := BigN.compare : bigN_scope. Infix "==" := BigN.eq (at level 70, no associativity) : bigN_scope. +Notation "x != y" := (~x==y)%bigN (at level 70, no associativity) : bigN_scope. Infix "<" := BigN.lt : bigN_scope. Infix "<=" := BigN.le : bigN_scope. Notation "x > y" := (BigN.lt y x)(only parsing) : bigN_scope. Notation "x >= y" := (BigN.le y x)(only parsing) : bigN_scope. +Notation "x < y < z" := (x<y /\ y<z)%bigN : bigN_scope. +Notation "x < y <= z" := (x<y /\ y<=z)%bigN : bigN_scope. +Notation "x <= y < z" := (x<=y /\ y<z)%bigN : bigN_scope. +Notation "x <= y <= z" := (x<=y /\ y<=z)%bigN : bigN_scope. Notation "[ i ]" := (BigN.to_Z i) : bigN_scope. +Infix "mod" := BigN.modulo (at level 40, no associativity) : bigN_scope. -Open Scope bigN_scope. +Local Open Scope bigN_scope. (** Example of reasoning about [BigN] *) -Theorem succ_pred: forall q:bigN, +Theorem succ_pred: forall q : bigN, 0 < q -> BigN.succ (BigN.pred q) == q. Proof. -intros; apply succ_pred. +intros; apply BigN.succ_pred. intro H'; rewrite H' in H; discriminate. Qed. (** [BigN] is a semi-ring *) -Lemma BigNring : - semi_ring_theory BigN.zero BigN.one BigN.add BigN.mul BigN.eq. +Lemma BigNring : semi_ring_theory 0 1 BigN.add BigN.mul BigN.eq. +Proof. +constructor. +exact BigN.add_0_l. exact BigN.add_comm. exact BigN.add_assoc. +exact BigN.mul_1_l. exact BigN.mul_0_l. exact BigN.mul_comm. +exact BigN.mul_assoc. exact BigN.mul_add_distr_r. +Qed. + +Lemma BigNeqb_correct : forall x y, BigN.eq_bool x y = true -> x==y. +Proof. now apply BigN.eqb_eq. Qed. + +Lemma BigNpower : power_theory 1 BigN.mul BigN.eq (@id N) BigN.power. Proof. constructor. -exact add_0_l. -exact add_comm. -exact add_assoc. -exact mul_1_l. -exact mul_0_l. -exact mul_comm. -exact mul_assoc. -exact mul_add_distr_r. +intros. red. rewrite BigN.spec_power. unfold id. +destruct Zpower_theory as [EQ]. rewrite EQ. +destruct n; simpl. reflexivity. +induction p; simpl; intros; BigN.zify; rewrite ?IHp; auto. +Qed. + +Lemma BigNdiv : div_theory BigN.eq BigN.add BigN.mul (@id _) + (fun a b => if BigN.eq_bool b 0 then (0,a) else BigN.div_eucl a b). +Proof. +constructor. unfold id. intros a b. +BigN.zify. +generalize (Zeq_bool_if [b] 0); destruct (Zeq_bool [b] 0). +BigN.zify. auto with zarith. +intros NEQ. +generalize (BigN.spec_div_eucl a b). +generalize (Z_div_mod_full [a] [b] NEQ). +destruct BigN.div_eucl as (q,r), Zdiv_eucl as (q',r'). +intros (EQ,_). injection 1. intros EQr EQq. +BigN.zify. rewrite EQr, EQq; auto. +Qed. + + +(** Detection of constants *) + +Ltac isStaticWordCst t := + match t with + | W0 => constr:true + | WW ?t1 ?t2 => + match isStaticWordCst t1 with + | false => constr:false + | true => isStaticWordCst t2 + end + | _ => isInt31cst t + end. + +Ltac isBigNcst t := + match t with + | BigN.N0 ?t => isStaticWordCst t + | BigN.N1 ?t => isStaticWordCst t + | BigN.N2 ?t => isStaticWordCst t + | BigN.N3 ?t => isStaticWordCst t + | BigN.N4 ?t => isStaticWordCst t + | BigN.N5 ?t => isStaticWordCst t + | BigN.N6 ?t => isStaticWordCst t + | BigN.Nn ?n ?t => match isnatcst n with + | true => isStaticWordCst t + | false => constr:false + end + | BigN.zero => constr:true + | BigN.one => constr:true + | _ => constr:false + end. + +Ltac BigNcst t := + match isBigNcst t with + | true => constr:t + | false => constr:NotConstant + end. + +Ltac Ncst t := + match isNcst t with + | true => constr:t + | false => constr:NotConstant + end. + +(** Registration for the "ring" tactic *) + +Add Ring BigNr : BigNring + (decidable BigNeqb_correct, + constants [BigNcst], + power_tac BigNpower [Ncst], + div BigNdiv). + +Section TestRing. +Let test : forall x y, 1 + x*y + x^2 + 1 == 1*1 + 1 + y*x + 1*x*x. +intros. ring_simplify. reflexivity. Qed. +End TestRing. + +(** We benefit also from an "order" tactic *) + +Ltac bigN_order := BigN.order. + +Section TestOrder. +Let test : forall x y : bigN, x<=y -> y<=x -> x==y. +Proof. bigN_order. Qed. +End TestOrder. -Add Ring BigNr : BigNring. +(** We can use at least a bit of (r)omega by translating to [Z]. *) -(** Todo: tactic translating from [BigN] to [Z] + omega *) +Section TestOmega. +Let test : forall x y : bigN, x<=y -> y<=x -> x==y. +Proof. intros x y. BigN.zify. omega. Qed. +End TestOmega. (** Todo: micromega *) diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v new file mode 100644 index 00000000..925b0535 --- /dev/null +++ b/theories/Numbers/Natural/BigN/NMake.v @@ -0,0 +1,524 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) +(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) +(************************************************************************) + +(** * NMake *) + +(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*) + +(** NB: This file contain the part which is independent from the underlying + representation. The representation-dependent (and macro-generated) part + is now in [NMake_gen]. *) + +Require Import BigNumPrelude ZArith CyclicAxioms. +Require Import Nbasic Wf_nat StreamMemo NSig NMake_gen. + +Module Make (Import W0:CyclicType) <: NType. + + (** Macro-generated part *) + + Include NMake_gen.Make W0. + + + (** * Predecessor *) + + Lemma spec_pred : forall x, [pred x] = Zmax 0 ([x]-1). + Proof. + intros. destruct (Zle_lt_or_eq _ _ (spec_pos x)). + rewrite Zmax_r; auto with zarith. + apply spec_pred_pos; auto. + rewrite <- H; apply spec_pred0; auto. + Qed. + + + (** * Subtraction *) + + Lemma spec_sub : forall x y, [sub x y] = Zmax 0 ([x]-[y]). + Proof. + intros. destruct (Zle_or_lt [y] [x]). + rewrite Zmax_r; auto with zarith. apply spec_sub_pos; auto. + rewrite Zmax_l; auto with zarith. apply spec_sub0; auto. + Qed. + + (** * Comparison *) + + Theorem spec_compare : forall x y, compare x y = Zcompare [x] [y]. + Proof. + intros x y. generalize (spec_compare_aux x y); destruct compare; + intros; symmetry; try rewrite Zcompare_Eq_iff_eq; assumption. + Qed. + + Definition eq_bool x y := + match compare x y with + | Eq => true + | _ => false + end. + + Theorem spec_eq_bool : forall x y, eq_bool x y = Zeq_bool [x] [y]. + Proof. + intros. unfold eq_bool, Zeq_bool. rewrite spec_compare; reflexivity. + Qed. + + Theorem spec_eq_bool_aux: forall x y, + if eq_bool x y then [x] = [y] else [x] <> [y]. + Proof. + intros x y; unfold eq_bool. + generalize (spec_compare_aux x y); case compare; auto with zarith. + Qed. + + Definition lt n m := [n] < [m]. + Definition le n m := [n] <= [m]. + + Definition min n m := match compare n m with Gt => m | _ => n end. + Definition max n m := match compare n m with Lt => m | _ => n end. + + Theorem spec_max : forall n m, [max n m] = Zmax [n] [m]. + Proof. + intros. unfold max, Zmax. rewrite spec_compare; destruct Zcompare; reflexivity. + Qed. + + Theorem spec_min : forall n m, [min n m] = Zmin [n] [m]. + Proof. + intros. unfold min, Zmin. rewrite spec_compare; destruct Zcompare; reflexivity. + Qed. + + + (** * Power *) + + Fixpoint power_pos (x:t) (p:positive) {struct p} : t := + match p with + | xH => x + | xO p => square (power_pos x p) + | xI p => mul (square (power_pos x p)) x + end. + + Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. + Proof. + intros x n; generalize x; elim n; clear n x; simpl power_pos. + intros; rewrite spec_mul; rewrite spec_square; rewrite H. + rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith. + rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. + rewrite Zpower_2; rewrite Zpower_1_r; auto. + intros; rewrite spec_square; rewrite H. + rewrite Zpos_xO; auto with zarith. + rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. + rewrite Zpower_2; auto. + intros; rewrite Zpower_1_r; auto. + Qed. + + Definition power x (n:N) := match n with + | BinNat.N0 => one + | BinNat.Npos p => power_pos x p + end. + + Theorem spec_power: forall x n, [power x n] = [x] ^ Z_of_N n. + Proof. + destruct n; simpl. apply (spec_1 w0_spec). + apply spec_power_pos. + Qed. + + + (** * Div *) + + Definition div_eucl x y := + if eq_bool y zero then (zero,zero) else + match compare x y with + | Eq => (one, zero) + | Lt => (zero, x) + | Gt => div_gt x y + end. + + Theorem spec_div_eucl: forall x y, + let (q,r) := div_eucl x y in + ([q], [r]) = Zdiv_eucl [x] [y]. + Proof. + assert (F0: [zero] = 0). + exact (spec_0 w0_spec). + assert (F1: [one] = 1). + exact (spec_1 w0_spec). + intros x y. unfold div_eucl. + generalize (spec_eq_bool_aux y zero). destruct eq_bool; rewrite F0. + intro H. rewrite H. destruct [x]; auto. + intro H'. + assert (0 < [y]) by (generalize (spec_pos y); auto with zarith). + clear H'. + generalize (spec_compare_aux x y); case compare; try rewrite F0; + try rewrite F1; intros; auto with zarith. + rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H)) + (Z_mod_same [y] (Zlt_gt _ _ H)); + unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. + assert (F2: 0 <= [x] < [y]). + generalize (spec_pos x); auto. + generalize (Zdiv_small _ _ F2) + (Zmod_small _ _ F2); + unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. + generalize (spec_div_gt _ _ H0 H); auto. + unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt. + intros a b c d (H1, H2); subst; auto. + Qed. + + Definition div x y := fst (div_eucl x y). + + Theorem spec_div: + forall x y, [div x y] = [x] / [y]. + Proof. + intros x y; unfold div; generalize (spec_div_eucl x y); + case div_eucl; simpl fst. + intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; + injection H; auto. + Qed. + + + (** * Modulo *) + + Definition modulo x y := + if eq_bool y zero then zero else + match compare x y with + | Eq => zero + | Lt => x + | Gt => mod_gt x y + end. + + Theorem spec_modulo: + forall x y, [modulo x y] = [x] mod [y]. + Proof. + assert (F0: [zero] = 0). + exact (spec_0 w0_spec). + assert (F1: [one] = 1). + exact (spec_1 w0_spec). + intros x y. unfold modulo. + generalize (spec_eq_bool_aux y zero). destruct eq_bool; rewrite F0. + intro H; rewrite H. destruct [x]; auto. + intro H'. + assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith). + clear H'. + generalize (spec_compare_aux x y); case compare; try rewrite F0; + try rewrite F1; intros; try split; auto with zarith. + rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith. + apply sym_equal; apply Zmod_small; auto with zarith. + generalize (spec_pos x); auto with zarith. + apply spec_mod_gt; auto. + Qed. + + + (** * Gcd *) + + Definition gcd_gt_body a b cont := + match compare b zero with + | Gt => + let r := mod_gt a b in + match compare r zero with + | Gt => cont r (mod_gt b r) + | _ => b + end + | _ => a + end. + + Theorem Zspec_gcd_gt_body: forall a b cont p, + [a] > [b] -> [a] < 2 ^ p -> + (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] -> + Zis_gcd [a1] [b1] [cont a1 b1]) -> + Zis_gcd [a] [b] [gcd_gt_body a b cont]. + Proof. + assert (F1: [zero] = 0). + unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto. + intros a b cont p H2 H3 H4; unfold gcd_gt_body. + generalize (spec_compare_aux b zero); case compare; try rewrite F1. + intros HH; rewrite HH; apply Zis_gcd_0. + intros HH; absurd (0 <= [b]); auto with zarith. + case (spec_digits b); auto with zarith. + intros H5; generalize (spec_compare_aux (mod_gt a b) zero); + case compare; try rewrite F1. + intros H6; rewrite <- (Zmult_1_r [b]). + rewrite (Z_div_mod_eq [a] [b]); auto with zarith. + rewrite <- spec_mod_gt; auto with zarith. + rewrite H6; rewrite Zplus_0_r. + apply Zis_gcd_mult; apply Zis_gcd_1. + intros; apply False_ind. + case (spec_digits (mod_gt a b)); auto with zarith. + intros H6; apply DoubleDiv.Zis_gcd_mod; auto with zarith. + apply DoubleDiv.Zis_gcd_mod; auto with zarith. + rewrite <- spec_mod_gt; auto with zarith. + assert (F2: [b] > [mod_gt a b]). + case (Z_mod_lt [a] [b]); auto with zarith. + repeat rewrite <- spec_mod_gt; auto with zarith. + assert (F3: [mod_gt a b] > [mod_gt b (mod_gt a b)]). + case (Z_mod_lt [b] [mod_gt a b]); auto with zarith. + rewrite <- spec_mod_gt; auto with zarith. + repeat rewrite <- spec_mod_gt; auto with zarith. + apply H4; auto with zarith. + apply Zmult_lt_reg_r with 2; auto with zarith. + apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith. + apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith. + apply Zplus_le_compat_r. + pattern [b] at 1; rewrite <- (Zmult_1_l [b]). + apply Zmult_le_compat_r; auto with zarith. + case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith. + intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2; + try rewrite <- HH in H2; auto with zarith. + case (Z_mod_lt [a] [b]); auto with zarith. + rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith. + rewrite <- Z_div_mod_eq; auto with zarith. + pattern 2 at 2; rewrite <- (Zpower_1_r 2). + rewrite <- Zpower_exp; auto with zarith. + ring_simplify (p - 1 + 1); auto. + case (Zle_lt_or_eq 0 p); auto with zarith. + generalize H3; case p; simpl Zpower; auto with zarith. + intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith. + Qed. + + Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t := + gcd_gt_body a b + (fun a b => + match p with + | xH => cont a b + | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b + | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b + end). + + Theorem Zspec_gcd_gt_aux: forall p n a b cont, + [a] > [b] -> [a] < 2 ^ (Zpos p + n) -> + (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] -> + Zis_gcd [a1] [b1] [cont a1 b1]) -> + Zis_gcd [a] [b] [gcd_gt_aux p cont a b]. + intros p; elim p; clear p. + intros p Hrec n a b cont H2 H3 H4. + unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto. + intros a1 b1 H6 H7. + apply Hrec with (Zpos p + n); auto. + replace (Zpos p + (Zpos p + n)) with + (Zpos (xI p) + n - 1); auto. + rewrite Zpos_xI; ring. + intros a2 b2 H9 H10. + apply Hrec with n; auto. + intros p Hrec n a b cont H2 H3 H4. + unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto. + intros a1 b1 H6 H7. + apply Hrec with (Zpos p + n - 1); auto. + replace (Zpos p + (Zpos p + n - 1)) with + (Zpos (xO p) + n - 1); auto. + rewrite Zpos_xO; ring. + intros a2 b2 H9 H10. + apply Hrec with (n - 1); auto. + replace (Zpos p + (n - 1)) with + (Zpos p + n - 1); auto with zarith. + intros a3 b3 H12 H13; apply H4; auto with zarith. + apply Zlt_le_trans with (1 := H12). + case (Zle_or_lt 1 n); intros HH. + apply Zpower_le_monotone; auto with zarith. + apply Zle_trans with 0; auto with zarith. + assert (HH1: n - 1 < 0); auto with zarith. + generalize HH1; case (n - 1); auto with zarith. + intros p1 HH2; discriminate. + intros n a b cont H H2 H3. + simpl gcd_gt_aux. + apply Zspec_gcd_gt_body with (n + 1); auto with zarith. + rewrite Zplus_comm; auto. + intros a1 b1 H5 H6; apply H3; auto. + replace n with (n + 1 - 1); auto; try ring. + Qed. + + Definition gcd_cont a b := + match compare one b with + | Eq => one + | _ => a + end. + + Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b. + + Theorem spec_gcd_gt: forall a b, + [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]. + Proof. + intros a b H2. + case (spec_digits (gcd_gt a b)); intros H3 H4. + case (spec_digits a); intros H5 H6. + apply sym_equal; apply Zis_gcd_gcd; auto with zarith. + unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith. + intros a1 a2; rewrite Zpower_0_r. + case (spec_digits a2); intros H7 H8; + intros; apply False_ind; auto with zarith. + Qed. + + Definition gcd a b := + match compare a b with + | Eq => a + | Lt => gcd_gt b a + | Gt => gcd_gt a b + end. + + Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]. + Proof. + intros a b. + case (spec_digits a); intros H1 H2. + case (spec_digits b); intros H3 H4. + unfold gcd; generalize (spec_compare_aux a b); case compare. + intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto. + apply Zis_gcd_refl. + intros; apply trans_equal with (Zgcd [b] [a]). + apply spec_gcd_gt; auto with zarith. + apply Zis_gcd_gcd; auto with zarith. + apply Zgcd_is_pos. + apply Zis_gcd_sym; apply Zgcd_is_gcd. + intros; apply spec_gcd_gt; auto. + Qed. + + + (** * Conversion *) + + Definition of_N x := + match x with + | BinNat.N0 => zero + | Npos p => of_pos p + end. + + Theorem spec_of_N: forall x, + [of_N x] = Z_of_N x. + Proof. + intros x; case x. + simpl of_N. + unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto. + intros p; exact (spec_of_pos p). + Qed. + + + (** * Shift *) + + Definition shiftr n x := + match compare n (Ndigits x) with + | Lt => unsafe_shiftr n x + | _ => N0 w_0 + end. + + Theorem spec_shiftr: forall n x, + [shiftr n x] = [x] / 2 ^ [n]. + Proof. + intros n x; unfold shiftr; + generalize (spec_compare_aux n (Ndigits x)); case compare; intros H. + apply trans_equal with (1 := spec_0 w0_spec). + apply sym_equal; apply Zdiv_small; rewrite H. + rewrite spec_Ndigits; exact (spec_digits x). + rewrite <- spec_unsafe_shiftr; auto with zarith. + apply trans_equal with (1 := spec_0 w0_spec). + apply sym_equal; apply Zdiv_small. + rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2. + split; auto. + apply Zlt_le_trans with (1 := H2). + apply Zpower_le_monotone; auto with zarith. + Qed. + + Definition shiftl_aux_body cont n x := + match compare n (head0 x) with + Gt => cont n (double_size x) + | _ => unsafe_shiftl n x + end. + + Theorem spec_shiftl_aux_body: forall n p x cont, + 2^ Zpos p <= [head0 x] -> + (forall x, 2 ^ (Zpos p + 1) <= [head0 x]-> + [cont n x] = [x] * 2 ^ [n]) -> + [shiftl_aux_body cont n x] = [x] * 2 ^ [n]. + Proof. + intros n p x cont H1 H2; unfold shiftl_aux_body. + generalize (spec_compare_aux n (head0 x)); case compare; intros H. + apply spec_unsafe_shiftl; auto with zarith. + apply spec_unsafe_shiftl; auto with zarith. + rewrite H2. + rewrite spec_double_size; auto. + rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith. + apply Zle_trans with (2 := spec_double_size_head0 x). + rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith. + Qed. + + Fixpoint shiftl_aux p cont n x {struct p} := + shiftl_aux_body + (fun n x => match p with + | xH => cont n x + | xO p => shiftl_aux p (shiftl_aux p cont) n x + | xI p => shiftl_aux p (shiftl_aux p cont) n x + end) n x. + + Theorem spec_shiftl_aux: forall p q n x cont, + 2 ^ (Zpos q) <= [head0 x] -> + (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] -> + [cont n x] = [x] * 2 ^ [n]) -> + [shiftl_aux p cont n x] = [x] * 2 ^ [n]. + Proof. + intros p; elim p; unfold shiftl_aux; fold shiftl_aux; clear p. + intros p Hrec q n x cont H1 H2. + apply spec_shiftl_aux_body with (q); auto. + intros x1 H3; apply Hrec with (q + 1)%positive; auto. + intros x2 H4; apply Hrec with (p + q + 1)%positive; auto. + rewrite <- Pplus_assoc. + rewrite Zpos_plus_distr; auto. + intros x3 H5; apply H2. + rewrite Zpos_xI. + replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1)); + auto. + repeat rewrite Zpos_plus_distr; ring. + intros p Hrec q n x cont H1 H2. + apply spec_shiftl_aux_body with (q); auto. + intros x1 H3; apply Hrec with (q); auto. + apply Zle_trans with (2 := H3); auto with zarith. + apply Zpower_le_monotone; auto with zarith. + intros x2 H4; apply Hrec with (p + q)%positive; auto. + intros x3 H5; apply H2. + rewrite (Zpos_xO p). + replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q)); + auto. + repeat rewrite Zpos_plus_distr; ring. + intros q n x cont H1 H2. + apply spec_shiftl_aux_body with (q); auto. + rewrite Zplus_comm; auto. + Qed. + + Definition shiftl n x := + shiftl_aux_body + (shiftl_aux_body + (shiftl_aux (digits n) unsafe_shiftl)) n x. + + Theorem spec_shiftl: forall n x, + [shiftl n x] = [x] * 2 ^ [n]. + Proof. + intros n x; unfold shiftl, shiftl_aux_body. + generalize (spec_compare_aux n (head0 x)); case compare; intros H. + apply spec_unsafe_shiftl; auto with zarith. + apply spec_unsafe_shiftl; auto with zarith. + rewrite <- (spec_double_size x). + generalize (spec_compare_aux n (head0 (double_size x))); case compare; intros H1. + apply spec_unsafe_shiftl; auto with zarith. + apply spec_unsafe_shiftl; auto with zarith. + rewrite <- (spec_double_size (double_size x)). + apply spec_shiftl_aux with 1%positive. + apply Zle_trans with (2 := spec_double_size_head0 (double_size x)). + replace (2 ^ 1) with (2 * 1). + apply Zmult_le_compat_l; auto with zarith. + generalize (spec_double_size_head0_pos x); auto with zarith. + rewrite Zpower_1_r; ring. + intros x1 H2; apply spec_unsafe_shiftl. + apply Zle_trans with (2 := H2). + apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith. + case (spec_digits n); auto with zarith. + apply Zpower_le_monotone; auto with zarith. + Qed. + + + (** * Zero and One *) + + Theorem spec_0: [zero] = 0. + Proof. + exact (spec_0 w0_spec). + Qed. + + Theorem spec_1: [one] = 1. + Proof. + exact (spec_1 w0_spec). + Qed. + + +End Make. diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml index 04c7b96d..b8552a39 100644 --- a/theories/Numbers/Natural/BigN/NMake_gen.ml +++ b/theories/Numbers/Natural/BigN/NMake_gen.ml @@ -8,14 +8,14 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: NMake_gen.ml 11576 2008-11-10 19:13:15Z msozeau $ i*) +(*i $Id$ i*) (*S NMake_gen.ml : this file generates NMake.v *) (*s The two parameters that control the generation: *) -let size = 6 (* how many times should we repeat the Z/nZ --> Z/2nZ +let size = 6 (* how many times should we repeat the Z/nZ --> Z/2nZ process before relying on a generic construct *) let gen_proof = true (* should we generate proofs ? *) @@ -27,18 +27,18 @@ let c = "N" let pz n = if n == 0 then "w_0" else "W0" let rec gen2 n = if n == 0 then "1" else if n == 1 then "2" else "2 * " ^ (gen2 (n - 1)) -let rec genxO n s = +let rec genxO n s = if n == 0 then s else " (xO" ^ (genxO (n - 1) s) ^ ")" -(* NB: in ocaml >= 3.10, we could use Printf.ifprintf for printing to - /dev/null, but for being compatible with earlier ocaml and not - relying on system-dependent stuff like open_out "/dev/null", +(* NB: in ocaml >= 3.10, we could use Printf.ifprintf for printing to + /dev/null, but for being compatible with earlier ocaml and not + relying on system-dependent stuff like open_out "/dev/null", let's use instead a magical hack *) (* Standard printer, with a final newline *) let pr s = Printf.printf (s^^"\n") (* Printing to /dev/null *) -let pn = (fun s -> Obj.magic (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> ()) +let pn = (fun s -> Obj.magic (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> ()) : ('a, out_channel, unit) format -> 'a) (* Proof printer : prints iff gen_proof is true *) let pp = if gen_proof then pr else pn @@ -51,7 +51,7 @@ let pp0 = if gen_proof then pr0 else pn (*s The actual printing *) -let _ = +let _ = pr "(************************************************************************)"; pr "(* v * The Coq Proof Assistant / The Coq Development Team *)"; @@ -67,21 +67,13 @@ let _ = pr ""; pr "(** From a cyclic Z/nZ representation to arbitrary precision natural numbers.*)"; pr ""; - pr "(** Remark: File automatically generated by NMake_gen.ml, DO NOT EDIT ! *)"; + pr "(** Remark: File automatically generated by NMake_gen.ml, DO NOT EDIT ! *)"; pr ""; - pr "Require Import BigNumPrelude."; - pr "Require Import ZArith."; - pr "Require Import CyclicAxioms."; - pr "Require Import DoubleType."; - pr "Require Import DoubleMul."; - pr "Require Import DoubleDivn1."; - pr "Require Import DoubleCyclic."; - pr "Require Import Nbasic."; - pr "Require Import Wf_nat."; - pr "Require Import StreamMemo."; - pr "Require Import NSig."; + pr "Require Import BigNumPrelude ZArith CyclicAxioms"; + pr " DoubleType DoubleMul DoubleDivn1 DoubleCyclic Nbasic"; + pr " Wf_nat StreamMemo."; pr ""; - pr "Module Make (Import W0:CyclicType) <: NType."; + pr "Module Make (Import W0:CyclicType)."; pr ""; pr " Definition w0 := W0.w."; @@ -132,7 +124,7 @@ let _ = pr ""; pr " Inductive %s_ :=" t; - for i = 0 to size do + for i = 0 to size do pr " | %s%i : w%i -> %s_" c i i t done; pr " | %sn : forall n, word w%i (S n) -> %s_." c size t; @@ -167,20 +159,20 @@ let _ = pr " Definition to_N x := Zabs_N (to_Z x)."; pr ""; - + pr " Definition eq x y := (to_Z x = to_Z y)."; pr ""; pp " (* Regular make op (no karatsuba) *)"; - pp " Fixpoint nmake_op (ww:Type) (ww_op: znz_op ww) (n: nat) : "; + pp " Fixpoint nmake_op (ww:Type) (ww_op: znz_op ww) (n: nat) :"; pp " znz_op (word ww n) :="; - pp " match n return znz_op (word ww n) with "; + pp " match n return znz_op (word ww n) with"; pp " O => ww_op"; - pp " | S n1 => mk_zn2z_op (nmake_op ww ww_op n1) "; + pp " | S n1 => mk_zn2z_op (nmake_op ww ww_op n1)"; pp " end."; pp ""; pp " (* Simplification by rewriting for nmake_op *)"; - pp " Theorem nmake_op_S: forall ww (w_op: znz_op ww) x, "; + pp " Theorem nmake_op_S: forall ww (w_op: znz_op ww) x,"; pp " nmake_op _ w_op (S x) = mk_zn2z_op (nmake_op _ w_op x)."; pp " auto."; pp " Qed."; @@ -191,7 +183,7 @@ let _ = for i = 0 to size do pp " Let nmake_op%i := nmake_op _ w%i_op." i i; pp " Let eval%in n := znz_to_Z (nmake_op%i n)." i i; - if i == 0 then + if i == 0 then pr " Let extend%i := DoubleBase.extend (WW w_0)." i else pr " Let extend%i := DoubleBase.extend (WW (W0: w%i))." i i; @@ -199,8 +191,8 @@ let _ = pr ""; - pp " Theorem digits_doubled:forall n ww (w_op: znz_op ww), "; - pp " znz_digits (nmake_op _ w_op n) = "; + pp " Theorem digits_doubled:forall n ww (w_op: znz_op ww),"; + pp " znz_digits (nmake_op _ w_op n) ="; pp " DoubleBase.double_digits (znz_digits w_op) n."; pp " Proof."; pp " intros n; elim n; auto; clear n."; @@ -208,7 +200,7 @@ let _ = pp " rewrite <- Hrec; auto."; pp " Qed."; pp ""; - pp " Theorem nmake_double: forall n ww (w_op: znz_op ww), "; + pp " Theorem nmake_double: forall n ww (w_op: znz_op ww),"; pp " znz_to_Z (nmake_op _ w_op n) ="; pp " @DoubleBase.double_to_Z _ (znz_digits w_op) (znz_to_Z w_op) n."; pp " Proof."; @@ -220,8 +212,8 @@ let _ = pp ""; - pp " Theorem digits_nmake:forall n ww (w_op: znz_op ww), "; - pp " znz_digits (nmake_op _ w_op (S n)) = "; + pp " Theorem digits_nmake:forall n ww (w_op: znz_op ww),"; + pp " znz_digits (nmake_op _ w_op (S n)) ="; pp " xO (znz_digits (nmake_op _ w_op n))."; pp " Proof."; pp " auto."; @@ -257,30 +249,30 @@ let _ = pp " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op n))))."; pp " rewrite Hrec; auto with arith."; pp " Qed."; - pp " "; + pp ""; for i = 1 to size + 2 do pp " Let znz_to_Z_%i: forall x y," i; - pp " znz_to_Z w%i_op (WW x y) = " i; + pp " znz_to_Z w%i_op (WW x y) =" i; pp " znz_to_Z w%i_op x * base (znz_digits w%i_op) + znz_to_Z w%i_op y." (i-1) (i-1) (i-1); pp " Proof."; pp " auto."; - pp " Qed. "; + pp " Qed."; pp ""; done; pp " Let znz_to_Z_n: forall n x y,"; - pp " znz_to_Z (make_op (S n)) (WW x y) = "; + pp " znz_to_Z (make_op (S n)) (WW x y) ="; pp " znz_to_Z (make_op n) x * base (znz_digits (make_op n)) + znz_to_Z (make_op n) y."; pp " Proof."; pp " intros n x y; rewrite make_op_S; auto."; - pp " Qed. "; + pp " Qed."; pp ""; pp " Let w0_spec: znz_spec w0_op := W0.w_spec."; for i = 1 to 3 do - pp " Let w%i_spec: znz_spec w%i_op := mk_znz2_spec w%i_spec." i i (i-1) + pp " Let w%i_spec: znz_spec w%i_op := mk_znz2_spec w%i_spec." i i (i-1) done; for i = 4 to size + 3 do pp " Let w%i_spec : znz_spec w%i_op := mk_znz2_karatsuba_spec w%i_spec." i i (i-1) @@ -309,14 +301,14 @@ let _ = for i = 0 to size do - pp " Theorem digits_w%i: znz_digits w%i_op = znz_digits (nmake_op _ w0_op %i)." i i i; + pp " Theorem digits_w%i: znz_digits w%i_op = znz_digits (nmake_op _ w0_op %i)." i i i; if i == 0 then pp " auto." else pp " rewrite digits_nmake; rewrite <- digits_w%i; auto." (i - 1); pp " Qed."; pp ""; - pp " Let spec_double_eval%in: forall n, eval%in n = DoubleBase.double_to_Z (znz_digits w%i_op) (znz_to_Z w%i_op) n." i i i i; + pp " Let spec_double_eval%in: forall n, eval%in n = DoubleBase.double_to_Z (znz_digits w%i_op) (znz_to_Z w%i_op) n." i i i i; pp " Proof."; pp " intros n; exact (nmake_double n w%i w%i_op)." i i; pp " Qed."; @@ -325,7 +317,7 @@ let _ = for i = 0 to size do for j = 0 to (size - i) do - pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i j (i + j) i j; + pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i j (i + j) i j; pp " Proof."; if j == 0 then if i == 0 then @@ -346,7 +338,7 @@ let _ = end; pp " Qed."; pp ""; - pp " Let spec_eval%in%i: forall x, [%s%i x] = eval%in %i x." i j c (i + j) i j; + pp " Let spec_eval%in%i: forall x, [%s%i x] = eval%in %i x." i j c (i + j) i j; pp " Proof."; if j == 0 then pp " intros x; rewrite spec_double_eval%in; unfold DoubleBase.double_to_Z, to_Z; auto." i @@ -363,7 +355,7 @@ let _ = pp " Qed."; if i + j <> size then begin - pp " Let spec_extend%in%i: forall x, [%s%i x] = [%s%i (extend%i %i x)]." i (i + j + 1) c i c (i + j + 1) i j; + pp " Let spec_extend%in%i: forall x, [%s%i x] = [%s%i (extend%i %i x)]." i (i + j + 1) c i c (i + j + 1) i j; if j == 0 then begin pp " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." i (i + j); @@ -393,7 +385,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_eval%in%i: forall x, [%sn 0 x] = eval%in %i x." i (size - i + 1) c i (size - i + 1); + pp " Let spec_eval%in%i: forall x, [%sn 0 x] = eval%in %i x." i (size - i + 1) c i (size - i + 1); pp " Proof."; pp " intros x; case x."; pp " auto."; @@ -405,7 +397,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_eval%in%i: forall x, [%sn 1 x] = eval%in %i x." i (size - i + 2) c i (size - i + 2); + pp " Let spec_eval%in%i: forall x, [%sn 1 x] = eval%in %i x." i (size - i + 2) c i (size - i + 2); pp " intros x; case x."; pp " auto."; pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (size + 2); @@ -430,7 +422,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_eval%in: forall n x, [%sn n x] = eval%in (S n) x." size c size; + pp " Let spec_eval%in: forall n x, [%sn n x] = eval%in (S n) x." size c size; pp " intros n; elim n; clear n."; pp " exact spec_eval%in1." size; pp " intros n Hrec x; case x; clear x."; @@ -446,7 +438,7 @@ let _ = pp " Qed."; pp ""; - pp " Let spec_extend%in: forall n x, [%s%i x] = [%sn n (extend%i n x)]." size c size c size ; + pp " Let spec_extend%in: forall n x, [%s%i x] = [%sn n (extend%i n x)]." size c size c size ; pp " intros n; elim n; clear n."; pp " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." size size; pp " unfold to_Z."; @@ -478,7 +470,6 @@ let _ = pp " unfold to_Z."; pp " case n1; auto; intros n2; repeat rewrite make_op_S; auto."; pp " Qed."; - pp " Hint Rewrite spec_extendn_0: extr."; pp ""; pp " Let spec_extendn0_0: forall n wx, [%sn (S n) (WW W0 wx)] = [%sn n wx]." c c; pp " Proof."; @@ -489,7 +480,6 @@ let _ = pp " case n; auto."; pp " intros n1; rewrite make_op_S; auto."; pp " Qed."; - pp " Hint Rewrite spec_extendn_0: extr."; pp ""; pp " Let spec_extend_tr: forall m n (w: word _ (S n)),"; pp " [%sn (m + n) (extend_tr w m)] = [%sn n w]." c c; @@ -498,7 +488,6 @@ let _ = pp " intros n x; simpl extend_tr."; pp " simpl plus; rewrite spec_extendn0_0; auto."; pp " Qed."; - pp " Hint Rewrite spec_extend_tr: extr."; pp ""; pp " Let spec_cast_l: forall n m x1,"; pp " [%sn (Max.max n m)" c; @@ -508,7 +497,6 @@ let _ = pp " intros n m x1; case (diff_r n m); simpl castm."; pp " rewrite spec_extend_tr; auto."; pp " Qed."; - pp " Hint Rewrite spec_cast_l: extr."; pp ""; pp " Let spec_cast_r: forall n m x1,"; pp " [%sn (Max.max n m)" c; @@ -518,7 +506,6 @@ let _ = pp " intros n m x1; case (diff_l n m); simpl castm."; pp " rewrite spec_extend_tr; auto."; pp " Qed."; - pp " Hint Rewrite spec_cast_r: extr."; pp ""; @@ -578,14 +565,14 @@ let _ = pr " | %s%i wx, %s%i wy => f%i (extend%i %i wx) wy" c i c j j i (j - i - 1); done; if i == size then - pr " | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy" c size c size - else + pr " | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy" c size c size + else pr " | %s%i wx, %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c i c size i (size - i - 1); done; for i = 0 to size do if i == size then - pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)" c c size size - else + pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)" c c size size + else pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n (extend%i %i wy))" c c i size i (size - i - 1); done; pr " | %sn n wx, Nn m wy =>" c; @@ -611,17 +598,17 @@ let _ = done; if i == size then pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size; done; pp " intros n x y; case y; clear y."; for i = 0 to size do if i == size then pp " intros y; rewrite (spec_extend%in n); apply Pfnn." size - else + else pp " intros y; rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size; done; - pp " intros m y; rewrite <- (spec_cast_l n m x); "; + pp " intros m y; rewrite <- (spec_cast_l n m x);"; pp " rewrite <- (spec_cast_r n m y); apply Pfnn."; pp " Qed."; pp ""; @@ -644,7 +631,7 @@ let _ = pr " match y with"; for j = 0 to i - 1 do pr " | %s%i wy =>" c j; - if j == 0 then + if j == 0 then pr " if w0_eq0 wy then ft0 x else"; pr " f%i wx (extend%i %i wy)" i j (i - j -1); done; @@ -653,8 +640,8 @@ let _ = pr " | %s%i wy => f%i (extend%i %i wx) wy" c j j i (j - i - 1); done; if i == size then - pr " | %sn m wy => fnn m (extend%i m wx) wy" c size - else + pr " | %sn m wy => fnn m (extend%i m wx) wy" c size + else pr " | %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c size i (size - i - 1); pr" end"; done; @@ -665,8 +652,8 @@ let _ = if i == 0 then pr " if w0_eq0 wy then ft0 x else"; if i == size then - pr " fnn n wx (extend%i n wy)" size - else + pr " fnn n wx (extend%i n wy)" size + else pr " fnn n wx (extend%i n (extend%i %i wy))" size i (size - i - 1); done; pr " | %sn m wy =>" c; @@ -707,7 +694,7 @@ let _ = done; if i == size then pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size; done; pp " intros n x y; case y; clear y."; @@ -721,16 +708,16 @@ let _ = end; if i == size then pp " rewrite (spec_extend%in n); apply Pfnn." size - else + else pp " rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size; done; - pp " intros m y; rewrite <- (spec_cast_l n m x); "; + pp " intros m y; rewrite <- (spec_cast_l n m x);"; pp " rewrite <- (spec_cast_r n m y); apply Pfnn."; pp " Qed."; pp ""; pr " (* We iter the smaller argument with the bigger *)"; - pr " Definition iter (x y: t_): res := "; + pr " Definition iter (x y: t_): res :="; pr0 " Eval lazy zeta beta iota delta ["; for i = 0 to size do pr0 "extend%i " i; @@ -748,14 +735,14 @@ let _ = pr " | %s%i wx, %s%i wy => f%in %i wx wy" c i c j i (j - i - 1); done; if i == size then - pr " | %s%i wx, %sn m wy => f%in m wx wy" c size c size - else + pr " | %s%i wx, %sn m wy => f%in m wx wy" c size c size + else pr " | %s%i wx, %sn m wy => f%in m (extend%i %i wx) wy" c i c size i (size - i - 1); done; for i = 0 to size do if i == size then - pr " | %sn n wx, %s%i wy => fn%i n wx wy" c c size size - else + pr " | %sn n wx, %s%i wy => fn%i n wx wy" c c size size + else pr " | %sn n wx, %s%i wy => fn%i n wx (extend%i %i wy)" c c i size i (size - i - 1); done; pr " | %sn n wx, %sn m wy => fnm n m wx wy" c c; @@ -765,6 +752,7 @@ let _ = pp " Ltac zg_tac := try"; pp " (red; simpl Zcompare; auto;"; pp " let t := fresh \"H\" in (intros t; discriminate t))."; + pp ""; pp " Lemma spec_iter: forall x y, P [x] [y] (iter x y)."; pp " Proof."; pp " intros x; case x; clear x; unfold iter."; @@ -779,14 +767,14 @@ let _ = done; if i == size then pp " intros m y; rewrite spec_eval%in; apply Pf%in." size size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size; done; pp " intros n x y; case y; clear y."; for i = 0 to size do if i == size then pp " intros y; rewrite spec_eval%in; apply Pfn%i." size size - else + else pp " intros y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size; done; pp " intros m y; apply Pfnm."; @@ -820,8 +808,8 @@ let _ = pr " | %s%i wy => f%in %i wx wy" c j i (j - i - 1); done; if i == size then - pr " | %sn m wy => f%in m wx wy" c size - else + pr " | %sn m wy => f%in m wx wy" c size + else pr " | %sn m wy => f%in m (extend%i %i wx) wy" c size i (size - i - 1); pr " end"; done; @@ -832,8 +820,8 @@ let _ = if i == 0 then pr " if w0_eq0 wy then ft0 x else"; if i == size then - pr " fn%i n wx wy" size - else + pr " fn%i n wx wy" size + else pr " fn%i n wx (extend%i %i wy)" size i (size - i - 1); done; pr " | %sn m wy => fnm n m wx wy" c; @@ -869,7 +857,7 @@ let _ = done; if i == size then pp " intros m y; rewrite spec_eval%in; apply Pf%in." size size - else + else pp " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size; done; pp " intros n x y; case y; clear y."; @@ -883,7 +871,7 @@ let _ = end; if i == size then pp " rewrite spec_eval%in; apply Pfn%i." size size - else + else pp " rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size; done; pp " intros m y; apply Pfnm."; @@ -897,27 +885,27 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Reduction *)"; + pr " (** * Reduction *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; - pr " Definition reduce_0 (x:w) := %s0 x." c; + pr " Definition reduce_0 (x:w) := %s0 x." c; pr " Definition reduce_1 :="; pr " Eval lazy beta iota delta[reduce_n1] in"; pr " reduce_n1 _ _ zero w0_eq0 %s0 %s1." c c; for i = 2 to size do pr " Definition reduce_%i :=" i; pr " Eval lazy beta iota delta[reduce_n1] in"; - pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i %s%i." + pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i %s%i." (i-1) (i-1) c i done; pr " Definition reduce_%i :=" (size+1); pr " Eval lazy beta iota delta[reduce_n1] in"; - pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i (%sn 0)." - size size c; + pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i (%sn 0)." + size size c; - pr " Definition reduce_n n := "; + pr " Definition reduce_n n :="; pr " Eval lazy beta iota delta[reduce_n] in"; pr " reduce_n _ _ zero reduce_%i %sn n." (size + 1) c; pr ""; @@ -927,7 +915,7 @@ let _ = pp " intros x; unfold to_Z, reduce_0."; pp " auto."; pp " Qed."; - pp " "; + pp ""; for i = 1 to size + 1 do if i == size + 1 then @@ -938,14 +926,14 @@ let _ = pp " intros x; case x; unfold reduce_%i." i; pp " exact (spec_0 w0_spec)."; pp " intros x1 y1."; - pp " generalize (spec_w%i_eq0 x1); " (i - 1); + pp " generalize (spec_w%i_eq0 x1);" (i - 1); pp " case w%i_eq0; intros H1; auto." (i - 1); - if i <> 1 then + if i <> 1 then pp " rewrite spec_reduce_%i." (i - 1); pp " unfold to_Z; rewrite znz_to_Z_%i." i; pp " unfold to_Z in H1; rewrite H1; auto."; pp " Qed."; - pp " "; + pp ""; done; pp " Let spec_reduce_n: forall n x, [reduce_n n x] = [%sn n x]." c; @@ -959,11 +947,11 @@ let _ = pp " rewrite Hrec."; pp " rewrite spec_extendn0_0; auto."; pp " Qed."; - pp " "; + pp ""; pr " (***************************************************************)"; pr " (* *)"; - pr " (* Successor *)"; + pr " (** * Successor *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -983,19 +971,19 @@ let _ = for i = 0 to size-1 do pr " | %s%i wx =>" c i; pr " match w%i_succ_c wx with" i; - pr " | C0 r => %s%i r" c i; + pr " | C0 r => %s%i r" c i; pr " | C1 r => %s%i (WW one%i r)" c (i+1) i; pr " end"; done; pr " | %s%i wx =>" c size; pr " match w%i_succ_c wx with" size; - pr " | C0 r => %s%i r" c size; + pr " | C0 r => %s%i r" c size; pr " | C1 r => %sn 0 (WW one%i r)" c size ; pr " end"; pr " | %sn n wx =>" c; pr " let op := make_op n in"; pr " match op.(znz_succ_c) wx with"; - pr " | C0 r => %sn n r" c; + pr " | C0 r => %sn n r" c; pr " | C1 r => %sn (S n) (WW op.(znz_1) r)" c; pr " end"; pr " end."; @@ -1027,13 +1015,13 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Adddition *)"; + pr " (** * Adddition *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; for i = 0 to size do - pr " Definition w%i_add_c := znz_add_c w%i_op." i i; + pr " Definition w%i_add_c := znz_add_c w%i_op." i i; pr " Definition w%i_add x y :=" i; pr " match w%i_add_c x y with" i; pr " | C0 r => %s%i r" c i; @@ -1057,26 +1045,24 @@ let _ = pp " Proof."; pp " intros n m; unfold to_Z, w%i_add, w%i_add_c." i i; pp " generalize (spec_add_c w%i_spec n m); case znz_add_c; auto." i; - pp " intros ww H; rewrite <- H."; + pp " intros ww H; rewrite <- H."; pp " rewrite znz_to_Z_%i; unfold interp_carry;" (i + 1); pp " apply f_equal2 with (f := Zplus); auto;"; pp " apply f_equal2 with (f := Zmult); auto;"; pp " exact (spec_1 w%i_spec)." i; pp " Qed."; - pp " Hint Rewrite spec_w%i_add: addr." i; pp ""; done; pp " Let spec_wn_add: forall n x y, [addn n x y] = [%sn n x] + [%sn n y]." c c; pp " Proof."; pp " intros k n m; unfold to_Z, addn."; pp " generalize (spec_add_c (wn_spec k) n m); case znz_add_c; auto."; - pp " intros ww H; rewrite <- H."; + pp " intros ww H; rewrite <- H."; pp " rewrite (znz_to_Z_n k); unfold interp_carry;"; pp " apply f_equal2 with (f := Zplus); auto;"; pp " apply f_equal2 with (f := Zmult); auto;"; pp " exact (spec_1 (wn_spec k))."; pp " Qed."; - pp " Hint Rewrite spec_wn_add: addr."; pr " Definition add := Eval lazy beta delta [same_level] in"; pr0 " (same_level t_ "; @@ -1101,7 +1087,7 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Predecessor *)"; + pr " (** * Predecessor *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1116,25 +1102,25 @@ let _ = for i = 0 to size do pr " | %s%i wx =>" c i; pr " match w%i_pred_c wx with" i; - pr " | C0 r => reduce_%i r" i; + pr " | C0 r => reduce_%i r" i; pr " | C1 r => zero"; pr " end"; done; pr " | %sn n wx =>" c; pr " let op := make_op n in"; pr " match op.(znz_pred_c) wx with"; - pr " | C0 r => reduce_n n r"; + pr " | C0 r => reduce_n n r"; pr " | C1 r => zero"; pr " end"; pr " end."; pr ""; - pr " Theorem spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1."; + pr " Theorem spec_pred_pos : forall x, 0 < [x] -> [pred x] = [x] - 1."; pa " Admitted."; pp " Proof."; pp " intros x; case x; unfold pred."; for i = 0 to size do - pp " intros x1 H1; unfold w%i_pred_c; " i; + pp " intros x1 H1; unfold w%i_pred_c;" i; pp " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i; pp " rewrite spec_reduce_%i; auto." i; pp " unfold interp_carry; unfold to_Z."; @@ -1143,7 +1129,7 @@ let _ = pp " assert (znz_to_Z w%i_op x1 - 1 < 0); auto with zarith." i; pp " unfold to_Z in H1; auto with zarith."; done; - pp " intros n x1 H1; "; + pp " intros n x1 H1;"; pp " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1."; pp " rewrite spec_reduce_n; auto."; pp " unfold interp_carry; unfold to_Z."; @@ -1152,32 +1138,31 @@ let _ = pp " assert (znz_to_Z (make_op n) x1 - 1 < 0); auto with zarith."; pp " unfold to_Z in H1; auto with zarith."; pp " Qed."; - pp " "; - + pp ""; + pp " Let spec_pred0: forall x, [x] = 0 -> [pred x] = 0."; pp " Proof."; pp " intros x; case x; unfold pred."; for i = 0 to size do - pp " intros x1 H1; unfold w%i_pred_c; " i; + pp " intros x1 H1; unfold w%i_pred_c;" i; pp " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i; pp " unfold interp_carry; unfold to_Z."; pp " unfold to_Z in H1; auto with zarith."; pp " case (spec_to_Z w%i_spec y1); intros HH3 HH4; auto with zarith." i; pp " intros; exact (spec_0 w0_spec)."; done; - pp " intros n x1 H1; "; + pp " intros n x1 H1;"; pp " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1."; pp " unfold interp_carry; unfold to_Z."; pp " unfold to_Z in H1; auto with zarith."; pp " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4; auto with zarith."; pp " intros; exact (spec_0 w0_spec)."; pp " Qed."; - pr " "; - + pr ""; pr " (***************************************************************)"; pr " (* *)"; - pr " (* Subtraction *)"; + pr " (** * Subtraction *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1187,7 +1172,7 @@ let _ = done; pr ""; - for i = 0 to size do + for i = 0 to size do pr " Definition w%i_sub x y :=" i; pr " match w%i_sub_c x y with" i; pr " | C0 r => reduce_%i r" i; @@ -1208,8 +1193,8 @@ let _ = pp " Let spec_w%i_sub: forall x y, [%s%i y] <= [%s%i x] -> [w%i_sub x y] = [%s%i x] - [%s%i y]." i c i c i i c i c i; pp " Proof."; pp " intros n m; unfold w%i_sub, w%i_sub_c." i i; - pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c; " i; - if i == 0 then + pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c;" i; + if i == 0 then pp " intros x; auto." else pp " intros x; try rewrite spec_reduce_%i; auto." i; @@ -1219,11 +1204,11 @@ let _ = pp " Qed."; pp ""; done; - + pp " Let spec_wn_sub: forall n x y, [%sn n y] <= [%sn n x] -> [subn n x y] = [%sn n x] - [%sn n y]." c c c c; pp " Proof."; pp " intros k n m; unfold subn."; - pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; "; + pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c;"; pp " intros x; auto."; pp " unfold interp_carry, to_Z."; pp " case (spec_to_Z (wn_spec k) x); intros; auto with zarith."; @@ -1238,7 +1223,7 @@ let _ = pr "subn)."; pr ""; - pr " Theorem spec_sub: forall x y, [y] <= [x] -> [sub x y] = [x] - [y]."; + pr " Theorem spec_sub_pos : forall x y, [y] <= [x] -> [sub x y] = [x] - [y]."; pa " Admitted."; pp " Proof."; pp " unfold sub."; @@ -1255,7 +1240,7 @@ let _ = pp " Let spec_w%i_sub0: forall x y, [%s%i x] < [%s%i y] -> [w%i_sub x y] = 0." i c i c i i; pp " Proof."; pp " intros n m; unfold w%i_sub, w%i_sub_c." i i; - pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c; " i; + pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c;" i; pp " intros x; unfold interp_carry."; pp " unfold to_Z; case (spec_to_Z w%i_spec x); intros; auto with zarith." i; pp " intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto."; @@ -1266,7 +1251,7 @@ let _ = pp " Let spec_wn_sub0: forall n x y, [%sn n x] < [%sn n y] -> [subn n x y] = 0." c c; pp " Proof."; pp " intros k n m; unfold subn."; - pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; "; + pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c;"; pp " intros x; unfold interp_carry."; pp " unfold to_Z; case (spec_to_Z (wn_spec k) x); intros; auto with zarith."; pp " intros; unfold to_Z, w_0; rewrite (spec_0 (w0_spec)); auto."; @@ -1289,7 +1274,7 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Comparison *)"; + pr " (** * Comparison *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1299,7 +1284,7 @@ let _ = pr " Definition comparen_%i :=" i; pr " compare_mn_1 w%i w%i %s compare_%i (compare_%i %s) compare_%i." i i (pz i) i i (pz i) i done; - pr ""; + pr ""; pr " Definition comparenm n m wx wy :="; pr " let mn := Max.max n m in"; @@ -1310,8 +1295,8 @@ let _ = pr " (castm (diff_l n m) (extend_tr wy (fst d)))."; pr ""; - pr " Definition compare := Eval lazy beta delta [iter] in "; - pr " (iter _ "; + pr " Definition compare := Eval lazy beta delta [iter] in"; + pr " (iter _"; for i = 0 to size do pr " compare_%i" i; pr " (fun n x y => opp_compare (comparen_%i (S n) y x))" i; @@ -1320,15 +1305,9 @@ let _ = pr " comparenm)."; pr ""; - pr " Definition lt n m := compare n m = Lt."; - pr " Definition le n m := compare n m <> Gt."; - pr " Definition min n m := match compare n m with Gt => m | _ => n end."; - pr " Definition max n m := match compare n m with Lt => m | _ => n end."; - pr ""; - for i = 0 to size do pp " Let spec_compare_%i: forall x y," i; - pp " match compare_%i x y with " i; + pp " match compare_%i x y with" i; pp " Eq => [%s%i x] = [%s%i y]" c i c i; pp " | Lt => [%s%i x] < [%s%i y]" c i c i; pp " | Gt => [%s%i x] > [%s%i y]" c i c i; @@ -1337,7 +1316,7 @@ let _ = pp " unfold compare_%i, to_Z; exact (spec_compare w%i_spec)." i i; pp " Qed."; pp ""; - + pp " Let spec_comparen_%i:" i; pp " forall (n : nat) (x : word w%i n) (y : w%i)," i i; pp " match comparen_%i n x y with" i; @@ -1367,16 +1346,16 @@ let _ = pp ""; - pr " Theorem spec_compare: forall x y,"; - pr " match compare x y with "; + pr " Theorem spec_compare_aux: forall x y,"; + pr " match compare x y with"; pr " Eq => [x] = [y]"; pr " | Lt => [x] < [y]"; pr " | Gt => [x] > [y]"; pr " end."; pa " Admitted."; pp " Proof."; - pp " refine (spec_iter _ (fun x y res => "; - pp " match res with "; + pp " refine (spec_iter _ (fun x y res =>"; + pp " match res with"; pp " Eq => x = y"; pp " | Lt => x < y"; pp " | Gt => x > y"; @@ -1387,12 +1366,12 @@ let _ = pp " (fun n => comparen_%i (S n)) _ _ _" i; done; pp " comparenm _)."; - + for i = 0 to size - 1 do pp " exact spec_compare_%i." i; pp " intros n x y H;apply spec_opp_compare; apply spec_comparen_%i." i; pp " intros n x y H; exact (spec_comparen_%i (S n) x y)." i; - done; + done; pp " exact spec_compare_%i." size; pp " intros n x y;apply spec_opp_compare; apply spec_comparen_%i." size; pp " intros n; exact (spec_comparen_%i (S n))." size; @@ -1402,28 +1381,9 @@ let _ = pp " Qed."; pr ""; - pr " Definition eq_bool x y :="; - pr " match compare x y with"; - pr " | Eq => true"; - pr " | _ => false"; - pr " end."; - pr ""; - - - pr " Theorem spec_eq_bool: forall x y,"; - pr " if eq_bool x y then [x] = [y] else [x] <> [y]."; - pa " Admitted."; - pp " Proof."; - pp " intros x y; unfold eq_bool."; - pp " generalize (spec_compare x y); case compare; auto with zarith."; - pp " Qed."; - pr ""; - - - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Multiplication *)"; + pr " (** * Multiplication *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1461,7 +1421,7 @@ let _ = pr " match n return word w%i (S n) -> t_ with" i; for j = 0 to size - i do if (i + j) == size then - begin + begin pr " | %i%s => fun x => %sn 0 x" j "%nat" c; pr " | %i%s => fun x => %sn 1 x" (j + 1) "%nat" c end @@ -1471,7 +1431,7 @@ let _ = pr " | _ => fun _ => N0 w_0"; pr " end."; pr ""; - done; + done; for i = 0 to size - 1 do @@ -1486,7 +1446,7 @@ let _ = pp " repeat rewrite inj_S; unfold Zsucc; auto with zarith."; pp " Qed."; pp ""; - done; + done; for i = 0 to size do @@ -1497,8 +1457,8 @@ let _ = pr " if w%i_eq0 w then %sn n r" i c; pr " else %sn (S n) (WW (extend%i n w) r)." c i; end - else - begin + else + begin pr " if w%i_eq0 w then to_Z%i n r" i i; pr " else to_Z%i (S n) (WW (extend%i n w) r)." i i; end; @@ -1514,10 +1474,10 @@ let _ = pr " (castm (diff_l n m) (extend_tr y (fst d))))."; pr ""; - pr " Definition mul := Eval lazy beta delta [iter0] in "; - pr " (iter0 t_ "; + pr " Definition mul := Eval lazy beta delta [iter0] in"; + pr " (iter0 t_"; for i = 0 to size do - pr " (fun x y => reduce_%i (w%i_mul_c x y)) " (i + 1) i; + pr " (fun x y => reduce_%i (w%i_mul_c x y))" (i + 1) i; pr " (fun n x y => w%i_mul n y x)" i; pr " w%i_mul" i; done; @@ -1556,7 +1516,7 @@ let _ = pp " Qed."; pp ""; done; - + pp " Lemma nmake_op_WW: forall ww ww1 n x y,"; pp " znz_to_Z (nmake_op ww ww1 (S n)) (WW x y) ="; pp " znz_to_Z (nmake_op ww ww1 n) x * base (znz_digits (nmake_op ww ww1 n)) +"; @@ -1564,21 +1524,21 @@ let _ = pp " auto."; pp " Qed."; pp ""; - + for i = 0 to size do pp " Lemma extend%in_spec: forall n x1," i; - pp " znz_to_Z (nmake_op _ w%i_op (S n)) (extend%i n x1) = " i i; + pp " znz_to_Z (nmake_op _ w%i_op (S n)) (extend%i n x1) =" i i; pp " znz_to_Z w%i_op x1." i; pp " Proof."; pp " intros n1 x2; rewrite nmake_double."; pp " unfold extend%i." i; pp " rewrite DoubleBase.spec_extend; auto."; - if i == 0 then + if i == 0 then pp " intros l; simpl; unfold w_0; rewrite (spec_0 w0_spec); ring."; pp " Qed."; pp ""; done; - + pp " Lemma spec_muln:"; pp " forall n (x: word _ (S n)) y,"; pp " [%sn (S n) (znz_mul_c (make_op n) x y)] = [%sn n x] * [%sn n y]." c c c; @@ -1588,12 +1548,13 @@ let _ = pp " rewrite make_op_S."; pp " case znz_mul_c; auto."; pp " Qed."; + pr ""; pr " Theorem spec_mul: forall x y, [mul x y] = [x] * [y]."; pa " Admitted."; pp " Proof."; for i = 0 to size do - pp " assert(F%i: " i; + pp " assert(F%i:" i; pp " forall n x y,"; if i <> size then pp0 " Z_of_nat n <= %i -> " (size - i); @@ -1614,7 +1575,7 @@ let _ = pp " generalize (spec_w%i_eq0 x1); case w%i_eq0; intros HH." i i; pp " unfold to_Z in HH; rewrite HH."; if i == size then - begin + begin pp " rewrite spec_eval%in; unfold eval%in, nmake_op%i; auto." i i i; pp " rewrite spec_eval%in; unfold eval%in, nmake_op%i." i i i end @@ -1627,7 +1588,7 @@ let _ = done; pp " refine (spec_iter0 t_ (fun x y res => [res] = x * y)"; for i = 0 to size do - pp " (fun x y => reduce_%i (w%i_mul_c x y)) " (i + 1) i; + pp " (fun x y => reduce_%i (w%i_mul_c x y))" (i + 1) i; pp " (fun n x y => w%i_mul n y x)" i; pp " w%i_mul _ _ _" i; done; @@ -1643,12 +1604,12 @@ let _ = if i == size then begin pp " intros n x y; rewrite F%i; auto with zarith." i; - pp " intros n x y; rewrite F%i; auto with zarith. " i; + pp " intros n x y; rewrite F%i; auto with zarith." i; end else begin pp " intros n x y H; rewrite F%i; auto with zarith." i; - pp " intros n x y H; rewrite F%i; auto with zarith. " i; + pp " intros n x y H; rewrite F%i; auto with zarith." i; end; done; pp " intros n m x y; unfold mulnm."; @@ -1663,7 +1624,7 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Square *)"; + pr " (** * Square *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1702,42 +1663,9 @@ let _ = pp "Qed."; pr ""; - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Power *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - pr " Fixpoint power_pos (x:%s) (p:positive) {struct p} : %s :=" t t; - pr " match p with"; - pr " | xH => x"; - pr " | xO p => square (power_pos x p)"; - pr " | xI p => mul (square (power_pos x p)) x"; - pr " end."; - pr ""; - - pr " Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n."; - pa " Admitted."; - pp " Proof."; - pp " intros x n; generalize x; elim n; clear n x; simpl power_pos."; - pp " intros; rewrite spec_mul; rewrite spec_square; rewrite H."; - pp " rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith."; - pp " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith."; - pp " rewrite Zpower_2; rewrite Zpower_1_r; auto."; - pp " intros; rewrite spec_square; rewrite H."; - pp " rewrite Zpos_xO; auto with zarith."; - pp " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith."; - pp " rewrite Zpower_2; auto."; - pp " intros; rewrite Zpower_1_r; auto."; - pp " Qed."; - pp ""; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (* Square root *)"; + pr " (** * Square root *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; @@ -1772,26 +1700,26 @@ let _ = pr " (***************************************************************)"; pr " (* *)"; - pr " (* Division *)"; + pr " (** * Division *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; for i = 0 to size do pr " Definition w%i_div_gt := w%i_op.(znz_div_gt)." i i done; pr ""; - pp " Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := "; - pp " (spec_double_divn1 "; + pp " Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) :="; + pp " (spec_double_divn1"; pp " ww_op.(znz_zdigits) ww_op.(znz_0)"; pp " (znz_WW ww_op) ww_op.(znz_head0)"; pp " ww_op.(znz_add_mul_div) ww_op.(znz_div21)"; pp " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)"; - pp " (spec_to_Z ww_spec) "; + pp " (spec_to_Z ww_spec)"; pp " (spec_zdigits ww_spec)"; pp " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)"; - pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) "; + pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec)"; pp " (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec))."; pp ""; @@ -1811,7 +1739,7 @@ let _ = for i = 0 to size do pp " Lemma spec_get_end%i: forall n x y," i; - pp " eval%in n x <= [%s%i y] -> " i c i; + pp " eval%in n x <= [%s%i y] ->" i c i; pp " [%s%i (DoubleBase.get_low %s n x)] = eval%in n x." c i (pz i) i; pp " Proof."; pp " intros n x y H."; @@ -1843,8 +1771,8 @@ let _ = pr ""; pr " Definition div_gt := Eval lazy beta delta [iter] in"; - pr " (iter _ "; - for i = 0 to size do + pr " (iter _"; + for i = 0 to size do pr " div_gt%i" i; pr " (fun n x y => div_gt%i x (DoubleBase.get_low %s (S n) y))" i (pz i); pr " w%i_divn1" i; @@ -1862,10 +1790,10 @@ let _ = pp " forall x y, [x] > [y] -> 0 < [y] ->"; pp " let (q,r) := div_gt x y in"; pp " [x] = [q] * [y] + [r] /\\ 0 <= [r] < [y])."; - pp " refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y ->"; + pp " refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y ->"; pp " let (q,r) := res in"; pp " x = [q] * y + [r] /\\ 0 <= [r] < y)"; - for i = 0 to size do + for i = 0 to size do pp " div_gt%i" i; pp " (fun n x y => div_gt%i x (DoubleBase.get_low %s (S n) y))" i (pz i); pp " w%i_divn1 _ _ _" i; @@ -1879,11 +1807,11 @@ let _ = pp " intros n x y H2 H3; unfold div_gt%i, w%i_div_gt." i i else pp " intros n x y H1 H2 H3; unfold div_gt%i, w%i_div_gt." i i; - pp " generalize (spec_div_gt w%i_spec x " i; + pp " generalize (spec_div_gt w%i_spec x" i; pp " (DoubleBase.get_low %s (S n) y))." (pz i); - pp0 " "; + pp0 ""; for j = 0 to i do - pp0 "unfold w%i; " (i-j); + pp0 "unfold w%i; " (i-j); done; pp "case znz_div_gt."; pp " intros xx yy H4; repeat rewrite spec_reduce_%i." i; @@ -1897,7 +1825,7 @@ let _ = pp " (spec_divn1 w%i w%i_op w%i_spec (S n) x y H3)." i i i; pp0 " unfold w%i_divn1; " i; for j = 0 to i do - pp0 "unfold w%i; " (i-j); + pp0 "unfold w%i; " (i-j); done; pp "case double_divn1."; pp " intros xx yy H4."; @@ -1936,61 +1864,12 @@ let _ = pp " Qed."; pr ""; - pr " Definition div_eucl x y :="; - pr " match compare x y with"; - pr " | Eq => (one, zero)"; - pr " | Lt => (zero, x)"; - pr " | Gt => div_gt x y"; - pr " end."; - pr ""; - - pr " Theorem spec_div_eucl: forall x y,"; - pr " 0 < [y] ->"; - pr " let (q,r) := div_eucl x y in"; - pr " ([q], [r]) = Zdiv_eucl [x] [y]."; - pa " Admitted."; - pp " Proof."; - pp " assert (F0: [zero] = 0)."; - pp " exact (spec_0 w0_spec)."; - pp " assert (F1: [one] = 1)."; - pp " exact (spec_1 w0_spec)."; - pp " intros x y H; generalize (spec_compare x y);"; - pp " unfold div_eucl; case compare; try rewrite F0;"; - pp " try rewrite F1; intros; auto with zarith."; - pp " rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H))"; - pp " (Z_mod_same [y] (Zlt_gt _ _ H));"; - pp " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto."; - pp " assert (F2: 0 <= [x] < [y])."; - pp " generalize (spec_pos x); auto."; - pp " generalize (Zdiv_small _ _ F2)"; - pp " (Zmod_small _ _ F2);"; - pp " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto."; - pp " generalize (spec_div_gt _ _ H0 H); auto."; - pp " unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt."; - pp " intros a b c d (H1, H2); subst; auto."; - pp " Qed."; - pr ""; - - pr " Definition div x y := fst (div_eucl x y)."; - pr ""; - - pr " Theorem spec_div:"; - pr " forall x y, 0 < [y] -> [div x y] = [x] / [y]."; - pa " Admitted."; - pp " Proof."; - pp " intros x y H1; unfold div; generalize (spec_div_eucl x y H1);"; - pp " case div_eucl; simpl fst."; - pp " intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; "; - pp " injection H; auto."; - pp " Qed."; - pr ""; - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Modulo *)"; + pr " (** * Modulo *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; for i = 0 to size do pr " Definition w%i_mod_gt := w%i_op.(znz_mod_gt)." i i @@ -2015,7 +1894,7 @@ let _ = pr ""; pr " Definition mod_gt := Eval lazy beta delta[iter] in"; - pr " (iter _ "; + pr " (iter _"; for i = 0 to size do pr " (fun x y => reduce_%i (w%i_mod_gt x y))" i i; pr " (fun n x y => reduce_%i (w%i_mod_gt x (DoubleBase.get_low %s (S n) y)))" i i (pz i); @@ -2024,16 +1903,16 @@ let _ = pr " mod_gtnm)."; pr ""; - pp " Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := "; - pp " (spec_double_modn1 "; + pp " Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) :="; + pp " (spec_double_modn1"; pp " ww_op.(znz_zdigits) ww_op.(znz_0)"; pp " (znz_WW ww_op) ww_op.(znz_head0)"; pp " ww_op.(znz_add_mul_div) ww_op.(znz_div21)"; pp " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)"; - pp " (spec_to_Z ww_spec) "; + pp " (spec_to_Z ww_spec)"; pp " (spec_zdigits ww_spec)"; pp " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)"; - pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) "; + pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec)"; pp " (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec))."; pp ""; @@ -2063,7 +1942,7 @@ let _ = pp " rewrite <- (spec_get_end%i (S n) y x) in H3; auto with zarith." i; if i == size then pp " intros n x y H2 H3; rewrite spec_reduce_%i." i - else + else pp " intros n x y H1 H2 H3; rewrite spec_reduce_%i." i; pp " unfold w%i_modn1, to_Z; rewrite spec_double_eval%in." i i; pp " apply (spec_modn1 _ _ w%i_spec); auto." i; @@ -2079,39 +1958,9 @@ let _ = pp " Qed."; pr ""; - pr " Definition modulo x y := "; - pr " match compare x y with"; - pr " | Eq => zero"; - pr " | Lt => x"; - pr " | Gt => mod_gt x y"; - pr " end."; + pr " (** digits: a measure for gcd *)"; pr ""; - pr " Theorem spec_modulo:"; - pr " forall x y, 0 < [y] -> [modulo x y] = [x] mod [y]."; - pa " Admitted."; - pp " Proof."; - pp " assert (F0: [zero] = 0)."; - pp " exact (spec_0 w0_spec)."; - pp " assert (F1: [one] = 1)."; - pp " exact (spec_1 w0_spec)."; - pp " intros x y H; generalize (spec_compare x y);"; - pp " unfold modulo; case compare; try rewrite F0;"; - pp " try rewrite F1; intros; try split; auto with zarith."; - pp " rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith."; - pp " apply sym_equal; apply Zmod_small; auto with zarith."; - pp " generalize (spec_pos x); auto with zarith."; - pp " apply spec_mod_gt; auto."; - pp " Qed."; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (* Gcd *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - pr " Definition digits x :="; pr " match x with"; for i = 0 to size do @@ -2134,189 +1983,18 @@ let _ = pp " Qed."; pr ""; - pr " Definition gcd_gt_body a b cont :="; - pr " match compare b zero with"; - pr " | Gt =>"; - pr " let r := mod_gt a b in"; - pr " match compare r zero with"; - pr " | Gt => cont r (mod_gt b r)"; - pr " | _ => b"; - pr " end"; - pr " | _ => a"; - pr " end."; - pr ""; - - pp " Theorem Zspec_gcd_gt_body: forall a b cont p,"; - pp " [a] > [b] -> [a] < 2 ^ p ->"; - pp " (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] ->"; - pp " Zis_gcd [a1] [b1] [cont a1 b1]) -> "; - pp " Zis_gcd [a] [b] [gcd_gt_body a b cont]."; - pp " Proof."; - pp " assert (F1: [zero] = 0)."; - pp " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto."; - pp " intros a b cont p H2 H3 H4; unfold gcd_gt_body."; - pp " generalize (spec_compare b zero); case compare; try rewrite F1."; - pp " intros HH; rewrite HH; apply Zis_gcd_0."; - pp " intros HH; absurd (0 <= [b]); auto with zarith."; - pp " case (spec_digits b); auto with zarith."; - pp " intros H5; generalize (spec_compare (mod_gt a b) zero); "; - pp " case compare; try rewrite F1."; - pp " intros H6; rewrite <- (Zmult_1_r [b])."; - pp " rewrite (Z_div_mod_eq [a] [b]); auto with zarith."; - pp " rewrite <- spec_mod_gt; auto with zarith."; - pp " rewrite H6; rewrite Zplus_0_r."; - pp " apply Zis_gcd_mult; apply Zis_gcd_1."; - pp " intros; apply False_ind."; - pp " case (spec_digits (mod_gt a b)); auto with zarith."; - pp " intros H6; apply DoubleDiv.Zis_gcd_mod; auto with zarith."; - pp " apply DoubleDiv.Zis_gcd_mod; auto with zarith."; - pp " rewrite <- spec_mod_gt; auto with zarith."; - pp " assert (F2: [b] > [mod_gt a b])."; - pp " case (Z_mod_lt [a] [b]); auto with zarith."; - pp " repeat rewrite <- spec_mod_gt; auto with zarith."; - pp " assert (F3: [mod_gt a b] > [mod_gt b (mod_gt a b)])."; - pp " case (Z_mod_lt [b] [mod_gt a b]); auto with zarith."; - pp " rewrite <- spec_mod_gt; auto with zarith."; - pp " repeat rewrite <- spec_mod_gt; auto with zarith."; - pp " apply H4; auto with zarith."; - pp " apply Zmult_lt_reg_r with 2; auto with zarith."; - pp " apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith."; - pp " apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith."; - pp " apply Zplus_le_compat_r."; - pp " pattern [b] at 1; rewrite <- (Zmult_1_l [b])."; - pp " apply Zmult_le_compat_r; auto with zarith."; - pp " case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith."; - pp " intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2;"; - pp " try rewrite <- HH in H2; auto with zarith."; - pp " case (Z_mod_lt [a] [b]); auto with zarith."; - pp " rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith."; - pp " rewrite <- Z_div_mod_eq; auto with zarith."; - pp " pattern 2 at 2; rewrite <- (Zpower_1_r 2)."; - pp " rewrite <- Zpower_exp; auto with zarith."; - pp " ring_simplify (p - 1 + 1); auto."; - pp " case (Zle_lt_or_eq 0 p); auto with zarith."; - pp " generalize H3; case p; simpl Zpower; auto with zarith."; - pp " intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith."; - pp " Qed."; - pp ""; - - pr " Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t :="; - pr " gcd_gt_body a b"; - pr " (fun a b =>"; - pr " match p with"; - pr " | xH => cont a b"; - pr " | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b"; - pr " | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b"; - pr " end)."; - pr ""; - - pp " Theorem Zspec_gcd_gt_aux: forall p n a b cont,"; - pp " [a] > [b] -> [a] < 2 ^ (Zpos p + n) ->"; - pp " (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] ->"; - pp " Zis_gcd [a1] [b1] [cont a1 b1]) ->"; - pp " Zis_gcd [a] [b] [gcd_gt_aux p cont a b]."; - pp " intros p; elim p; clear p."; - pp " intros p Hrec n a b cont H2 H3 H4."; - pp " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto."; - pp " intros a1 b1 H6 H7."; - pp " apply Hrec with (Zpos p + n); auto."; - pp " replace (Zpos p + (Zpos p + n)) with"; - pp " (Zpos (xI p) + n - 1); auto."; - pp " rewrite Zpos_xI; ring."; - pp " intros a2 b2 H9 H10."; - pp " apply Hrec with n; auto."; - pp " intros p Hrec n a b cont H2 H3 H4."; - pp " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto."; - pp " intros a1 b1 H6 H7."; - pp " apply Hrec with (Zpos p + n - 1); auto."; - pp " replace (Zpos p + (Zpos p + n - 1)) with"; - pp " (Zpos (xO p) + n - 1); auto."; - pp " rewrite Zpos_xO; ring."; - pp " intros a2 b2 H9 H10."; - pp " apply Hrec with (n - 1); auto."; - pp " replace (Zpos p + (n - 1)) with"; - pp " (Zpos p + n - 1); auto with zarith."; - pp " intros a3 b3 H12 H13; apply H4; auto with zarith."; - pp " apply Zlt_le_trans with (1 := H12)."; - pp " case (Zle_or_lt 1 n); intros HH."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " apply Zle_trans with 0; auto with zarith."; - pp " assert (HH1: n - 1 < 0); auto with zarith."; - pp " generalize HH1; case (n - 1); auto with zarith."; - pp " intros p1 HH2; discriminate."; - pp " intros n a b cont H H2 H3."; - pp " simpl gcd_gt_aux."; - pp " apply Zspec_gcd_gt_body with (n + 1); auto with zarith."; - pp " rewrite Zplus_comm; auto."; - pp " intros a1 b1 H5 H6; apply H3; auto."; - pp " replace n with (n + 1 - 1); auto; try ring."; - pp " Qed."; - pp ""; - - pr " Definition gcd_cont a b :="; - pr " match compare one b with"; - pr " | Eq => one"; - pr " | _ => a"; - pr " end."; - pr ""; - - pr " Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b."; - pr ""; - - pr " Theorem spec_gcd_gt: forall a b,"; - pr " [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]."; - pa " Admitted."; - pp " Proof."; - pp " intros a b H2."; - pp " case (spec_digits (gcd_gt a b)); intros H3 H4."; - pp " case (spec_digits a); intros H5 H6."; - pp " apply sym_equal; apply Zis_gcd_gcd; auto with zarith."; - pp " unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith."; - pp " intros a1 a2; rewrite Zpower_0_r."; - pp " case (spec_digits a2); intros H7 H8;"; - pp " intros; apply False_ind; auto with zarith."; - pp " Qed."; - pr ""; - - pr " Definition gcd a b :="; - pr " match compare a b with"; - pr " | Eq => a"; - pr " | Lt => gcd_gt b a"; - pr " | Gt => gcd_gt a b"; - pr " end."; - pr ""; - - pr " Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]."; - pa " Admitted."; - pp " Proof."; - pp " intros a b."; - pp " case (spec_digits a); intros H1 H2."; - pp " case (spec_digits b); intros H3 H4."; - pp " unfold gcd; generalize (spec_compare a b); case compare."; - pp " intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto."; - pp " apply Zis_gcd_refl."; - pp " intros; apply trans_equal with (Zgcd [b] [a])."; - pp " apply spec_gcd_gt; auto with zarith."; - pp " apply Zis_gcd_gcd; auto with zarith."; - pp " apply Zgcd_is_pos."; - pp " apply Zis_gcd_sym; apply Zgcd_is_gcd."; - pp " intros; apply spec_gcd_gt; auto."; - pp " Qed."; - pr ""; - - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Conversion *)"; + pr " (** * Conversion *)"; pr " (* *)"; pr " (***************************************************************)"; pr ""; - pr " Definition pheight p := "; + pr " Definition pheight p :="; pr " Peano.pred (nat_of_P (get_height w0_op.(znz_digits) (plength p)))."; pr ""; - pr " Theorem pheight_correct: forall p, "; + pr " Theorem pheight_correct: forall p,"; pr " Zpos p < 2 ^ (Zpos (znz_digits w0_op) * 2 ^ (Z_of_nat (pheight p)))."; pr " Proof."; pr " intros p; unfold pheight."; @@ -2400,30 +2078,12 @@ let _ = pp " Qed."; pr ""; - pr " Definition of_N x :="; - pr " match x with"; - pr " | BinNat.N0 => zero"; - pr " | Npos p => of_pos p"; - pr " end."; - pr ""; - - pr " Theorem spec_of_N: forall x,"; - pr " [of_N x] = Z_of_N x."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x."; - pp " simpl of_N."; - pp " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto."; - pp " intros p; exact (spec_of_pos p)."; - pp " Qed."; - pr ""; - pr " (***************************************************************)"; pr " (* *)"; - pr " (* Shift *)"; + pr " (** * Shift *)"; pr " (* *)"; pr " (***************************************************************)"; - pr ""; + pr ""; (* Head0 *) pr " Definition head0 w := match w with"; @@ -2443,21 +2103,21 @@ let _ = done; pp " intros n x; rewrite spec_reduce_n; exact (spec_head00 (wn_spec n) x)."; pp " Qed."; - pr " "; + pr ""; pr " Theorem spec_head0: forall x, 0 < [x] ->"; pr " 2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x)."; pa " Admitted."; pp " Proof."; pp " assert (F0: forall x, (x - 1) + 1 = x)."; - pp " intros; ring. "; + pp " intros; ring."; pp " intros x; case x; unfold digits, head0; clear x."; for i = 0 to size do pp " intros x Hx; rewrite spec_reduce_%i." i; pp " assert (F1:= spec_more_than_1_digit w%i_spec)." i; pp " generalize (spec_head0 w%i_spec x Hx)." i; pp " unfold base."; - pp " pattern (Zpos (znz_digits w%i_op)) at 1; " i; + pp " pattern (Zpos (znz_digits w%i_op)) at 1;" i; pp " rewrite <- (fun x => (F0 (Zpos x)))."; pp " rewrite Zpower_exp; auto with zarith."; pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith."; @@ -2466,7 +2126,7 @@ let _ = pp " assert (F1:= spec_more_than_1_digit (wn_spec n))."; pp " generalize (spec_head0 (wn_spec n) x Hx)."; pp " unfold base."; - pp " pattern (Zpos (znz_digits (make_op n))) at 1; "; + pp " pattern (Zpos (znz_digits (make_op n))) at 1;"; pp " rewrite <- (fun x => (F0 (Zpos x)))."; pp " rewrite Zpower_exp; auto with zarith."; pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith."; @@ -2493,7 +2153,7 @@ let _ = done; pp " intros n x; rewrite spec_reduce_n; exact (spec_tail00 (wn_spec n) x)."; pp " Qed."; - pr " "; + pr ""; pr " Theorem spec_tail0: forall x,"; @@ -2513,7 +2173,7 @@ let _ = pr " Definition %sdigits x :=" c; pr " match x with"; pr " | %s0 _ => %s0 w0_op.(znz_zdigits)" c c; - for i = 1 to size do + for i = 1 to size do pr " | %s%i _ => reduce_%i w%i_op.(znz_zdigits)" c i i i; done; pr " | %sn n _ => reduce_n n (make_op n).(znz_zdigits)" c; @@ -2534,22 +2194,22 @@ let _ = (* Shiftr *) for i = 0 to size do - pr " Definition shiftr%i n x := w%i_op.(znz_add_mul_div) (w%i_op.(znz_sub) w%i_op.(znz_zdigits) n) w%i_op.(znz_0) x." i i i i i; + pr " Definition unsafe_shiftr%i n x := w%i_op.(znz_add_mul_div) (w%i_op.(znz_sub) w%i_op.(znz_zdigits) n) w%i_op.(znz_0) x." i i i i i; done; - pr " Definition shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x."; + pr " Definition unsafe_shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x."; pr ""; - pr " Definition shiftr := Eval lazy beta delta [same_level] in "; - pr " same_level _ (fun n x => %s0 (shiftr0 n x))" c; + pr " Definition unsafe_shiftr := Eval lazy beta delta [same_level] in"; + pr " same_level _ (fun n x => %s0 (unsafe_shiftr0 n x))" c; for i = 1 to size do - pr " (fun n x => reduce_%i (shiftr%i n x))" i i; + pr " (fun n x => reduce_%i (unsafe_shiftr%i n x))" i i; done; - pr " (fun n p x => reduce_n n (shiftrn n p x))."; + pr " (fun n p x => reduce_n n (unsafe_shiftrn n p x))."; pr ""; - pr " Theorem spec_shiftr: forall n x,"; - pr " [n] <= [Ndigits x] -> [shiftr n x] = [x] / 2 ^ [n]."; + pr " Theorem spec_unsafe_shiftr: forall n x,"; + pr " [n] <= [Ndigits x] -> [unsafe_shiftr n x] = [x] / 2 ^ [n]."; pa " Admitted."; pp " Proof."; pp " assert (F0: forall x y, x - (x - y) = y)."; @@ -2568,7 +2228,7 @@ let _ = pp " split; auto with zarith."; pp " apply Zle_lt_trans with xx; auto with zarith."; pp " apply Zpower2_lt_lin; auto with zarith."; - pp " assert (F4: forall ww ww1 ww2 "; + pp " assert (F4: forall ww ww1 ww2"; pp " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)"; pp " xx yy xx1 yy1,"; pp " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_zdigits ww1_op) ->"; @@ -2586,7 +2246,7 @@ let _ = pp " rewrite <- Hy."; pp " generalize (spec_add_mul_div Hw"; pp " (znz_0 ww_op) xx1"; - pp " (znz_sub ww_op (znz_zdigits ww_op) "; + pp " (znz_sub ww_op (znz_zdigits ww_op)"; pp " yy1)"; pp " )."; pp " rewrite (spec_0 Hw)."; @@ -2612,11 +2272,11 @@ let _ = pp " rewrite Zpos_xO."; pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size; pp " apply F5; auto with arith."; - pp " intros x; case x; clear x; unfold shiftr, same_level."; + pp " intros x; case x; clear x; unfold unsafe_shiftr, same_level."; for i = 0 to size do pp " intros x y; case y; clear y."; for j = 0 to i - 1 do - pp " intros y; unfold shiftr%i, Ndigits." i; + pp " intros y; unfold unsafe_shiftr%i, Ndigits." i; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i; pp " rewrite (spec_zdigits w%i_spec)." i; @@ -2628,25 +2288,25 @@ let _ = pp " try (apply sym_equal; exact (spec_extend%in%i y))." j i; done; - pp " intros y; unfold shiftr%i, Ndigits." i; + pp " intros y; unfold unsafe_shiftr%i, Ndigits." i; pp " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i; for j = i + 1 to size do - pp " intros y; unfold shiftr%i, Ndigits." j; + pp " intros y; unfold unsafe_shiftr%i, Ndigits." j; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i; pp " try (apply sym_equal; exact (spec_extend%in%i x))." i j; done; if i == size then begin - pp " intros m y; unfold shiftrn, Ndigits."; + pp " intros m y; unfold unsafe_shiftrn, Ndigits."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size; pp " try (apply sym_equal; exact (spec_extend%in m x))." size; end - else + else begin - pp " intros m y; unfold shiftrn, Ndigits."; + pp " intros m y; unfold unsafe_shiftrn, Ndigits."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i; pp " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i; @@ -2654,7 +2314,7 @@ let _ = end done; pp " intros n x y; case y; clear y;"; - pp " intros y; unfold shiftrn, Ndigits; try rewrite spec_reduce_n."; + pp " intros y; unfold unsafe_shiftrn, Ndigits; try rewrite spec_reduce_n."; for i = 0 to size do pp " try rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i; @@ -2684,52 +2344,23 @@ let _ = pp " Qed."; pr ""; - pr " Definition safe_shiftr n x := "; - pr " match compare n (Ndigits x) with"; - pr " | Lt => shiftr n x "; - pr " | _ => %s0 w_0" c; - pr " end."; - pr ""; - - - pr " Theorem spec_safe_shiftr: forall n x,"; - pr " [safe_shiftr n x] = [x] / 2 ^ [n]."; - pa " Admitted."; - pp " Proof."; - pp " intros n x; unfold safe_shiftr;"; - pp " generalize (spec_compare n (Ndigits x)); case compare; intros H."; - pp " apply trans_equal with (1 := spec_0 w0_spec)."; - pp " apply sym_equal; apply Zdiv_small; rewrite H."; - pp " rewrite spec_Ndigits; exact (spec_digits x)."; - pp " rewrite <- spec_shiftr; auto with zarith."; - pp " apply trans_equal with (1 := spec_0 w0_spec)."; - pp " apply sym_equal; apply Zdiv_small."; - pp " rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2."; - pp " split; auto."; - pp " apply Zlt_le_trans with (1 := H2)."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " Qed."; - pr ""; - - pr ""; - - (* Shiftl *) + (* Unsafe_Shiftl *) for i = 0 to size do - pr " Definition shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0)." i i i + pr " Definition unsafe_shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0)." i i i done; - pr " Definition shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0)."; - pr " Definition shiftl := Eval lazy beta delta [same_level] in"; - pr " same_level _ (fun n x => %s0 (shiftl0 n x))" c; + pr " Definition unsafe_shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0)."; + pr " Definition unsafe_shiftl := Eval lazy beta delta [same_level] in"; + pr " same_level _ (fun n x => %s0 (unsafe_shiftl0 n x))" c; for i = 1 to size do - pr " (fun n x => reduce_%i (shiftl%i n x))" i i; + pr " (fun n x => reduce_%i (unsafe_shiftl%i n x))" i i; done; - pr " (fun n p x => reduce_n n (shiftln n p x))."; + pr " (fun n p x => reduce_n n (unsafe_shiftln n p x))."; pr ""; pr ""; - pr " Theorem spec_shiftl: forall n x,"; - pr " [n] <= [head0 x] -> [shiftl n x] = [x] * 2 ^ [n]."; + pr " Theorem spec_unsafe_shiftl: forall n x,"; + pr " [n] <= [head0 x] -> [unsafe_shiftl n x] = [x] * 2 ^ [n]."; pa " Admitted."; pp " Proof."; pp " assert (F0: forall x y, x - (x - y) = y)."; @@ -2748,7 +2379,7 @@ let _ = pp " split; auto with zarith."; pp " apply Zle_lt_trans with xx; auto with zarith."; pp " apply Zpower2_lt_lin; auto with zarith."; - pp " assert (F4: forall ww ww1 ww2 "; + pp " assert (F4: forall ww ww1 ww2"; pp " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)"; pp " xx yy xx1 yy1,"; pp " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_head0 ww1_op xx) ->"; @@ -2788,7 +2419,7 @@ let _ = pp " rewrite Zmod_small; auto with zarith."; pp " intros HH; apply HH."; pp " rewrite Hy; apply Zle_trans with (1:= Hl)."; - pp " rewrite <- (spec_zdigits Hw). "; + pp " rewrite <- (spec_zdigits Hw)."; pp " apply Zle_trans with (2 := Hl1); auto."; pp " rewrite (spec_zdigits Hw1); auto with zarith."; pp " split; auto with zarith ."; @@ -2826,11 +2457,11 @@ let _ = pp " rewrite Zpos_xO."; pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size; pp " apply F5; auto with arith."; - pp " intros x; case x; clear x; unfold shiftl, same_level."; + pp " intros x; case x; clear x; unfold unsafe_shiftl, same_level."; for i = 0 to size do pp " intros x y; case y; clear y."; for j = 0 to i - 1 do - pp " intros y; unfold shiftl%i, head0." i; + pp " intros y; unfold unsafe_shiftl%i, head0." i; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i; pp " rewrite (spec_zdigits w%i_spec)." i; @@ -2841,25 +2472,25 @@ let _ = pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." j; pp " try (apply sym_equal; exact (spec_extend%in%i y))." j i; done; - pp " intros y; unfold shiftl%i, head0." i; + pp " intros y; unfold unsafe_shiftl%i, head0." i; pp " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i; for j = i + 1 to size do - pp " intros y; unfold shiftl%i, head0." j; + pp " intros y; unfold unsafe_shiftl%i, head0." j; pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i; pp " try (apply sym_equal; exact (spec_extend%in%i x))." i j; done; if i == size then begin - pp " intros m y; unfold shiftln, head0."; + pp " intros m y; unfold unsafe_shiftln, head0."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size; pp " try (apply sym_equal; exact (spec_extend%in m x))." size; end - else + else begin - pp " intros m y; unfold shiftln, head0."; + pp " intros m y; unfold unsafe_shiftln, head0."; pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i; pp " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i; @@ -2867,7 +2498,7 @@ let _ = end done; pp " intros n x y; case y; clear y;"; - pp " intros y; unfold shiftln, head0; try rewrite spec_reduce_n."; + pp " intros y; unfold unsafe_shiftln, head0; try rewrite spec_reduce_n."; for i = 0 to size do pp " try rewrite spec_reduce_%i; unfold to_Z; intros H1." i; pp " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i; @@ -2907,7 +2538,7 @@ let _ = pr " end."; pr ""; - pr " Theorem spec_double_size_digits: "; + pr " Theorem spec_double_size_digits:"; pr " forall x, digits (double_size x) = xO (digits x)."; pa " Admitted."; pp " Proof."; @@ -2922,7 +2553,7 @@ let _ = pp " Proof."; pp " intros x; case x; unfold double_size; clear x."; for i = 0 to size do - pp " intros x; unfold to_Z, make_op; "; + pp " intros x; unfold to_Z, make_op;"; pp " rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto with zarith." (i + 1) i; done; pp " intros n x; unfold to_Z;"; @@ -2934,7 +2565,7 @@ let _ = pr ""; - pr " Theorem spec_double_size_head0: "; + pr " Theorem spec_double_size_head0:"; pr " forall x, 2 * [head0 x] <= [head0 (double_size x)]."; pa " Admitted."; pp " Proof."; @@ -2963,7 +2594,7 @@ let _ = pp " apply Zmult_le_compat_l; auto with zarith."; pp " rewrite Zpower_1_r; auto with zarith."; pp " apply Zpower_le_monotone; auto with zarith."; - pp " split; auto with zarith. "; + pp " split; auto with zarith."; pp " case (Zle_or_lt (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6."; pp " absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith."; pp " rewrite <- HH5; rewrite Zmult_1_r."; @@ -2988,7 +2619,7 @@ let _ = pp " Qed."; pr ""; - pr " Theorem spec_double_size_head0_pos: "; + pr " Theorem spec_double_size_head0_pos:"; pr " forall x, 0 < [head0 (double_size x)]."; pa " Admitted."; pp " Proof."; @@ -3015,114 +2646,6 @@ let _ = pp " Qed."; pr ""; - - (* Safe shiftl *) - - pr " Definition safe_shiftl_aux_body cont n x :="; - pr " match compare n (head0 x) with"; - pr " Gt => cont n (double_size x)"; - pr " | _ => shiftl n x"; - pr " end."; - pr ""; - - pr " Theorem spec_safe_shift_aux_body: forall n p x cont,"; - pr " 2^ Zpos p <= [head0 x] ->"; - pr " (forall x, 2 ^ (Zpos p + 1) <= [head0 x]->"; - pr " [cont n x] = [x] * 2 ^ [n]) ->"; - pr " [safe_shiftl_aux_body cont n x] = [x] * 2 ^ [n]."; - pa " Admitted."; - pp " Proof."; - pp " intros n p x cont H1 H2; unfold safe_shiftl_aux_body."; - pp " generalize (spec_compare n (head0 x)); case compare; intros H."; - pp " apply spec_shiftl; auto with zarith."; - pp " apply spec_shiftl; auto with zarith."; - pp " rewrite H2."; - pp " rewrite spec_double_size; auto."; - pp " rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith."; - pp " apply Zle_trans with (2 := spec_double_size_head0 x)."; - pp " rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith."; - pp " Qed."; - pr ""; - - pr " Fixpoint safe_shiftl_aux p cont n x {struct p} :="; - pr " safe_shiftl_aux_body "; - pr " (fun n x => match p with"; - pr " | xH => cont n x"; - pr " | xO p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x"; - pr " | xI p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x"; - pr " end) n x."; - pr ""; - - pr " Theorem spec_safe_shift_aux: forall p q n x cont,"; - pr " 2 ^ (Zpos q) <= [head0 x] ->"; - pr " (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] ->"; - pr " [cont n x] = [x] * 2 ^ [n]) -> "; - pr " [safe_shiftl_aux p cont n x] = [x] * 2 ^ [n]."; - pa " Admitted."; - pp " Proof."; - pp " intros p; elim p; unfold safe_shiftl_aux; fold safe_shiftl_aux; clear p."; - pp " intros p Hrec q n x cont H1 H2."; - pp " apply spec_safe_shift_aux_body with (q); auto."; - pp " intros x1 H3; apply Hrec with (q + 1)%spositive; auto." "%"; - pp " intros x2 H4; apply Hrec with (p + q + 1)%spositive; auto." "%"; - pp " rewrite <- Pplus_assoc."; - pp " rewrite Zpos_plus_distr; auto."; - pp " intros x3 H5; apply H2."; - pp " rewrite Zpos_xI."; - pp " replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1));"; - pp " auto."; - pp " repeat rewrite Zpos_plus_distr; ring."; - pp " intros p Hrec q n x cont H1 H2."; - pp " apply spec_safe_shift_aux_body with (q); auto."; - pp " intros x1 H3; apply Hrec with (q); auto."; - pp " apply Zle_trans with (2 := H3); auto with zarith."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " intros x2 H4; apply Hrec with (p + q)%spositive; auto." "%"; - pp " intros x3 H5; apply H2."; - pp " rewrite (Zpos_xO p)."; - pp " replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q));"; - pp " auto."; - pp " repeat rewrite Zpos_plus_distr; ring."; - pp " intros q n x cont H1 H2."; - pp " apply spec_safe_shift_aux_body with (q); auto."; - pp " rewrite Zplus_comm; auto."; - pp " Qed."; - pr ""; - - - pr " Definition safe_shiftl n x :="; - pr " safe_shiftl_aux_body"; - pr " (safe_shiftl_aux_body"; - pr " (safe_shiftl_aux (digits n) shiftl)) n x."; - pr ""; - - pr " Theorem spec_safe_shift: forall n x,"; - pr " [safe_shiftl n x] = [x] * 2 ^ [n]."; - pa " Admitted."; - pp " Proof."; - pp " intros n x; unfold safe_shiftl, safe_shiftl_aux_body."; - pp " generalize (spec_compare n (head0 x)); case compare; intros H."; - pp " apply spec_shiftl; auto with zarith."; - pp " apply spec_shiftl; auto with zarith."; - pp " rewrite <- (spec_double_size x)."; - pp " generalize (spec_compare n (head0 (double_size x))); case compare; intros H1."; - pp " apply spec_shiftl; auto with zarith."; - pp " apply spec_shiftl; auto with zarith."; - pp " rewrite <- (spec_double_size (double_size x))."; - pp " apply spec_safe_shift_aux with 1%spositive." "%"; - pp " apply Zle_trans with (2 := spec_double_size_head0 (double_size x))."; - pp " replace (2 ^ 1) with (2 * 1)."; - pp " apply Zmult_le_compat_l; auto with zarith."; - pp " generalize (spec_double_size_head0_pos x); auto with zarith."; - pp " rewrite Zpower_1_r; ring."; - pp " intros x1 H2; apply spec_shiftl."; - pp " apply Zle_trans with (2 := H2)."; - pp " apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith."; - pp " case (spec_digits n); auto with zarith."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " Qed."; - pr ""; - (* even *) pr " Definition is_even x :="; pr " match x with"; @@ -3146,20 +2669,6 @@ let _ = pp " Qed."; pr ""; - pr " Theorem spec_0: [zero] = 0."; - pa " Admitted."; - pp " Proof."; - pp " exact (spec_0 w0_spec)."; - pp " Qed."; - pr ""; - - pr " Theorem spec_1: [one] = 1."; - pa " Admitted."; - pp " Proof."; - pp " exact (spec_1 w0_spec)."; - pp " Qed."; - pr ""; - pr "End Make."; pr ""; diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v index ae2cfd30..d42db97d 100644 --- a/theories/Numbers/Natural/BigN/Nbasic.v +++ b/theories/Numbers/Natural/BigN/Nbasic.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: Nbasic.v 10964 2008-05-22 11:08:13Z letouzey $ i*) +(*i $Id$ i*) Require Import ZArith. Require Import BigNumPrelude. @@ -21,7 +21,7 @@ Require Import DoubleCyclic. (* To compute the necessary height *) Fixpoint plength (p: positive) : positive := - match p with + match p with xH => xH | xO p1 => Psucc (plength p1) | xI p1 => Psucc (plength p1) @@ -34,10 +34,10 @@ rewrite Zpower_exp; auto with zarith. rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith. intros p; elim p; simpl plength; auto. intros p1 Hp1; rewrite F; repeat rewrite Zpos_xI. -assert (tmp: (forall p, 2 * p = p + p)%Z); +assert (tmp: (forall p, 2 * p = p + p)%Z); try repeat rewrite tmp; auto with zarith. intros p1 Hp1; rewrite F; rewrite (Zpos_xO p1). -assert (tmp: (forall p, 2 * p = p + p)%Z); +assert (tmp: (forall p, 2 * p = p + p)%Z); try repeat rewrite tmp; auto with zarith. rewrite Zpower_1_r; auto with zarith. Qed. @@ -73,7 +73,7 @@ case (Z_mod_lt (Zpos p) (Zpos q) H1); auto with zarith. intros q1 H2. replace (Zpos p - Zpos q * Zpos q1) with (Zpos p mod Zpos q). 2: pattern (Zpos p) at 2; rewrite H2; auto with zarith. -generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2; +generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2; case Zmod. intros HH _; rewrite HH; auto with zarith. intros r1 HH (_,HH1); rewrite HH; rewrite Zpos_succ_morphism. @@ -121,9 +121,9 @@ Definition zn2z_word_comm : forall w n, zn2z (word w n) = word (zn2z w) n. Defined. Fixpoint extend (n:nat) {struct n} : forall w:Type, zn2z w -> word w (S n) := - match n return forall w:Type, zn2z w -> word w (S n) with + match n return forall w:Type, zn2z w -> word w (S n) with | O => fun w x => x - | S m => + | S m => let aux := extend m in fun w x => WW W0 (aux w x) end. @@ -169,7 +169,7 @@ Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n := | S n1 => let v := fst (diff m1 n1) + n1 in let v1 := fst (diff m1 n1) + S n1 in - eq_ind v (fun n => v1 = S n) + eq_ind v (fun n => v1 = S n) (eq_ind v1 (fun n => v1 = n) (refl_equal v1) (S v) (plusnS _ _)) _ (diff_l _ _) end @@ -182,7 +182,7 @@ Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n := | 0 => refl_equal _ | S _ => plusn0 _ end - | S m => + | S m => match n return (snd (diff (S m) n) + S m = max (S m) n) with | 0 => refl_equal (snd (diff (S m) 0) + S m) | S n1 => @@ -253,9 +253,9 @@ Section ReduceRec. | WW xh xl => match xh with | W0 => @reduce_n m xl - | _ => @c (S m) x + | _ => @c (S m) x end - end + end end. End ReduceRec. @@ -276,14 +276,14 @@ Section CompareRec. Variable compare_m : wm -> w -> comparison. Fixpoint compare0_mn (n:nat) : word wm n -> comparison := - match n return word wm n -> comparison with - | O => compare0_m + match n return word wm n -> comparison with + | O => compare0_m | S m => fun x => match x with | W0 => Eq - | WW xh xl => + | WW xh xl => match compare0_mn m xh with - | Eq => compare0_mn m xl + | Eq => compare0_mn m xl | r => Lt end end @@ -296,7 +296,7 @@ Section CompareRec. Variable spec_compare0_m: forall x, match compare0_m x with Eq => w_to_Z w_0 = wm_to_Z x - | Lt => w_to_Z w_0 < wm_to_Z x + | Lt => w_to_Z w_0 < wm_to_Z x | Gt => w_to_Z w_0 > wm_to_Z x end. Variable wm_to_Z_pos: forall x, 0 <= wm_to_Z x < base wm_base. @@ -341,14 +341,14 @@ Section CompareRec. Qed. Fixpoint compare_mn_1 (n:nat) : word wm n -> w -> comparison := - match n return word wm n -> w -> comparison with - | O => compare_m - | S m => fun x y => + match n return word wm n -> w -> comparison with + | O => compare_m + | S m => fun x y => match x with | W0 => compare w_0 y - | WW xh xl => + | WW xh xl => match compare0_mn m xh with - | Eq => compare_mn_1 m xl y + | Eq => compare_mn_1 m xl y | r => Gt end end @@ -366,7 +366,7 @@ Section CompareRec. | Lt => wm_to_Z x < w_to_Z y | Gt => wm_to_Z x > w_to_Z y end. - Variable wm_base_lt: forall x, + Variable wm_base_lt: forall x, 0 <= w_to_Z x < base (wm_base). Let double_wB_lt: forall n x, @@ -385,7 +385,7 @@ Section CompareRec. unfold Zpower_pos; simpl; ring. Qed. - + Lemma spec_compare_mn_1: forall n x y, match compare_mn_1 n x y with Eq => double_to_Z n x = w_to_Z y @@ -434,7 +434,7 @@ Section AddS. | C1 z => match incr hy with C0 z1 => C0 (WW z1 z) | C1 z1 => C1 (WW z1 z) - end + end end end. @@ -458,12 +458,12 @@ End AddS. Fixpoint length_pos x := match x with xH => O | xO x1 => S (length_pos x1) | xI x1 => S (length_pos x1) end. - + Theorem length_pos_lt: forall x y, (length_pos x < length_pos y)%nat -> Zpos x < Zpos y. Proof. intros x; elim x; clear x; [intros x1 Hrec | intros x1 Hrec | idtac]; - intros y; case y; clear y; intros y1 H || intros H; simpl length_pos; + intros y; case y; clear y; intros y1 H || intros H; simpl length_pos; try (rewrite (Zpos_xI x1) || rewrite (Zpos_xO x1)); try (rewrite (Zpos_xI y1) || rewrite (Zpos_xO y1)); try (inversion H; fail); @@ -492,20 +492,20 @@ End AddS. Qed. Theorem make_zop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op x) = - fun z => match z with + znz_to_Z (mk_zn2z_op x) = + fun z => match z with W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) + | WW xh xl => znz_to_Z x xh * base (znz_digits x) + znz_to_Z x xl end. intros ww x; auto. Qed. Theorem make_kzop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op_karatsuba x) = - fun z => match z with + znz_to_Z (mk_zn2z_op_karatsuba x) = + fun z => match z with W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) + | WW xh xl => znz_to_Z x xh * base (znz_digits x) + znz_to_Z x xl end. intros ww x; auto. diff --git a/theories/Numbers/Natural/Binary/NBinDefs.v b/theories/Numbers/Natural/Binary/NBinDefs.v deleted file mode 100644 index fc2bd2df..00000000 --- a/theories/Numbers/Natural/Binary/NBinDefs.v +++ /dev/null @@ -1,267 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(* Evgeny Makarov, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: NBinDefs.v 11040 2008-06-03 00:04:16Z letouzey $ i*) - -Require Import BinPos. -Require Export BinNat. -Require Import NSub. - -Open Local Scope N_scope. - -(** Implementation of [NAxiomsSig] module type via [BinNat.N] *) - -Module NBinaryAxiomsMod <: NAxiomsSig. -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. - -Definition NZ := N. -Definition NZeq := @eq N. -Definition NZ0 := N0. -Definition NZsucc := Nsucc. -Definition NZpred := Npred. -Definition NZadd := Nplus. -Definition NZsub := Nminus. -Definition NZmul := Nmult. - -Theorem NZeq_equiv : equiv N NZeq. -Proof (eq_equiv N). - -Add Relation N NZeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. - -Add Morphism NZsucc with signature NZeq ==> NZeq as NZsucc_wd. -Proof. -congruence. -Qed. - -Add Morphism NZpred with signature NZeq ==> NZeq as NZpred_wd. -Proof. -congruence. -Qed. - -Add Morphism NZadd with signature NZeq ==> NZeq ==> NZeq as NZadd_wd. -Proof. -congruence. -Qed. - -Add Morphism NZsub with signature NZeq ==> NZeq ==> NZeq as NZsub_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmul with signature NZeq ==> NZeq ==> NZeq as NZmul_wd. -Proof. -congruence. -Qed. - -Theorem NZinduction : - forall A : NZ -> Prop, predicate_wd NZeq A -> - A N0 -> (forall n, A n <-> A (NZsucc n)) -> forall n : NZ, A n. -Proof. -intros A A_wd A0 AS. apply Nrect. assumption. intros; now apply -> AS. -Qed. - -Theorem NZpred_succ : forall n : NZ, NZpred (NZsucc n) = n. -Proof. -destruct n as [| p]; simpl. reflexivity. -case_eq (Psucc p); try (intros q H; rewrite <- H; now rewrite Ppred_succ). -intro H; false_hyp H Psucc_not_one. -Qed. - -Theorem NZadd_0_l : forall n : NZ, N0 + n = n. -Proof. -reflexivity. -Qed. - -Theorem NZadd_succ_l : forall n m : NZ, (NZsucc n) + m = NZsucc (n + m). -Proof. -destruct n; destruct m. -simpl in |- *; reflexivity. -unfold NZsucc, NZadd, Nsucc, Nplus. rewrite <- Pplus_one_succ_l; reflexivity. -simpl in |- *; reflexivity. -simpl in |- *; rewrite Pplus_succ_permute_l; reflexivity. -Qed. - -Theorem NZsub_0_r : forall n : NZ, n - N0 = n. -Proof. -now destruct n. -Qed. - -Theorem NZsub_succ_r : forall n m : NZ, n - (NZsucc m) = NZpred (n - m). -Proof. -destruct n as [| p]; destruct m as [| q]; try reflexivity. -now destruct p. -simpl. rewrite Pminus_mask_succ_r, Pminus_mask_carry_spec. -now destruct (Pminus_mask p q) as [| r |]; [| destruct r |]. -Qed. - -Theorem NZmul_0_l : forall n : NZ, N0 * n = N0. -Proof. -destruct n; reflexivity. -Qed. - -Theorem NZmul_succ_l : forall n m : NZ, (NZsucc n) * m = n * m + m. -Proof. -destruct n as [| n]; destruct m as [| m]; simpl; try reflexivity. -now rewrite Pmult_Sn_m, Pplus_comm. -Qed. - -End NZAxiomsMod. - -Definition NZlt := Nlt. -Definition NZle := Nle. -Definition NZmin := Nmin. -Definition NZmax := Nmax. - -Add Morphism NZlt with signature NZeq ==> NZeq ==> iff as NZlt_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZle with signature NZeq ==> NZeq ==> iff as NZle_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZmin with signature NZeq ==> NZeq ==> NZeq as NZmin_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmax with signature NZeq ==> NZeq ==> NZeq as NZmax_wd. -Proof. -congruence. -Qed. - -Theorem NZlt_eq_cases : forall n m : N, n <= m <-> n < m \/ n = m. -Proof. -intros n m. unfold Nle, Nlt. rewrite <- Ncompare_eq_correct. -destruct (n ?= m); split; intro H1; (try discriminate); try (now left); try now right. -now elim H1. destruct H1; discriminate. -Qed. - -Theorem NZlt_irrefl : forall n : NZ, ~ n < n. -Proof. -intro n; unfold Nlt; now rewrite Ncompare_refl. -Qed. - -Theorem NZlt_succ_r : forall n m : NZ, n < (NZsucc m) <-> n <= m. -Proof. -intros n m; unfold Nlt, Nle; destruct n as [| p]; destruct m as [| q]; simpl; -split; intro H; try reflexivity; try discriminate. -destruct p; simpl; intros; discriminate. elimtype False; now apply H. -apply -> Pcompare_p_Sq in H. destruct H as [H | H]. -now rewrite H. now rewrite H, Pcompare_refl. -apply <- Pcompare_p_Sq. case_eq ((p ?= q)%positive Eq); intro H1. -right; now apply Pcompare_Eq_eq. now left. elimtype False; now apply H. -Qed. - -Theorem NZmin_l : forall n m : N, n <= m -> NZmin n m = n. -Proof. -unfold NZmin, Nmin, Nle; intros n m H. -destruct (n ?= m); try reflexivity. now elim H. -Qed. - -Theorem NZmin_r : forall n m : N, m <= n -> NZmin n m = m. -Proof. -unfold NZmin, Nmin, Nle; intros n m H. -case_eq (n ?= m); intro H1; try reflexivity. -now apply -> Ncompare_eq_correct. -rewrite <- Ncompare_antisym, H1 in H; elim H; auto. -Qed. - -Theorem NZmax_l : forall n m : N, m <= n -> NZmax n m = n. -Proof. -unfold NZmax, Nmax, Nle; intros n m H. -case_eq (n ?= m); intro H1; try reflexivity. -symmetry; now apply -> Ncompare_eq_correct. -rewrite <- Ncompare_antisym, H1 in H; elim H; auto. -Qed. - -Theorem NZmax_r : forall n m : N, n <= m -> NZmax n m = m. -Proof. -unfold NZmax, Nmax, Nle; intros n m H. -destruct (n ?= m); try reflexivity. now elim H. -Qed. - -End NZOrdAxiomsMod. - -Definition recursion (A : Type) (a : A) (f : N -> A -> A) (n : N) := - Nrect (fun _ => A) a f n. -Implicit Arguments recursion [A]. - -Theorem pred_0 : Npred N0 = N0. -Proof. -reflexivity. -Qed. - -Theorem recursion_wd : -forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : N -> A -> A, fun2_eq NZeq Aeq Aeq f f' -> - forall x x' : N, x = x' -> - Aeq (recursion a f x) (recursion a' f' x'). -Proof. -unfold fun2_wd, NZeq, fun2_eq. -intros A Aeq a a' Eaa' f f' Eff'. -intro x; pattern x; apply Nrect. -intros x' H; now rewrite <- H. -clear x. -intros x IH x' H; rewrite <- H. -unfold recursion in *. do 2 rewrite Nrect_step. -now apply Eff'; [| apply IH]. -Qed. - -Theorem recursion_0 : - forall (A : Type) (a : A) (f : N -> A -> A), recursion a f N0 = a. -Proof. -intros A a f; unfold recursion; now rewrite Nrect_base. -Qed. - -Theorem recursion_succ : - forall (A : Type) (Aeq : relation A) (a : A) (f : N -> A -> A), - Aeq a a -> fun2_wd NZeq Aeq Aeq f -> - forall n : N, Aeq (recursion a f (Nsucc n)) (f n (recursion a f n)). -Proof. -unfold NZeq, recursion, fun2_wd; intros A Aeq a f EAaa f_wd n; pattern n; apply Nrect. -rewrite Nrect_step; rewrite Nrect_base; now apply f_wd. -clear n; intro n; do 2 rewrite Nrect_step; intro IH. apply f_wd; [reflexivity|]. -now rewrite Nrect_step. -Qed. - -End NBinaryAxiomsMod. - -Module Export NBinarySubPropMod := NSubPropFunct NBinaryAxiomsMod. - -(* Some fun comparing the efficiency of the generic log defined -by strong (course-of-value) recursion and the log defined by recursion -on notation *) -(* Time Eval compute in (log 100000). *) (* 98 sec *) - -(* -Fixpoint binposlog (p : positive) : N := -match p with -| xH => 0 -| xO p' => Nsucc (binposlog p') -| xI p' => Nsucc (binposlog p') -end. - -Definition binlog (n : N) : N := -match n with -| 0 => 0 -| Npos p => binposlog p -end. -*) -(* Eval compute in (binlog 1000000000000000000). *) (* Works very fast *) - diff --git a/theories/Numbers/Natural/Binary/NBinary.v b/theories/Numbers/Natural/Binary/NBinary.v index 2c99128d..e593f4a5 100644 --- a/theories/Numbers/Natural/Binary/NBinary.v +++ b/theories/Numbers/Natural/Binary/NBinary.v @@ -8,8 +8,175 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NBinary.v 10934 2008-05-15 21:58:20Z letouzey $ i*) +(*i $Id$ i*) -Require Export NBinDefs. -Require Export NArithRing. +Require Import BinPos. +Require Export BinNat. +Require Import NAxioms NProperties. +Local Open Scope N_scope. + +(** * Implementation of [NAxiomsSig] module type via [BinNat.N] *) + +Module NBinaryAxiomsMod <: NAxiomsSig. + +(** Bi-directional induction. *) + +Theorem bi_induction : + forall A : N -> Prop, Proper (eq==>iff) A -> + A N0 -> (forall n, A n <-> A (Nsucc n)) -> forall n : N, A n. +Proof. +intros A A_wd A0 AS. apply Nrect. assumption. intros; now apply -> AS. +Qed. + +(** Basic operations. *) + +Definition eq_equiv : Equivalence (@eq N) := eq_equivalence. +Local Obligation Tactic := simpl_relation. +Program Instance succ_wd : Proper (eq==>eq) Nsucc. +Program Instance pred_wd : Proper (eq==>eq) Npred. +Program Instance add_wd : Proper (eq==>eq==>eq) Nplus. +Program Instance sub_wd : Proper (eq==>eq==>eq) Nminus. +Program Instance mul_wd : Proper (eq==>eq==>eq) Nmult. + +Definition pred_succ := Npred_succ. +Definition add_0_l := Nplus_0_l. +Definition add_succ_l := Nplus_succ. +Definition sub_0_r := Nminus_0_r. +Definition sub_succ_r := Nminus_succ_r. +Definition mul_0_l := Nmult_0_l. +Definition mul_succ_l n m := eq_trans (Nmult_Sn_m n m) (Nplus_comm _ _). + +(** Order *) + +Program Instance lt_wd : Proper (eq==>eq==>iff) Nlt. + +Definition lt_eq_cases := Nle_lteq. +Definition lt_irrefl := Nlt_irrefl. + +Theorem lt_succ_r : forall n m, n < (Nsucc m) <-> n <= m. +Proof. +intros n m; unfold Nlt, Nle; destruct n as [| p]; destruct m as [| q]; simpl; +split; intro H; try reflexivity; try discriminate. +destruct p; simpl; intros; discriminate. exfalso; now apply H. +apply -> Pcompare_p_Sq in H. destruct H as [H | H]. +now rewrite H. now rewrite H, Pcompare_refl. +apply <- Pcompare_p_Sq. case_eq ((p ?= q)%positive Eq); intro H1. +right; now apply Pcompare_Eq_eq. now left. exfalso; now apply H. +Qed. + +Theorem min_l : forall n m, n <= m -> Nmin n m = n. +Proof. +unfold Nmin, Nle; intros n m H. +destruct (n ?= m); try reflexivity. now elim H. +Qed. + +Theorem min_r : forall n m, m <= n -> Nmin n m = m. +Proof. +unfold Nmin, Nle; intros n m H. +case_eq (n ?= m); intro H1; try reflexivity. +now apply -> Ncompare_eq_correct. +rewrite <- Ncompare_antisym, H1 in H; elim H; auto. +Qed. + +Theorem max_l : forall n m, m <= n -> Nmax n m = n. +Proof. +unfold Nmax, Nle; intros n m H. +case_eq (n ?= m); intro H1; try reflexivity. +symmetry; now apply -> Ncompare_eq_correct. +rewrite <- Ncompare_antisym, H1 in H; elim H; auto. +Qed. + +Theorem max_r : forall n m : N, n <= m -> Nmax n m = m. +Proof. +unfold Nmax, Nle; intros n m H. +destruct (n ?= m); try reflexivity. now elim H. +Qed. + +(** Part specific to natural numbers, not integers. *) + +Theorem pred_0 : Npred 0 = 0. +Proof. +reflexivity. +Qed. + +Definition recursion (A : Type) : A -> (N -> A -> A) -> N -> A := + Nrect (fun _ => A). +Implicit Arguments recursion [A]. + +Instance recursion_wd A (Aeq : relation A) : + Proper (Aeq==>(eq==>Aeq==>Aeq)==>eq==>Aeq) (@recursion A). +Proof. +intros a a' Eaa' f f' Eff'. +intro x; pattern x; apply Nrect. +intros x' H; now rewrite <- H. +clear x. +intros x IH x' H; rewrite <- H. +unfold recursion in *. do 2 rewrite Nrect_step. +now apply Eff'; [| apply IH]. +Qed. + +Theorem recursion_0 : + forall (A : Type) (a : A) (f : N -> A -> A), recursion a f N0 = a. +Proof. +intros A a f; unfold recursion; now rewrite Nrect_base. +Qed. + +Theorem recursion_succ : + forall (A : Type) (Aeq : relation A) (a : A) (f : N -> A -> A), + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> + forall n : N, Aeq (recursion a f (Nsucc n)) (f n (recursion a f n)). +Proof. +unfold recursion; intros A Aeq a f EAaa f_wd n; pattern n; apply Nrect. +rewrite Nrect_step; rewrite Nrect_base; now apply f_wd. +clear n; intro n; do 2 rewrite Nrect_step; intro IH. apply f_wd; [reflexivity|]. +now rewrite Nrect_step. +Qed. + +(** The instantiation of operations. + Placing them at the very end avoids having indirections in above lemmas. *) + +Definition t := N. +Definition eq := @eq N. +Definition zero := N0. +Definition succ := Nsucc. +Definition pred := Npred. +Definition add := Nplus. +Definition sub := Nminus. +Definition mul := Nmult. +Definition lt := Nlt. +Definition le := Nle. +Definition min := Nmin. +Definition max := Nmax. + +End NBinaryAxiomsMod. + +Module Export NBinaryPropMod := NPropFunct NBinaryAxiomsMod. + +(* +Require Import NDefOps. +Module Import NBinaryDefOpsMod := NdefOpsPropFunct NBinaryAxiomsMod. + +(* Some fun comparing the efficiency of the generic log defined +by strong (course-of-value) recursion and the log defined by recursion +on notation *) + +Time Eval vm_compute in (log 500000). (* 11 sec *) + +Fixpoint binposlog (p : positive) : N := +match p with +| xH => 0 +| xO p' => Nsucc (binposlog p') +| xI p' => Nsucc (binposlog p') +end. + +Definition binlog (n : N) : N := +match n with +| 0 => 0 +| Npos p => binposlog p +end. + +Time Eval vm_compute in (binlog 500000). (* 0 sec *) +Time Eval vm_compute in (binlog 1000000000000000000000000000000). (* 0 sec *) + +*) diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v index 1c83da45..becbd243 100644 --- a/theories/Numbers/Natural/Peano/NPeano.v +++ b/theories/Numbers/Natural/Peano/NPeano.v @@ -8,134 +8,73 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NPeano.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id$ i*) -Require Import Arith. -Require Import Min. -Require Import Max. -Require Import NSub. +Require Import Arith MinMax NAxioms NProperties. -Module NPeanoAxiomsMod <: NAxiomsSig. -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. - -Definition NZ := nat. -Definition NZeq := (@eq nat). -Definition NZ0 := 0. -Definition NZsucc := S. -Definition NZpred := pred. -Definition NZadd := plus. -Definition NZsub := minus. -Definition NZmul := mult. - -Theorem NZeq_equiv : equiv nat NZeq. -Proof (eq_equiv nat). - -Add Relation nat NZeq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) -as NZeq_rel. - -(* If we say "Add Relation nat (@eq nat)" instead of "Add Relation nat NZeq" -then the theorem generated for succ_wd below is forall x, succ x = succ x, -which does not match the axioms in NAxiomsSig *) - -Add Morphism NZsucc with signature NZeq ==> NZeq as NZsucc_wd. -Proof. -congruence. -Qed. - -Add Morphism NZpred with signature NZeq ==> NZeq as NZpred_wd. -Proof. -congruence. -Qed. +(** * Implementation of [NAxiomsSig] by [nat] *) -Add Morphism NZadd with signature NZeq ==> NZeq ==> NZeq as NZadd_wd. -Proof. -congruence. -Qed. - -Add Morphism NZsub with signature NZeq ==> NZeq ==> NZeq as NZsub_wd. -Proof. -congruence. -Qed. +Module NPeanoAxiomsMod <: NAxiomsSig. -Add Morphism NZmul with signature NZeq ==> NZeq ==> NZeq as NZmul_wd. -Proof. -congruence. -Qed. +(** Bi-directional induction. *) -Theorem NZinduction : - forall A : nat -> Prop, predicate_wd (@eq nat) A -> +Theorem bi_induction : + forall A : nat -> Prop, Proper (eq==>iff) A -> A 0 -> (forall n : nat, A n <-> A (S n)) -> forall n : nat, A n. Proof. intros A A_wd A0 AS. apply nat_ind. assumption. intros; now apply -> AS. Qed. -Theorem NZpred_succ : forall n : nat, pred (S n) = n. +(** Basic operations. *) + +Definition eq_equiv : Equivalence (@eq nat) := eq_equivalence. +Local Obligation Tactic := simpl_relation. +Program Instance succ_wd : Proper (eq==>eq) S. +Program Instance pred_wd : Proper (eq==>eq) pred. +Program Instance add_wd : Proper (eq==>eq==>eq) plus. +Program Instance sub_wd : Proper (eq==>eq==>eq) minus. +Program Instance mul_wd : Proper (eq==>eq==>eq) mult. + +Theorem pred_succ : forall n : nat, pred (S n) = n. Proof. reflexivity. Qed. -Theorem NZadd_0_l : forall n : nat, 0 + n = n. +Theorem add_0_l : forall n : nat, 0 + n = n. Proof. reflexivity. Qed. -Theorem NZadd_succ_l : forall n m : nat, (S n) + m = S (n + m). +Theorem add_succ_l : forall n m : nat, (S n) + m = S (n + m). Proof. reflexivity. Qed. -Theorem NZsub_0_r : forall n : nat, n - 0 = n. +Theorem sub_0_r : forall n : nat, n - 0 = n. Proof. intro n; now destruct n. Qed. -Theorem NZsub_succ_r : forall n m : nat, n - (S m) = pred (n - m). +Theorem sub_succ_r : forall n m : nat, n - (S m) = pred (n - m). Proof. -intros n m; induction n m using nat_double_ind; simpl; auto. apply NZsub_0_r. +intros n m; induction n m using nat_double_ind; simpl; auto. apply sub_0_r. Qed. -Theorem NZmul_0_l : forall n : nat, 0 * n = 0. +Theorem mul_0_l : forall n : nat, 0 * n = 0. Proof. reflexivity. Qed. -Theorem NZmul_succ_l : forall n m : nat, S n * m = n * m + m. +Theorem mul_succ_l : forall n m : nat, S n * m = n * m + m. Proof. intros n m; now rewrite plus_comm. Qed. -End NZAxiomsMod. +(** Order on natural numbers *) -Definition NZlt := lt. -Definition NZle := le. -Definition NZmin := min. -Definition NZmax := max. +Program Instance lt_wd : Proper (eq==>eq==>iff) lt. -Add Morphism NZlt with signature NZeq ==> NZeq ==> iff as NZlt_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZle with signature NZeq ==> NZeq ==> iff as NZle_wd. -Proof. -unfold NZeq; intros x1 x2 H1 y1 y2 H2; rewrite H1; now rewrite H2. -Qed. - -Add Morphism NZmin with signature NZeq ==> NZeq ==> NZeq as NZmin_wd. -Proof. -congruence. -Qed. - -Add Morphism NZmax with signature NZeq ==> NZeq ==> NZeq as NZmax_wd. -Proof. -congruence. -Qed. - -Theorem NZlt_eq_cases : forall n m : nat, n <= m <-> n < m \/ n = m. +Theorem lt_eq_cases : forall n m : nat, n <= m <-> n < m \/ n = m. Proof. intros n m; split. apply le_lt_or_eq. @@ -143,59 +82,52 @@ intro H; destruct H as [H | H]. now apply lt_le_weak. rewrite H; apply le_refl. Qed. -Theorem NZlt_irrefl : forall n : nat, ~ (n < n). +Theorem lt_irrefl : forall n : nat, ~ (n < n). Proof. exact lt_irrefl. Qed. -Theorem NZlt_succ_r : forall n m : nat, n < S m <-> n <= m. +Theorem lt_succ_r : forall n m : nat, n < S m <-> n <= m. Proof. intros n m; split; [apply lt_n_Sm_le | apply le_lt_n_Sm]. Qed. -Theorem NZmin_l : forall n m : nat, n <= m -> NZmin n m = n. +Theorem min_l : forall n m : nat, n <= m -> min n m = n. Proof. exact min_l. Qed. -Theorem NZmin_r : forall n m : nat, m <= n -> NZmin n m = m. +Theorem min_r : forall n m : nat, m <= n -> min n m = m. Proof. exact min_r. Qed. -Theorem NZmax_l : forall n m : nat, m <= n -> NZmax n m = n. +Theorem max_l : forall n m : nat, m <= n -> max n m = n. Proof. exact max_l. Qed. -Theorem NZmax_r : forall n m : nat, n <= m -> NZmax n m = m. +Theorem max_r : forall n m : nat, n <= m -> max n m = m. Proof. exact max_r. Qed. -End NZOrdAxiomsMod. - -Definition recursion : forall A : Type, A -> (nat -> A -> A) -> nat -> A := - fun A : Type => nat_rect (fun _ => A). -Implicit Arguments recursion [A]. - -Theorem succ_neq_0 : forall n : nat, S n <> 0. -Proof. -intros; discriminate. -Qed. +(** Facts specific to natural numbers, not integers. *) Theorem pred_0 : pred 0 = 0. Proof. reflexivity. Qed. -Theorem recursion_wd : forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : nat -> A -> A, fun2_eq (@eq nat) Aeq Aeq f f' -> - forall n n' : nat, n = n' -> - Aeq (recursion a f n) (recursion a' f' n'). +Definition recursion (A : Type) : A -> (nat -> A -> A) -> nat -> A := + nat_rect (fun _ => A). +Implicit Arguments recursion [A]. + +Instance recursion_wd (A : Type) (Aeq : relation A) : + Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A). Proof. -unfold fun2_eq; induction n; intros n' Enn'; rewrite <- Enn' in *; simpl; auto. +intros a a' Ha f f' Hf n n' Hn. subst n'. +induction n; simpl; auto. apply Hf; auto. Qed. Theorem recursion_0 : @@ -206,15 +138,100 @@ Qed. Theorem recursion_succ : forall (A : Type) (Aeq : relation A) (a : A) (f : nat -> A -> A), - Aeq a a -> fun2_wd (@eq nat) Aeq Aeq f -> + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> forall n : nat, Aeq (recursion a f (S n)) (f n (recursion a f n)). Proof. -induction n; simpl; auto. +unfold Proper, respectful in *; induction n; simpl; auto. Qed. -End NPeanoAxiomsMod. +(** The instantiation of operations. + Placing them at the very end avoids having indirections in above lemmas. *) -(* Now we apply the largest property functor *) +Definition t := nat. +Definition eq := @eq nat. +Definition zero := 0. +Definition succ := S. +Definition pred := pred. +Definition add := plus. +Definition sub := minus. +Definition mul := mult. +Definition lt := lt. +Definition le := le. +Definition min := min. +Definition max := max. -Module Export NPeanoSubPropMod := NSubPropFunct NPeanoAxiomsMod. +End NPeanoAxiomsMod. +(** Now we apply the largest property functor *) + +Module Export NPeanoPropMod := NPropFunct NPeanoAxiomsMod. + + + +(** Euclidean Division *) + +Definition divF div x y := if leb y x then S (div (x-y) y) else 0. +Definition modF mod x y := if leb y x then mod (x-y) y else x. +Definition initF (_ _ : nat) := 0. + +Fixpoint loop {A} (F:A->A)(i:A) (n:nat) : A := + match n with + | 0 => i + | S n => F (loop F i n) + end. + +Definition div x y := loop divF initF x x y. +Definition modulo x y := loop modF initF x x y. +Infix "/" := div : nat_scope. +Infix "mod" := modulo (at level 40, no associativity) : nat_scope. + +Lemma div_mod : forall x y, y<>0 -> x = y*(x/y) + x mod y. +Proof. + cut (forall n x y, y<>0 -> x<=n -> + x = y*(loop divF initF n x y) + (loop modF initF n x y)). + intros H x y Hy. apply H; auto. + induction n. + simpl; unfold initF; simpl. intros. nzsimpl. auto with arith. + simpl; unfold divF at 1, modF at 1. + intros. + destruct (leb y x) as [ ]_eqn:L; + [apply leb_complete in L | apply leb_complete_conv in L]. + rewrite mul_succ_r, <- add_assoc, (add_comm y), add_assoc. + rewrite <- IHn; auto. + symmetry; apply sub_add; auto. + rewrite <- NPeanoAxiomsMod.lt_succ_r. + apply lt_le_trans with x; auto. + apply lt_minus; auto. rewrite <- neq_0_lt_0; auto. + nzsimpl; auto. +Qed. + +Lemma mod_upper_bound : forall x y, y<>0 -> x mod y < y. +Proof. + cut (forall n x y, y<>0 -> x<=n -> loop modF initF n x y < y). + intros H x y Hy. apply H; auto. + induction n. + simpl; unfold initF. intros. rewrite <- neq_0_lt_0; auto. + simpl; unfold modF at 1. + intros. + destruct (leb y x) as [ ]_eqn:L; + [apply leb_complete in L | apply leb_complete_conv in L]; auto. + apply IHn; auto. + rewrite <- NPeanoAxiomsMod.lt_succ_r. + apply lt_le_trans with x; auto. + apply lt_minus; auto. rewrite <- neq_0_lt_0; auto. +Qed. + +Require Import NDiv. + +Module NDivMod <: NDivSig. + Include NPeanoAxiomsMod. + Definition div := div. + Definition modulo := modulo. + Definition div_mod := div_mod. + Definition mod_upper_bound := mod_upper_bound. + Local Obligation Tactic := simpl_relation. + Program Instance div_wd : Proper (eq==>eq==>eq) div. + Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. +End NDivMod. + +Module Export NDivPropMod := NDivPropFunct NDivMod NPeanoPropMod. diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v index 0275d1e1..85639aa6 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSig.v +++ b/theories/Numbers/Natural/SpecViaZ/NSig.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: NSig.v 11027 2008-06-01 13:28:59Z letouzey $ i*) +(*i $Id$ i*) Require Import ZArith Znumtheory. @@ -25,91 +25,76 @@ Module Type NType. Parameter t : Type. Parameter to_Z : t -> Z. - Notation "[ x ]" := (to_Z x). + Local Notation "[ x ]" := (to_Z x). Parameter spec_pos: forall x, 0 <= [x]. Parameter of_N : N -> t. Parameter spec_of_N: forall x, to_Z (of_N x) = Z_of_N x. Definition to_N n := Zabs_N (to_Z n). - Definition eq n m := ([n] = [m]). - - Parameter zero : t. - Parameter one : t. - - Parameter spec_0: [zero] = 0. - Parameter spec_1: [one] = 1. + Definition eq n m := [n] = [m]. + Definition lt n m := [n] < [m]. + Definition le n m := [n] <= [m]. Parameter compare : t -> t -> comparison. - - Parameter spec_compare: forall x y, - match compare x y with - | Eq => [x] = [y] - | Lt => [x] < [y] - | Gt => [x] > [y] - end. - - Definition lt n m := compare n m = Lt. - Definition le n m := compare n m <> Gt. - Definition min n m := match compare n m with Gt => m | _ => n end. - Definition max n m := match compare n m with Lt => m | _ => n end. - Parameter eq_bool : t -> t -> bool. - - Parameter spec_eq_bool: forall x y, - if eq_bool x y then [x] = [y] else [x] <> [y]. - + Parameter max : t -> t -> t. + Parameter min : t -> t -> t. + Parameter zero : t. + Parameter one : t. Parameter succ : t -> t. - - Parameter spec_succ: forall n, [succ n] = [n] + 1. - - Parameter add : t -> t -> t. - - Parameter spec_add: forall x y, [add x y] = [x] + [y]. - Parameter pred : t -> t. - - Parameter spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1. - Parameter spec_pred0: forall x, [x] = 0 -> [pred x] = 0. - + Parameter add : t -> t -> t. Parameter sub : t -> t -> t. - - Parameter spec_sub: forall x y, [y] <= [x] -> [sub x y] = [x] - [y]. - Parameter spec_sub0: forall x y, [x] < [y]-> [sub x y] = 0. - Parameter mul : t -> t -> t. - - Parameter spec_mul: forall x y, [mul x y] = [x] * [y]. - Parameter square : t -> t. - - Parameter spec_square: forall x, [square x] = [x] * [x]. - Parameter power_pos : t -> positive -> t. - - Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. - + Parameter power : t -> N -> t. Parameter sqrt : t -> t. - - Parameter spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. - Parameter div_eucl : t -> t -> t * t. - - Parameter spec_div_eucl: forall x y, - 0 < [y] -> - let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. - Parameter div : t -> t -> t. - - Parameter spec_div: forall x y, 0 < [y] -> [div x y] = [x] / [y]. - Parameter modulo : t -> t -> t. - - Parameter spec_modulo: - forall x y, 0 < [y] -> [modulo x y] = [x] mod [y]. - Parameter gcd : t -> t -> t. - - Parameter spec_gcd: forall a b, [gcd a b] = Zgcd (to_Z a) (to_Z b). + Parameter shiftr : t -> t -> t. + Parameter shiftl : t -> t -> t. + Parameter is_even : t -> bool. + + Parameter spec_compare: forall x y, compare x y = Zcompare [x] [y]. + Parameter spec_eq_bool: forall x y, eq_bool x y = Zeq_bool [x] [y]. + Parameter spec_max : forall x y, [max x y] = Zmax [x] [y]. + Parameter spec_min : forall x y, [min x y] = Zmin [x] [y]. + Parameter spec_0: [zero] = 0. + Parameter spec_1: [one] = 1. + Parameter spec_succ: forall n, [succ n] = [n] + 1. + Parameter spec_add: forall x y, [add x y] = [x] + [y]. + Parameter spec_pred: forall x, [pred x] = Zmax 0 ([x] - 1). + Parameter spec_sub: forall x y, [sub x y] = Zmax 0 ([x] - [y]). + Parameter spec_mul: forall x y, [mul x y] = [x] * [y]. + Parameter spec_square: forall x, [square x] = [x] * [x]. + Parameter spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. + Parameter spec_power: forall x n, [power x n] = [x] ^ Z_of_N n. + Parameter spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. + Parameter spec_div_eucl: forall x y, + let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. + Parameter spec_div: forall x y, [div x y] = [x] / [y]. + Parameter spec_modulo: forall x y, [modulo x y] = [x] mod [y]. + Parameter spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]. + Parameter spec_shiftr: forall p x, [shiftr p x] = [x] / 2^[p]. + Parameter spec_shiftl: forall p x, [shiftl p x] = [x] * 2^[p]. + Parameter spec_is_even: forall x, + if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1. End NType. + +Module Type NType_Notation (Import N:NType). + Notation "[ x ]" := (to_Z x). + Infix "==" := eq (at level 70). + Notation "0" := zero. + Infix "+" := add. + Infix "-" := sub. + Infix "*" := mul. + Infix "<=" := le. + Infix "<" := lt. +End NType_Notation. + +Module Type NType' := NType <+ NType_Notation. diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v index 84836268..ab749bd1 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v +++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v @@ -6,101 +6,47 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: NSigNAxioms.v 11282 2008-07-28 11:51:53Z msozeau $ i*) +(*i $Id$ i*) -Require Import ZArith. -Require Import Nnat. -Require Import NAxioms. -Require Import NSig. +Require Import ZArith Nnat NAxioms NDiv NSig. (** * The interface [NSig.NType] implies the interface [NAxiomsSig] *) -Module NSig_NAxioms (N:NType) <: NAxiomsSig. - -Delimit Scope IntScope with Int. -Bind Scope IntScope with N.t. -Open Local Scope IntScope. -Notation "[ x ]" := (N.to_Z x) : IntScope. -Infix "==" := N.eq (at level 70) : IntScope. -Notation "0" := N.zero : IntScope. -Infix "+" := N.add : IntScope. -Infix "-" := N.sub : IntScope. -Infix "*" := N.mul : IntScope. - -Module Export NZOrdAxiomsMod <: NZOrdAxiomsSig. -Module Export NZAxiomsMod <: NZAxiomsSig. - -Definition NZ := N.t. -Definition NZeq := N.eq. -Definition NZ0 := N.zero. -Definition NZsucc := N.succ. -Definition NZpred := N.pred. -Definition NZadd := N.add. -Definition NZsub := N.sub. -Definition NZmul := N.mul. - -Theorem NZeq_equiv : equiv N.t N.eq. -Proof. -repeat split; repeat red; intros; auto; congruence. -Qed. +Module NTypeIsNAxioms (Import N : NType'). -Add Relation N.t N.eq - reflexivity proved by (proj1 NZeq_equiv) - symmetry proved by (proj2 (proj2 NZeq_equiv)) - transitivity proved by (proj1 (proj2 NZeq_equiv)) - as NZeq_rel. +Hint Rewrite + spec_0 spec_succ spec_add spec_mul spec_pred spec_sub + spec_div spec_modulo spec_gcd spec_compare spec_eq_bool + spec_max spec_min spec_power_pos spec_power + : nsimpl. +Ltac nsimpl := autorewrite with nsimpl. +Ltac ncongruence := unfold eq; repeat red; intros; nsimpl; congruence. +Ltac zify := unfold eq, lt, le in *; nsimpl. -Add Morphism NZsucc with signature N.eq ==> N.eq as NZsucc_wd. -Proof. -unfold N.eq; intros; rewrite 2 N.spec_succ; f_equal; auto. -Qed. +Local Obligation Tactic := ncongruence. -Add Morphism NZpred with signature N.eq ==> N.eq as NZpred_wd. -Proof. -unfold N.eq; intros. -generalize (N.spec_pos y) (N.spec_pos x) (N.spec_eq_bool x 0). -destruct N.eq_bool; rewrite N.spec_0; intros. -rewrite 2 N.spec_pred0; congruence. -rewrite 2 N.spec_pred; f_equal; auto; try omega. -Qed. +Instance eq_equiv : Equivalence eq. +Proof. unfold eq. firstorder. Qed. -Add Morphism NZadd with signature N.eq ==> N.eq ==> N.eq as NZadd_wd. -Proof. -unfold N.eq; intros; rewrite 2 N.spec_add; f_equal; auto. -Qed. +Program Instance succ_wd : Proper (eq==>eq) succ. +Program Instance pred_wd : Proper (eq==>eq) pred. +Program Instance add_wd : Proper (eq==>eq==>eq) add. +Program Instance sub_wd : Proper (eq==>eq==>eq) sub. +Program Instance mul_wd : Proper (eq==>eq==>eq) mul. -Add Morphism NZsub with signature N.eq ==> N.eq ==> N.eq as NZsub_wd. +Theorem pred_succ : forall n, pred (succ n) == n. Proof. -unfold N.eq; intros x x' Hx y y' Hy. -destruct (Z_lt_le_dec [x] [y]). -rewrite 2 N.spec_sub0; f_equal; congruence. -rewrite 2 N.spec_sub; f_equal; congruence. +intros. zify. generalize (spec_pos n); omega with *. Qed. -Add Morphism NZmul with signature N.eq ==> N.eq ==> N.eq as NZmul_wd. -Proof. -unfold N.eq; intros; rewrite 2 N.spec_mul; f_equal; auto. -Qed. - -Theorem NZpred_succ : forall n, N.pred (N.succ n) == n. -Proof. -unfold N.eq; intros. -rewrite N.spec_pred; rewrite N.spec_succ. -omega. -generalize (N.spec_pos n); omega. -Qed. - -Definition N_of_Z z := N.of_N (Zabs_N z). +Definition N_of_Z z := of_N (Zabs_N z). Section Induction. Variable A : N.t -> Prop. -Hypothesis A_wd : predicate_wd N.eq A. +Hypothesis A_wd : Proper (eq==>iff) A. Hypothesis A0 : A 0. -Hypothesis AS : forall n, A n <-> A (N.succ n). - -Add Morphism A with signature N.eq ==> iff as A_morph. -Proof. apply A_wd. Qed. +Hypothesis AS : forall n, A n <-> A (succ n). Let B (z : Z) := A (N_of_Z z). @@ -108,17 +54,17 @@ Lemma B0 : B 0. Proof. unfold B, N_of_Z; simpl. rewrite <- (A_wd 0); auto. -red; rewrite N.spec_0, N.spec_of_N; auto. +red; rewrite spec_0, spec_of_N; auto. Qed. Lemma BS : forall z : Z, (0 <= z)%Z -> B z -> B (z + 1). Proof. intros z H1 H2. unfold B in *. apply -> AS in H2. -setoid_replace (N_of_Z (z + 1)) with (N.succ (N_of_Z z)); auto. -unfold N.eq. rewrite N.spec_succ. +setoid_replace (N_of_Z (z + 1)) with (succ (N_of_Z z)); auto. +unfold eq. rewrite spec_succ. unfold N_of_Z. -rewrite 2 N.spec_of_N, 2 Z_of_N_abs, 2 Zabs_eq; auto with zarith. +rewrite 2 spec_of_N, 2 Z_of_N_abs, 2 Zabs_eq; auto with zarith. Qed. Lemma B_holds : forall z : Z, (0 <= z)%Z -> B z. @@ -126,193 +72,144 @@ Proof. exact (natlike_ind B B0 BS). Qed. -Theorem NZinduction : forall n, A n. +Theorem bi_induction : forall n, A n. Proof. -intro n. setoid_replace n with (N_of_Z (N.to_Z n)). -apply B_holds. apply N.spec_pos. +intro n. setoid_replace n with (N_of_Z (to_Z n)). +apply B_holds. apply spec_pos. red; unfold N_of_Z. -rewrite N.spec_of_N, Z_of_N_abs, Zabs_eq; auto. -apply N.spec_pos. +rewrite spec_of_N, Z_of_N_abs, Zabs_eq; auto. +apply spec_pos. Qed. End Induction. -Theorem NZadd_0_l : forall n, 0 + n == n. +Theorem add_0_l : forall n, 0 + n == n. Proof. -intros; red; rewrite N.spec_add, N.spec_0; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZadd_succ_l : forall n m, (N.succ n) + m == N.succ (n + m). +Theorem add_succ_l : forall n m, (succ n) + m == succ (n + m). Proof. -intros; red; rewrite N.spec_add, 2 N.spec_succ, N.spec_add; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZsub_0_r : forall n, n - 0 == n. +Theorem sub_0_r : forall n, n - 0 == n. Proof. -intros; red; rewrite N.spec_sub; rewrite N.spec_0; auto with zarith. -apply N.spec_pos. +intros. zify. generalize (spec_pos n); omega with *. Qed. -Theorem NZsub_succ_r : forall n m, n - (N.succ m) == N.pred (n - m). +Theorem sub_succ_r : forall n m, n - (succ m) == pred (n - m). Proof. -intros; red. -destruct (Z_lt_le_dec [n] [N.succ m]) as [H|H]. -rewrite N.spec_sub0; auto. -rewrite N.spec_succ in H. -rewrite N.spec_pred0; auto. -destruct (Z_eq_dec [n] [m]). -rewrite N.spec_sub; auto with zarith. -rewrite N.spec_sub0; auto with zarith. - -rewrite N.spec_sub, N.spec_succ in *; auto. -rewrite N.spec_pred, N.spec_sub; auto with zarith. -rewrite N.spec_sub; auto with zarith. +intros. zify. omega with *. Qed. -Theorem NZmul_0_l : forall n, 0 * n == 0. +Theorem mul_0_l : forall n, 0 * n == 0. Proof. -intros; red. -rewrite N.spec_mul, N.spec_0; auto with zarith. +intros. zify. auto with zarith. Qed. -Theorem NZmul_succ_l : forall n m, (N.succ n) * m == n * m + m. +Theorem mul_succ_l : forall n m, (succ n) * m == n * m + m. Proof. -intros; red. -rewrite N.spec_add, 2 N.spec_mul, N.spec_succ; ring. +intros. zify. ring. Qed. -End NZAxiomsMod. - -Definition NZlt := N.lt. -Definition NZle := N.le. -Definition NZmin := N.min. -Definition NZmax := N.max. +(** Order *) -Infix "<=" := N.le : IntScope. -Infix "<" := N.lt : IntScope. - -Lemma spec_compare_alt : forall x y, N.compare x y = ([x] ?= [y])%Z. +Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. - intros; generalize (N.spec_compare x y). - destruct (N.compare x y); auto. - intros H; rewrite H; symmetry; apply Zcompare_refl. + intros. zify. destruct (Zcompare_spec [x] [y]); auto. Qed. -Lemma spec_lt : forall x y, (x<y) <-> ([x]<[y])%Z. -Proof. - intros; unfold N.lt, Zlt; rewrite spec_compare_alt; intuition. -Qed. +Definition eqb := eq_bool. -Lemma spec_le : forall x y, (x<=y) <-> ([x]<=[y])%Z. +Lemma eqb_eq : forall x y, eq_bool x y = true <-> x == y. Proof. - intros; unfold N.le, Zle; rewrite spec_compare_alt; intuition. + intros. zify. symmetry. apply Zeq_is_eq_bool. Qed. -Lemma spec_min : forall x y, [N.min x y] = Zmin [x] [y]. +Instance compare_wd : Proper (eq ==> eq ==> Logic.eq) compare. Proof. - intros; unfold N.min, Zmin. - rewrite spec_compare_alt; destruct Zcompare; auto. +intros x x' Hx y y' Hy. rewrite 2 spec_compare, Hx, Hy; intuition. Qed. -Lemma spec_max : forall x y, [N.max x y] = Zmax [x] [y]. +Instance lt_wd : Proper (eq ==> eq ==> iff) lt. Proof. - intros; unfold N.max, Zmax. - rewrite spec_compare_alt; destruct Zcompare; auto. -Qed. - -Add Morphism N.compare with signature N.eq ==> N.eq ==> (@eq comparison) as compare_wd. -Proof. -intros x x' Hx y y' Hy. -rewrite 2 spec_compare_alt. unfold N.eq in *. rewrite Hx, Hy; intuition. +intros x x' Hx y y' Hy; unfold lt; rewrite Hx, Hy; intuition. Qed. -Add Morphism N.lt with signature N.eq ==> N.eq ==> iff as NZlt_wd. +Theorem lt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. Proof. -intros x x' Hx y y' Hy; unfold N.lt; rewrite Hx, Hy; intuition. +intros. zify. omega. Qed. -Add Morphism N.le with signature N.eq ==> N.eq ==> iff as NZle_wd. +Theorem lt_irrefl : forall n, ~ n < n. Proof. -intros x x' Hx y y' Hy; unfold N.le; rewrite Hx, Hy; intuition. +intros. zify. omega. Qed. -Add Morphism N.min with signature N.eq ==> N.eq ==> N.eq as NZmin_wd. +Theorem lt_succ_r : forall n m, n < (succ m) <-> n <= m. Proof. -intros; red; rewrite 2 spec_min; congruence. +intros. zify. omega. Qed. -Add Morphism N.max with signature N.eq ==> N.eq ==> N.eq as NZmax_wd. +Theorem min_l : forall n m, n <= m -> min n m == n. Proof. -intros; red; rewrite 2 spec_max; congruence. +intros n m. zify. omega with *. Qed. -Theorem NZlt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. +Theorem min_r : forall n m, m <= n -> min n m == m. Proof. -intros. -unfold N.eq; rewrite spec_lt, spec_le; omega. +intros n m. zify. omega with *. Qed. -Theorem NZlt_irrefl : forall n, ~ n < n. +Theorem max_l : forall n m, m <= n -> max n m == n. Proof. -intros; rewrite spec_lt; auto with zarith. +intros n m. zify. omega with *. Qed. -Theorem NZlt_succ_r : forall n m, n < (N.succ m) <-> n <= m. +Theorem max_r : forall n m, n <= m -> max n m == m. Proof. -intros; rewrite spec_lt, spec_le, N.spec_succ; omega. +intros n m. zify. omega with *. Qed. -Theorem NZmin_l : forall n m, n <= m -> N.min n m == n. -Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_min. -generalize (Zmin_spec [n] [m]); omega. -Qed. +(** Properties specific to natural numbers, not integers. *) -Theorem NZmin_r : forall n m, m <= n -> N.min n m == m. +Theorem pred_0 : pred 0 == 0. Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_min. -generalize (Zmin_spec [n] [m]); omega. +zify. auto. Qed. -Theorem NZmax_l : forall n m, m <= n -> N.max n m == n. -Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_max. -generalize (Zmax_spec [n] [m]); omega. -Qed. +Program Instance div_wd : Proper (eq==>eq==>eq) div. +Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. -Theorem NZmax_r : forall n m, n <= m -> N.max n m == m. +Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b). Proof. -intros n m; unfold N.eq; rewrite spec_le, spec_max. -generalize (Zmax_spec [n] [m]); omega. +intros a b. zify. intros. apply Z_div_mod_eq_full; auto. Qed. -End NZOrdAxiomsMod. - -Theorem pred_0 : N.pred 0 == 0. +Theorem mod_upper_bound : forall a b, ~b==0 -> modulo a b < b. Proof. -red; rewrite N.spec_pred0; rewrite N.spec_0; auto. +intros a b. zify. intros. +destruct (Z_mod_lt [a] [b]); auto. +generalize (spec_pos b); auto with zarith. Qed. Definition recursion (A : Type) (a : A) (f : N.t -> A -> A) (n : N.t) := Nrect (fun _ => A) a (fun n a => f (N.of_N n) a) (N.to_N n). Implicit Arguments recursion [A]. -Theorem recursion_wd : -forall (A : Type) (Aeq : relation A), - forall a a' : A, Aeq a a' -> - forall f f' : N.t -> A -> A, fun2_eq N.eq Aeq Aeq f f' -> - forall x x' : N.t, x == x' -> - Aeq (recursion a f x) (recursion a' f' x'). +Instance recursion_wd (A : Type) (Aeq : relation A) : + Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) (@recursion A). Proof. -unfold fun2_wd, N.eq, fun2_eq. -intros A Aeq a a' Eaa' f f' Eff' x x' Exx'. +unfold eq. +intros a a' Eaa' f f' Eff' x x' Exx'. unfold recursion. unfold N.to_N. rewrite <- Exx'; clear x' Exx'. replace (Zabs_N [x]) with (N_of_nat (Zabs_nat [x])). induction (Zabs_nat [x]). simpl; auto. -rewrite N_of_S, 2 Nrect_step; auto. +rewrite N_of_S, 2 Nrect_step; auto. apply Eff'; auto. destruct [x]; simpl; auto. change (nat_of_P p) with (nat_of_N (Npos p)); apply N_of_nat_of_N. change (nat_of_P p) with (nat_of_N (Npos p)); apply N_of_nat_of_N. @@ -326,11 +223,11 @@ Qed. Theorem recursion_succ : forall (A : Type) (Aeq : relation A) (a : A) (f : N.t -> A -> A), - Aeq a a -> fun2_wd N.eq Aeq Aeq f -> - forall n, Aeq (recursion a f (N.succ n)) (f n (recursion a f n)). + Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> + forall n, Aeq (recursion a f (succ n)) (f n (recursion a f n)). Proof. -unfold N.eq, recursion, fun2_wd; intros A Aeq a f EAaa f_wd n. -replace (N.to_N (N.succ n)) with (Nsucc (N.to_N n)). +unfold N.eq, recursion; intros A Aeq a f EAaa f_wd n. +replace (N.to_N (succ n)) with (Nsucc (N.to_N n)). rewrite Nrect_step. apply f_wd; auto. unfold N.to_N. @@ -340,7 +237,6 @@ rewrite N.spec_of_N, Z_of_N_abs, Zabs_eq; auto. fold (recursion a f n). apply recursion_wd; auto. red; auto. -red; auto. unfold N.to_N. rewrite N.spec_succ. @@ -349,8 +245,12 @@ apply Z_of_N_eq_rev. rewrite Z_of_N_succ. rewrite 2 Z_of_N_abs. rewrite 2 Zabs_eq; auto. -generalize (N.spec_pos n); auto with zarith. -apply N.spec_pos; auto. +generalize (spec_pos n); auto with zarith. +apply spec_pos; auto. Qed. -End NSig_NAxioms. +End NTypeIsNAxioms. + +Module NType_NAxioms (N : NType) + <: NAxiomsSig <: NDivSig <: HasCompare N <: HasEqBool N <: HasMinMax N + := N <+ NTypeIsNAxioms. diff --git a/theories/Numbers/NumPrelude.v b/theories/Numbers/NumPrelude.v index 95d8b366..468b0613 100644 --- a/theories/Numbers/NumPrelude.v +++ b/theories/Numbers/NumPrelude.v @@ -8,9 +8,9 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NumPrelude.v 11674 2008-12-12 19:48:40Z letouzey $ i*) +(*i $Id$ i*) -Require Export Setoid. +Require Export Setoid Morphisms. Set Implicit Arguments. (* @@ -91,85 +91,31 @@ end. Tactic Notation "stepr" constr(t2') "in" hyp(H) "by" tactic(r) := stepr t2' in H; [| r]. -(** Extentional properties of predicates, relations and functions *) +(** Predicates, relations, functions *) Definition predicate (A : Type) := A -> Prop. -Section ExtensionalProperties. - -Variables A B C : Type. -Variable Aeq : relation A. -Variable Beq : relation B. -Variable Ceq : relation C. - -(* "wd" stands for "well-defined" *) - -Definition fun_wd (f : A -> B) := forall x y : A, Aeq x y -> Beq (f x) (f y). - -Definition fun2_wd (f : A -> B -> C) := - forall x x' : A, Aeq x x' -> forall y y' : B, Beq y y' -> Ceq (f x y) (f x' y'). - -Definition fun_eq : relation (A -> B) := - fun f f' => forall x x' : A, Aeq x x' -> Beq (f x) (f' x'). - -(* Note that reflexivity of fun_eq means that every function -is well-defined w.r.t. Aeq and Beq, i.e., -forall x x' : A, Aeq x x' -> Beq (f x) (f x') *) - -Definition fun2_eq (f f' : A -> B -> C) := - forall x x' : A, Aeq x x' -> forall y y' : B, Beq y y' -> Ceq (f x y) (f' x' y'). - -End ExtensionalProperties. - -(* The following definitions instantiate Beq or Ceq to iff; therefore, they -have to be outside the ExtensionalProperties section *) - -Definition predicate_wd (A : Type) (Aeq : relation A) := fun_wd Aeq iff. - -Definition relation_wd (A B : Type) (Aeq : relation A) (Beq : relation B) := - fun2_wd Aeq Beq iff. - -Definition relations_eq (A B : Type) (R1 R2 : A -> B -> Prop) := - forall (x : A) (y : B), R1 x y <-> R2 x y. - -Theorem relations_eq_equiv : - forall (A B : Type), equiv (A -> B -> Prop) (@relations_eq A B). -Proof. -intros A B; unfold equiv. split; [| split]; -unfold reflexive, symmetric, transitive, relations_eq. -reflexivity. -intros R1 R2 R3 H1 H2 x y; rewrite H1; apply H2. -now symmetry. -Qed. - -Add Parametric Relation (A B : Type) : (A -> B -> Prop) (@relations_eq A B) - reflexivity proved by (proj1 (relations_eq_equiv A B)) - symmetry proved by (proj2 (proj2 (relations_eq_equiv A B))) - transitivity proved by (proj1 (proj2 (relations_eq_equiv A B))) -as relations_eq_rel. - -Add Parametric Morphism (A : Type) : (@well_founded A) with signature (@relations_eq A A) ==> iff as well_founded_wd. +Instance well_founded_wd A : + Proper (@relation_equivalence A ==> iff) (@well_founded A). Proof. -unfold relations_eq, well_founded; intros R1 R2 H; -split; intros H1 a; induction (H1 a) as [x H2 H3]; constructor; -intros y H4; apply H3; [now apply <- H | now apply -> H]. +intros R1 R2 H. +split; intros WF a; induction (WF a) as [x _ WF']; constructor; +intros y Ryx; apply WF'; destruct (H y x); auto. Qed. -(* solve_predicate_wd solves the goal [predicate_wd P] for P consisting of -morhisms and quatifiers *) +(** [solve_predicate_wd] solves the goal [Proper (?==>iff) P] + for P consisting of morphisms and quantifiers *) Ltac solve_predicate_wd := -unfold predicate_wd; let x := fresh "x" in let y := fresh "y" in let H := fresh "H" in intros x y H; setoid_rewrite H; reflexivity. -(* solve_relation_wd solves the goal [relation_wd R] for R consisting of -morhisms and quatifiers *) +(** [solve_relation_wd] solves the goal [Proper (?==>?==>iff) R] + for R consisting of morphisms and quantifiers *) Ltac solve_relation_wd := -unfold relation_wd, fun2_wd; let x1 := fresh "x" in let y1 := fresh "y" in let H1 := fresh "H" in @@ -191,77 +137,3 @@ Ltac induction_maker n t := pattern n; t; clear n; [solve_predicate_wd | ..]. -(** Relations on cartesian product. Used in MiscFunct for defining -functions whose domain is a product of sets by primitive recursion *) - -Section RelationOnProduct. - -Variables A B : Set. -Variable Aeq : relation A. -Variable Beq : relation B. - -Hypothesis EA_equiv : equiv A Aeq. -Hypothesis EB_equiv : equiv B Beq. - -Definition prod_rel : relation (A * B) := - fun p1 p2 => Aeq (fst p1) (fst p2) /\ Beq (snd p1) (snd p2). - -Lemma prod_rel_refl : reflexive (A * B) prod_rel. -Proof. -unfold reflexive, prod_rel. -destruct x; split; [apply (proj1 EA_equiv) | apply (proj1 EB_equiv)]; simpl. -Qed. - -Lemma prod_rel_sym : symmetric (A * B) prod_rel. -Proof. -unfold symmetric, prod_rel. -destruct x; destruct y; -split; [apply (proj2 (proj2 EA_equiv)) | apply (proj2 (proj2 EB_equiv))]; simpl in *; tauto. -Qed. - -Lemma prod_rel_trans : transitive (A * B) prod_rel. -Proof. -unfold transitive, prod_rel. -destruct x; destruct y; destruct z; simpl. -intros; split; [apply (proj1 (proj2 EA_equiv)) with (y := a0) | -apply (proj1 (proj2 EB_equiv)) with (y := b0)]; tauto. -Qed. - -Theorem prod_rel_equiv : equiv (A * B) prod_rel. -Proof. -unfold equiv; split; [exact prod_rel_refl | split; [exact prod_rel_trans | exact prod_rel_sym]]. -Qed. - -End RelationOnProduct. - -Implicit Arguments prod_rel [A B]. -Implicit Arguments prod_rel_equiv [A B]. - -(** Miscellaneous *) - -(*Definition comp_bool (x y : comparison) : bool := -match x, y with -| Lt, Lt => true -| Eq, Eq => true -| Gt, Gt => true -| _, _ => false -end. - -Theorem comp_bool_correct : forall x y : comparison, - comp_bool x y <-> x = y. -Proof. -destruct x; destruct y; simpl; split; now intro. -Qed.*) - -Lemma eq_equiv : forall A : Set, equiv A (@eq A). -Proof. -intro A; unfold equiv, reflexive, symmetric, transitive. -repeat split; [exact (@trans_eq A) | exact (@sym_eq A)]. -(* It is interesting how the tactic split proves reflexivity *) -Qed. - -(*Add Relation (fun A : Set => A) LE_Set - reflexivity proved by (fun A : Set => (proj1 (eq_equiv A))) - symmetry proved by (fun A : Set => (proj2 (proj2 (eq_equiv A)))) - transitivity proved by (fun A : Set => (proj1 (proj2 (eq_equiv A)))) -as EA_rel.*) diff --git a/theories/Numbers/Rational/BigQ/BigQ.v b/theories/Numbers/Rational/BigQ/BigQ.v index f01cbbc5..0bc71166 100644 --- a/theories/Numbers/Rational/BigQ/BigQ.v +++ b/theories/Numbers/Rational/BigQ/BigQ.v @@ -5,12 +5,13 @@ (* // * 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: BigQ.v 12509 2009-11-12 15:52:50Z letouzey $ i*) +(** * BigQ: an efficient implementation of rational numbers *) + +(** Initial authors: Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) -Require Import Field Qfield BigN BigZ QSig QMake. +Require Export BigZ. +Require Import Field Qfield QSig QMake Orders GenericMinMax. (** We choose for BigQ an implemention with multiple representation of 0: 0, 1/0, 2/0 etc. @@ -34,7 +35,9 @@ 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. +Module BigQ <: QType <: OrderedTypeFull <: TotalOrder := + QMake.Make BigN BigZ BigN_BigZ <+ !QProperties <+ HasEqBool2Dec + <+ !MinMaxLogicalProperties <+ !MinMaxDecProperties. (** Notations about [BigQ] *) @@ -43,12 +46,40 @@ Notation bigQ := BigQ.t. Delimit Scope bigQ_scope with bigQ. Bind Scope bigQ_scope with bigQ. Bind Scope bigQ_scope with BigQ.t. - -(* Allow nice printing of rational numerals, either as (Qz 1234) - or as (Qq 1234 5678) *) +Bind Scope bigQ_scope with BigQ.t_. +(* Bind Scope has no retroactive effect, let's declare scopes by hand. *) Arguments Scope BigQ.Qz [bigZ_scope]. -Arguments Scope BigQ.Qq [bigZ_scope bigN_scope]. - +Arguments Scope BigQ.Qq [bigZ_scope bigN_scope]. +Arguments Scope BigQ.to_Q [bigQ_scope]. +Arguments Scope BigQ.red [bigQ_scope]. +Arguments Scope BigQ.opp [bigQ_scope]. +Arguments Scope BigQ.inv [bigQ_scope]. +Arguments Scope BigQ.square [bigQ_scope]. +Arguments Scope BigQ.add [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.sub [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.mul [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.div [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.eq [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.lt [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.le [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.eq [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.compare [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.min [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.max [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.eq_bool [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.power_pos [bigQ_scope positive_scope]. +Arguments Scope BigQ.power [bigQ_scope Z_scope]. +Arguments Scope BigQ.inv_norm [bigQ_scope]. +Arguments Scope BigQ.add_norm [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.sub_norm [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.mul_norm [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.div_norm [bigQ_scope bigQ_scope]. +Arguments Scope BigQ.power_norm [bigQ_scope bigQ_scope]. + +(** As in QArith, we use [#] to denote fractions *) +Notation "p # q" := (BigQ.Qq p q) (at level 55, no associativity) : bigQ_scope. +Local Notation "0" := BigQ.zero : bigQ_scope. +Local Notation "1" := BigQ.one : bigQ_scope. Infix "+" := BigQ.add : bigQ_scope. Infix "-" := BigQ.sub : bigQ_scope. Notation "- x" := (BigQ.opp x) : bigQ_scope. @@ -57,142 +88,102 @@ Infix "/" := BigQ.div : bigQ_scope. Infix "^" := BigQ.power : bigQ_scope. Infix "?=" := BigQ.compare : bigQ_scope. Infix "==" := BigQ.eq : bigQ_scope. +Notation "x != y" := (~x==y)%bigQ (at level 70, no associativity) : 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 "x < y < z" := (x<y /\ y<z)%bigQ : bigQ_scope. +Notation "x < y <= z" := (x<y /\ y<=z)%bigQ : bigQ_scope. +Notation "x <= y < z" := (x<=y /\ y<z)%bigQ : bigQ_scope. +Notation "x <= y <= z" := (x<=y /\ y<=z)%bigQ : 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. *) - +Local Open Scope bigQ_scope. (** [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. + field_theory 0 1 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. +exact BigQ.add_0_l. exact BigQ.add_comm. exact BigQ.add_assoc. +exact BigQ.mul_1_l. exact BigQ.mul_comm. exact BigQ.mul_assoc. +exact BigQ.mul_add_distr_r. exact BigQ.sub_add_opp. +exact BigQ.add_opp_diag_r. exact BigQ.neq_1_0. +exact BigQ.div_mul_inv. exact BigQ.mul_inv_diag_l. Qed. -Lemma BigQ_eq_bool_complete : - forall x y, x==y -> BigQ.eq_bool x y = true. +Lemma BigQpowerth : + power_theory 1 BigQ.mul BigQ.eq Z_of_N BigQ.power. Proof. -intros; generalize (BigQ.spec_eq_bool x y). -destruct BigQ.eq_bool; auto. +constructor. intros. BigQ.qify. +replace ([r] ^ Z_of_N n)%Q with (pow_N 1 Qmult [r] n)%Q by (now destruct n). +destruct n. reflexivity. +induction p; simpl; auto; rewrite ?BigQ.spec_mul, ?IHp; reflexivity. Qed. -(* TODO : improve later the detection of constants ... *) +Ltac isBigQcst t := + match t with + | BigQ.Qz ?t => isBigZcst t + | BigQ.Qq ?n ?d => match isBigZcst n with + | true => isBigNcst d + | false => constr:false + end + | BigQ.zero => constr:true + | BigQ.one => constr:true + | BigQ.minus_one => constr:true + | _ => constr:false + end. Ltac BigQcst t := - match t with - | BigQ.zero => BigQ.zero - | BigQ.one => BigQ.one - | BigQ.minus_one => BigQ.minus_one - | _ => NotConstant + match isBigQcst t with + | true => constr:t + | false => constr:NotConstant end. Add Field BigQfield : BigQfieldth - (decidable BigQ_eq_bool_correct, - completeness BigQ_eq_bool_complete, + (decidable BigQ.eqb_correct, + completeness BigQ.eqb_complete, constants [BigQcst], power_tac BigQpowerth [Qpow_tac]). -Section Examples. +Section TestField. Let ex1 : forall x y z, (x+y)*z == (x*z)+(y*z). intros. ring. Qed. -Let ex8 : forall x, x ^ 1 == x. +Let ex8 : forall x, x ^ 2 == x*x. intro. ring. Qed. -Let ex10 : forall x y, ~(y==BigQ.zero) -> (x/y)*y == x. +Let ex10 : forall x y, y!=0 -> (x/y)*y == x. intros. field. auto. Qed. -End Examples.
\ No newline at end of file +End TestField. + +(** [BigQ] can also benefit from an "order" tactic *) + +Module BigQ_Order := !OrdersTac.MakeOrderTac BigQ. +Ltac bigQ_order := BigQ_Order.order. + +Section TestOrder. +Let test : forall x y : bigQ, x<=y -> y<=x -> x==y. +Proof. bigQ_order. Qed. +End TestOrder. + +(** We can also reason by switching to QArith thanks to tactic + BigQ.qify. *) + +Section TestQify. +Let test : forall x : bigQ, 0+x == 1*x. +Proof. intro x. BigQ.qify. ring. Qed. +End TestQify. diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v index 494420bd..407f7b90 100644 --- a/theories/Numbers/Rational/BigQ/QMake.v +++ b/theories/Numbers/Rational/BigQ/QMake.v @@ -5,15 +5,20 @@ (* // * 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*) +(** * QMake : a generic efficient implementation of rational numbers *) + +(** Initial authors : Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) Require Import BigNumPrelude ROmega. -Require Import QArith Qcanon Qpower. +Require Import QArith Qcanon Qpower Qminmax. Require Import NSig ZSig QSig. +(** We will build rationals out of an implementation of integers [ZType] + for numerators and an implementation of natural numbers [NType] for + denominators. But first we will need some glue between [NType] and + [ZType]. *) + 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. @@ -28,27 +33,27 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. number y interpreted as x/y. The pairs (x,0) and (0,y) are all interpreted as 0. *) - Inductive t_ := + Inductive t_ := | Qz : Z.t -> t_ | Qq : Z.t -> N.t -> t_. Definition t := t_. - (** Specification with respect to [QArith] *) + (** Specification with respect to [QArith] *) - Open Local Scope Q_scope. + Local Open Scope Q_scope. Definition of_Z x: t := Qz (Z.of_Z x). - Definition of_Q (q:Q) : t := - let (x,y) := q in - match y with + Definition of_Q (q:Q) : t := + let (x,y) := q in + match y with | 1%positive => Qz (Z.of_Z x) | _ => Qq (Z.of_Z x) (N.of_N (Npos y)) end. - Definition to_Q (q: t) := - match q with + Definition to_Q (q: t) := + match q with | Qz x => Z.to_Z x # 1 | Qq x y => if N.eq_bool y N.zero then 0 else Z.to_Z x # Z2P (N.to_Z y) @@ -56,17 +61,56 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Notation "[ x ]" := (to_Q x). + Lemma N_to_Z_pos : + forall x, (N.to_Z x <> N.to_Z N.zero)%Z -> (0 < N.to_Z x)%Z. + Proof. + intros x; rewrite N.spec_0; generalize (N.spec_pos x). romega. + Qed. +(* + Lemma if_fun_commut : forall A B (f:A->B)(b:bool) a a', + f (if b then a else a') = if b then f a else f a'. + Proof. now destruct b. Qed. + + Lemma if_fun_commut' : forall A B C D (f:A->B)(b:{C}+{D}) a a', + f (if b then a else a') = if b then f a else f a'. + Proof. now destruct b. Qed. +*) + Ltac destr_eqb := + match goal with + | |- context [Z.eq_bool ?x ?y] => + rewrite (Z.spec_eq_bool x y); + generalize (Zeq_bool_if (Z.to_Z x) (Z.to_Z y)); + case (Zeq_bool (Z.to_Z x) (Z.to_Z y)); + destr_eqb + | |- context [N.eq_bool ?x ?y] => + rewrite (N.spec_eq_bool x y); + generalize (Zeq_bool_if (N.to_Z x) (N.to_Z y)); + case (Zeq_bool (N.to_Z x) (N.to_Z y)); + [ | let H:=fresh "H" in + try (intro H;generalize (N_to_Z_pos _ H); clear H)]; + destr_eqb + | _ => idtac + end. + + 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 + Z.spec_compare N.spec_compare + Z.spec_add N.spec_add Z.spec_mul N.spec_mul Z.spec_div N.spec_div + Z.spec_gcd N.spec_gcd Zgcd_Zabs Zgcd_1 + spec_Z_of_N spec_Zabs_N + : nz. + Ltac nzsimpl := autorewrite with nz in *. + + Ltac qsimpl := try red; unfold to_Q; simpl; intros; + destr_eqb; simpl; nzsimpl; intros; + rewrite ?Z2P_correct by auto; + auto. + 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. + intros(x,y); destruct y; simpl; rewrite ?Z.spec_of_Z; auto; + destr_eqb; now rewrite ?N.spec_0, ?N.spec_of_N. Qed. Theorem spec_of_Q: forall q: Q, [of_Q q] == q. @@ -82,131 +126,96 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Lemma spec_0: [zero] == 0. Proof. - simpl; rewrite Z.spec_0; reflexivity. + simpl. nzsimpl. reflexivity. Qed. Lemma spec_1: [one] == 1. Proof. - simpl; rewrite Z.spec_1; reflexivity. + simpl. nzsimpl. reflexivity. Qed. Lemma spec_m1: [minus_one] == -(1). Proof. - simpl; rewrite Z.spec_m1; reflexivity. + simpl. nzsimpl. reflexivity. Qed. Definition compare (x y: t) := match x, y with | Qz zx, Qz zy => Z.compare zx zy - | Qz zx, Qq ny dy => + | Qz zx, Qq ny dy => if N.eq_bool dy N.zero then Z.compare zx Z.zero else Z.compare (Z.mul zx (Z_of_N dy)) ny - | Qq nx dx, Qz zy => - if N.eq_bool dx N.zero then Z.compare Z.zero zy + | Qq nx dx, Qz zy => + if N.eq_bool dx N.zero then Z.compare Z.zero zy else Z.compare nx (Z.mul zy (Z_of_N dx)) | Qq nx dx, Qq ny dy => match N.eq_bool dx N.zero, N.eq_bool dy N.zero with | true, true => Eq | true, false => Z.compare Z.zero ny | false, true => Z.compare nx Z.zero - | false, false => Z.compare (Z.mul nx (Z_of_N dy)) + | false, false => Z.compare (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) end end. - Lemma Zcompare_spec_alt : - forall z z', Z.compare z z' = (Z.to_Z z ?= Z.to_Z z')%Z. + Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]). Proof. - intros; generalize (Z.spec_compare z z'); destruct Z.compare; auto. - intro H; rewrite H; symmetry; apply Zcompare_refl. + intros [z1 | x1 y1] [z2 | x2 y2]; + unfold Qcompare, compare; qsimpl. Qed. - - Lemma Ncompare_spec_alt : - forall n n', N.compare n n' = (N.to_Z n ?= N.to_Z n')%Z. + + Definition lt n m := [n] < [m]. + Definition le n m := [n] <= [m]. + + Definition min n m := match compare n m with Gt => m | _ => n end. + Definition max n m := match compare n m with Lt => m | _ => n end. + + Lemma spec_min : forall n m, [min n m] == Qmin [n] [m]. Proof. - intros; generalize (N.spec_compare n n'); destruct N.compare; auto. - intro H; rewrite H; symmetry; apply Zcompare_refl. + unfold min, Qmin, GenericMinMax.gmin. intros. + rewrite spec_compare; destruct Qcompare; auto with qarith. Qed. - Lemma N_to_Z2P : forall n, N.to_Z n <> 0%Z -> - Zpos (Z2P (N.to_Z n)) = N.to_Z n. + Lemma spec_max : forall n m, [max n m] == Qmax [n] [m]. Proof. - intros; apply Z2P_correct. - generalize (N.spec_pos n); romega. + unfold max, Qmax, GenericMinMax.gmax. intros. + rewrite spec_compare; destruct Qcompare; auto with qarith. 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. + Definition eq_bool n m := + match compare n m with Eq => true | _ => false end. - Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]). + Theorem spec_eq_bool: forall x y, eq_bool x y = Qeq_bool [x] [y]. Proof. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare; qsimpl; rewrite ! N_to_Z2P; auto. + intros. unfold eq_bool. rewrite spec_compare. reflexivity. 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. + (** [check_int] : is a reduced fraction [n/d] in fact a integer ? *) - Definition eq_bool n m := - match compare n m with Eq => true | _ => false end. + Definition check_int n d := + match N.compare N.one d with + | Lt => Qq n d + | Eq => Qz n + | Gt => zero (* n/0 encodes 0 *) + end. - Theorem spec_eq_bool: forall x y, - if eq_bool x y then [x] == [y] else ~([x] == [y]). + Theorem strong_spec_check_int : forall n d, [check_int n d] = [Qq n d]. 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. + intros; unfold check_int. + nzsimpl. + destr_zcompare. + simpl. rewrite <- H; qsimpl. congruence. + reflexivity. + qsimpl. exfalso; romega. Qed. (** Normalisation function *) Definition norm n d : t := - let gcd := N.gcd (Zabs_N n) d in + let gcd := N.gcd (Zabs_N n) d in match N.compare N.one gcd with - | Lt => - 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 + | Lt => check_int (Z.div n (Z_of_N gcd)) (N.div d gcd) + | Eq => check_int n d | Gt => zero (* gcd = 0 => both numbers are 0 *) end. @@ -217,29 +226,16 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. assert (Hq := N.spec_pos q). nzsimpl. destr_zcompare. + (* Eq *) + rewrite strong_spec_check_int; reflexivity. + (* Lt *) + rewrite strong_spec_check_int. 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. + generalize (Zgcd_div_pos (Z.to_Z p) (N.to_Z q)). romega. + replace (N.to_Z q) with 0%Z in * by assumption. + rewrite Zdiv_0_l in *; auto with zarith. apply Zgcd_div_swap0; romega. - + (* Gt *) 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. @@ -249,48 +245,37 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem strong_spec_norm : forall p q, [norm p q] = Qred [Qq p q]. Proof. intros. - replace (Qred [Qq p q]) with (Qred [norm p q]) by + replace (Qred [Qq p q]) with (Qred [norm p q]) by (apply Qred_complete; apply spec_norm). symmetry; apply Qred_identity. unfold norm. assert (Hp := N.spec_pos (Zabs_N p)). assert (Hq := N.spec_pos q). nzsimpl. - destr_zcompare. + destr_zcompare; rewrite ?strong_spec_check_int. (* Eq *) - simpl. - destr_neq_bool; nzsimpl; simpl; auto. - intros. - rewrite N_to_Z2P; auto. - (* Lt *) - simpl_ndiv. - destr_zcompare. - qsimpl; auto. qsimpl. + (* Lt *) 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. + rewrite Zdiv_0_l in *; romega. (* Gt *) - simpl; auto. + simpl; auto with zarith. Qed. - (** Reduction function : producing irreducible fractions *) + (** Reduction function : producing irreducible fractions *) - Definition red (x : t) : t := - match x with + Definition red (x : t) : t := + match x with | Qz z => x | Qq n d => norm n d end. - Definition Reduced x := [red x] = [x]. + Class Reduced x := is_reduced : [red x] = [x]. Theorem spec_red : forall x, [red x] == [x]. Proof. @@ -304,21 +289,21 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Proof. intros [ z | n d ]. unfold red. - symmetry; apply Qred_identity; simpl; auto. + symmetry; apply Qred_identity; simpl; auto with zarith. unfold red; apply strong_spec_norm. Qed. - + Definition add (x y: t): t := match x with | Qz zx => match y with | Qz zy => Qz (Z.add zx zy) - | Qq ny dy => - if N.eq_bool dy N.zero then x + | Qq ny dy => + if N.eq_bool dy N.zero then x else Qq (Z.add (Z.mul zx (Z_of_N dy)) ny) dy end | Qq nx dx => - if N.eq_bool dx N.zero then y + if N.eq_bool dx N.zero then y else match y with | Qz zy => Qq (Z.add nx (Z.mul zy (Z_of_N dx))) dx | Qq ny dy => @@ -332,19 +317,12 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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. + intros [x | nx dx] [y | ny dy]; unfold Qplus; qsimpl; + auto with zarith. + rewrite Pmult_1_r, Z2P_correct; auto. + rewrite Pmult_1_r, Z2P_correct; auto. + destruct (Zmult_integral (N.to_Z dx) (N.to_Z dy)); intuition. + rewrite Zpos_mult_morphism, 2 Z2P_correct; auto. Qed. Definition add_norm (x y: t): t := @@ -352,12 +330,12 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. | Qz zx => match y with | Qz zy => Qz (Z.add zx zy) - | Qq ny dy => - if N.eq_bool dy N.zero then x + | Qq ny dy => + if N.eq_bool dy N.zero then x else norm (Z.add (Z.mul zx (Z_of_N dy)) ny) dy end | Qq nx dx => - if N.eq_bool dx N.zero then y + if N.eq_bool dx N.zero then y else match y with | Qz zy => norm (Z.add nx (Z.mul zy (Z_of_N dx))) dx | Qq ny dy => @@ -372,26 +350,20 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_add_norm : forall x y, [add_norm x y] == [x] + [y]. Proof. intros x y; rewrite <- spec_add. - destruct x; destruct y; unfold add_norm, add; - destr_neq_bool; auto using Qeq_refl, spec_norm. + destruct x; destruct y; unfold add_norm, add; + destr_eqb; 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). + Instance strong_spec_add_norm x y + `(Reduced x, Reduced y) : Reduced (add_norm x y). Proof. unfold Reduced; intros. rewrite strong_spec_red. - rewrite <- (Qred_complete [add x y]); + rewrite <- (Qred_complete [add x y]); [ | rewrite spec_add, spec_add_norm; apply Qeq_refl ]. rewrite <- strong_spec_red. - destruct x as [zx|nx dx]; destruct y as [zy|ny dy]. - 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. + destruct x as [zx|nx dx]; destruct y as [zy|ny dy]; + simpl; destr_eqb; nzsimpl; simpl; auto. Qed. Definition opp (x: t): t := @@ -404,7 +376,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Proof. intros [z | x y]; simpl. rewrite Z.spec_opp; auto. - match goal with |- context[N.eq_bool ?X ?Y] => + match goal with |- context[N.eq_bool ?X ?Y] => generalize (N.spec_eq_bool X Y); case N.eq_bool end; auto; rewrite N.spec_0. rewrite Z.spec_opp; auto. @@ -415,7 +387,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. intros; rewrite strong_spec_opp; red; auto. Qed. - Theorem strong_spec_opp_norm : forall q, Reduced q -> Reduced (opp q). + Instance strong_spec_opp_norm q `(Reduced q) : Reduced (opp q). Proof. unfold Reduced; intros. rewrite strong_spec_opp, <- H, !strong_spec_red, <- Qred_opp. @@ -438,8 +410,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite spec_opp; ring. Qed. - Theorem strong_spec_sub_norm : forall x y, - Reduced x -> Reduced y -> Reduced (sub_norm x y). + Instance strong_spec_sub_norm x y + `(Reduced x, Reduced y) : Reduced (sub_norm x y). Proof. intros. unfold sub_norm. @@ -458,35 +430,34 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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. + rewrite Pmult_1_r, Z2P_correct; auto. + destruct (Zmult_integral (N.to_Z dx) (N.to_Z dy)); intuition. + rewrite H0 in H1; auto with zarith. + rewrite H0 in H1; auto with zarith. + rewrite H in H1; nzsimpl; auto with zarith. + rewrite Zpos_mult_morphism, 2 Z2P_correct; auto. Qed. - Lemma norm_denum : forall n d, - [if N.eq_bool d N.one then Qz n else Qq n d] == [Qq n d]. + Definition norm_denum n d := + if N.eq_bool d N.one then Qz n else Qq n d. + + Lemma spec_norm_denum : forall n d, + [norm_denum n d] == [Qq n d]. Proof. - intros; simpl; qsimpl. - rewrite H0 in H; discriminate. - rewrite N_to_Z2P, H0; auto with zarith. + unfold norm_denum; intros; simpl; qsimpl. + congruence. + rewrite H0 in *; auto with zarith. Qed. - Definition irred n d := + Definition irred n d := let gcd := N.gcd (Zabs_N n) d in - match N.compare gcd N.one with + match N.compare gcd N.one with | Gt => (Z.div n (Z_of_N gcd), N.div d gcd) | _ => (n, d) end. - Lemma spec_irred : forall n d, exists g, - let (n',d') := irred n d in + Lemma spec_irred : forall n d, exists g, + let (n',d') := irred n d in (Z.to_Z n' * g = Z.to_Z n)%Z /\ (N.to_Z d' * g = N.to_Z d)%Z. Proof. intros. @@ -503,15 +474,15 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. exists (Zgcd (Z.to_Z n) (N.to_Z d)). simpl. split. - simpl_zdiv; nzsimpl. + 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. + 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, + Lemma spec_irred_zero : forall n d, (N.to_Z d = 0)%Z <-> (N.to_Z (snd (irred n d)) = 0)%Z. Proof. intros. @@ -520,10 +491,10 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. nzsimpl; intros. destr_zcompare; auto. simpl. - simpl_ndiv; nzsimpl. + nzsimpl. rewrite H, Zdiv_0_l; auto. nzsimpl; destr_zcompare; simpl; auto. - simpl_ndiv; nzsimpl. + nzsimpl. intros. generalize (N.spec_pos d); intros. destruct (N.to_Z d); auto. @@ -535,8 +506,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. compute in H1; elim H1; auto. Qed. - Lemma strong_spec_irred : forall n d, - (N.to_Z d <> 0%Z) -> + Lemma strong_spec_irred : forall n d, + (N.to_Z d <> 0%Z) -> let (n',d') := irred n d in Zgcd (Z.to_Z n') (N.to_Z d') = 1%Z. Proof. unfold irred; intros. @@ -546,7 +517,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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. + nzsimpl. rewrite Zgcd_1_rel_prime. apply Zis_gcd_rel_prime. generalize (N.spec_pos d); romega. @@ -554,89 +525,81 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Zgcd_is_gcd; auto. Qed. - Definition mul_norm_Qz_Qq z n d := - if Z.eq_bool z Z.zero then zero + Definition mul_norm_Qz_Qq z n d := + if Z.eq_bool z Z.zero then zero else let gcd := N.gcd (Zabs_N z) d in match N.compare gcd N.one with - | Gt => + | Gt => let z := Z.div z (Z_of_N gcd) in let d := N.div d gcd in - if N.eq_bool d N.one then Qz (Z.mul z n) else Qq (Z.mul z n) d + norm_denum (Z.mul z n) d | _ => Qq (Z.mul z n) d end. - Definition mul_norm (x y: t): t := + Definition mul_norm (x y: t): t := match x, y with | Qz zx, Qz zy => Qz (Z.mul zx zy) | Qz zx, Qq ny dy => mul_norm_Qz_Qq zx ny dy | Qq nx dx, Qz zy => mul_norm_Qz_Qq zy nx dx - | Qq nx dx, Qq ny dy => - let (nx, dy) := irred nx dy in - let (ny, dx) := irred ny dx in - 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 + | Qq nx dx, Qq ny dy => + let (nx, dy) := irred nx dy in + let (ny, dx) := irred ny dx in + norm_denum (Z.mul ny nx) (N.mul dx dy) end. - Lemma spec_mul_norm_Qz_Qq : forall z n d, + Lemma spec_mul_norm_Qz_Qq : forall z n d, [mul_norm_Qz_Qq z n d] == [Qq (Z.mul z n) d]. Proof. intros z n d; unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. - destr_zeq_bool; intros Hz; nzsimpl. + destr_eqb; nzsimpl; intros Hz. qsimpl; rewrite Hz; auto. - assert (Hd := N.spec_pos d). - destruct Z_le_gt_dec. + destruct Z_le_gt_dec; intros. qsimpl. - rewrite norm_denum. + rewrite spec_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. + rewrite Zdiv_gcd_zero in z0; auto with zarith. + rewrite H in *. rewrite Zdiv_0_l in *; discriminate. + rewrite <- Zmult_assoc, (Zmult_comm (Z.to_Z n)), Zmult_assoc. + rewrite Zgcd_div_swap0; try romega. + 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). + Instance strong_spec_mul_norm_Qz_Qq z n d : + forall `(Reduced (Qq n d)), Reduced (mul_norm_Qz_Qq z n d). Proof. - unfold Reduced; intros z n d. + unfold Reduced. rewrite 2 strong_spec_red, 2 Qred_iff. simpl; nzsimpl. - destr_neq_bool; intros Hd H; simpl in *; nzsimpl. - + destr_eqb; intros Hd H; simpl in *; nzsimpl. + unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. - destr_zeq_bool; intros Hz; simpl; nzsimpl; simpl; auto. + destr_eqb; 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. + destr_eqb; simpl; nzsimpl; auto with zarith. + unfold norm_denum. destr_eqb; simpl; nzsimpl. + rewrite Hd, Zdiv_0_l; discriminate. intros _. - destr_neq_bool; simpl; nzsimpl; auto. - simpl_ndiv; nzsimpl; rewrite Hd, Zdiv_0_l; intro H'; elim H'; auto. + destr_eqb; simpl; nzsimpl; auto. + nzsimpl; rewrite Hd, Zdiv_0_l; auto with zarith. - rewrite N_to_Z2P in H; auto. + rewrite Z2P_correct in H; auto. unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. - destr_zeq_bool; intros Hz; simpl; nzsimpl; simpl; auto. + destr_eqb; intros Hz; simpl; nzsimpl; simpl; auto. destruct Z_le_gt_dec as [H'|H']. simpl; nzsimpl. - destr_neq_bool; simpl; nzsimpl; auto. + destr_eqb; simpl; nzsimpl; auto. intros. - rewrite N_to_Z2P; auto. + rewrite Z2P_correct; 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. + destr_eqb; simpl; nzsimpl; auto. + unfold norm_denum. + destr_eqb; nzsimpl; simpl; destr_eqb; simpl; auto. + intros; nzsimpl. + rewrite Z2P_correct; auto. apply Zgcd_mult_rel_prime. rewrite Zgcd_1_rel_prime. apply Zis_gcd_rel_prime. @@ -652,9 +615,6 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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]. @@ -670,37 +630,31 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destruct (spec_irred ny dx) as (g' & Hg'). assert (Hz := spec_irred_zero nx dy). assert (Hz':= spec_irred_zero ny dx). - destruct irred as (n1,d1); destruct irred as (n2,d2). + destruct irred as (n1,d1); destruct irred as (n2,d2). simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2']. - rewrite norm_denum. + rewrite spec_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. + destruct (Zmult_integral _ _ H0) as [Eq|Eq]. + rewrite Eq in *; simpl in *. + rewrite <- Hg2' in *; auto with zarith. + rewrite Eq in *; simpl in *. + rewrite <- Hg2 in *; auto with zarith. - 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. + destruct (Zmult_integral _ _ H) as [Eq|Eq]. + rewrite Hz' in Eq; rewrite Eq in *; auto with zarith. + rewrite Hz in Eq; rewrite Eq in *; auto with zarith. - 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). + Instance strong_spec_mul_norm x y : + forall `(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 in *; auto with zarith. simpl. rewrite <- Qred_iff, <- strong_spec_red, strong_spec_mul_norm_Qz_Qq; auto. simpl. @@ -712,26 +666,27 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. assert (Hz':= spec_irred_zero ny dx). assert (Hgc := strong_spec_irred nx dy). assert (Hgc' := strong_spec_irred ny dx). - destruct irred as (n1,d1); destruct irred as (n2,d2). + destruct irred as (n1,d1); destruct irred as (n2,d2). simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2']. - destr_neq_bool; simpl; nzsimpl; intros. - apply Zis_gcd_gcd; auto with zarith; apply Zis_gcd_1. - destr_neq_bool; simpl; nzsimpl; intros. - auto. + + unfold norm_denum; qsimpl. + + assert (NEQ : N.to_Z dy <> 0%Z) by + (rewrite Hz; intros EQ; rewrite EQ in *; romega). + specialize (Hgc NEQ). + + assert (NEQ' : N.to_Z dx <> 0%Z) by + (rewrite Hz'; intro EQ; rewrite EQ in *; romega). + specialize (Hgc' NEQ'). 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. + destr_eqb; simpl; nzsimpl; try romega; intros. + rewrite Z2P_correct in *; auto. - rewrite N_to_Z2P in *; auto. - rewrite Z2P_correct. + apply Zgcd_mult_rel_prime; rewrite Zgcd_comm; + apply Zgcd_mult_rel_prime; rewrite Zgcd_comm; auto. - 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]. @@ -743,21 +698,17 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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 := + Definition inv (x: t): t := match x with - | Qz z => - match Z.compare Z.zero z with + | Qz z => + match Z.compare Z.zero z with | Eq => zero | Lt => Qq Z.one (Zabs_N z) | Gt => Qq Z.minus_one (Zabs_N z) end - | Qq n d => + | Qq n d => match Z.compare Z.zero n with | Eq => zero | Lt => Qq (Z_of_N d) (Zabs_N n) @@ -770,13 +721,13 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destruct x as [ z | n d ]. (* Qz z *) simpl. - rewrite Zcompare_spec_alt; destr_zcompare. + rewrite Z.spec_compare; destr_zcompare. (* 0 = z *) rewrite <- H. simpl; nzsimpl; compute; auto. (* 0 < z *) simpl. - destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ]. + destr_eqb; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ]. set (z':=Z.to_Z z) in *; clearbody z'. red; simpl. rewrite Zabs_eq by romega. @@ -784,7 +735,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. unfold Qinv; simpl; destruct z'; simpl; auto; discriminate. (* 0 > z *) simpl. - destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ]. + destr_eqb; 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. @@ -792,14 +743,14 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. unfold Qinv; simpl; destruct z'; simpl; auto; discriminate. (* Qq n d *) simpl. - rewrite Zcompare_spec_alt; destr_zcompare. + rewrite Z.spec_compare; destr_zcompare. (* 0 = n *) rewrite <- H. simpl; nzsimpl. - destr_neq_bool; intros; compute; auto. + destr_eqb; intros; compute; auto. (* 0 < n *) simpl. - destr_neq_bool; nzsimpl; intros. + destr_eqb; nzsimpl; intros. intros; rewrite Zabs_eq in *; romega. intros; rewrite Zabs_eq in *; romega. clear H1. @@ -811,10 +762,10 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. red; simpl. rewrite Z2P_correct by auto. unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate. - rewrite Zpos_mult_morphism, N_to_Z2P; auto. + rewrite Zpos_mult_morphism, Z2P_correct; auto. (* 0 > n *) simpl. - destr_neq_bool; nzsimpl; intros. + destr_eqb; nzsimpl; intros. intros; rewrite Zabs_non_eq in *; romega. intros; rewrite Zabs_non_eq in *; romega. clear H1. @@ -826,28 +777,28 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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. + rewrite T, Zpos_mult_morphism, Z2P_correct; auto; ring. Qed. - Definition inv_norm (x: t): t := + Definition inv_norm (x: t): t := match x with - | Qz z => - match Z.compare Z.zero z with + | Qz z => + match Z.compare Z.zero z with | Eq => zero | Lt => Qq Z.one (Zabs_N z) | Gt => Qq Z.minus_one (Zabs_N z) end - | Qq n d => - if N.eq_bool d N.zero then zero else - match Z.compare Z.zero n with + | Qq n d => + if N.eq_bool d N.zero then zero else + match Z.compare Z.zero n with | Eq => zero - | Lt => - match Z.compare n Z.one with + | Lt => + match Z.compare n Z.one with | Gt => Qq (Z_of_N d) (Zabs_N n) | _ => Qz (Z_of_N d) end - | Gt => - match Z.compare n Z.minus_one with + | Gt => + match Z.compare n Z.minus_one with | Lt => Qq (Z.opp (Z_of_N d)) (Zabs_N n) | _ => Qz (Z.opp (Z_of_N d)) end @@ -861,74 +812,72 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destruct x as [ z | n d ]. (* Qz z *) simpl. - rewrite Zcompare_spec_alt; destr_zcompare; auto with qarith. + rewrite Z.spec_compare; destr_zcompare; auto with qarith. (* Qq n d *) - simpl; nzsimpl; destr_neq_bool. + simpl; nzsimpl; destr_eqb. destr_zcompare; simpl; auto with qarith. - destr_neq_bool; nzsimpl; auto with qarith. + destr_eqb; nzsimpl; auto with qarith. intros _ Hd; rewrite Hd; auto with qarith. - destr_neq_bool; nzsimpl; auto with qarith. + destr_eqb; 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 _ ]. + destr_eqb; 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 _ ]. + destr_eqb; 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). + Instance strong_spec_inv_norm x : Reduced x -> Reduced (inv_norm x). Proof. - unfold Reduced. + 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. + destr_eqb; nzsimpl; simpl; auto. + destr_eqb; 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_eqb; nzsimpl; auto with qarith. destr_zcompare; simpl; nzsimpl; auto; intros. (* 0 < n *) destr_zcompare; simpl; nzsimpl; auto. - destr_neq_bool; nzsimpl; simpl; auto. + destr_eqb; nzsimpl; simpl; auto. rewrite Zabs_eq; romega. intros _. rewrite strong_spec_norm; simpl; nzsimpl. - destr_neq_bool; nzsimpl. + destr_eqb; 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. + rewrite Z2P_correct in *; auto. + rewrite Zgcd_comm; auto. (* 0 > n *) - destr_neq_bool; nzsimpl; simpl; auto; intros. + destr_eqb; nzsimpl; simpl; auto; intros. destr_zcompare; simpl; nzsimpl; auto. - destr_neq_bool; nzsimpl. + destr_eqb; nzsimpl. rewrite Zabs_non_eq; romega. intros _. rewrite strong_spec_norm; simpl; nzsimpl. - destr_neq_bool; nzsimpl. + destr_eqb; nzsimpl. rewrite Zabs_non_eq; romega. intros _. rewrite Qred_iff. simpl. - rewrite N_to_Z2P in *; auto. - rewrite Z2P_correct; auto with zarith. + rewrite Z2P_correct in *; auto. intros. - rewrite Zgcd_sym, Zgcd_Zabs, Zgcd_sym. + rewrite Zgcd_comm, Zgcd_Zabs, Zgcd_comm. apply Zis_gcd_gcd; auto with zarith. apply Zis_gcd_minus. rewrite Zopp_involutive, <- H1; apply Zgcd_is_gcd. @@ -939,7 +888,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_div x y: [div x y] == [x] / [y]. Proof. - intros x y; unfold div; rewrite spec_mul; auto. + unfold div; rewrite spec_mul; auto. unfold Qdiv; apply Qmult_comp. apply Qeq_refl. apply spec_inv; auto. @@ -949,14 +898,14 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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 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). + + Instance strong_spec_div_norm x y + `(Reduced x, Reduced y) : Reduced (div_norm x y). Proof. intros; unfold div_norm. apply strong_spec_mul_norm; auto. @@ -974,15 +923,13 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destruct x as [ z | n d ]. simpl; rewrite Z.spec_square; red; auto. simpl. - destr_neq_bool; nzsimpl; intros. + destr_eqb; nzsimpl; intros. apply Qeq_refl. rewrite N.spec_square in *; nzsimpl. - contradict H; elim (Zmult_integral _ _ H0); auto. + elim (Zmult_integral _ _ H0); romega. 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. + rewrite H in H0; romega. + rewrite Z.spec_square, N.spec_square. red; simpl. rewrite Zpos_mult_morphism; rewrite !Z2P_correct; auto. apply Zmult_lt_0_compat; auto. @@ -993,7 +940,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. | Qz zx => Qz (Z.power_pos zx p) | Qq nx dx => Qq (Z.power_pos nx p) (N.power_pos dx p) end. - + Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p. Proof. intros [ z | n d ] p; unfold power_pos. @@ -1006,44 +953,42 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (* Qq *) simpl. rewrite Z.spec_power_pos. - destr_neq_bool; nzsimpl; intros. + destr_eqb; 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. + assert (0 < N.to_Z d ^ ' p)%Z by + (apply Zpower_gt_0; auto with zarith). romega. rewrite N.spec_power_pos, H in *. - rewrite Zpower_0_l in H0; [ elim H0; auto | discriminate ]. + rewrite Zpower_0_l in H0; [romega|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). + Instance strong_spec_power_pos 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. + destr_eqb; nzsimpl; intros. simpl; auto. rewrite Qred_iff. revert H. unfold Reduced; rewrite strong_spec_red, Qred_iff; simpl. - destr_neq_bool; nzsimpl; simpl; intros. + destr_eqb; 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 H, Zpower_0_l in *; [romega|discriminate]. + rewrite Z2P_correct 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 + 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) @@ -1058,8 +1003,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite spec_inv, spec_power_pos; apply Qeq_refl. Qed. - Definition power_norm (x : t) (z : Z) : t := - match z with + Definition power_norm (x : t) (z : Z) : t := + match z with | Z0 => one | Zpos p => power_pos x p | Zneg p => inv_norm (power_pos x p) @@ -1074,7 +1019,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. rewrite spec_inv_norm, spec_power_pos; apply Qeq_refl. Qed. - Theorem strong_spec_power_norm : forall x z, + Instance strong_spec_power_norm x z : Reduced x -> Reduced (power_norm x z). Proof. destruct z; simpl. @@ -1087,7 +1032,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (** Interaction with [Qcanon.Qc] *) - + Open Scope Qc_scope. Definition of_Qc q := of_Q (this q). @@ -1102,7 +1047,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. unfold of_Qc; rewrite strong_spec_of_Q; auto. Qed. - Lemma strong_spec_of_Qc_bis : forall q, Reduced (of_Qc q). + Instance strong_spec_of_Qc_bis q : Reduced (of_Qc q). Proof. intros; red; rewrite strong_spec_red, strong_spec_of_Qc. destruct q; simpl; auto. @@ -1143,7 +1088,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_addc x y: [[add x y]] = [[x]] + [[y]]. Proof. - intros x y; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! ([x] + [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. @@ -1157,7 +1102,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_add_normc x y: [[add_norm x y]] = [[x]] + [[y]]. Proof. - intros x y; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! ([x] + [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. @@ -1168,7 +1113,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Qplus_comp; apply Qeq_sym; apply Qred_correct. Qed. - Theorem spec_add_normc_bis : forall x y : Qc, + Theorem spec_add_normc_bis : forall x y : Qc, [add_norm (of_Qc x) (of_Qc y)] = x+y. Proof. intros. @@ -1180,18 +1125,18 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. Proof. - intros x y; unfold sub; rewrite spec_addc; auto. + 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. + unfold sub_norm; rewrite spec_add_normc; auto. rewrite spec_oppc; ring. Qed. - Theorem spec_sub_normc_bis : forall x y : Qc, + Theorem spec_sub_normc_bis : forall x y : Qc, [sub_norm (of_Qc x) (of_Qc y)] = x-y. Proof. intros. @@ -1199,13 +1144,13 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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. + unfold Qcopp, Q2Qc, this. rewrite Qred_correct ; auto with qarith. Qed. Theorem spec_mulc x y: [[mul x y]] = [[x]] * [[y]]. Proof. - intros x y; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! ([x] * [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. @@ -1219,7 +1164,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_mul_normc x y: [[mul_norm x y]] = [[x]] * [[y]]. Proof. - intros x y; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! ([x] * [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. @@ -1230,7 +1175,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Qmult_comp; apply Qeq_sym; apply Qred_correct. Qed. - Theorem spec_mul_normc_bis : forall x y : Qc, + Theorem spec_mul_normc_bis : forall x y : Qc, [mul_norm (of_Qc x) (of_Qc y)] = x*y. Proof. intros. @@ -1243,7 +1188,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_invc x: [[inv x]] = /[[x]]. Proof. - intros x; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! (/[x])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. @@ -1257,7 +1202,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_inv_normc x: [[inv_norm x]] = /[[x]]. Proof. - intros x; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! (/[x])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. @@ -1268,7 +1213,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. apply Qinv_comp; apply Qeq_sym; apply Qred_correct. Qed. - Theorem spec_inv_normc_bis : forall x : Qc, + Theorem spec_inv_normc_bis : forall x : Qc, [inv_norm (of_Qc x)] = /x. Proof. intros. @@ -1280,19 +1225,19 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. Proof. - intros x y; unfold div; rewrite spec_mulc; auto. + unfold div; rewrite spec_mulc; auto. unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. + apply spec_invc; auto. Qed. Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. Proof. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. + 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, + Theorem spec_div_normc_bis : forall x y : Qc, [div_norm (of_Qc x) (of_Qc y)] = x/y. Proof. intros. @@ -1300,12 +1245,12 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. 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. + unfold Qcinv, Q2Qc, this; rewrite Qred_correct; auto with qarith. Qed. - Theorem spec_squarec x: [[square x]] = [[x]]^2. + Theorem spec_squarec x: [[square x]] = [[x]]^2. Proof. - intros x; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! ([x]^2)). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. @@ -1322,7 +1267,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_power_posc x p: [[power_pos x p]] = [[x]] ^ nat_of_P p. Proof. - intros x p; unfold to_Qc. + unfold to_Qc. apply trans_equal with (!! ([x]^Zpos p)). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v index be9b2d4e..10d0189a 100644 --- a/theories/Numbers/Rational/SpecViaQ/QSig.v +++ b/theories/Numbers/Rational/SpecViaQ/QSig.v @@ -6,9 +6,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: QSig.v 11207 2008-07-04 16:50:32Z letouzey $ i*) +(*i $Id$ i*) -Require Import QArith Qpower. +Require Import QArith Qpower Qminmax Orders RelationPairs GenericMinMax. Open Scope Q_scope. @@ -23,75 +23,203 @@ Module Type QType. Parameter t : Type. Parameter to_Q : t -> Q. - Notation "[ x ]" := (to_Q x). + Local Notation "[ x ]" := (to_Q x). Definition eq x y := [x] == [y]. + Definition lt x y := [x] < [y]. + Definition le x y := [x] <= [y]. Parameter of_Q : Q -> t. Parameter spec_of_Q: forall x, to_Q (of_Q x) == x. + Parameter red : t -> t. + Parameter compare : t -> t -> comparison. + Parameter eq_bool : t -> t -> bool. + Parameter max : t -> t -> t. + Parameter min : t -> t -> t. Parameter zero : t. Parameter one : t. Parameter minus_one : t. + Parameter add : t -> t -> t. + Parameter sub : t -> t -> t. + Parameter opp : t -> t. + Parameter mul : t -> t -> t. + Parameter square : t -> t. + Parameter inv : t -> t. + Parameter div : t -> t -> t. + Parameter power : t -> Z -> t. + Parameter spec_red : forall x, [red x] == [x]. + Parameter strong_spec_red : forall x, [red x] = Qred [x]. + Parameter spec_compare : forall x y, compare x y = ([x] ?= [y]). + Parameter spec_eq_bool : forall x y, eq_bool x y = Qeq_bool [x] [y]. + Parameter spec_max : forall x y, [max x y] == Qmax [x] [y]. + Parameter spec_min : forall x y, [min x y] == Qmin [x] [y]. Parameter spec_0: [zero] == 0. Parameter spec_1: [one] == 1. Parameter spec_m1: [minus_one] == -(1). + Parameter spec_add: forall x y, [add x y] == [x] + [y]. + Parameter spec_sub: forall x y, [sub x y] == [x] - [y]. + Parameter spec_opp: forall x, [opp x] == - [x]. + Parameter spec_mul: forall x y, [mul x y] == [x] * [y]. + Parameter spec_square: forall x, [square x] == [x] ^ 2. + Parameter spec_inv : forall x, [inv x] == / [x]. + Parameter spec_div: forall x y, [div x y] == [x] / [y]. + Parameter spec_power: forall x z, [power x z] == [x] ^ z. - Parameter compare : t -> t -> comparison. +End QType. - Parameter spec_compare : forall x y, compare x y = ([x] ?= [y]). +(** NB: several of the above functions come with [..._norm] variants + that expect reduced arguments and return reduced results. *) - 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. +(** TODO : also speak of specifications via Qcanon ... *) - Parameter eq_bool : t -> t -> bool. - - Parameter spec_eq_bool : forall x y, - if eq_bool x y then [x]==[y] else ~([x]==[y]). +Module Type QType_Notation (Import Q : QType). + Notation "[ x ]" := (to_Q x). + Infix "==" := eq (at level 70). + Notation "x != y" := (~x==y) (at level 70). + Infix "<=" := le. + Infix "<" := lt. + Notation "0" := zero. + Notation "1" := one. + Infix "+" := add. + Infix "-" := sub. + Infix "*" := mul. + Notation "- x" := (opp x). + Infix "/" := div. + Notation "/ x" := (inv x). + Infix "^" := power. +End QType_Notation. - Parameter red : t -> t. - - Parameter spec_red : forall x, [red x] == [x]. - Parameter strong_spec_red : forall x, [red x] = Qred [x]. +Module Type QType' := QType <+ QType_Notation. - Parameter add : t -> t -> t. - Parameter spec_add: forall x y, [add x y] == [x] + [y]. +Module QProperties (Import Q : QType'). - Parameter sub : t -> t -> t. +(** Conversion to Q *) - Parameter spec_sub: forall x y, [sub x y] == [x] - [y]. +Hint Rewrite + spec_red spec_compare spec_eq_bool spec_min spec_max + spec_add spec_sub spec_opp spec_mul spec_square spec_inv spec_div + spec_power : qsimpl. +Ltac qify := unfold eq, lt, le in *; autorewrite with qsimpl; + try rewrite spec_0 in *; try rewrite spec_1 in *; try rewrite spec_m1 in *. - Parameter opp : t -> t. +(** NB: do not add [spec_0] in the autorewrite database. Otherwise, + after instanciation in BigQ, this lemma become convertible to 0=0, + and autorewrite loops. Idem for [spec_1] and [spec_m1] *) - Parameter spec_opp: forall x, [opp x] == - [x]. +(** Morphisms *) - Parameter mul : t -> t -> t. +Ltac solve_wd1 := intros x x' Hx; qify; now rewrite Hx. +Ltac solve_wd2 := intros x x' Hx y y' Hy; qify; now rewrite Hx, Hy. - Parameter spec_mul: forall x y, [mul x y] == [x] * [y]. +Local Obligation Tactic := solve_wd2 || solve_wd1. - Parameter square : t -> t. +Instance : Measure to_Q. +Instance eq_equiv : Equivalence eq. - Parameter spec_square: forall x, [square x] == [x] ^ 2. +Program Instance lt_wd : Proper (eq==>eq==>iff) lt. +Program Instance le_wd : Proper (eq==>eq==>iff) le. +Program Instance red_wd : Proper (eq==>eq) red. +Program Instance compare_wd : Proper (eq==>eq==>Logic.eq) compare. +Program Instance eq_bool_wd : Proper (eq==>eq==>Logic.eq) eq_bool. +Program Instance min_wd : Proper (eq==>eq==>eq) min. +Program Instance max_wd : Proper (eq==>eq==>eq) max. +Program Instance add_wd : Proper (eq==>eq==>eq) add. +Program Instance sub_wd : Proper (eq==>eq==>eq) sub. +Program Instance opp_wd : Proper (eq==>eq) opp. +Program Instance mul_wd : Proper (eq==>eq==>eq) mul. +Program Instance square_wd : Proper (eq==>eq) square. +Program Instance inv_wd : Proper (eq==>eq) inv. +Program Instance div_wd : Proper (eq==>eq==>eq) div. +Program Instance power_wd : Proper (eq==>Logic.eq==>eq) power. - Parameter inv : t -> t. +(** Let's implement [HasCompare] *) - Parameter spec_inv : forall x, [inv x] == / [x]. +Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). +Proof. intros. qify. destruct (Qcompare_spec [x] [y]); auto. Qed. - Parameter div : t -> t -> t. +(** Let's implement [TotalOrder] *) - Parameter spec_div: forall x y, [div x y] == [x] / [y]. +Definition lt_compat := lt_wd. +Instance lt_strorder : StrictOrder lt. - Parameter power : t -> Z -> t. +Lemma le_lteq : forall x y, x<=y <-> x<y \/ x==y. +Proof. intros. qify. apply Qle_lteq. Qed. - Parameter spec_power: forall x z, [power x z] == [x] ^ z. +Lemma lt_total : forall x y, x<y \/ x==y \/ y<x. +Proof. intros. destruct (compare_spec x y); auto. Qed. -End QType. +(** Let's implement [HasEqBool] *) -(** NB: several of the above functions come with [..._norm] variants - that expect reduced arguments and return reduced results. *) +Definition eqb := eq_bool. -(** TODO : also speak of specifications via Qcanon ... *) +Lemma eqb_eq : forall x y, eq_bool x y = true <-> x == y. +Proof. intros. qify. apply Qeq_bool_iff. Qed. + +Lemma eqb_correct : forall x y, eq_bool x y = true -> x == y. +Proof. now apply eqb_eq. Qed. + +Lemma eqb_complete : forall x y, x == y -> eq_bool x y = true. +Proof. now apply eqb_eq. Qed. + +(** Let's implement [HasMinMax] *) + +Lemma max_l : forall x y, y<=x -> max x y == x. +Proof. intros x y. qify. apply Qminmax.Q.max_l. Qed. + +Lemma max_r : forall x y, x<=y -> max x y == y. +Proof. intros x y. qify. apply Qminmax.Q.max_r. Qed. + +Lemma min_l : forall x y, x<=y -> min x y == x. +Proof. intros x y. qify. apply Qminmax.Q.min_l. Qed. + +Lemma min_r : forall x y, y<=x -> min x y == y. +Proof. intros x y. qify. apply Qminmax.Q.min_r. Qed. + +(** Q is a ring *) + +Lemma add_0_l : forall x, 0+x == x. +Proof. intros. qify. apply Qplus_0_l. Qed. + +Lemma add_comm : forall x y, x+y == y+x. +Proof. intros. qify. apply Qplus_comm. Qed. + +Lemma add_assoc : forall x y z, x+(y+z) == x+y+z. +Proof. intros. qify. apply Qplus_assoc. Qed. + +Lemma mul_1_l : forall x, 1*x == x. +Proof. intros. qify. apply Qmult_1_l. Qed. + +Lemma mul_comm : forall x y, x*y == y*x. +Proof. intros. qify. apply Qmult_comm. Qed. + +Lemma mul_assoc : forall x y z, x*(y*z) == x*y*z. +Proof. intros. qify. apply Qmult_assoc. Qed. + +Lemma mul_add_distr_r : forall x y z, (x+y)*z == x*z + y*z. +Proof. intros. qify. apply Qmult_plus_distr_l. Qed. + +Lemma sub_add_opp : forall x y, x-y == x+(-y). +Proof. intros. qify. now unfold Qminus. Qed. + +Lemma add_opp_diag_r : forall x, x+(-x) == 0. +Proof. intros. qify. apply Qplus_opp_r. Qed. + +(** Q is a field *) + +Lemma neq_1_0 : 1!=0. +Proof. intros. qify. apply Q_apart_0_1. Qed. + +Lemma div_mul_inv : forall x y, x/y == x*(/y). +Proof. intros. qify. now unfold Qdiv. Qed. + +Lemma mul_inv_diag_l : forall x, x!=0 -> /x * x == 1. +Proof. intros x. qify. rewrite Qmult_comm. apply Qmult_inv_r. Qed. + +End QProperties. + +Module QTypeExt (Q : QType) + <: QType <: TotalOrder <: HasCompare Q <: HasMinMax Q <: HasEqBool Q + := Q <+ QProperties.
\ No newline at end of file diff --git a/theories/Numbers/vo.itarget b/theories/Numbers/vo.itarget new file mode 100644 index 00000000..175a15e9 --- /dev/null +++ b/theories/Numbers/vo.itarget @@ -0,0 +1,70 @@ +BigNumPrelude.vo +Cyclic/Abstract/CyclicAxioms.vo +Cyclic/Abstract/NZCyclic.vo +Cyclic/DoubleCyclic/DoubleAdd.vo +Cyclic/DoubleCyclic/DoubleBase.vo +Cyclic/DoubleCyclic/DoubleCyclic.vo +Cyclic/DoubleCyclic/DoubleDivn1.vo +Cyclic/DoubleCyclic/DoubleDiv.vo +Cyclic/DoubleCyclic/DoubleLift.vo +Cyclic/DoubleCyclic/DoubleMul.vo +Cyclic/DoubleCyclic/DoubleSqrt.vo +Cyclic/DoubleCyclic/DoubleSub.vo +Cyclic/DoubleCyclic/DoubleType.vo +Cyclic/Int31/Int31.vo +Cyclic/Int31/Cyclic31.vo +Cyclic/Int31/Ring31.vo +Cyclic/ZModulo/ZModulo.vo +Integer/Abstract/ZAddOrder.vo +Integer/Abstract/ZAdd.vo +Integer/Abstract/ZAxioms.vo +Integer/Abstract/ZBase.vo +Integer/Abstract/ZLt.vo +Integer/Abstract/ZMulOrder.vo +Integer/Abstract/ZMul.vo +Integer/Abstract/ZSgnAbs.vo +Integer/Abstract/ZProperties.vo +Integer/Abstract/ZDivFloor.vo +Integer/Abstract/ZDivTrunc.vo +Integer/Abstract/ZDivEucl.vo +Integer/BigZ/BigZ.vo +Integer/BigZ/ZMake.vo +Integer/Binary/ZBinary.vo +Integer/NatPairs/ZNatPairs.vo +Integer/SpecViaZ/ZSig.vo +Integer/SpecViaZ/ZSigZAxioms.vo +NaryFunctions.vo +NatInt/NZAddOrder.vo +NatInt/NZAdd.vo +NatInt/NZAxioms.vo +NatInt/NZBase.vo +NatInt/NZMulOrder.vo +NatInt/NZMul.vo +NatInt/NZOrder.vo +NatInt/NZProperties.vo +NatInt/NZDomain.vo +NatInt/NZDiv.vo +Natural/Abstract/NAddOrder.vo +Natural/Abstract/NAdd.vo +Natural/Abstract/NAxioms.vo +Natural/Abstract/NBase.vo +Natural/Abstract/NDefOps.vo +Natural/Abstract/NIso.vo +Natural/Abstract/NMulOrder.vo +Natural/Abstract/NOrder.vo +Natural/Abstract/NStrongRec.vo +Natural/Abstract/NSub.vo +Natural/Abstract/NProperties.vo +Natural/Abstract/NDiv.vo +Natural/BigN/BigN.vo +Natural/BigN/Nbasic.vo +Natural/BigN/NMake_gen.vo +Natural/BigN/NMake.vo +Natural/Binary/NBinary.vo +Natural/Peano/NPeano.vo +Natural/SpecViaZ/NSigNAxioms.vo +Natural/SpecViaZ/NSig.vo +NumPrelude.vo +Rational/BigQ/BigQ.vo +Rational/BigQ/QMake.vo +Rational/SpecViaQ/QSig.vo |