diff options
| author | letouzey | 2010-02-08 18:17:54 +0000 |
|---|---|---|
| committer | letouzey | 2010-02-08 18:17:54 +0000 |
| commit | 911c50439abdedd0f75856d43ff12e9615ec9980 (patch) | |
| tree | 6dbe4453fab01358f42f99bc7cc831d0dc189f4b | |
| parent | c71e226db9a2cab3e73064d24e2020a0a11e2651 (diff) | |
DoubleCyclic + NMake : typeclasses, more genericity, less ML macro-generation
- Records of operations and specs in CyclicAxioms are now
type classes (under a module ZnZ for qualification).
We benefit from inference and from generic names:
(ZnZ.mul x y) instead of (znz_mul (some_ops...) x y).
- Beware of typeclasses unfolds: the line about
Typeclasses Opaque w1 w2 ... is critical for decent
compilation time (x2.5 without it).
- Functions defined via same_level are now obtained from a
generic version by (Eval ... in ...) during definition.
The code obtained this way should be just as before, apart
from some (minor?) details. Proofs for these functions
are _way_ simplier and lighter.
- The macro-generated NMake_gen.v contains only generic iterators
and compare, mul, div_gt, mod_gt. I hope to be able to adapt
these functions as well soon.
- Spec of comparison is now fully done with respect to Zcompare
- A log2 function has been added.
- No more unsafe_shiftr, we detect the underflow directly with sub_c
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12713 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | theories/Numbers/Cyclic/Abstract/CyclicAxioms.v | 464 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/Abstract/NZCyclic.v | 110 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v | 55 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v | 421 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v | 117 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v | 11 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v | 34 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v | 19 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v | 23 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/Int31/Cyclic31.v | 287 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/Int31/Ring31.v | 7 | ||||
| -rw-r--r-- | theories/Numbers/Cyclic/ZModulo/ZModulo.v | 448 | ||||
| -rw-r--r-- | theories/Numbers/Natural/BigN/NMake.v | 869 | ||||
| -rw-r--r-- | theories/Numbers/Natural/BigN/NMake_gen.ml | 1910 | ||||
| -rw-r--r-- | theories/Numbers/Natural/BigN/Nbasic.v | 122 | ||||
| -rw-r--r-- | theories/Numbers/Natural/SpecViaZ/NSig.v | 3 |
16 files changed, 2144 insertions, 2756 deletions
diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v index 51df2fa380..af30b0175b 100644 --- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v +++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v @@ -26,352 +26,284 @@ Local Open Scope Z_scope. (** First, a description via an operator record and a spec record. *) -Section Z_nZ_Op. +Module ZnZ. - Variable znz : Type. - - Record znz_op := mk_znz_op { + Class Ops (t:Type) := MkOps { (* Conversion functions with Z *) - znz_digits : positive; - znz_zdigits: znz; - znz_to_Z : znz -> Z; - znz_of_pos : positive -> N * znz; (* Euclidean division by [2^digits] *) - znz_head0 : znz -> znz; (* number of digits 0 in front of the number *) - znz_tail0 : znz -> znz; (* number of digits 0 at the bottom of the number *) + digits : positive; + zdigits: t; + to_Z : t -> Z; + of_pos : positive -> N * t; (* Euclidean division by [2^digits] *) + head0 : t -> t; (* number of digits 0 in front of the number *) + tail0 : t -> t; (* number of digits 0 at the bottom of the number *) (* Basic numbers *) - znz_0 : znz; - znz_1 : znz; - znz_Bm1 : znz; (* [2^digits-1], which is equivalent to [-1] *) + zero : t; + one : t; + minus_one : t; (* [2^digits-1], which is equivalent to [-1] *) (* Comparison *) - znz_compare : znz -> znz -> comparison; - znz_eq0 : znz -> bool; + compare : t -> t -> comparison; + eq0 : t -> bool; (* Basic arithmetic operations *) - znz_opp_c : znz -> carry znz; - znz_opp : znz -> znz; - znz_opp_carry : znz -> znz; (* the carry is known to be -1 *) - - znz_succ_c : znz -> carry znz; - znz_add_c : znz -> znz -> carry znz; - znz_add_carry_c : znz -> znz -> carry znz; - znz_succ : znz -> znz; - znz_add : znz -> znz -> znz; - znz_add_carry : znz -> znz -> znz; - - znz_pred_c : znz -> carry znz; - znz_sub_c : znz -> znz -> carry znz; - znz_sub_carry_c : znz -> znz -> carry znz; - znz_pred : znz -> znz; - znz_sub : znz -> znz -> znz; - znz_sub_carry : znz -> znz -> znz; - - znz_mul_c : znz -> znz -> zn2z znz; - znz_mul : znz -> znz -> znz; - znz_square_c : znz -> zn2z znz; + opp_c : t -> carry t; + opp : t -> t; + opp_carry : t -> t; (* the carry is known to be -1 *) + + succ_c : t -> carry t; + add_c : t -> t -> carry t; + add_carry_c : t -> t -> carry t; + succ : t -> t; + add : t -> t -> t; + add_carry : t -> t -> t; + + pred_c : t -> carry t; + sub_c : t -> t -> carry t; + sub_carry_c : t -> t -> carry t; + pred : t -> t; + sub : t -> t -> t; + sub_carry : t -> t -> t; + + mul_c : t -> t -> zn2z t; + mul : t -> t -> t; + square_c : t -> zn2z t; (* Special divisions operations *) - znz_div21 : znz -> znz -> znz -> znz*znz; - znz_div_gt : znz -> znz -> znz * znz; (* specialized version of [znz_div] *) - znz_div : znz -> znz -> znz * znz; + div21 : t -> t -> t -> t*t; + div_gt : t -> t -> t * t; (* specialized version of [div] *) + div : t -> t -> t * t; - znz_mod_gt : znz -> znz -> znz; (* specialized version of [znz_mod] *) - znz_mod : znz -> znz -> znz; + modulo_gt : t -> t -> t; (* specialized version of [mod] *) + modulo : t -> t -> t; - znz_gcd_gt : znz -> znz -> znz; (* specialized version of [znz_gcd] *) - znz_gcd : znz -> znz -> znz; - (* [znz_add_mul_div p i j] is a combination of the [(digits-p)] + gcd_gt : t -> t -> t; (* specialized version of [gcd] *) + gcd : t -> t -> t; + (* [add_mul_div p i j] is a combination of the [(digits-p)] 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] *) - znz_pos_mod : znz -> znz -> znz; + [add_mul_div p i j = i*2^p+j/2^(digits-p)] *) + add_mul_div : t -> t -> t -> t; + (* [pos_mod p i] is [i mod 2^p] *) + pos_mod : t -> t -> t; - znz_is_even : znz -> bool; + is_even : t -> bool; (* square root *) - znz_sqrt2 : znz -> znz -> znz * carry znz; - znz_sqrt : znz -> znz }. - -End Z_nZ_Op. - -Section Z_nZ_Spec. - Variable w : Type. - Variable w_op : znz_op w. - - Let w_digits := w_op.(znz_digits). - Let w_zdigits := w_op.(znz_zdigits). - Let w_to_Z := w_op.(znz_to_Z). - Let w_of_pos := w_op.(znz_of_pos). - Let w_head0 := w_op.(znz_head0). - Let w_tail0 := w_op.(znz_tail0). - - Let w0 := w_op.(znz_0). - Let w1 := w_op.(znz_1). - Let wBm1 := w_op.(znz_Bm1). - - Let w_compare := w_op.(znz_compare). - Let w_eq0 := w_op.(znz_eq0). - - Let w_opp_c := w_op.(znz_opp_c). - Let w_opp := w_op.(znz_opp). - Let w_opp_carry := w_op.(znz_opp_carry). - - Let w_succ_c := w_op.(znz_succ_c). - Let w_add_c := w_op.(znz_add_c). - Let w_add_carry_c := w_op.(znz_add_carry_c). - Let w_succ := w_op.(znz_succ). - Let w_add := w_op.(znz_add). - Let w_add_carry := w_op.(znz_add_carry). + sqrt2 : t -> t -> t * carry t; + sqrt : t -> t }. - Let w_pred_c := w_op.(znz_pred_c). - Let w_sub_c := w_op.(znz_sub_c). - Let w_sub_carry_c := w_op.(znz_sub_carry_c). - Let w_pred := w_op.(znz_pred). - Let w_sub := w_op.(znz_sub). - Let w_sub_carry := w_op.(znz_sub_carry). + Section Specs. + Context {t : Type}{ops : Ops t}. - 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). + Notation "[| x |]" := (to_Z x) (at level 0, x at level 99). - Let w_div21 := w_op.(znz_div21). - Let w_div_gt := w_op.(znz_div_gt). - Let w_div := w_op.(znz_div). - - Let w_mod_gt := w_op.(znz_mod_gt). - Let w_mod := w_op.(znz_mod). - - 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_pos_mod := w_op.(znz_pos_mod). - - Let w_is_even := w_op.(znz_is_even). - Let w_sqrt2 := w_op.(znz_sqrt2). - Let w_sqrt := w_op.(znz_sqrt). - - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - - Let wB := base w_digits. + Let wB := base digits. Notation "[+| c |]" := - (interp_carry 1 wB w_to_Z c) (at level 0, x at level 99). + (interp_carry 1 wB to_Z c) (at level 0, x at level 99). Notation "[-| c |]" := - (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). + (interp_carry (-1) wB to_Z c) (at level 0, x at level 99). Notation "[|| x ||]" := - (zn2z_to_Z wB w_to_Z x) (at level 0, x at level 99). + (zn2z_to_Z wB to_Z x) (at level 0, x at level 99). - Record znz_spec := mk_znz_spec { + Class Specs := MkSpecs { (* Conversion functions with Z *) spec_to_Z : forall x, 0 <= [| x |] < wB; spec_of_pos : forall p, - Zpos p = (Z_of_N (fst (w_of_pos p)))*wB + [|(snd (w_of_pos p))|]; - spec_zdigits : [| w_zdigits |] = Zpos w_digits; - spec_more_than_1_digit: 1 < Zpos w_digits; + Zpos p = (Z_of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]; + spec_zdigits : [| zdigits |] = Zpos digits; + spec_more_than_1_digit: 1 < Zpos digits; (* Basic numbers *) - spec_0 : [|w0|] = 0; - spec_1 : [|w1|] = 1; - spec_Bm1 : [|wBm1|] = wB - 1; + spec_0 : [|zero|] = 0; + spec_1 : [|one|] = 1; + spec_m1 : [|minus_one|] = wB - 1; (* Comparison *) - spec_compare : - forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end; - spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0; + spec_compare : forall x y, compare x y = ([|x|] ?= [|y|]); + (* NB: the spec of [eq0] is deliberately partial, + see DoubleCyclic where [eq0 x = true <-> x = W0] *) + spec_eq0 : forall x, eq0 x = true -> [|x|] = 0; (* Basic arithmetic operations *) - spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|]; - spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB; - spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1; - - spec_succ_c : forall x, [+|w_succ_c x|] = [|x|] + 1; - spec_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]; - spec_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1; - spec_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB; - spec_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB; + spec_opp_c : forall x, [-|opp_c x|] = -[|x|]; + spec_opp : forall x, [|opp x|] = (-[|x|]) mod wB; + spec_opp_carry : forall x, [|opp_carry x|] = wB - [|x|] - 1; + + spec_succ_c : forall x, [+|succ_c x|] = [|x|] + 1; + spec_add_c : forall x y, [+|add_c x y|] = [|x|] + [|y|]; + spec_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|] + [|y|] + 1; + spec_succ : forall x, [|succ x|] = ([|x|] + 1) mod wB; + spec_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wB; spec_add_carry : - forall x y, [|w_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB; + forall x y, [|add_carry x y|] = ([|x|] + [|y|] + 1) mod wB; - spec_pred_c : forall x, [-|w_pred_c x|] = [|x|] - 1; - spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|]; - spec_sub_carry_c : forall x y, [-|w_sub_carry_c x y|] = [|x|] - [|y|] - 1; - spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB; - spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB; + spec_pred_c : forall x, [-|pred_c x|] = [|x|] - 1; + spec_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|]; + spec_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|] - [|y|] - 1; + spec_pred : forall x, [|pred x|] = ([|x|] - 1) mod wB; + spec_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wB; spec_sub_carry : - forall x y, [|w_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB; + forall x y, [|sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB; - spec_mul_c : forall x y, [|| w_mul_c x y ||] = [|x|] * [|y|]; - spec_mul : forall x y, [|w_mul x y|] = ([|x|] * [|y|]) mod wB; - spec_square_c : forall x, [|| w_square_c x||] = [|x|] * [|x|]; + spec_mul_c : forall x y, [|| mul_c x y ||] = [|x|] * [|y|]; + spec_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wB; + spec_square_c : forall x, [|| square_c x||] = [|x|] * [|x|]; (* Special divisions operations *) spec_div21 : forall a1 a2 b, wB/2 <= [|b|] -> [|a1|] < [|b|] -> - let (q,r) := w_div21 a1 a2 b in + let (q,r) := div21 a1 a2 b in [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]; spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> - let (q,r) := w_div_gt a b in + let (q,r) := div_gt a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]; spec_div : forall a b, 0 < [|b|] -> - let (q,r) := w_div a b in + let (q,r) := div a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 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_modulo_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> + [|modulo_gt a b|] = [|a|] mod [|b|]; + spec_modulo : forall a b, 0 < [|b|] -> + [|modulo 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|]; + Zis_gcd [|a|] [|b|] [|gcd_gt a b|]; + spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|]; (* shift operations *) - spec_head00: forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits; + spec_head00: forall x, [|x|] = 0 -> [|head0 x|] = Zpos digits; spec_head0 : forall x, 0 < [|x|] -> - wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB; - spec_tail00: forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits; + wB/ 2 <= 2 ^ ([|head0 x|]) * [|x|] < wB; + spec_tail00: forall x, [|x|] = 0 -> [|tail0 x|] = Zpos digits; spec_tail0 : forall x, 0 < [|x|] -> - exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|w_tail0 x|]) ; + exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail0 x|]) ; spec_add_mul_div : forall x y p, - [|p|] <= Zpos w_digits -> - [| w_add_mul_div p x y |] = + [|p|] <= Zpos digits -> + [| add_mul_div p x y |] = ([|x|] * (2 ^ [|p|]) + - [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB; + [|y|] / (2 ^ ((Zpos digits) - [|p|]))) mod wB; spec_pos_mod : forall w p, - [|w_pos_mod p w|] = [|w|] mod (2 ^ [|p|]); + [|pos_mod p w|] = [|w|] mod (2 ^ [|p|]); (* sqrt *) spec_is_even : forall x, - if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1; + if is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1; spec_sqrt2 : forall x y, wB/ 4 <= [|x|] -> - let (s,r) := w_sqrt2 x y in + let (s,r) := sqrt2 x y in [||WW x y||] = [|s|] ^ 2 + [+|r|] /\ [+|r|] <= 2 * [|s|]; spec_sqrt : forall x, - [|w_sqrt x|] ^ 2 <= [|x|] < ([|w_sqrt x|] + 1) ^ 2 + [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2 }. -End Z_nZ_Spec. + End Specs. + + Implicit Arguments Specs [[t]]. -(** Generic construction of double words *) + (** Generic construction of double words *) -Section WW. + Section WW. - Variable w : Type. - Variable w_op : znz_op w. - Variable op_spec : znz_spec w_op. + Context {t : Type}{ops : Ops t}{specs : Specs ops}. - 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). + Let wB := base digits. - Definition znz_W0 h := - if w_eq0 h then W0 else WW h w_0. + Definition WO h := + if eq0 h then W0 else WW h zero. - Definition znz_0W l := - if w_eq0 l then W0 else WW w_0 l. + Definition OW l := + if eq0 l then W0 else WW zero l. - Definition znz_WW h l := - if w_eq0 h then znz_0W l else WW h l. + Definition WW h l := + if eq0 h then OW l else WW h l. - Lemma spec_W0 : forall h, - zn2z_to_Z wB w_to_Z (znz_W0 h) = (w_to_Z h)*wB. + Lemma spec_WO : forall h, + zn2z_to_Z wB to_Z (WO h) = (to_Z h)*wB. Proof. - unfold zn2z_to_Z, znz_W0, w_to_Z; simpl; intros. - case_eq (w_eq0 h); intros. - rewrite (op_spec.(spec_eq0) _ H); auto. - unfold w_0; rewrite op_spec.(spec_0); auto with zarith. + unfold zn2z_to_Z, WO; simpl; intros. + case_eq (eq0 h); intros. + rewrite (spec_eq0 _ H); auto. + rewrite spec_0; auto with zarith. Qed. - Lemma spec_0W : forall l, - zn2z_to_Z wB w_to_Z (znz_0W l) = w_to_Z l. + Lemma spec_OW : forall l, + zn2z_to_Z wB to_Z (OW l) = to_Z l. Proof. - unfold zn2z_to_Z, znz_0W, w_to_Z; simpl; intros. - case_eq (w_eq0 l); intros. - rewrite (op_spec.(spec_eq0) _ H); auto. - unfold w_0; rewrite op_spec.(spec_0); auto with zarith. + unfold zn2z_to_Z, OW; simpl; intros. + case_eq (eq0 l); intros. + rewrite (spec_eq0 _ H); auto. + rewrite spec_0; auto with zarith. Qed. 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. + zn2z_to_Z wB to_Z (WW h l) = (to_Z h)*wB + to_Z l. Proof. - unfold znz_WW, w_to_Z; simpl; intros. - case_eq (w_eq0 h); intros. - rewrite (op_spec.(spec_eq0) _ H); auto. - rewrite spec_0W; auto. + unfold WW; simpl; intros. + case_eq (eq0 h); intros. + rewrite (spec_eq0 _ H); auto. + rewrite spec_OW; auto. simpl; auto. Qed. -End WW. + End WW. -(** Injecting [Z] numbers into a cyclic structure *) + (** Injecting [Z] numbers into a cyclic structure *) -Section znz_of_pos. + Section Of_Z. - Variable w : Type. - Variable w_op : znz_op w. - Variable op_spec : znz_spec w_op. + Context {t : Type}{ops : Ops t}{specs : Specs ops}. - Notation "[| x |]" := (znz_to_Z w_op x) (at level 0, x at level 99). + Notation "[| x |]" := (to_Z x) (at level 0, x at level 99). - Definition znz_of_Z (w:Type) (op:znz_op w) z := - match z with - | Zpos p => snd (op.(znz_of_pos) p) - | _ => op.(znz_0) - end. - - Theorem znz_of_pos_correct: - forall p, Zpos p < base (znz_digits w_op) -> [|(snd (znz_of_pos w_op p))|] = Zpos p. + Theorem of_pos_correct: + forall p, Zpos p < base digits -> [|(snd (of_pos p))|] = Zpos p. + Proof. intros p Hp. - generalize (spec_of_pos op_spec p). - case (znz_of_pos w_op p); intros n w1; simpl. + generalize (spec_of_pos p). + case (of_pos p); intros n w1; simpl. case n; simpl Npos; auto with zarith. intros p1 Hp1; contradict Hp; apply Zle_not_lt. - rewrite Hp1; auto with zarith. - match goal with |- _ <= ?X + ?Y => - apply Zle_trans with X; auto with zarith - end. - match goal with |- ?X <= _ => - pattern X at 1; rewrite <- (Zmult_1_l); - apply Zmult_le_compat_r; auto with zarith - end. + replace (base digits) with (1 * base digits + 0) by auto with zarith. + rewrite Hp1. + apply Zplus_le_compat. + apply Zmult_le_compat; auto with zarith. case p1; simpl; intros; red; simpl; intros; discriminate. unfold base; auto with zarith. - case (spec_to_Z op_spec w1); auto with zarith. + case (spec_to_Z w1); auto with zarith. Qed. - Theorem znz_of_Z_correct: - forall p, 0 <= p < base (znz_digits w_op) -> [|znz_of_Z w_op p|] = p. + Definition of_Z z := + match z with + | Zpos p => snd (of_pos p) + | _ => zero + end. + + Theorem of_Z_correct: + forall p, 0 <= p < base digits -> [|of_Z p|] = p. + Proof. intros p; case p; simpl; try rewrite spec_0; auto. - intros; rewrite znz_of_pos_correct; auto with zarith. + intros; rewrite of_pos_correct; auto with zarith. intros p1 (H1, _); contradict H1; apply Zlt_not_le; red; simpl; auto. Qed. -End znz_of_pos. + End Of_Z. + +End ZnZ. (** A modular specification grouping the earlier records. *) Module Type CyclicType. - Parameter w : Type. - Parameter w_op : znz_op w. - Parameter w_spec : znz_spec w_op. + Parameter t : Type. + Declare Instance ops : ZnZ.Ops t. + Declare Instance specs : ZnZ.Specs ops. End CyclicType. @@ -379,38 +311,29 @@ End CyclicType. Module CyclicRing (Import Cyclic : CyclicType). -Definition t := w. - -Local Notation "[| x |]" := (w_op.(znz_to_Z) x) (at level 0, x at level 99). +Local Notation "[| x |]" := (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) +Local Notation "0" := ZnZ.zero. +Local Notation "1" := ZnZ.one. +Local Infix "+" := ZnZ.add. +Local Infix "-" := ZnZ.sub. +Local Notation "- x" := (ZnZ.opp x). +Local Infix "*" := ZnZ.mul. +Local Notation wB := (base ZnZ.digits). + +Hint Rewrite ZnZ.spec_0 ZnZ.spec_1 ZnZ.spec_add ZnZ.spec_mul + ZnZ.spec_opp ZnZ.spec_sub : cyclic. -Ltac zify := - unfold eq, zero, one, add, sub, mul, opp in *; autorewrite with cyclic. +Ltac zify := unfold eq 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). +apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Lemma add_comm : forall x y, x + y == y + x. @@ -426,7 +349,7 @@ 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). +apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Lemma mul_comm : forall x y, x * y == y * x. @@ -444,22 +367,22 @@ 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. +Lemma add_opp_r : forall x y, x + - y == x-y. Proof. intros. zify. rewrite <- Zminus_mod_idemp_r. unfold Zminus. -destruct (Z_eq_dec ([|y|] mod !!) 0) as [EQ|NEQ]. +destruct (Z_eq_dec ([|y|] mod wB) 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. +Lemma add_opp_diag_r : forall x, x + - 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. +Lemma CyclicRing : ring_theory 0 1 ZnZ.add ZnZ.mul ZnZ.sub ZnZ.opp eq. Proof. constructor. exact add_0_l. exact add_comm. exact add_assoc. @@ -470,13 +393,24 @@ exact add_opp_diag_r. Qed. Definition eqb x y := - match w_op.(znz_compare) x y with Eq => true | _ => false end. + match 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. + rewrite ZnZ.spec_compare. + case Zcompare_spec; intuition; try discriminate. +Qed. +(* POUR HUGO: 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. + intros. unfold eqb, eq. generalize (ZnZ.spec_compare x y). + case (ZnZ.compare x y); intuition; try discriminate. + (* BUG ?! using destruct instead of case won't work: + it gives 3 subcases, but ZnZ.compare x y is still there in them! *) Qed. +*) Lemma eqb_correct : forall x y, eqb x y = true -> x==y. Proof. now apply eqb_eq. Qed. diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v index 517e48ad9c..b68e89560e 100644 --- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v +++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v @@ -27,21 +27,17 @@ Module NZCyclicAxiomsMod (Import Cyclic : CyclicType) <: NZAxiomsSig. Local Open Scope Z_scope. -Definition t := w. +Local Notation wB := (base 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)). - -Local Notation "[| x |]" := (w_op.(znz_to_Z) x) (at level 0, x at level 99). +Local Notation "[| x |]" := (ZnZ.to_Z x) (at level 0, x at level 99). 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). +Definition zero := ZnZ.zero. +Definition succ := ZnZ.succ. +Definition pred := ZnZ.pred. +Definition add := ZnZ.add. +Definition sub := ZnZ.sub. +Definition mul := ZnZ.mul. Local Infix "==" := eq (at level 70). Local Notation "0" := zero. @@ -51,41 +47,25 @@ Local Infix "+" := add. Local Infix "-" := sub. Local Infix "*" := mul. -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. +Hint Rewrite ZnZ.spec_0 ZnZ.spec_succ ZnZ.spec_pred + ZnZ.spec_add ZnZ.spec_mul ZnZ.spec_sub : cyclic. +Ltac zify := + unfold eq, zero, succ, pred, add, sub, mul in *; + autorewrite with cyclic. +Ltac zcongruence := repeat red; intros; zify; congruence. Instance eq_equiv : Equivalence eq. Proof. unfold eq. firstorder. Qed. -Instance succ_wd : Proper (eq ==> eq) succ. -Proof. -wcongruence. -Qed. - -Instance pred_wd : Proper (eq ==> eq) pred. -Proof. -wcongruence. -Qed. +Local Obligation Tactic := zcongruence. -Instance add_wd : Proper (eq ==> eq ==> eq) add. -Proof. -wcongruence. -Qed. - -Instance sub_wd : Proper (eq ==> eq ==> eq) sub. -Proof. -wcongruence. -Qed. - -Instance mul_wd : Proper (eq ==> eq ==> eq) mul. -Proof. -wcongruence. -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. Theorem gt_wB_1 : 1 < wB. Proof. @@ -115,23 +95,16 @@ Qed. Lemma NZ_to_Z_mod : forall n, [| n |] mod wB = [| n |]. Proof. -intro n; rewrite Zmod_small. reflexivity. apply w_spec.(spec_to_Z). +intro n; rewrite Zmod_small. reflexivity. apply ZnZ.spec_to_Z. Qed. Theorem pred_succ : forall n, P (S n) == n. Proof. -intro n. wsimpl. +intro n. zify. 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. -Proof. -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 : t -> Prop. @@ -140,21 +113,22 @@ Hypothesis A0 : A 0. Hypothesis AS : forall n, A n <-> A (S n). (* Below, we use only -> direction *) -Let B (n : Z) := A (Z_to_NZ n). +Let B (n : Z) := A (ZnZ.of_Z n). Lemma B0 : B 0. Proof. -unfold B. now rewrite Z_to_NZ_0. +unfold B. +setoid_replace (ZnZ.of_Z 0) with zero. assumption. +red; zify. apply ZnZ.of_Z_correct. auto using gt_wB_0 with zarith. Qed. 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)). assumption. -wsimpl. -unfold NZ_to_Z, Z_to_NZ. -do 2 (rewrite znz_of_Z_correct; [ | exact w_spec | auto with zarith]). +setoid_replace (ZnZ.of_Z (n + 1)) with (S (ZnZ.of_Z n)). assumption. +zify. +rewrite 2 ZnZ.of_Z_correct; auto with zarith. symmetry; apply Zmod_small; auto with zarith. Qed. @@ -167,25 +141,23 @@ Qed. Theorem bi_induction : forall n, A n. Proof. -intro n. setoid_replace n with (Z_to_NZ (NZ_to_Z n)). -apply B_holds. apply w_spec.(spec_to_Z). -unfold eq, NZ_to_Z, Z_to_NZ; rewrite znz_of_Z_correct. -reflexivity. -exact w_spec. -apply w_spec.(spec_to_Z). +intro n. setoid_replace n with (ZnZ.of_Z (ZnZ.to_Z n)). +apply B_holds. apply ZnZ.spec_to_Z. +red. symmetry. apply ZnZ.of_Z_correct. +apply ZnZ.spec_to_Z. Qed. End Induction. Theorem add_0_l : forall n, 0 + n == n. Proof. -intro n. wsimpl. -rewrite Zplus_0_l. rewrite Zmod_small; [reflexivity | apply w_spec.(spec_to_Z)]. +intro n. zify. +rewrite Zplus_0_l. apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Theorem add_succ_l : forall n m, (S n) + m == S (n + m). Proof. -intros n m. wsimpl. +intros n m. zify. 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. @@ -193,25 +165,27 @@ Qed. Theorem sub_0_r : forall n, n - 0 == n. Proof. -intro n. wsimpl. rewrite Zminus_0_r. apply NZ_to_Z_mod. +intro n. zify. rewrite Zminus_0_r. apply NZ_to_Z_mod. Qed. Theorem sub_succ_r : forall n m, n - (S m) == P (n - m). Proof. -intros n m. wsimpl. rewrite Zminus_mod_idemp_r, Zminus_mod_idemp_l. +intros n m. zify. 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 mul_0_l : forall n, 0 * n == 0. Proof. -intro n. wsimpl. now rewrite Zmult_0_l. +intro n. now zify. Qed. Theorem mul_succ_l : forall n m, (S n) * m == n * m + m. Proof. -intros n m. wsimpl. rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l. +intros n m. zify. rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l. now rewrite Zmult_plus_distr_l, Zmult_1_l. Qed. +Definition t := t. + End NZCyclicAxiomsMod. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v index 88c34915d3..23c62740c8 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v @@ -167,11 +167,7 @@ Section DoubleBase. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_to_Z : forall x, 0 <= [|x|] < wB. Variable spec_w_compare : forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + w_compare x y = Zcompare [|x|] [|y|]. Lemma wwB_wBwB : wwB = wB^2. Proof. @@ -408,35 +404,40 @@ Section DoubleBase. intros a b c d H1; apply beta_lex_inv with (1 := H1); auto. Qed. + Ltac comp2ord := match goal with + | |- Lt = (?x ?= ?y) => symmetry; change (x < y) + | |- Gt = (?x ?= ?y) => symmetry; change (x > y); apply Zlt_gt + end. + Lemma spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. + ww_compare x y = Zcompare [[x]] [[y]]. Proof. destruct x as [ |xh xl];destruct y as [ |yh yl];simpl;trivial. - generalize (spec_w_compare w_0 yh);destruct (w_compare w_0 yh); - 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. + (* 1st case *) + rewrite 2 spec_w_compare, spec_w_0. + destruct (Zcompare_spec 0 [|yh|]) as [H|H|H]. + rewrite <- H;simpl. reflexivity. + symmetry. change (0 < [|yh|]*wB+[|yl|]). + change 0 with (0*wB+0). rewrite <- spec_w_0 at 2. apply wB_lex_inv;trivial. - absurd (0 <= [|yh|]). apply Zgt_not_le;trivial. + absurd (0 <= [|yh|]). apply Zlt_not_le; trivial. destruct (spec_to_Z yh);trivial. - generalize (spec_w_compare xh w_0);destruct (w_compare xh w_0); - intros H;rewrite spec_w_0 in H. - rewrite H;simpl;rewrite <- spec_w_0;apply spec_w_compare. - absurd (0 <= [|xh|]). apply Zgt_not_le;apply Zlt_gt;trivial. + (* 2nd case *) + rewrite 2 spec_w_compare, spec_w_0. + destruct (Zcompare_spec [|xh|] 0) as [H|H|H]. + rewrite H;simpl;reflexivity. + absurd (0 <= [|xh|]). apply Zlt_not_le; 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. - - 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]; - trivial. + comp2ord. + change 0 with (0*wB+0). rewrite <- spec_w_0 at 2. apply wB_lex_inv;trivial. - apply Zlt_gt;apply wB_lex_inv;apply Zgt_lt;trivial. + (* 3rd case *) + rewrite 2 spec_w_compare. + destruct (Zcompare_spec [|xh|] [|yh|]) as [H|H|H]. + rewrite H. + symmetry. apply Zcompare_plus_compat. + comp2ord. apply wB_lex_inv;trivial. + comp2ord. apply wB_lex_inv;trivial. Qed. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v index eea29e7ca2..49a4f950a8 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v @@ -30,65 +30,65 @@ Local Open Scope Z_scope. Section Z_2nZ. - Variable w : Type. - Variable w_op : znz_op w. - Let w_digits := w_op.(znz_digits). - Let w_zdigits := w_op.(znz_zdigits). + Context {t : Type}{ops : ZnZ.Ops t}. - Let w_to_Z := w_op.(znz_to_Z). - Let w_of_pos := w_op.(znz_of_pos). - Let w_head0 := w_op.(znz_head0). - Let w_tail0 := w_op.(znz_tail0). + Let w_digits := ZnZ.digits. + Let w_zdigits := ZnZ.zdigits. - Let w_0 := w_op.(znz_0). - Let w_1 := w_op.(znz_1). - Let w_Bm1 := w_op.(znz_Bm1). + Let w_to_Z := ZnZ.to_Z. + Let w_of_pos := ZnZ.of_pos. + Let w_head0 := ZnZ.head0. + Let w_tail0 := ZnZ.tail0. - Let w_compare := w_op.(znz_compare). - Let w_eq0 := w_op.(znz_eq0). + Let w_0 := ZnZ.zero. + Let w_1 := ZnZ.one. + Let w_Bm1 := ZnZ.minus_one. - Let w_opp_c := w_op.(znz_opp_c). - Let w_opp := w_op.(znz_opp). - Let w_opp_carry := w_op.(znz_opp_carry). + Let w_compare := ZnZ.compare. + Let w_eq0 := ZnZ.eq0. - Let w_succ_c := w_op.(znz_succ_c). - Let w_add_c := w_op.(znz_add_c). - Let w_add_carry_c := w_op.(znz_add_carry_c). - Let w_succ := w_op.(znz_succ). - Let w_add := w_op.(znz_add). - Let w_add_carry := w_op.(znz_add_carry). + Let w_opp_c := ZnZ.opp_c. + Let w_opp := ZnZ.opp. + Let w_opp_carry := ZnZ.opp_carry. - Let w_pred_c := w_op.(znz_pred_c). - Let w_sub_c := w_op.(znz_sub_c). - Let w_sub_carry_c := w_op.(znz_sub_carry_c). - Let w_pred := w_op.(znz_pred). - Let w_sub := w_op.(znz_sub). - Let w_sub_carry := w_op.(znz_sub_carry). + Let w_succ_c := ZnZ.succ_c. + Let w_add_c := ZnZ.add_c. + Let w_add_carry_c := ZnZ.add_carry_c. + Let w_succ := ZnZ.succ. + Let w_add := ZnZ.add. + Let w_add_carry := ZnZ.add_carry. + Let w_pred_c := ZnZ.pred_c. + Let w_sub_c := ZnZ.sub_c. + Let w_sub_carry_c := ZnZ.sub_carry_c. + Let w_pred := ZnZ.pred. + Let w_sub := ZnZ.sub. + Let w_sub_carry := ZnZ.sub_carry. - 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). + Let w_mul_c := ZnZ.mul_c. + Let w_mul := ZnZ.mul. + Let w_square_c := ZnZ.square_c. - Let w_mod_gt := w_op.(znz_mod_gt). - Let w_mod := w_op.(znz_mod). + Let w_div21 := ZnZ.div21. + Let w_div_gt := ZnZ.div_gt. + Let w_div := ZnZ.div. - Let w_gcd_gt := w_op.(znz_gcd_gt). - Let w_gcd := w_op.(znz_gcd). + Let w_mod_gt := ZnZ.modulo_gt. + Let w_mod := ZnZ.modulo. - Let w_add_mul_div := w_op.(znz_add_mul_div). + Let w_gcd_gt := ZnZ.gcd_gt. + Let w_gcd := ZnZ.gcd. - Let w_pos_mod := w_op.(znz_pos_mod). + Let w_add_mul_div := ZnZ.add_mul_div. - Let w_is_even := w_op.(znz_is_even). - Let w_sqrt2 := w_op.(znz_sqrt2). - Let w_sqrt := w_op.(znz_sqrt). + Let w_pos_mod := ZnZ.pos_mod. - Let _zn2z := zn2z w. + Let w_is_even := ZnZ.is_even. + Let w_sqrt2 := ZnZ.sqrt2. + Let w_sqrt := ZnZ.sqrt. + + Let _zn2z := zn2z t. Let wB := base w_digits. @@ -105,9 +105,9 @@ Section Z_2nZ. Let to_Z := zn2z_to_Z wB w_to_Z. - Let w_W0 := znz_W0 w_op. - Let w_0W := znz_0W w_op. - Let w_WW := znz_WW w_op. + Let w_W0 (x:t) := ZnZ.WO x. + Let w_0W (x:t) := ZnZ.OW x. + Let w_WW (x y:t) := ZnZ.WW x y. Let ww_of_pos p := match w_of_pos p with @@ -124,15 +124,15 @@ Section Z_2nZ. 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). - Let ww_0W := Eval lazy beta delta [ww_0W] in (@ww_0W w). - Let ww_W0 := Eval lazy beta delta [ww_W0] in (@ww_W0 w). + Let ww_WW := Eval lazy beta delta [ww_WW] in (@ww_WW t). + Let ww_0W := Eval lazy beta delta [ww_0W] in (@ww_0W t). + Let ww_W0 := Eval lazy beta delta [ww_W0] in (@ww_W0 t). (* ** Comparison ** *) Let compare := Eval lazy beta delta[ww_compare] in ww_compare w_0 w_compare. - Let eq0 (x:zn2z w) := + Let eq0 (x:zn2z t) := match x with | W0 => true | _ => false @@ -226,7 +226,7 @@ Section Z_2nZ. Eval lazy beta iota delta [ww_div21] in ww_div21 w_0 w_0W div32 ww_1 compare sub. - Let low (p: zn2z w) := match p with WW _ p1 => p1 | _ => w_0 end. + Let low (p: zn2z t) := match p with WW _ p1 => p1 | _ => w_0 end. Let add_mul_div := Eval lazy beta delta [ww_add_mul_div] in @@ -287,8 +287,8 @@ Section Z_2nZ. (* ** Record of operators on 2 words *) - Definition mk_zn2z_op := - mk_znz_op _ww_digits _ww_zdigits + Global Instance mk_zn2z_ops : ZnZ.Ops (zn2z t) := + ZnZ.MkOps _ww_digits _ww_zdigits to_Z ww_of_pos head0 tail0 W0 ww_1 ww_Bm1 compare eq0 @@ -307,8 +307,8 @@ Section Z_2nZ. sqrt2 sqrt. - Definition mk_zn2z_op_karatsuba := - mk_znz_op _ww_digits _ww_zdigits + Global Instance mk_zn2z_ops_karatsuba : ZnZ.Ops (zn2z t) := + ZnZ.MkOps _ww_digits _ww_zdigits to_Z ww_of_pos head0 tail0 W0 ww_1 ww_Bm1 compare eq0 @@ -328,51 +328,51 @@ Section Z_2nZ. sqrt. (* Proof *) - Variable op_spec : znz_spec w_op. + Context {specs : ZnZ.Specs ops}. Hint Resolve - (spec_to_Z op_spec) - (spec_of_pos op_spec) - (spec_0 op_spec) - (spec_1 op_spec) - (spec_Bm1 op_spec) - (spec_compare op_spec) - (spec_eq0 op_spec) - (spec_opp_c op_spec) - (spec_opp op_spec) - (spec_opp_carry op_spec) - (spec_succ_c op_spec) - (spec_add_c op_spec) - (spec_add_carry_c op_spec) - (spec_succ op_spec) - (spec_add op_spec) - (spec_add_carry op_spec) - (spec_pred_c op_spec) - (spec_sub_c op_spec) - (spec_sub_carry_c op_spec) - (spec_pred op_spec) - (spec_sub op_spec) - (spec_sub_carry op_spec) - (spec_mul_c op_spec) - (spec_mul op_spec) - (spec_square_c op_spec) - (spec_div21 op_spec) - (spec_div_gt op_spec) - (spec_div op_spec) - (spec_mod_gt op_spec) - (spec_mod op_spec) - (spec_gcd_gt 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) - (spec_sqrt2) - (spec_sqrt) - (spec_W0 op_spec) - (spec_0W op_spec) - (spec_WW op_spec). + ZnZ.spec_to_Z + ZnZ.spec_of_pos + ZnZ.spec_0 + ZnZ.spec_1 + ZnZ.spec_m1 + ZnZ.spec_compare + ZnZ.spec_eq0 + ZnZ.spec_opp_c + ZnZ.spec_opp + ZnZ.spec_opp_carry + ZnZ.spec_succ_c + ZnZ.spec_add_c + ZnZ.spec_add_carry_c + ZnZ.spec_succ + ZnZ.spec_add + ZnZ.spec_add_carry + ZnZ.spec_pred_c + ZnZ.spec_sub_c + ZnZ.spec_sub_carry_c + ZnZ.spec_pred + ZnZ.spec_sub + ZnZ.spec_sub_carry + ZnZ.spec_mul_c + ZnZ.spec_mul + ZnZ.spec_square_c + ZnZ.spec_div21 + ZnZ.spec_div_gt + ZnZ.spec_div + ZnZ.spec_modulo_gt + ZnZ.spec_modulo + ZnZ.spec_gcd_gt + ZnZ.spec_gcd + ZnZ.spec_head0 + ZnZ.spec_tail0 + ZnZ.spec_add_mul_div + ZnZ.spec_pos_mod + ZnZ.spec_is_even + ZnZ.spec_sqrt2 + ZnZ.spec_sqrt + ZnZ.spec_WO + ZnZ.spec_OW + ZnZ.spec_WW. Ltac wwauto := unfold ww_to_Z; auto. @@ -395,16 +395,17 @@ Section Z_2nZ. Zpos p = (Z_of_N (fst (ww_of_pos p)))*wwB + [|(snd (ww_of_pos p))|]. Proof. unfold ww_of_pos;intros. - assert (H:= spec_of_pos op_spec p);unfold w_of_pos; - destruct (znz_of_pos w_op p). simpl in H. - rewrite H;clear H;destruct n;simpl to_Z. - simpl;unfold w_to_Z,w_0;rewrite (spec_0 op_spec);trivial. - unfold Z_of_N; assert (H:= spec_of_pos op_spec p0); - destruct (znz_of_pos w_op p0). simpl in H. - rewrite H;unfold fst, snd,Z_of_N, to_Z. - rewrite (spec_WW op_spec). + rewrite (ZnZ.spec_of_pos p). unfold w_of_pos. + case (ZnZ.of_pos p); intros. simpl. + destruct n; simpl ZnZ.to_Z. + simpl;unfold w_to_Z,w_0; rewrite ZnZ.spec_0;trivial. + unfold Z_of_N. + rewrite (ZnZ.spec_of_pos p0). + case (ZnZ.of_pos p0); intros. simpl. + unfold fst, snd,Z_of_N, to_Z, wB, w_digits, w_to_Z, w_WW. + rewrite ZnZ.spec_WW. replace wwB with (wB*wB). - unfold wB,w_to_Z,w_digits;clear H;destruct n;ring. + unfold wB,w_to_Z,w_digits;destruct n;ring. symmetry. rewrite <- Zpower_2; exact (wwB_wBwB w_digits). Qed. @@ -418,15 +419,9 @@ Section Z_2nZ. Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed. Let spec_ww_compare : - forall x y, - match compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + forall x y, compare x y = Zcompare [|x|] [|y|]. 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. @@ -531,8 +526,7 @@ Section Z_2nZ. Proof. refine (spec_ww_karatsuba_c _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto. - unfold w_digits; apply spec_more_than_1_digit; auto. - exact (spec_compare op_spec). + unfold w_digits; apply ZnZ.spec_more_than_1_digit; auto. Qed. Let spec_ww_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wwB. @@ -559,11 +553,10 @@ Section Z_2nZ. w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c w_digits w_to_Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. unfold w_Bm2, w_to_Z, w_pred, w_Bm1. - rewrite (spec_pred op_spec);rewrite (spec_Bm1 op_spec). + rewrite ZnZ.spec_pred, ZnZ.spec_m1. unfold w_digits;rewrite Zmod_small. ring. - assert (H:= wB_pos(znz_digits w_op)). omega. - exact (spec_compare op_spec). - exact (spec_div21 op_spec). + assert (H:= wB_pos(ZnZ.digits)). omega. + exact ZnZ.spec_div21. Qed. Let spec_ww_div21 : forall a1 a2 b, @@ -580,22 +573,19 @@ Section Z_2nZ. Let spec_add2: forall x y, [|w_add2 x y|] = w_to_Z x + w_to_Z y. unfold w_add2. - intros xh xl; generalize (spec_add_c op_spec xh xl). - unfold w_add_c; case znz_add_c; unfold interp_carry; simpl ww_to_Z. + intros xh xl; generalize (ZnZ.spec_add_c xh xl). + unfold w_add_c; case ZnZ.add_c; unfold interp_carry; simpl ww_to_Z. intros w0 Hw0; simpl; unfold w_to_Z; rewrite Hw0. - unfold w_0; rewrite spec_0; simpl; auto with zarith. + unfold w_0; rewrite ZnZ.spec_0; simpl; auto with zarith. intros w0; rewrite Zmult_1_l; simpl. - unfold w_to_Z, w_1; rewrite spec_1; auto with zarith. + unfold w_to_Z, w_1; rewrite ZnZ.spec_1; auto with zarith. rewrite Zmult_1_l; auto. Qed. Let spec_low: forall x, w_to_Z (low x) = [|x|] mod wB. intros x; case x; simpl low. - unfold ww_to_Z, w_to_Z, w_0; rewrite (spec_0 op_spec); simpl. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - unfold wB, base; auto with zarith. + unfold ww_to_Z, w_to_Z, w_0; rewrite ZnZ.spec_0; simpl; auto. intros xh xl; simpl. rewrite Zplus_comm; rewrite Z_mod_plus; auto with zarith. rewrite Zmod_small; auto with zarith. @@ -608,7 +598,7 @@ Section Z_2nZ. unfold w_to_Z, _ww_zdigits. rewrite spec_add2. unfold w_to_Z, w_zdigits, w_digits. - rewrite spec_zdigits; auto. + rewrite ZnZ.spec_zdigits; auto. rewrite Zpos_xO; auto with zarith. Qed. @@ -618,9 +608,8 @@ Section Z_2nZ. 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). - exact (spec_head00 op_spec). - exact (spec_zdigits op_spec). + exact ZnZ.spec_head00. + exact ZnZ.spec_zdigits. Qed. Let spec_ww_head0 : forall x, 0 < [|x|] -> @@ -629,8 +618,7 @@ Section Z_2nZ. 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). + exact ZnZ.spec_zdigits. Qed. Let spec_ww_tail00 : forall x, [|x|] = 0 -> [|tail0 x|] = Zpos _ww_digits. @@ -638,9 +626,8 @@ Section Z_2nZ. 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). - exact (spec_tail00 op_spec). - exact (spec_zdigits op_spec). + exact ZnZ.spec_tail00. + exact ZnZ.spec_zdigits. Qed. @@ -649,8 +636,7 @@ Section Z_2nZ. Proof. 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). + exact ZnZ.spec_zdigits. Qed. Lemma spec_ww_add_mul_div : forall x y p, @@ -659,10 +645,10 @@ 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 t 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). + exact ZnZ.spec_zdigits. Qed. Let spec_ww_div_gt : forall a b, @@ -671,29 +657,29 @@ Section Z_2nZ. [|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 +(@spec_ww_div_gt t 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 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ). - exact (spec_0 op_spec). - exact (spec_to_Z op_spec). + exact ZnZ.spec_0. + exact ZnZ.spec_to_Z. wwauto. wwauto. - exact (spec_compare op_spec). - exact (spec_eq0 op_spec). - exact (spec_opp_c op_spec). - exact (spec_opp op_spec). - exact (spec_opp_carry op_spec). - exact (spec_sub_c op_spec). - exact (spec_sub op_spec). - exact (spec_sub_carry op_spec). - exact (spec_div_gt op_spec). - exact (spec_add_mul_div op_spec). - exact (spec_head0 op_spec). - exact (spec_div21 op_spec). + exact ZnZ.spec_compare. + exact ZnZ.spec_eq0. + exact ZnZ.spec_opp_c. + exact ZnZ.spec_opp. + exact ZnZ.spec_opp_carry. + exact ZnZ.spec_sub_c. + exact ZnZ.spec_sub. + exact ZnZ.spec_sub_carry. + exact ZnZ.spec_div_gt. + exact ZnZ.spec_add_mul_div. + exact ZnZ.spec_head0. + exact ZnZ.spec_div21. exact spec_w_div32. - exact (spec_zdigits op_spec). + exact ZnZ.spec_zdigits. exact spec_ww_digits. exact spec_ww_1. exact spec_ww_add_mul_div. @@ -711,15 +697,14 @@ refine [|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 t 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 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. - exact (spec_compare op_spec). - exact (spec_div_gt op_spec). - exact (spec_div21 op_spec). - exact (spec_zdigits op_spec). + exact ZnZ.spec_div_gt. + exact ZnZ.spec_div21. + exact ZnZ.spec_zdigits. exact spec_ww_add_mul_div. Qed. @@ -731,37 +716,33 @@ 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 t 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 + refine (@spec_ww_gcd_gt_aux t 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 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. - exact (spec_compare op_spec). - exact (spec_div21 op_spec). - exact (spec_zdigits op_spec). + exact ZnZ.spec_div21. + exact ZnZ.spec_zdigits. exact spec_ww_add_mul_div. - refine (@spec_gcd_cont w w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare + refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare _ _);auto. - exact (spec_compare op_spec). Qed. Let spec_ww_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|]. Proof. - refine (@spec_ww_gcd w w_digits W0 compare w_to_Z _ _ w_0 w_0 w_eq0 w_gcd_gt + refine (@spec_ww_gcd t w_digits W0 compare 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 + refine (@spec_ww_gcd_gt_aux t 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 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);wwauto. - exact (spec_compare op_spec). - exact (spec_div21 op_spec). - exact (spec_zdigits op_spec). + exact ZnZ.spec_div21. + exact ZnZ.spec_zdigits. exact spec_ww_add_mul_div. - refine (@spec_gcd_cont w w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare + refine (@spec_gcd_cont t w_digits ww_1 w_to_Z _ _ w_0 w_1 w_compare _ _);auto. - exact (spec_compare op_spec). Qed. Let spec_ww_is_even : forall x, @@ -770,8 +751,8 @@ refine | false => [|x|] mod 2 = 1 end. Proof. - refine (@spec_ww_is_even w w_is_even w_0 w_1 w_Bm1 w_digits _ _ _ _ _); auto. - exact (spec_is_even op_spec). + refine (@spec_ww_is_even t w_is_even w_0 w_1 w_Bm1 w_digits _ _ _ _ _); auto. + exact ZnZ.spec_is_even. Qed. Let spec_ww_sqrt2 : forall x y, @@ -781,60 +762,57 @@ refine [+|r|] <= 2 * [|s|]. Proof. intros x y H. - refine (@spec_ww_sqrt2 w w_is_even w_compare w_0 w_1 w_Bm1 + refine (@spec_ww_sqrt2 t 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_digits w_zdigits _ww_zdigits w_add_c w_sqrt2 w_pred pred_c pred add_c add sub_c add_mul_div _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); wwauto. - exact (spec_zdigits op_spec). - exact (spec_more_than_1_digit op_spec). - exact (spec_is_even op_spec). - exact (spec_compare op_spec). - exact (spec_div21 op_spec). - exact (spec_ww_add_mul_div). - exact (spec_sqrt2 op_spec). + exact ZnZ.spec_zdigits. + exact ZnZ.spec_more_than_1_digit. + exact ZnZ.spec_is_even. + exact ZnZ.spec_div21. + exact spec_ww_add_mul_div. + exact ZnZ.spec_sqrt2. Qed. 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 t 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. - exact (spec_zdigits op_spec). - exact (spec_more_than_1_digit op_spec). - exact (spec_is_even op_spec). - exact (spec_ww_add_mul_div). - exact (spec_sqrt2 op_spec). + exact ZnZ.spec_zdigits. + exact ZnZ.spec_more_than_1_digit. + exact ZnZ.spec_is_even. + exact spec_ww_add_mul_div. + exact ZnZ.spec_sqrt2. Qed. - Lemma mk_znz2_spec : znz_spec mk_zn2z_op. + Global Instance mk_zn2z_specs : ZnZ.Specs mk_zn2z_ops. Proof. - apply mk_znz_spec;auto. + apply ZnZ.MkSpecs; 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 t 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). - exact (spec_zdigits op_spec). + exact ZnZ.spec_zdigits. unfold w_to_Z, w_zdigits. - rewrite (spec_zdigits op_spec). + rewrite ZnZ.spec_zdigits. rewrite <- Zpos_xO; exact spec_ww_digits. Qed. - Lemma mk_znz2_karatsuba_spec : znz_spec mk_zn2z_op_karatsuba. + Global Instance mk_zn2z_specs_karatsuba : ZnZ.Specs mk_zn2z_ops_karatsuba. Proof. - apply mk_znz_spec;auto. + apply ZnZ.MkSpecs; 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 t 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). - exact (spec_zdigits op_spec). + exact ZnZ.spec_zdigits. unfold w_to_Z, w_zdigits. - rewrite (spec_zdigits op_spec). + rewrite ZnZ.spec_zdigits. rewrite <- Zpos_xO; exact spec_ww_digits. Qed. @@ -842,17 +820,14 @@ End Z_2nZ. Section MulAdd. - Variable w: Type. - Variable op: znz_op w. - Variable sop: znz_spec op. + Context {t : Type}{ops : ZnZ.Ops t}{specs : ZnZ.Specs ops}. - Definition mul_add:= w_mul_add (znz_0 op) (znz_succ op) (znz_add_c op) (znz_mul_c op). + Definition mul_add:= w_mul_add ZnZ.zero ZnZ.succ ZnZ.add_c ZnZ.mul_c. - Notation "[| x |]" := (znz_to_Z op x) (at level 0, x at level 99). + Notation "[| x |]" := (ZnZ.to_Z x) (at level 0, x at level 99). Notation "[|| x ||]" := - (zn2z_to_Z (base (znz_digits op)) (znz_to_Z op) x) (at level 0, x at level 99). - + (zn2z_to_Z (base ZnZ.digits) ZnZ.to_Z x) (at level 0, x at level 99). Lemma spec_mul_add: forall x y z, let (zh, zl) := mul_add x y z in @@ -860,11 +835,11 @@ Section MulAdd. Proof. intros x y z. refine (spec_w_mul_add _ _ _ _ _ _ _ _ _ _ _ _ x y z); auto. - exact (spec_0 sop). - exact (spec_to_Z sop). - exact (spec_succ sop). - exact (spec_add_c sop). - exact (spec_mul_c sop). + exact ZnZ.spec_0. + exact ZnZ.spec_to_Z. + exact ZnZ.spec_succ. + exact ZnZ.spec_add_c. + exact ZnZ.spec_mul_c. Qed. End MulAdd. @@ -873,13 +848,13 @@ End MulAdd. (** Modular versions of DoubleCyclic *) Module DoubleCyclic (C:CyclicType) <: CyclicType. - Definition w := zn2z C.w. - Definition w_op := mk_zn2z_op C.w_op. - Definition w_spec := mk_znz2_spec C.w_spec. + Definition t := zn2z C.t. + Instance ops : ZnZ.Ops t := mk_zn2z_ops. + Instance specs : ZnZ.Specs ops := mk_zn2z_specs. End DoubleCyclic. Module DoubleCyclicKaratsuba (C:CyclicType) <: CyclicType. - Definition w := zn2z C.w. - Definition w_op := mk_zn2z_op_karatsuba C.w_op. - Definition w_spec := mk_znz2_karatsuba_spec C.w_spec. + Definition t := zn2z C.t. + Definition ops : ZnZ.Ops t := mk_zn2z_ops_karatsuba. + Definition specs : ZnZ.Specs ops := mk_zn2z_specs_karatsuba. End DoubleCyclicKaratsuba. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v index 9204b4e05f..1ce1e81b0c 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v @@ -82,11 +82,7 @@ Section POS_MOD. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. + ww_compare x y = Zcompare [[x]] [[y]]. Variable spec_ww_sub: forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. @@ -105,8 +101,8 @@ Section POS_MOD. intros w1 p; case (spec_to_w_Z p); intros HH1 HH2. 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; + intros xh xl; rewrite spec_ww_compare. + case Zcompare_spec; rewrite spec_w_0W; rewrite spec_zdigits; fold wB; intros H1. rewrite H1; simpl ww_to_Z. @@ -134,8 +130,8 @@ Section POS_MOD. rewrite Z_mod_mult; auto with zarith. 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; + rewrite spec_ww_compare. + case Zcompare_spec; rewrite spec_ww_zdigits; rewrite spec_zdigits; intros H2. replace (2^[[p]]) with wwB. rewrite Zmod_small; auto with zarith. @@ -266,12 +262,7 @@ Section DoubleDiv32. Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. Variable spec_compare : - forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + forall x y, w_compare x y = Zcompare [|x|] [|y|]. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. Variable spec_w_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1. @@ -343,7 +334,7 @@ Section DoubleDiv32. (WW (w_sub a2 b2) a3) (WW b1 b2) | Gt => (w_0, W0) (* cas absurde *) end. - assert (Hcmp:=spec_compare a1 b1);destruct (w_compare a1 b1). + rewrite spec_compare. case Zcompare_spec; intro Hcmp. simpl in Hlt. rewrite Hcmp in Hlt;assert ([|a2|] < [|b2|]). omega. assert ([[WW (w_sub a2 b2) a3]] = ([|a2|]-[|b2|])*wB + [|a3|] + wwB). @@ -545,11 +536,7 @@ Section DoubleDiv21. 0 <= [[r]] < [|b1|] * wB + [|b2|]. Variable spec_ww_1 : [[ww_1]] = 1. Variable spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. + ww_compare x y = Zcompare [[x]] [[y]]. Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Theorem wwB_div: wwB = 2 * (wwB / 2). @@ -576,10 +563,9 @@ Section DoubleDiv21. intros a1 a2 b H Hlt; unfold ww_div21. Spec_ww_to_Z b; assert (Eq: 0 < [[b]]). Spec_ww_to_Z a1;omega. generalize Hlt H ;clear Hlt H;case a1. - intros H1 H2;simpl in H1;Spec_ww_to_Z a2; - match goal with |-context [ww_compare ?Y ?Z] => - generalize (spec_ww_compare Y Z); case (ww_compare Y Z) - end; simpl;try rewrite spec_ww_1;autorewrite with rm10; intros;zarith. + intros H1 H2;simpl in H1;Spec_ww_to_Z a2. + rewrite spec_ww_compare. case Zcompare_spec; + simpl;try rewrite spec_ww_1;autorewrite with rm10; intros;zarith. rewrite spec_ww_sub;simpl. rewrite Zmod_small;zarith. split. ring. assert (wwB <= 2*[[b]]);zarith. @@ -809,12 +795,7 @@ Section DoubleDivGt. Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_compare : - forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + forall x y, w_compare x y = Zcompare [|x|] [|y|]. Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|]. @@ -914,7 +895,7 @@ Section DoubleDivGt. end in [[WW ah al]]=[[q]]*[[WW bh bl]]+[[r]] /\ 0 <=[[r]]< [[WW bh bl]]). assert (Hh := spec_head0 Hpos). lazy zeta. - generalize (spec_compare (w_head0 bh) w_0); case w_compare; + rewrite spec_compare; case Zcompare_spec; rewrite spec_w_0; intros HH. generalize Hh; rewrite HH; simpl Zpower; rewrite Zmult_1_l; intros (HH1, HH2); clear HH. @@ -1058,7 +1039,7 @@ Section DoubleDivGt. assert (H2:=spec_div_gt Hgt Hpos);destruct (w_div_gt al bl). repeat rewrite spec_w_0W;simpl;rewrite spec_w_0;simpl;trivial. clear H. - assert (Hcmp := spec_compare w_0 bh); destruct (w_compare w_0 bh). + rewrite spec_compare; case Zcompare_spec; intros Hcmp. rewrite spec_w_0 in Hcmp. change [[WW bh bl]] with ([|bh|]*wB+[|bl|]). rewrite <- Hcmp;rewrite Zmult_0_l;rewrite Zplus_0_l. simpl in Hpos;rewrite <- Hcmp in Hpos;simpl in Hpos. @@ -1154,7 +1135,7 @@ Section DoubleDivGt. rewrite spec_w_0W;rewrite spec_w_mod_gt_eq;trivial. 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_compare; case Zcompare_spec; intros H2. 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 @@ -1227,13 +1208,14 @@ Section DoubleDivGt. end | Gt => W0 (* absurde *) end). - 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 spec_compare, spec_w_0. + case Zcompare_spec; intros Hbh. + simpl ww_to_Z in *. rewrite <- Hbh. rewrite Zmult_0_l;rewrite Zplus_0_l. - 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. + rewrite spec_compare, spec_w_0. + case Zcompare_spec; intros 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. apply Zis_gcd_mod;zarith. change ([|ah|] * wB + [|al|]) with (double_to_Z w_digits w_to_Z 1 (WW ah al)). rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div @@ -1243,20 +1225,20 @@ Section DoubleDivGt. 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;exfalso;omega. - rewrite spec_w_0 in Hbh;assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh). + Spec_w_to_Z bl;exfalso;omega. + assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh). 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;rewrite spec_w_0 in Hmh; rewrite <- Hmh;simpl. - 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. - rewrite spec_w_0 in Hml. apply Zis_gcd_mod;zarith. + rewrite spec_compare, spec_w_0; case Zcompare_spec; intros Hmh. + simpl;rewrite <- Hmh;simpl. + rewrite spec_compare, spec_w_0; case Zcompare_spec; intros Hml. + rewrite <- Hml;simpl;apply Zis_gcd_0. + simpl; rewrite spec_w_0; simpl. + 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 @@ -1265,8 +1247,8 @@ Section DoubleDivGt. 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;exfalso;omega. - rewrite spec_w_0 in Hmh. assert ([[WW bh bl]] > [[WW mh ml]]). + Spec_w_to_Z ml;exfalso;omega. + assert ([[WW bh bl]] > [[WW mh ml]]). 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). @@ -1300,8 +1282,8 @@ 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;exfalso;zarith. - rewrite spec_w_0 in Hbh;Spec_w_to_Z bh;exfalso;zarith. + Spec_w_to_Z mh;exfalso;zarith. + Spec_w_to_Z bh;exfalso;zarith. Qed. Lemma spec_ww_gcd_gt_aux : @@ -1374,11 +1356,7 @@ Section DoubleDiv. Variable spec_to_Z : forall x, 0 <= [|x|] < wB. Variable spec_ww_1 : [[ww_1]] = 1. Variable spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. + ww_compare x y = Zcompare [[x]] [[y]]. Variable spec_ww_div_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> let (q,r) := ww_div_gt a b in [[a]] = [[q]] * [[b]] + [[r]] /\ @@ -1400,20 +1378,20 @@ Section DoubleDiv. 0 <= [[r]] < [[b]]. Proof. intros a b Hpos;unfold ww_div. - assert (H:=spec_ww_compare a b);destruct (ww_compare a b). + rewrite spec_ww_compare; case Zcompare_spec; intros. simpl;rewrite spec_ww_1;split;zarith. simpl;split;[ring|Spec_ww_to_Z a;zarith]. - apply spec_ww_div_gt;trivial. + apply spec_ww_div_gt;auto with zarith. Qed. Lemma spec_ww_mod : forall a b, 0 < [[b]] -> [[ww_mod a b]] = [[a]] mod [[b]]. Proof. intros a b Hpos;unfold ww_mod. - assert (H := spec_ww_compare a b);destruct (ww_compare a b). + rewrite spec_ww_compare; case Zcompare_spec; intros. simpl;apply Zmod_unique with 1;try rewrite H;zarith. Spec_ww_to_Z a;symmetry;apply Zmod_small;zarith. - apply spec_ww_mod_gt;trivial. + apply spec_ww_mod_gt;auto with zarith. Qed. @@ -1431,12 +1409,7 @@ Section DoubleDiv. Variable spec_w_0 : [|w_0|] = 0. Variable spec_w_1 : [|w_1|] = 1. Variable spec_compare : - forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + forall x y, w_compare x y = Zcompare [|x|] [|y|]. 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|]. @@ -1468,14 +1441,14 @@ Section DoubleDiv. 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. - unfold gcd_cont;assert (Hcmpy:=spec_compare w_1 yl); - rewrite spec_w_1 in Hcmpy. - simpl;rewrite H;simpl;destruct (w_compare w_1 yl). + unfold gcd_cont; rewrite spec_compare, spec_w_1. + case Zcompare_spec; intros Hcmpy. + simpl;rewrite H;simpl; 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; exfalso;zarith. - assert ([|yl|] = 0). Spec_w_to_Z yl;zarith. - rewrite H0;simpl;apply Zis_gcd_0;trivial. + assert (H0 : [|yl|] = 0) by (Spec_w_to_Z yl;zarith). + simpl. rewrite H0, H;simpl;apply Zis_gcd_0;trivial. Qed. @@ -1528,7 +1501,7 @@ Section DoubleDiv. | Eq => a | Lt => ww_gcd_gt b a end). - assert (Hcmp := spec_ww_compare a b);destruct (ww_compare a b). + rewrite spec_ww_compare; case Zcompare_spec; intros Hcmp. Spec_ww_to_Z b;rewrite Hcmp. apply Zis_gcd_for_euclid with 1;zarith. ring_simplify ([[b]] - 1 * [[b]]). apply Zis_gcd_0;zarith. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v index 386bbb9e59..136f96c043 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v @@ -62,12 +62,7 @@ Section GENDIVN1. [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Variable spec_compare : - forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + forall x y, w_compare x y = Zcompare [|x|] [|y|]. Variable spec_sub: forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. @@ -373,7 +368,7 @@ Section GENDIVN1. intros n a b H. unfold double_divn1. case (spec_head0 H); intros H0 H1. case (spec_to_Z (w_head0 b)); intros HH1 HH2. - generalize (spec_compare (w_head0 b) w_0); case w_compare; + rewrite spec_compare; case Zcompare_spec; rewrite spec_0; intros H2; auto with zarith. assert (Hv1: wB/2 <= [|b|]). generalize H0; rewrite H2; rewrite Zpower_0_r; @@ -506,7 +501,7 @@ Section GENDIVN1. double_modn1 n a b = snd (double_divn1 n a b). Proof. intros n a b;unfold double_divn1,double_modn1. - generalize (spec_compare (w_head0 b) w_0); case w_compare; + rewrite spec_compare; case Zcompare_spec; rewrite spec_0; intros H2; auto with zarith. apply spec_double_modn1_0. apply spec_double_modn1_0. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v index 21e694e577..3405b6f4d6 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v @@ -106,17 +106,9 @@ Section DoubleLift. Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_compare : forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + w_compare x y = Zcompare [|x|] [|y|]. Variable spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. + ww_compare x y = Zcompare [[x]] [[y]]. Variable spec_ww_digits : ww_Digits = xO w_digits. Variable spec_w_head00 : forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits. Variable spec_w_head0 : forall x, 0 < [|x|] -> @@ -159,7 +151,7 @@ Section DoubleLift. absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. rewrite <- Hy3; rewrite Zplus_0_r; auto with zarith. apply Zmult_lt_0_compat; auto with zarith. - generalize (spec_compare w_0 xh); case w_compare. + rewrite spec_compare. case Zcompare_spec. intros H; simpl. rewrite spec_w_add; rewrite spec_w_head00. rewrite spec_zdigits; rewrite spec_ww_digits. @@ -176,9 +168,8 @@ Section DoubleLift. rewrite wwB_div_2;rewrite Zmult_comm;rewrite wwB_wBwB. assert (U:= lt_0_wB w_digits); destruct x as [ |xh xl];simpl ww_to_Z;intros H. unfold Zlt in H;discriminate H. - 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. + rewrite spec_compare, spec_w_0. case Zcompare_spec; intros H0. + rewrite <- H0 in *. simpl Zplus. simpl in H. case (spec_to_Z w_zdigits); case (spec_to_Z (w_head0 xl)); intros HH1 HH2 HH3 HH4. rewrite spec_w_add. @@ -233,7 +224,7 @@ Section DoubleLift. apply Zmult_lt_0_compat; auto with zarith. assert (F2: [|xl|] = 0). rewrite F1 in Hx; auto with zarith. - generalize (spec_compare w_0 xl); case w_compare. + rewrite spec_compare; case Zcompare_spec. intros H; simpl. rewrite spec_w_add; rewrite spec_w_tail00; auto. rewrite spec_zdigits; rewrite spec_ww_digits. @@ -248,8 +239,7 @@ Section DoubleLift. clear spec_ww_zdigits. destruct x as [ |xh xl];simpl ww_to_Z;intros H. unfold Zlt in H;discriminate H. - assert (H0 := spec_compare w_0 xl);rewrite spec_w_0 in H0. - destruct (w_compare w_0 xl). + rewrite spec_compare, spec_w_0. case Zcompare_spec; intros H0. rewrite <- H0; rewrite Zplus_0_r. case (spec_to_Z (w_tail0 xh)); intros HH1 HH2. generalize H; rewrite <- H0; rewrite Zplus_0_r; clear H; intros H. @@ -323,7 +313,7 @@ Section DoubleLift. assert (Hx := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)); simpl in Hx;assert (Hyh := spec_to_Z yh);assert (Hyl:=spec_to_Z yl); assert (Hy:=spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW yh yl));simpl in Hy. - generalize (spec_ww_compare p zdigits); case ww_compare; intros H1. + rewrite spec_ww_compare; case Zcompare_spec; intros H1. rewrite H1; unfold zdigits; rewrite spec_w_0W. rewrite spec_zdigits; rewrite Zminus_diag; rewrite Zplus_0_r. simpl ww_to_Z; w_rewrite;zarith. @@ -365,7 +355,7 @@ Section DoubleLift. ring_simplify ([[p]] + (Zpos w_digits - [[p]]));fold wB;zarith. assert (Hv: [[p]] > Zpos w_digits). generalize H1; clear H1. - unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits; auto. + unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits; auto with zarith. clear H1. assert (HH0: [|low (ww_sub p zdigits)|] = [[p]] - Zpos w_digits). rewrite spec_low. @@ -446,8 +436,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)); - case ww_compare; intros H1; w_rewrite. + rewrite spec_ww_compare. case Zcompare_spec; 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. assert (HH0: [|low p|] = [[p]]). @@ -464,7 +453,8 @@ Section DoubleLift. rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. rewrite Zpos_xO in H;zarith. assert (HH: [|low (ww_sub p (w_0W w_zdigits)) |] = [[p]] - Zpos w_digits). - generalize H1; clear H1. + symmetry in H1; change ([[p]] > [[w_0W w_zdigits]]) in H1. + revert H1. rewrite spec_low. rewrite spec_ww_sub; w_rewrite; intros H1. rewrite <- Zmod_div_mod; auto with zarith. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v index 7090c76a87..6a2a344490 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v @@ -248,12 +248,7 @@ Section DoubleMul. Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_w_compare : - forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + forall x y, w_compare x y = Zcompare [|x|] [|y|]. Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. @@ -408,9 +403,9 @@ Section DoubleMul. 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)). - generalize (spec_w_compare xl xh); case (w_compare xl xh); intros Hxlh; + rewrite spec_w_compare; case Zcompare_spec; intros Hxlh; 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 spec_w_compare; case Zcompare_spec; intros Hylh. rewrite Hylh; 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). @@ -430,7 +425,7 @@ Section DoubleMul. rewrite spec_w_1; unfold interp_carry in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh. + rewrite spec_w_compare; case Zcompare_spec; intros Hylh. rewrite Hylh; rewrite spec_w_0; try (ring; fail). match goal with |- context[ww_add_c ?x ?y] => generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_0; @@ -455,9 +450,9 @@ Section DoubleMul. apply Zmult_le_0_compat; auto with zarith. (** there is a carry in hh + ll **) rewrite Zmult_1_l. - generalize (spec_w_compare xl xh); case (w_compare xl xh); intros Hxlh; + rewrite spec_w_compare; case Zcompare_spec; intros Hxlh; try rewrite Hxlh; try rewrite spec_w_1; try (ring; fail). - generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh; + rewrite spec_w_compare; case Zcompare_spec; intros Hylh; try rewrite Hylh; try rewrite spec_w_1; try (ring; fail). match goal with |- context[ww_sub_c ?x ?y] => generalize (spec_ww_sub_c x y); case (ww_sub_c x y); try rewrite spec_w_1; @@ -480,7 +475,7 @@ Section DoubleMul. ring. rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - generalize (spec_w_compare yl yh); case (w_compare yl yh); intros Hylh; + rewrite spec_w_compare; case Zcompare_spec; intros Hylh; try rewrite Hylh; try rewrite spec_w_1; try (ring; fail). match goal with |- context[ww_add_c ?x ?y] => generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_1; diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v index 83a2e7177d..ee12c6a8db 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v @@ -220,12 +220,8 @@ Section DoubleSqrt. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_w_is_even : forall x, if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. - Variable spec_w_compare : forall x y, - match w_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. + Variable spec_w_compare : forall x y, + w_compare x y = Zcompare [|x|] [|y|]. Variable spec_w_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. Variable spec_w_square_c : forall x, [[ w_square_c x]] = [|x|] * [|x|]. Variable spec_w_div21 : forall a1 a2 b, @@ -257,11 +253,7 @@ Section DoubleSqrt. Variable spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB. Variable spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]]. Variable spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. + ww_compare x y = Zcompare [[x]] [[y]]. Variable spec_ww_head0 : forall x, 0 < [[x]] -> wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB. Variable spec_low: forall x, [|low x|] = [[x]] mod wB. @@ -299,10 +291,7 @@ intros x; case x; simpl ww_is_even. apply Zlt_le_trans with (2 := Hb); auto with zarith. apply Zlt_le_trans with 1; auto with zarith. apply Zdiv_le_lower_bound; auto with zarith. - repeat match goal with |- context[w_compare ?y ?z] => - generalize (spec_w_compare y z); - case (w_compare y z) - end. + rewrite !spec_w_compare. repeat case Zcompare_spec. intros H1 H2; split. unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith. rewrite H1; rewrite H2; ring. @@ -1113,7 +1102,7 @@ intros x; case x; simpl ww_is_even. Lemma spec_ww_is_zero: forall x, if ww_is_zero x then [[x]] = 0 else 0 < [[x]]. intro x; unfold ww_is_zero. - generalize (spec_ww_compare W0 x); case (ww_compare W0 x); + rewrite spec_ww_compare. case Zcompare_spec; 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. @@ -1198,7 +1187,7 @@ intros x; case x; simpl ww_is_even. simpl ww_to_Z; simpl Zpower; unfold Zpower_pos; simpl; auto with zarith. intros H1. - generalize (spec_ww_compare (ww_head1 x) W0); case ww_compare; + rewrite spec_ww_compare. case Zcompare_spec; simpl ww_to_Z; autorewrite with rm10. generalize H1; case x. intros HH; contradict HH; simpl ww_to_Z; auto with zarith. diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v index 744f2f47cc..99bac5d7e8 100644 --- a/theories/Numbers/Cyclic/Int31/Cyclic31.v +++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v @@ -1106,81 +1106,61 @@ Section Basics. End Basics. - -Section Int31_Op. - -(** Nullity test *) -Let w_iszero i := match i ?= 0 with Eq => true | _ => false end. - -(** Modulo [2^p] *) -Let w_pos_mod p i := - match compare31 p 31 with +Instance int31_ops : ZnZ.Ops int31 := +{ + digits := 31%positive; (* number of digits *) + zdigits := 31; (* number of digits *) + to_Z := phi; (* conversion to Z *) + of_pos := positive_to_int31; (* positive -> N*int31 : p => N,i + where p = N*2^31+phi i *) + head0 := head031; (* number of head 0 *) + tail0 := tail031; (* number of tail 0 *) + zero := 0; + one := 1; + minus_one := Tn; (* 2^31 - 1 *) + compare := compare31; + eq0 := fun i => match i ?= 0 with Eq => true | _ => false end; + opp_c := fun i => 0 -c i; + opp := opp31; + opp_carry := fun i => 0-i-1; + succ_c := fun i => i +c 1; + add_c := add31c; + add_carry_c := add31carryc; + succ := fun i => i + 1; + add := add31; + add_carry := fun i j => i + j + 1; + pred_c := fun i => i -c 1; + sub_c := sub31c; + sub_carry_c := sub31carryc; + pred := fun i => i - 1; + sub := sub31; + sub_carry := fun i j => i - j - 1; + mul_c := mul31c; + mul := mul31; + square_c := fun x => x *c x; + div21 := div3121; + div_gt := div31; (* this is supposed to be the special case of + division a/b where a > b *) + div := div31; + modulo_gt := fun i j => let (_,r) := i/j in r; + modulo := fun i j => let (_,r) := i/j in r; + gcd_gt := gcd31; + gcd := gcd31; + add_mul_div := addmuldiv31; + pos_mod := (* modulo 2^p *) + fun p i => + match p ?= 31 with | Lt => addmuldiv31 p 0 (addmuldiv31 (31-p) i 0) | _ => i - end. + end; + is_even := + fun i => let (_,r) := i/2 in + match r ?= 0 with Eq => true | _ => false end; + sqrt2 := sqrt312; + sqrt := sqrt31 +}. -(** Parity test *) -Let w_iseven i := - let (_,r) := i/2 in - match r ?= 0 with Eq => true | _ => false end. - -Definition int31_op := (mk_znz_op - 31%positive (* number of digits *) - 31 (* number of digits *) - phi (* conversion to Z *) - positive_to_int31 (* positive -> N*int31 : p => N,i where p = N*2^31+phi i *) - head031 (* number of head 0 *) - tail031 (* number of tail 0 *) - (* Basic constructors *) - 0 - 1 - Tn (* 2^31 - 1 *) - (* Comparison *) - compare31 - w_iszero - (* Basic arithmetic operations *) - (fun i => 0 -c i) - opp31 - (fun i => 0-i-1) - (fun i => i +c 1) - add31c - add31carryc - (fun i => i + 1) - add31 - (fun i j => i + j + 1) - (fun i => i -c 1) - sub31c - sub31carryc - (fun i => i - 1) - sub31 - (fun i j => i - j - 1) - mul31c - mul31 - (fun x => x *c x) - (* special (euclidian) division operations *) - div3121 - div31 (* this is supposed to be the special case of division a/b where a > b *) - div31 - (* euclidian division remainder *) - (* again special case for a > b *) - (fun i j => let (_,r) := i/j in r) - (fun i j => let (_,r) := i/j in r) - gcd31 (*gcd_gt*) - gcd31 (*gcd*) - (* shift operations *) - addmuldiv31 (*add_mul_div *) - (* modulo 2^p *) - w_pos_mod - (* is i even ? *) - w_iseven - (* square root operations *) - sqrt312 (* sqrt2 *) - sqrt31 (* sqrt *) -). - -End Int31_Op. - -Section Int31_Spec. +Section Int31_Specs. Local Open Scope Z_scope. @@ -1222,22 +1202,14 @@ Section Int31_Spec. reflexivity. Qed. - Lemma spec_Bm1 : [| Tn |] = wB - 1. + Lemma spec_m1 : [| Tn |] = wB - 1. Proof. reflexivity. Qed. Lemma spec_compare : forall x y, - match (x ?= y)%int31 with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. - Proof. - clear; unfold compare31; simpl; intros. - case_eq ([|x|] ?= [|y|]); auto. - intros; apply Zcompare_Eq_eq; auto. - Qed. + (x ?= y)%int31 = ([|x|] ?= [|y|]). + Proof. reflexivity. Qed. (** Addition *) @@ -1654,12 +1626,10 @@ Section Int31_Spec. rewrite Zmult_comm, Z_div_mult; auto with zarith. Qed. - Let w_pos_mod := int31_op.(znz_pos_mod). - Lemma spec_pos_mod : forall w p, - [|w_pos_mod p w|] = [|w|] mod (2 ^ [|p|]). + [|ZnZ.pos_mod p w|] = [|w|] mod (2 ^ [|p|]). Proof. - unfold w_pos_mod, znz_pos_mod, int31_op, compare31. + unfold ZnZ.pos_mod, int31_ops, compare31. change [|31|] with 31%Z. assert (forall w p, 31<=p -> [|w|] = [|w|] mod 2^p). intros. @@ -2018,8 +1988,8 @@ Section Int31_Spec. Proof. assert (Hp2: 0 < [|2|]) by exact (refl_equal Lt). intros rec i j Hi Hj Hij H31 Hrec; rewrite sqrt31_step_def. - generalize (spec_compare (fst (i/j)%int31) j); case compare31; - rewrite div31_phi; auto; intros Hc; + rewrite spec_compare, div31_phi; auto. + case Zcompare_spec; 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|]). @@ -2072,7 +2042,7 @@ Section Int31_Spec. [|sqrt31 x|] ^ 2 <= [|x|] < ([|sqrt31 x|] + 1) ^ 2. Proof. intros i; unfold sqrt31. - generalize (spec_compare 1 i); case compare31; change [|1|] with 1; + rewrite spec_compare. case Zcompare_spec; change [|1|] with 1; intros Hi; auto with zarith. repeat rewrite Zpower_2; auto with zarith. apply iter31_sqrt_correct; auto with zarith. @@ -2157,7 +2127,7 @@ Section Int31_Spec. unfold phi2; apply Zlt_le_trans with ([|ih|] * base)%Z; auto with zarith. apply Zmult_lt_0_compat; auto with zarith. apply Zlt_le_trans with (2:= Hih); auto with zarith. - generalize (spec_compare ih j); case compare31; intros Hc1. + rewrite spec_compare. case Zcompare_spec; intros Hc1. split; auto. apply sqrt_test_true; auto. unfold phi2, base; auto with zarith. @@ -2166,7 +2136,7 @@ Section Int31_Spec. rewrite Zmult_comm, Z_div_plus_full_l; unfold base; auto with zarith. unfold Zpower, Zpower_pos in Hj1; simpl in Hj1; auto with zarith. case (Zle_or_lt (2 ^ 30) [|j|]); intros Hjj. - generalize (spec_compare (fst (div3121 ih il j)) j); case compare31; + rewrite spec_compare; case Zcompare_spec; rewrite div312_phi; auto; intros Hc; try (split; auto; apply sqrt_test_true; auto with zarith; fail). apply Hrec. @@ -2300,7 +2270,7 @@ Section Int31_Spec. generalize (spec_sub_c il il1). case sub31c; intros il2 Hil2. simpl interp_carry in Hil2. - generalize (spec_compare ih ih1); case compare31. + rewrite spec_compare; case Zcompare_spec. unfold interp_carry. intros H1; split. rewrite Zpower_2, <- Hihl1. @@ -2347,7 +2317,7 @@ Section Int31_Spec. case (phi_bounded ih); intros H1 H2. generalize Hih; change (2 ^ Z_of_nat size / 4) with 536870912. split; auto with zarith. - generalize (spec_compare (ih - 1) ih1); case compare31. + rewrite spec_compare; case Zcompare_spec. rewrite Hsih. intros H1; split. rewrite Zpower_2, <- Hihl1. @@ -2418,11 +2388,9 @@ Section Int31_Spec. (** [iszero] *) - Let w_eq0 := int31_op.(znz_eq0). - - Lemma spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. + Lemma spec_eq0 : forall x, ZnZ.eq0 x = true -> [|x|] = 0. Proof. - clear; unfold w_eq0, znz_eq0; simpl. + clear; unfold ZnZ.eq0; simpl. unfold compare31; simpl; intros. change [|0|] with 0 in H. apply Zcompare_Eq_eq. @@ -2431,12 +2399,10 @@ Section Int31_Spec. (* Even *) - Let w_is_even := int31_op.(znz_is_even). - Lemma spec_is_even : forall x, - if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. + if ZnZ.is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. Proof. - unfold w_is_even; simpl; intros. + unfold ZnZ.is_even; simpl; intros. generalize (spec_div x 2). destruct (x/2)%int31 as (q,r); intros. unfold compare31. @@ -2445,77 +2411,60 @@ Section Int31_Spec. destruct H; auto with zarith. replace ([|x|] mod 2) with [|r|]. destruct H; auto with zarith. - case_eq ([|r|] ?= 0)%Z; intros. - apply Zcompare_Eq_eq; auto. - change ([|r|] < 0)%Z in H; auto with zarith. - change ([|r|] > 0)%Z in H; auto with zarith. + case Zcompare_spec; auto with zarith. apply Zmod_unique with [|q|]; auto with zarith. Qed. - Definition int31_spec : znz_spec int31_op. - split. - exact phi_bounded. - exact positive_to_int31_spec. - exact spec_zdigits. - exact spec_more_than_1_digit. - - exact spec_0. - exact spec_1. - exact spec_Bm1. - - exact spec_compare. - exact spec_eq0. - - exact spec_opp_c. - exact spec_opp. - exact spec_opp_carry. - - exact spec_succ_c. - exact spec_add_c. - exact spec_add_carry_c. - exact spec_succ. - exact spec_add. - exact spec_add_carry. - - exact spec_pred_c. - exact spec_sub_c. - exact spec_sub_carry_c. - exact spec_pred. - exact spec_sub. - exact spec_sub_carry. - - exact spec_mul_c. - exact spec_mul. - exact spec_square_c. - - exact spec_div21. - intros; apply spec_div; auto. - exact spec_div. - - intros; unfold int31_op; simpl; apply spec_mod; auto. - exact spec_mod. - - intros; apply spec_gcd; auto. - exact spec_gcd. - - exact spec_head00. - exact spec_head0. - exact spec_tail00. - exact spec_tail0. - - exact spec_add_mul_div. - exact spec_pos_mod. - - exact spec_is_even. - exact spec_sqrt2. - exact spec_sqrt. - Qed. - -End Int31_Spec. + Global Instance int31_specs : ZnZ.Specs int31_ops := { + spec_to_Z := phi_bounded; + spec_of_pos := positive_to_int31_spec; + spec_zdigits := spec_zdigits; + spec_more_than_1_digit := spec_more_than_1_digit; + spec_0 := spec_0; + spec_1 := spec_1; + spec_m1 := spec_m1; + spec_compare := spec_compare; + spec_eq0 := spec_eq0; + spec_opp_c := spec_opp_c; + spec_opp := spec_opp; + spec_opp_carry := spec_opp_carry; + spec_succ_c := spec_succ_c; + spec_add_c := spec_add_c; + spec_add_carry_c := spec_add_carry_c; + spec_succ := spec_succ; + spec_add := spec_add; + spec_add_carry := spec_add_carry; + spec_pred_c := spec_pred_c; + spec_sub_c := spec_sub_c; + spec_sub_carry_c := spec_sub_carry_c; + spec_pred := spec_pred; + spec_sub := spec_sub; + spec_sub_carry := spec_sub_carry; + spec_mul_c := spec_mul_c; + spec_mul := spec_mul; + spec_square_c := spec_square_c; + spec_div21 := spec_div21; + spec_div_gt := fun a b _ => spec_div a b; + spec_div := spec_div; + spec_modulo_gt := fun a b _ => spec_mod a b; + spec_modulo := spec_mod; + spec_gcd_gt := fun a b _ => spec_gcd a b; + spec_gcd := spec_gcd; + spec_head00 := spec_head00; + spec_head0 := spec_head0; + spec_tail00 := spec_tail00; + spec_tail0 := spec_tail0; + spec_add_mul_div := spec_add_mul_div; + spec_pos_mod := spec_pos_mod; + spec_is_even := spec_is_even; + spec_sqrt2 := spec_sqrt2; + spec_sqrt := spec_sqrt }. + +End Int31_Specs. Module Int31Cyclic <: CyclicType. - Definition w := int31. - Definition w_op := int31_op. - Definition w_spec := int31_spec. + Definition t := int31. + Definition ops := int31_ops. + Definition specs := int31_specs. End Int31Cyclic. diff --git a/theories/Numbers/Cyclic/Int31/Ring31.v b/theories/Numbers/Cyclic/Int31/Ring31.v index 2ec406b0f1..a9c499fb95 100644 --- a/theories/Numbers/Cyclic/Int31/Ring31.v +++ b/theories/Numbers/Cyclic/Int31/Ring31.v @@ -83,9 +83,10 @@ 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. +rewrite Cyclic31.spec_compare. case Zcompare_spec. +intuition. apply Int31_canonic; auto. +intuition; subst; auto with zarith; try discriminate. +intuition; subst; auto with zarith; try discriminate. Qed. Lemma eqb31_correct : forall x y, eqb31 x y = true -> x=y. diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v index 4f0f6c7c49..da0be5e2ab 100644 --- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v +++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v @@ -33,25 +33,23 @@ Section ZModulo. Definition wB := base digits. - Definition znz := Z. - Definition znz_digits := digits. - Definition znz_zdigits := Zpos digits. - Definition znz_to_Z x := x mod wB. + Definition t := Z. + Definition zdigits := Zpos digits. + Definition to_Z x := x mod wB. - Notation "[| x |]" := (znz_to_Z x) (at level 0, x at level 99). + Notation "[| x |]" := (to_Z x) (at level 0, x at level 99). Notation "[+| c |]" := - (interp_carry 1 wB znz_to_Z c) (at level 0, x at level 99). + (interp_carry 1 wB to_Z c) (at level 0, x at level 99). Notation "[-| c |]" := - (interp_carry (-1) wB znz_to_Z c) (at level 0, x at level 99). + (interp_carry (-1) wB to_Z c) (at level 0, x at level 99). Notation "[|| x ||]" := - (zn2z_to_Z wB znz_to_Z x) (at level 0, x at level 99). + (zn2z_to_Z wB to_Z x) (at level 0, x at level 99). Lemma spec_more_than_1_digit: 1 < Zpos digits. Proof. - unfold znz_digits. generalize digits_ne_1; destruct digits; auto. destruct 1; auto. Qed. @@ -65,12 +63,12 @@ Section ZModulo. Lemma spec_to_Z_1 : forall x, 0 <= [|x|]. Proof. - unfold znz_to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto. + unfold to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto. Qed. Lemma spec_to_Z_2 : forall x, [|x|] < wB. Proof. - unfold znz_to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto. + unfold to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto. Qed. Hint Resolve spec_to_Z_1 spec_to_Z_2. @@ -79,16 +77,16 @@ Section ZModulo. auto. Qed. - Definition znz_of_pos x := + Definition of_pos x := let (q,r) := Zdiv_eucl_POS x wB in (N_of_Z q, r). Lemma spec_of_pos : forall p, - Zpos p = (Z_of_N (fst (znz_of_pos p)))*wB + [|(snd (znz_of_pos p))|]. + Zpos p = (Z_of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]. Proof. - intros; unfold znz_of_pos; simpl. + intros; unfold of_pos; simpl. generalize (Z_div_mod_POS wB wB_pos p). destruct (Zdiv_eucl_POS p wB); simpl; destruct 1. - unfold znz_to_Z; rewrite Zmod_small; auto. + unfold to_Z; rewrite Zmod_small; auto. assert (0 <= z). replace z with (Zpos p / wB) by (symmetry; apply Zdiv_unique with z0; auto). @@ -98,37 +96,37 @@ Section ZModulo. rewrite Zmult_comm; auto. Qed. - Lemma spec_zdigits : [|znz_zdigits|] = Zpos znz_digits. + Lemma spec_zdigits : [|zdigits|] = Zpos digits. Proof. - unfold znz_to_Z, znz_zdigits, znz_digits. + unfold to_Z, zdigits. apply Zmod_small. unfold wB, base. split; auto with zarith. apply Zpower2_lt_lin; auto with zarith. Qed. - Definition znz_0 := 0. - Definition znz_1 := 1. - Definition znz_Bm1 := wB - 1. + Definition zero := 0. + Definition one := 1. + Definition minus_one := wB - 1. - Lemma spec_0 : [|znz_0|] = 0. + Lemma spec_0 : [|zero|] = 0. Proof. - unfold znz_to_Z, znz_0. + unfold to_Z, zero. apply Zmod_small; generalize wB_pos; auto with zarith. Qed. - Lemma spec_1 : [|znz_1|] = 1. + Lemma spec_1 : [|one|] = 1. Proof. - unfold znz_to_Z, znz_1. + unfold to_Z, one. apply Zmod_small; split; auto with zarith. unfold wB, base. apply Zlt_trans with (Zpos digits); auto. apply Zpower2_lt_lin; auto with zarith. Qed. - Lemma spec_Bm1 : [|znz_Bm1|] = wB - 1. + Lemma spec_Bm1 : [|minus_one|] = wB - 1. Proof. - unfold znz_to_Z, znz_Bm1. + unfold to_Z, minus_one. apply Zmod_small; split; auto with zarith. unfold wB, base. cut (1 <= 2 ^ Zpos digits); auto with zarith. @@ -136,54 +134,46 @@ Section ZModulo. apply Zpower2_le_lin; auto with zarith. Qed. - Definition znz_compare x y := Zcompare [|x|] [|y|]. + Definition compare x y := Zcompare [|x|] [|y|]. Lemma spec_compare : forall x y, - match znz_compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. - Proof. - intros; unfold znz_compare, Zlt, Zgt. - case_eq (Zcompare [|x|] [|y|]); auto. - intros; apply Zcompare_Eq_eq; auto. - Qed. + compare x y = Zcompare [|x|] [|y|]. + Proof. reflexivity. Qed. - Definition znz_eq0 x := + Definition eq0 x := match [|x|] with Z0 => true | _ => false end. - Lemma spec_eq0 : forall x, znz_eq0 x = true -> [|x|] = 0. + Lemma spec_eq0 : forall x, eq0 x = true -> [|x|] = 0. Proof. - unfold znz_eq0; intros; now destruct [|x|]. + unfold eq0; intros; now destruct [|x|]. Qed. - 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. + Definition opp_c x := + if eq0 x then C0 0 else C1 (- x). + Definition opp x := - x. + Definition opp_carry x := - x - 1. - Lemma spec_opp_c : forall x, [-|znz_opp_c x|] = -[|x|]. + Lemma spec_opp_c : forall x, [-|opp_c x|] = -[|x|]. Proof. - intros; unfold znz_opp_c, znz_to_Z; auto. - case_eq (znz_eq0 x); intros; unfold interp_carry. + intros; unfold opp_c, to_Z; auto. + case_eq (eq0 x); intros; unfold interp_carry. fold [|x|]; rewrite (spec_eq0 x H); auto. assert (x mod wB <> 0). - unfold znz_eq0, znz_to_Z in H. + unfold eq0, to_Z in H. intro H0; rewrite H0 in H; discriminate. rewrite Z_mod_nz_opp_full; auto with zarith. Qed. - Lemma spec_opp : forall x, [|znz_opp x|] = (-[|x|]) mod wB. + Lemma spec_opp : forall x, [|opp x|] = (-[|x|]) mod wB. Proof. - intros; unfold znz_opp, znz_to_Z; auto. + intros; unfold opp, to_Z; auto. 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. + Lemma spec_opp_carry : forall x, [|opp_carry x|] = wB - [|x|] - 1. Proof. - intros; unfold znz_opp_carry, znz_to_Z; auto. + intros; unfold opp_carry, to_Z; auto. replace (- x - 1) with (- 1 - x) by omega. rewrite <- Zminus_mod_idemp_r. replace ( -1 - x mod wB) with (0 + ( -1 - x mod wB)) by omega. @@ -194,21 +184,21 @@ Section ZModulo. generalize (Z_mod_lt x wB wB_pos); omega. Qed. - Definition znz_succ_c x := + Definition succ_c x := let y := Zsucc x in - if znz_eq0 y then C1 0 else C0 y. + if eq0 y then C1 0 else C0 y. - Definition znz_add_c x y := + Definition 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 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). - Definition znz_succ := Zsucc. - Definition znz_add := Zplus. - Definition znz_add_carry x y := x + y + 1. + Definition succ := Zsucc. + Definition add := Zplus. + Definition add_carry x y := x + y + 1. Lemma Zmod_equal : forall x y z, z>0 -> (x-y) mod z = 0 -> x mod z = y mod z. @@ -221,10 +211,10 @@ Section ZModulo. rewrite Zplus_comm, Zmult_comm, Z_mod_plus; auto. Qed. - Lemma spec_succ_c : forall x, [+|znz_succ_c x|] = [|x|] + 1. + Lemma spec_succ_c : forall x, [+|succ_c x|] = [|x|] + 1. Proof. - intros; unfold znz_succ_c, znz_to_Z, Zsucc. - case_eq (znz_eq0 (x+1)); intros; unfold interp_carry. + intros; unfold succ_c, to_Z, Zsucc. + case_eq (eq0 (x+1)); intros; unfold interp_carry. rewrite Zmult_1_l. replace (wB + 0 mod wB) with wB by auto with zarith. @@ -236,7 +226,7 @@ Section ZModulo. apply Zmod_equal; auto. assert ((x+1) mod wB <> 0). - unfold znz_eq0, znz_to_Z in *; now destruct ((x+1) mod wB). + unfold eq0, to_Z in *; now destruct ((x+1) mod wB). assert (x mod wB + 1 <> wB). contradict H0. rewrite Zeq_plus_swap in H0; simpl in H0. @@ -247,9 +237,9 @@ Section ZModulo. generalize (Z_mod_lt x wB wB_pos); omega. Qed. - Lemma spec_add_c : forall x y, [+|znz_add_c x y|] = [|x|] + [|y|]. + Lemma spec_add_c : forall x y, [+|add_c x y|] = [|x|] + [|y|]. Proof. - intros; unfold znz_add_c, znz_to_Z, interp_carry. + intros; unfold add_c, to_Z, interp_carry. destruct Z_lt_le_dec. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. @@ -258,9 +248,9 @@ Section ZModulo. generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. Qed. - Lemma spec_add_carry_c : forall x y, [+|znz_add_carry_c x y|] = [|x|] + [|y|] + 1. + Lemma spec_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|] + [|y|] + 1. Proof. - intros; unfold znz_add_carry_c, znz_to_Z, interp_carry. + intros; unfold add_carry_c, to_Z, interp_carry. destruct Z_lt_le_dec. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. @@ -269,59 +259,59 @@ Section ZModulo. generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. Qed. - Lemma spec_succ : forall x, [|znz_succ x|] = ([|x|] + 1) mod wB. + Lemma spec_succ : forall x, [|succ x|] = ([|x|] + 1) mod wB. Proof. - intros; unfold znz_succ, znz_to_Z, Zsucc. + intros; unfold succ, to_Z, Zsucc. symmetry; apply Zplus_mod_idemp_l. Qed. - Lemma spec_add : forall x y, [|znz_add x y|] = ([|x|] + [|y|]) mod wB. + Lemma spec_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wB. Proof. - intros; unfold znz_add, znz_to_Z; apply Zplus_mod. + intros; unfold add, to_Z; apply Zplus_mod. Qed. Lemma spec_add_carry : - forall x y, [|znz_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB. + forall x y, [|add_carry x y|] = ([|x|] + [|y|] + 1) mod wB. Proof. - intros; unfold znz_add_carry, znz_to_Z. + intros; unfold add_carry, to_Z. rewrite <- Zplus_mod_idemp_l. rewrite (Zplus_mod x y). rewrite Zplus_mod_idemp_l; auto. Qed. - Definition znz_pred_c x := - if znz_eq0 x then C1 (wB-1) else C0 (x-1). + Definition pred_c x := + if eq0 x then C1 (wB-1) else C0 (x-1). - Definition znz_sub_c x y := + Definition 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 := + Definition 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. - Definition znz_sub := Zminus. - Definition znz_sub_carry x y := x - y - 1. + Definition pred := Zpred. + Definition sub := Zminus. + Definition sub_carry x y := x - y - 1. - Lemma spec_pred_c : forall x, [-|znz_pred_c x|] = [|x|] - 1. + Lemma spec_pred_c : forall x, [-|pred_c x|] = [|x|] - 1. Proof. - intros; unfold znz_pred_c, znz_to_Z, interp_carry. - case_eq (znz_eq0 x); intros. + intros; unfold pred_c, to_Z, interp_carry. + case_eq (eq0 x); intros. fold [|x|]; rewrite spec_eq0; auto. replace ((wB-1) mod wB) with (wB-1); auto with zarith. symmetry; apply Zmod_small; generalize wB_pos; omega. assert (x mod wB <> 0). - unfold znz_eq0, znz_to_Z in *; now destruct (x mod wB). + unfold eq0, to_Z in *; now destruct (x mod wB). rewrite <- Zminus_mod_idemp_l. apply Zmod_small. generalize (Z_mod_lt x wB wB_pos); omega. Qed. - Lemma spec_sub_c : forall x y, [-|znz_sub_c x y|] = [|x|] - [|y|]. + Lemma spec_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|]. Proof. - intros; unfold znz_sub_c, znz_to_Z, interp_carry. + intros; unfold sub_c, to_Z, interp_carry. destruct Z_lt_le_dec. replace ((wB + (x mod wB - y mod wB)) mod wB) with (wB + (x mod wB - y mod wB)). @@ -333,9 +323,9 @@ Section ZModulo. generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. Qed. - Lemma spec_sub_carry_c : forall x y, [-|znz_sub_carry_c x y|] = [|x|] - [|y|] - 1. + Lemma spec_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|] - [|y|] - 1. Proof. - intros; unfold znz_sub_carry_c, znz_to_Z, interp_carry. + intros; unfold sub_carry_c, to_Z, interp_carry. destruct Z_lt_le_dec. replace ((wB + (x mod wB - y mod wB - 1)) mod wB) with (wB + (x mod wB - y mod wB -1)). @@ -347,38 +337,38 @@ Section ZModulo. generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. Qed. - Lemma spec_pred : forall x, [|znz_pred x|] = ([|x|] - 1) mod wB. + Lemma spec_pred : forall x, [|pred x|] = ([|x|] - 1) mod wB. Proof. - intros; unfold znz_pred, znz_to_Z, Zpred. + intros; unfold pred, to_Z, Zpred. rewrite <- Zplus_mod_idemp_l; auto. Qed. - Lemma spec_sub : forall x y, [|znz_sub x y|] = ([|x|] - [|y|]) mod wB. + Lemma spec_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wB. Proof. - intros; unfold znz_sub, znz_to_Z; apply Zminus_mod. + intros; unfold sub, to_Z; apply Zminus_mod. Qed. Lemma spec_sub_carry : - forall x y, [|znz_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB. + forall x y, [|sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB. Proof. - intros; unfold znz_sub_carry, znz_to_Z. + intros; unfold sub_carry, to_Z. rewrite <- Zminus_mod_idemp_l. rewrite (Zminus_mod x y). rewrite Zminus_mod_idemp_l. auto. Qed. - Definition znz_mul_c x y := + Definition 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. + if eq0 h then if eq0 l then W0 else WW h l else WW h l. - Definition znz_mul := Zmult. + Definition mul := Zmult. - Definition znz_square_c x := znz_mul_c x x. + Definition square_c x := mul_c x x. - Lemma spec_mul_c : forall x y, [|| znz_mul_c x y ||] = [|x|] * [|y|]. + Lemma spec_mul_c : forall x y, [|| mul_c x y ||] = [|x|] * [|y|]. Proof. - intros; unfold znz_mul_c, zn2z_to_Z. + intros; unfold mul_c, zn2z_to_Z. assert (Zdiv_eucl ([|x|]*[|y|]) wB = (([|x|]*[|y|])/wB,([|x|]*[|y|]) mod wB)). unfold Zmod, Zdiv; destruct Zdiv_eucl; auto. generalize (Z_div_mod ([|x|]*[|y|]) wB wB_pos); destruct Zdiv_eucl as (h,l). @@ -394,31 +384,31 @@ Section ZModulo. apply Zdiv_lt_upper_bound; auto with zarith. apply Zmult_lt_compat; auto with zarith. clear H H0 H1 H2. - case_eq (znz_eq0 h); simpl; intros. - case_eq (znz_eq0 l); simpl; intros. + case_eq (eq0 h); simpl; intros. + case_eq (eq0 l); simpl; intros. rewrite <- H3, <- H4, (spec_eq0 h), (spec_eq0 l); auto with zarith. rewrite H3, H4; auto with zarith. rewrite H3, H4; auto with zarith. Qed. - Lemma spec_mul : forall x y, [|znz_mul x y|] = ([|x|] * [|y|]) mod wB. + Lemma spec_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wB. Proof. - intros; unfold znz_mul, znz_to_Z; apply Zmult_mod. + intros; unfold mul, to_Z; apply Zmult_mod. Qed. - Lemma spec_square_c : forall x, [|| znz_square_c x||] = [|x|] * [|x|]. + Lemma spec_square_c : forall x, [|| square_c x||] = [|x|] * [|x|]. Proof. intros x; exact (spec_mul_c x x). Qed. - Definition znz_div x y := Zdiv_eucl [|x|] [|y|]. + Definition div x y := Zdiv_eucl [|x|] [|y|]. Lemma spec_div : forall a b, 0 < [|b|] -> - let (q,r) := znz_div a b in + let (q,r) := div a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. - intros; unfold znz_div. + intros; unfold div. assert ([|b|]>0) by auto with zarith. assert (Zdiv_eucl [|a|] [|b|] = ([|a|]/[|b|], [|a|] mod [|b|])). unfold Zmod, Zdiv; destruct Zdiv_eucl; auto. @@ -440,10 +430,10 @@ Section ZModulo. rewrite H5, H6; rewrite Zmult_comm; auto with zarith. Qed. - Definition znz_div_gt := znz_div. + Definition div_gt := div. Lemma spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> - let (q,r) := znz_div_gt a b in + let (q,r) := div_gt a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. @@ -451,27 +441,27 @@ Section ZModulo. apply spec_div; auto. Qed. - Definition znz_mod x y := [|x|] mod [|y|]. - Definition znz_mod_gt x y := [|x|] mod [|y|]. + Definition modulo x y := [|x|] mod [|y|]. + Definition modulo_gt x y := [|x|] mod [|y|]. - Lemma spec_mod : forall a b, 0 < [|b|] -> - [|znz_mod a b|] = [|a|] mod [|b|]. + Lemma spec_modulo : forall a b, 0 < [|b|] -> + [|modulo a b|] = [|a|] mod [|b|]. Proof. - intros; unfold znz_mod. + intros; unfold modulo. apply Zmod_small. assert ([|b|]>0) by auto with zarith. generalize (Z_mod_lt [|a|] [|b|] H0) (Z_mod_lt b wB wB_pos). fold [|b|]; omega. Qed. - Lemma spec_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> - [|znz_mod_gt a b|] = [|a|] mod [|b|]. + Lemma spec_modulo_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> + [|modulo_gt a b|] = [|a|] mod [|b|]. Proof. - intros; apply spec_mod; auto. + intros; apply spec_modulo; auto. Qed. - Definition znz_gcd x y := Zgcd [|x|] [|y|]. - Definition znz_gcd_gt x y := Zgcd [|x|] [|y|]. + Definition gcd x y := Zgcd [|x|] [|y|]. + Definition gcd_gt x y := Zgcd [|x|] [|y|]. Lemma Zgcd_bound : forall a b, 0<=a -> 0<=b -> Zgcd a b <= Zmax a b. Proof. @@ -495,9 +485,9 @@ Section ZModulo. generalize (Zmax_spec a b); omega. Qed. - Lemma spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|znz_gcd a b|]. + Lemma spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|]. Proof. - intros; unfold znz_gcd. + intros; unfold gcd. generalize (Z_mod_lt a wB wB_pos)(Z_mod_lt b wB wB_pos); intros. fold [|a|] in *; fold [|b|] in *. replace ([|Zgcd [|a|] [|b|]|]) with (Zgcd [|a|] [|b|]). @@ -511,22 +501,22 @@ Section ZModulo. Qed. Lemma spec_gcd_gt : forall a b, [|a|] > [|b|] -> - Zis_gcd [|a|] [|b|] [|znz_gcd_gt a b|]. + Zis_gcd [|a|] [|b|] [|gcd_gt a b|]. Proof. intros. apply spec_gcd; auto. Qed. - Definition znz_div21 a1 a2 b := + Definition div21 a1 a2 b := Zdiv_eucl ([|a1|]*wB+[|a2|]) [|b|]. Lemma spec_div21 : forall a1 a2 b, wB/2 <= [|b|] -> [|a1|] < [|b|] -> - let (q,r) := znz_div21 a1 a2 b in + let (q,r) := div21 a1 a2 b in [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. - intros; unfold znz_div21. + intros; unfold div21. generalize (Z_mod_lt a1 wB wB_pos); fold [|a1|]; intros. generalize (Z_mod_lt a2 wB wB_pos); fold [|a2|]; intros. assert ([|b|]>0) by auto with zarith. @@ -552,22 +542,22 @@ Section ZModulo. rewrite H8, H9; rewrite Zmult_comm; auto with zarith. Qed. - Definition znz_add_mul_div p x y := - ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos znz_digits) - [|p|]))). + Definition add_mul_div p x y := + ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos digits) - [|p|]))). Lemma spec_add_mul_div : forall x y p, - [|p|] <= Zpos znz_digits -> - [| znz_add_mul_div p x y |] = + [|p|] <= Zpos digits -> + [| add_mul_div p x y |] = ([|x|] * (2 ^ [|p|]) + - [|y|] / (2 ^ ((Zpos znz_digits) - [|p|]))) mod wB. + [|y|] / (2 ^ ((Zpos digits) - [|p|]))) mod wB. Proof. - intros; unfold znz_add_mul_div; auto. + intros; unfold add_mul_div; auto. Qed. - Definition znz_pos_mod p w := [|w|] mod (2 ^ [|p|]). + Definition pos_mod p w := [|w|] mod (2 ^ [|p|]). Lemma spec_pos_mod : forall w p, - [|znz_pos_mod p w|] = [|w|] mod (2 ^ [|p|]). + [|pos_mod p w|] = [|w|] mod (2 ^ [|p|]). Proof. - intros; unfold znz_pos_mod. + intros; unfold pos_mod. apply Zmod_small. generalize (Z_mod_lt [|w|] (2 ^ [|p|])); intros. split. @@ -576,22 +566,22 @@ Section ZModulo. apply Zmod_le; auto with zarith. Qed. - Definition znz_is_even x := + Definition is_even x := if Z_eq_dec ([|x|] mod 2) 0 then true else false. Lemma spec_is_even : forall x, - if znz_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. + if is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. Proof. - intros; unfold znz_is_even; destruct Z_eq_dec; auto. + intros; unfold is_even; destruct Z_eq_dec; auto. generalize (Z_mod_lt [|x|] 2); omega. Qed. - Definition znz_sqrt x := Zsqrt_plain [|x|]. + Definition sqrt x := Zsqrt_plain [|x|]. Lemma spec_sqrt : forall x, - [|znz_sqrt x|] ^ 2 <= [|x|] < ([|znz_sqrt x|] + 1) ^ 2. + [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2. Proof. intros. - unfold znz_sqrt. + unfold sqrt. repeat rewrite Zpower_2. replace [|Zsqrt_plain [|x|]|] with (Zsqrt_plain [|x|]). apply Zsqrt_interval; auto with zarith. @@ -609,7 +599,7 @@ Section ZModulo. generalize wB_pos; auto with zarith. Qed. - Definition znz_sqrt2 x y := + Definition sqrt2 x y := let z := [|x|]*wB+[|y|] in match z with | Z0 => (0, C0 0) @@ -621,11 +611,11 @@ Section ZModulo. Lemma spec_sqrt2 : forall x y, wB/ 4 <= [|x|] -> - let (s,r) := znz_sqrt2 x y in + let (s,r) := sqrt2 x y in [||WW x y||] = [|s|] ^ 2 + [+|r|] /\ [+|r|] <= 2 * [|s|]. Proof. - intros; unfold znz_sqrt2. + intros; unfold sqrt2. simpl zn2z_to_Z. remember ([|x|]*wB+[|y|]) as z. destruct z. @@ -665,15 +655,15 @@ Section ZModulo. apply two_power_pos_correct. Qed. - Definition znz_head0 x := match [|x|] with - | Z0 => znz_zdigits - | Zpos p => znz_zdigits - log_inf p - 1 + Definition head0 x := match [|x|] with + | Z0 => zdigits + | Zpos p => zdigits - log_inf p - 1 | _ => 0 end. - Lemma spec_head00: forall x, [|x|] = 0 -> [|znz_head0 x|] = Zpos znz_digits. + Lemma spec_head00: forall x, [|x|] = 0 -> [|head0 x|] = Zpos digits. Proof. - unfold znz_head0; intros. + unfold head0; intros. rewrite H; simpl. apply spec_zdigits. Qed. @@ -701,43 +691,43 @@ Section ZModulo. Lemma spec_head0 : forall x, 0 < [|x|] -> - wB/ 2 <= 2 ^ ([|znz_head0 x|]) * [|x|] < wB. + wB/ 2 <= 2 ^ ([|head0 x|]) * [|x|] < wB. Proof. - intros; unfold znz_head0. + intros; unfold head0. generalize (spec_to_Z x). destruct [|x|]; try discriminate. intros. destruct (log_inf_correct p). rewrite 2 two_p_power2 in H2; auto with zarith. - assert (0 <= znz_zdigits - log_inf p - 1 < wB). + assert (0 <= zdigits - log_inf p - 1 < wB). split. - cut (log_inf p < znz_zdigits); try omega. - unfold znz_zdigits. + cut (log_inf p < zdigits); try omega. + unfold zdigits. unfold wB, base in *. apply log_inf_bounded; auto with zarith. - apply Zlt_trans with znz_zdigits. + apply Zlt_trans with zdigits. omega. - unfold znz_zdigits, wB, base; apply Zpower2_lt_lin; auto with zarith. + unfold zdigits, wB, base; apply Zpower2_lt_lin; auto with zarith. - unfold znz_to_Z; rewrite (Zmod_small _ _ H3). + unfold to_Z; rewrite (Zmod_small _ _ H3). destruct H2. split. - apply Zle_trans with (2^(znz_zdigits - log_inf p - 1)*(2^log_inf p)). + apply Zle_trans with (2^(zdigits - log_inf p - 1)*(2^log_inf p)). apply Zdiv_le_upper_bound; auto with zarith. rewrite <- Zpower_exp; auto with zarith. rewrite Zmult_comm; rewrite <- Zpower_Zsucc; auto with zarith. - replace (Zsucc (znz_zdigits - log_inf p -1 +log_inf p)) with znz_zdigits + replace (Zsucc (zdigits - log_inf p -1 +log_inf p)) with zdigits by ring. - unfold wB, base, znz_zdigits; auto with zarith. + unfold wB, base, zdigits; auto with zarith. apply Zmult_le_compat; auto with zarith. apply Zlt_le_trans - with (2^(znz_zdigits - log_inf p - 1)*(2^(Zsucc (log_inf p)))). + with (2^(zdigits - log_inf p - 1)*(2^(Zsucc (log_inf p)))). apply Zmult_lt_compat_l; auto with zarith. rewrite <- Zpower_exp; auto with zarith. - replace (znz_zdigits - log_inf p -1 +Zsucc (log_inf p)) with znz_zdigits + replace (zdigits - log_inf p -1 +Zsucc (log_inf p)) with zdigits by ring. - unfold wB, base, znz_zdigits; auto with zarith. + unfold wB, base, zdigits; auto with zarith. Qed. Fixpoint Ptail p := match p with @@ -774,24 +764,24 @@ Section ZModulo. rewrite <- H1; omega. Qed. - Definition znz_tail0 x := + Definition tail0 x := match [|x|] with - | Z0 => znz_zdigits + | Z0 => zdigits | Zpos p => Ptail p | Zneg _ => 0 end. - Lemma spec_tail00: forall x, [|x|] = 0 -> [|znz_tail0 x|] = Zpos znz_digits. + Lemma spec_tail00: forall x, [|x|] = 0 -> [|tail0 x|] = Zpos digits. Proof. - unfold znz_tail0; intros. + unfold tail0; intros. rewrite H; simpl. apply spec_zdigits. Qed. Lemma spec_tail0 : forall x, 0 < [|x|] -> - exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|znz_tail0 x|]). + exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail0 x|]). Proof. - intros; unfold znz_tail0. + intros; unfold tail0. generalize (spec_to_Z x). destruct [|x|]; try discriminate; intros. assert ([|Ptail p|] = Ptail p). @@ -818,60 +808,60 @@ Section ZModulo. (** Let's now group everything in two records *) - Definition zmod_op := mk_znz_op - (znz_digits : positive) - (znz_zdigits: znz) - (znz_to_Z : znz -> Z) - (znz_of_pos : positive -> N * znz) - (znz_head0 : znz -> znz) - (znz_tail0 : znz -> znz) - - (znz_0 : znz) - (znz_1 : znz) - (znz_Bm1 : znz) - - (znz_compare : znz -> znz -> comparison) - (znz_eq0 : znz -> bool) - - (znz_opp_c : znz -> carry znz) - (znz_opp : znz -> znz) - (znz_opp_carry : znz -> znz) - - (znz_succ_c : znz -> carry znz) - (znz_add_c : znz -> znz -> carry znz) - (znz_add_carry_c : znz -> znz -> carry znz) - (znz_succ : znz -> znz) - (znz_add : znz -> znz -> znz) - (znz_add_carry : znz -> znz -> znz) - - (znz_pred_c : znz -> carry znz) - (znz_sub_c : znz -> znz -> carry znz) - (znz_sub_carry_c : znz -> znz -> carry znz) - (znz_pred : znz -> znz) - (znz_sub : znz -> znz -> znz) - (znz_sub_carry : znz -> znz -> znz) - - (znz_mul_c : znz -> znz -> zn2z znz) - (znz_mul : znz -> znz -> znz) - (znz_square_c : znz -> zn2z znz) - - (znz_div21 : znz -> znz -> znz -> znz*znz) - (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_gcd_gt : znz -> znz -> znz) - (znz_gcd : znz -> znz -> znz) - (znz_add_mul_div : znz -> znz -> znz -> znz) - (znz_pos_mod : znz -> znz -> znz) - - (znz_is_even : znz -> bool) - (znz_sqrt2 : znz -> znz -> znz * carry znz) - (znz_sqrt : znz -> znz). - - Definition zmod_spec := mk_znz_spec zmod_op + Instance zmod_ops : ZnZ.Ops Z := ZnZ.MkOps + (digits : positive) + (zdigits: t) + (to_Z : t -> Z) + (of_pos : positive -> N * t) + (head0 : t -> t) + (tail0 : t -> t) + + (zero : t) + (one : t) + (minus_one : t) + + (compare : t -> t -> comparison) + (eq0 : t -> bool) + + (opp_c : t -> carry t) + (opp : t -> t) + (opp_carry : t -> t) + + (succ_c : t -> carry t) + (add_c : t -> t -> carry t) + (add_carry_c : t -> t -> carry t) + (succ : t -> t) + (add : t -> t -> t) + (add_carry : t -> t -> t) + + (pred_c : t -> carry t) + (sub_c : t -> t -> carry t) + (sub_carry_c : t -> t -> carry t) + (pred : t -> t) + (sub : t -> t -> t) + (sub_carry : t -> t -> t) + + (mul_c : t -> t -> zn2z t) + (mul : t -> t -> t) + (square_c : t -> zn2z t) + + (div21 : t -> t -> t -> t*t) + (div_gt : t -> t -> t * t) + (div : t -> t -> t * t) + + (modulo_gt : t -> t -> t) + (modulo : t -> t -> t) + + (gcd_gt : t -> t -> t) + (gcd : t -> t -> t) + (add_mul_div : t -> t -> t -> t) + (pos_mod : t -> t -> t) + + (is_even : t -> bool) + (sqrt2 : t -> t -> t * carry t) + (sqrt : t -> t). + + Instance zmod_specs : ZnZ.Specs zmod_ops := ZnZ.MkSpecs spec_to_Z spec_of_pos spec_zdigits @@ -910,8 +900,8 @@ Section ZModulo. spec_div_gt spec_div - spec_mod_gt - spec_mod + spec_modulo_gt + spec_modulo spec_gcd_gt spec_gcd @@ -934,12 +924,12 @@ 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. - Definition w := Z. - Definition w_op := zmod_op P.p. - Definition w_spec := zmod_spec P.not_one. + Definition t := Z. + Instance ops : ZnZ.Ops t := zmod_ops P.p. + Instance specs : ZnZ.Specs ops := zmod_specs P.not_one. End ZModuloCyclicType. diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v index 925b0535ac..b3f7befc8c 100644 --- a/theories/Numbers/Natural/BigN/NMake.v +++ b/theories/Numbers/Natural/BigN/NMake.v @@ -16,18 +16,204 @@ 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. +Require Import BigNumPrelude ZArith CyclicAxioms DoubleType + Nbasic Wf_nat StreamMemo NSig NMake_gen. -Module Make (Import W0:CyclicType) <: NType. +Module Make (W0:CyclicType) <: NType. - (** Macro-generated part *) + (** * Macro-generated part *) Include NMake_gen.Make W0. + Declare Reduction red_t := + lazy beta iota delta + [iter_t reduce same_level mk_t mk_t_S dom_t dom_op]. + + Ltac red_t := + match goal with |- ?u => let v := (eval red_t in u) in change v end. + + (** * Generic results *) + + Theorem spec_mk_t : forall n (x:dom_t n), [mk_t n x] = ZnZ.to_Z x. + Proof. + intros. change to_Z with (iter_t (fun _ x => ZnZ.to_Z x)). + unfold iter_t. + repeat (destruct n; try reflexivity). + Qed. + + Theorem spec_mk_t_S : forall n (x:zn2z (dom_t n)), + [mk_t_S n x] = zn2z_to_Z (base (ZnZ.digits (dom_op n))) ZnZ.to_Z x. + Proof. + intros. + repeat ((simpl; rewrite !make_op_S; reflexivity) || + (destruct n; [reflexivity|])). + Qed. + + Lemma spec_iter_t : forall A (P:Z->A->Prop)(f:forall n, dom_t n -> A), + (forall n x, P (ZnZ.to_Z x) (f n x)) -> forall x, P [x] (iter_t f x). + Proof. + intros A P f H; destruct x; unfold iter_t; + match goal with |- context [f ?n _] => apply (H n) end. + Qed. + + Lemma spec_iter_t_2 : forall A B (P:Z->A->B->Prop) + (f:forall n, dom_t n -> A) + (g:forall n, dom_t n -> B), + (forall n x, P (ZnZ.to_Z x) (f n x) (g n x)) -> + forall x, P [x] (iter_t f x) (iter_t g x). + Proof. + intros A B P f g H; destruct x; unfold iter_t; + match goal with |- context [f ?n _] => apply (H n) end. + Qed. + + Lemma spec_iter_t_3 : forall A B C (P:Z->A->B->C->Prop) + (f:forall n, dom_t n -> A) + (g:forall n, dom_t n -> B) + (h:forall n, dom_t n -> C), + (forall n x, P (ZnZ.to_Z x) (f n x) (g n x) (h n x)) -> + forall x, P [x] (iter_t f x) (iter_t g x) (iter_t h x). + Proof. + intros A B C P f g h H; destruct x; unfold iter_t; + match goal with |- context [f ?n _] => apply (H n) end. + Qed. + + Theorem spec_pos: forall x, 0 <= [x]. + Proof. + intros x; apply spec_iter_t with (f := fun _ _ => 0)(P := fun u _ => 0<=u). + intros n wx. now case (ZnZ.spec_to_Z wx). + Qed. + + Lemma digits_dom_op_incr : forall n m, (n<=m)%nat -> + (ZnZ.digits (dom_op n) <= ZnZ.digits (dom_op m))%positive. + Proof. + intros. + change (Zpos (ZnZ.digits (dom_op n)) <= Zpos (ZnZ.digits (dom_op m))). + rewrite 2 digits_dom_op. + apply Zmult_le_compat_l; auto with zarith. + apply Zpower_le_monotone2; auto with zarith. + Qed. + + (** Number of level in the tree representation of a number. + NB: This function isn't a morphism for setoid [eq]. *) + + Definition level := iter_t (fun n _ => n). + + (** Specification of [same_level] indexed by [level] *) + + Theorem spec_same_level_dep : + forall res + (P : nat -> Z -> Z -> res -> Prop) + (Pantimon : forall n m z z' r, (n <= m)%nat -> P m z z' r -> P n z z' r) + (f : forall n, dom_t n -> dom_t n -> res) + (Pf: forall n x y, P n (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)), + forall x y, P (level y) [x] [y] (same_level f x y). + Proof. + intros res P Pantimon f Pf. + set (f' := fun n x y => (n, f n x y)). + set (P' := fun z z' r => P (fst r) z z' (snd r)). + assert (FST : forall x y, (level y <= fst (same_level f' x y))%nat) + by (destruct x, y; simpl; omega with * ). + assert (SND : forall x y, same_level f x y = snd (same_level f' x y)) + by (destruct x, y; reflexivity). + intros. eapply Pantimon; [eapply FST|]. + rewrite SND. eapply (@spec_same_level _ P' f'); eauto. + Qed. + + + (** * Zero and One *) + + Theorem spec_0: [zero] = 0. + Proof. + exact ZnZ.spec_0. + Qed. + + Theorem spec_1: [one] = 1. + Proof. + exact ZnZ.spec_1. + Qed. + + (** * Successor *) + + Local Notation succn := (fun n (x:dom_t n) => + let op := dom_op n in + match ZnZ.succ_c x with + | C0 r => mk_t n r + | C1 r => mk_t_S n (WW ZnZ.one r) + end). + + Definition succ : t -> t := Eval red_t in iter_t succn. + + Lemma succ_fold : succ = iter_t succn. + Proof. red_t; reflexivity. Qed. + + Theorem spec_succ: forall n, [succ n] = [n] + 1. + Proof. + intros x. rewrite succ_fold. apply spec_iter_t. clear x. + intros n x. simpl. + generalize (ZnZ.spec_succ_c x); case ZnZ.succ_c. + intros. rewrite spec_mk_t. assumption. + intros. unfold interp_carry in *. + rewrite spec_mk_t_S. simpl. rewrite ZnZ.spec_1. assumption. + Qed. + + (** * Addition *) + + Local Notation addn := (fun n (x y : dom_t n) => + let op := dom_op n in + match ZnZ.add_c x y with + | C0 r => mk_t n r + | C1 r => mk_t_S n (WW ZnZ.one r) + end). + + Definition add : t -> t -> t := Eval red_t in same_level addn. + + Lemma add_fold : add = same_level addn. + Proof. red_t; reflexivity. Qed. + + Theorem spec_add: forall x y, [add x y] = [x] + [y]. + Proof. + intros x y. rewrite add_fold. apply spec_same_level; clear x y. + intros n x y. simpl. + generalize (ZnZ.spec_add_c x y); case ZnZ.add_c; intros z H. + rewrite spec_mk_t. assumption. + rewrite spec_mk_t_S. unfold interp_carry in H. + simpl. rewrite ZnZ.spec_1. assumption. + Qed. (** * Predecessor *) + Local Notation predn := (fun n (x:dom_t n) => + match ZnZ.pred_c x with + | C0 r => reduce n r + | C1 _ => zero + end). + + Definition pred : t -> t := Eval red_t in iter_t predn. + + Lemma pred_fold : pred = iter_t predn. + Proof. red_t; reflexivity. Qed. + + Theorem spec_pred_pos : forall x, 0 < [x] -> [pred x] = [x] - 1. + Proof. + intros x. rewrite pred_fold. apply spec_iter_t. clear x. + intros n x H. + generalize (ZnZ.spec_pred_c x); case ZnZ.pred_c; intros y H'. + rewrite spec_reduce. assumption. + exfalso. unfold interp_carry in *. + generalize (ZnZ.spec_to_Z x) (ZnZ.spec_to_Z y); auto with zarith. + Qed. + + Theorem spec_pred0 : forall x, [x] = 0 -> [pred x] = 0. + Proof. + intros x. rewrite pred_fold. apply spec_iter_t. clear x. + intros n x H. + generalize (ZnZ.spec_pred_c x); case ZnZ.pred_c; intros y H'. + rewrite spec_reduce. + unfold interp_carry in H'. + generalize (ZnZ.spec_to_Z y); auto with zarith. + exact spec_0. + Qed. + Lemma spec_pred : forall x, [pred x] = Zmax 0 ([x]-1). Proof. intros. destruct (Zle_lt_or_eq _ _ (spec_pos x)). @@ -36,9 +222,42 @@ Module Make (Import W0:CyclicType) <: NType. rewrite <- H; apply spec_pred0; auto. Qed. - (** * Subtraction *) + Local Notation subn := (fun n (x y : dom_t n) => + let op := dom_op n in + match ZnZ.sub_c x y with + | C0 r => reduce n r + | C1 r => zero + end). + + Definition sub : t -> t -> t := Eval red_t in same_level subn. + + Lemma sub_fold : sub = same_level subn. + Proof. red_t; reflexivity. Qed. + + Theorem spec_sub_pos : forall x y, [y] <= [x] -> [sub x y] = [x] - [y]. + Proof. + intros x y. rewrite sub_fold. apply spec_same_level. clear x y. + intros n x y. simpl. + generalize (ZnZ.spec_sub_c x y); case ZnZ.sub_c; intros z H LE. + rewrite spec_reduce. assumption. + unfold interp_carry in H. + exfalso. + generalize (ZnZ.spec_to_Z z); auto with zarith. + Qed. + + Theorem spec_sub0 : forall x y, [x] < [y] -> [sub x y] = 0. + Proof. + intros x y. rewrite sub_fold. apply spec_same_level. clear x y. + intros n x y. simpl. + generalize (ZnZ.spec_sub_c x y); case ZnZ.sub_c; intros z H LE. + rewrite spec_reduce. + unfold interp_carry in H. + generalize (ZnZ.spec_to_Z z); auto with zarith. + exact spec_0. + Qed. + Lemma spec_sub : forall x y, [sub x y] = Zmax 0 ([x]-[y]). Proof. intros. destruct (Zle_or_lt [y] [x]). @@ -48,13 +267,7 @@ Module Make (Import W0:CyclicType) <: NType. (** * 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 := + Definition eq_bool (x y : t) : bool := match compare x y with | Eq => true | _ => false @@ -65,18 +278,11 @@ Module Make (Import W0:CyclicType) <: NType. 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 lt (n m : t) := [n] < [m]. + Definition le (n m : t) := [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. + Definition min (n m : t) : t := match compare n m with Gt => m | _ => n end. + Definition max (n m : t) : t := match compare n m with Lt => m | _ => n end. Theorem spec_max : forall n m, [max n m] = Zmax [n] [m]. Proof. @@ -88,10 +294,43 @@ Module Make (Import W0:CyclicType) <: NType. intros. unfold min, Zmin. rewrite spec_compare; destruct Zcompare; reflexivity. Qed. + (** * Square *) + + (** TODO: use reduce (original version was using it for N0 only) *) + + Local Notation squaren := + (fun n (x : dom_t n) => mk_t_S n (ZnZ.square_c x)). + + Definition square : t -> t := Eval red_t in iter_t squaren. + + Lemma square_fold : square = iter_t squaren. + Proof. red_t; reflexivity. Qed. + + Theorem spec_square: forall x, [square x] = [x] * [x]. + Proof. + intros x. rewrite square_fold. apply spec_iter_t. clear x. + intros n x. rewrite spec_mk_t_S. exact (ZnZ.spec_square_c x). + Qed. + + (** * Sqrt *) + + Local Notation sqrtn := + (fun n (x : dom_t n) => reduce n (ZnZ.sqrt x)). + + Definition sqrt : t -> t := Eval red_t in iter_t sqrtn. + + Lemma sqrt_fold : sqrt = iter_t sqrtn. + Proof. red_t; reflexivity. Qed. + + Theorem spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. + Proof. + intros x. rewrite sqrt_fold. apply spec_iter_t. clear x. + intros n x; rewrite spec_reduce; exact (ZnZ.spec_sqrt x). + Qed. (** * Power *) - Fixpoint power_pos (x:t) (p:positive) {struct p} : t := + Fixpoint power_pos (x:t)(p:positive) : t := match p with | xH => x | xO p => square (power_pos x p) @@ -112,21 +351,20 @@ Module Make (Import W0:CyclicType) <: NType. intros; rewrite Zpower_1_r; auto. Qed. - Definition power x (n:N) := match n with + Definition power (x:t)(n:N) : t := 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). + destruct n; simpl. apply ZnZ.spec_1. apply spec_power_pos. Qed. - (** * Div *) - Definition div_eucl x y := + Definition div_eucl (x y : t) : t * t := if eq_bool y zero then (zero,zero) else match compare x y with | Eq => (one, zero) @@ -138,32 +376,27 @@ Module Make (Import W0:CyclicType) <: NType. 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). + rewrite spec_eq_bool, spec_compare, spec_0. + generalize (Zeq_bool_if [y] 0); case Zeq_bool. + intros ->. rewrite spec_0. destruct [x]; auto. + intros 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; auto with zarith. - rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H)) - (Z_mod_same [y] (Zlt_gt _ _ H)); + case Zcompare_spec; intros Cmp; + rewrite ?spec_0, ?spec_1; intros; auto with zarith. + rewrite Cmp; 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); + assert (LeLt: 0 <= [x] < [y]) by (generalize (spec_pos x); auto). + generalize (Zdiv_small _ _ LeLt) (Zmod_small _ _ LeLt); unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. - generalize (spec_div_gt _ _ H0 H); auto. + generalize (spec_div_gt _ _ (Zlt_gt _ _ Cmp) 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). + Definition div (x y : t) : t := fst (div_eucl x y). Theorem spec_div: forall x y, [div x y] = [x] / [y]. @@ -174,10 +407,9 @@ Module Make (Import W0:CyclicType) <: NType. injection H; auto. Qed. - (** * Modulo *) - Definition modulo x y := + Definition modulo (x y : t) : t := if eq_bool y zero then zero else match compare x y with | Eq => zero @@ -188,24 +420,45 @@ Module Make (Import W0:CyclicType) <: NType. 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. + rewrite spec_eq_bool, spec_compare, spec_0. + generalize (Zeq_bool_if [y] 0). case Zeq_bool. + intros ->; rewrite spec_0. 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. + case Zcompare_spec; + rewrite ?spec_0, ?spec_1; 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. + apply spec_mod_gt; auto with zarith. Qed. + (** * digits + + Number of digits in the representation of a numbers + (including head zero's). + NB: This function isn't a morphism for setoid [eq]. + *) + + Local Notation digitsn := (fun n _ => ZnZ.digits (dom_op n)). + + Definition digits : t -> positive := Eval red_t in iter_t digitsn. + + Lemma digits_fold : digits = iter_t digitsn. + Proof. red_t; reflexivity. Qed. + + Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x). + Proof. + intros x. rewrite digits_fold. apply spec_iter_t. clear x. + intros n x. exact (ZnZ.spec_to_Z x). + Qed. + + Lemma digits_level : forall x, digits x = ZnZ.digits (dom_op (level x)). + Proof. + destruct x; reflexivity. + Qed. (** * Gcd *) @@ -226,15 +479,12 @@ Module Make (Import W0:CyclicType) <: NType. 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. + rewrite ! spec_compare, spec_0. case Zcompare_spec. + intros ->; 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 H5; case Zcompare_spec. intros H6; rewrite <- (Zmult_1_r [b]). rewrite (Z_div_mod_eq [a] [b]); auto with zarith. rewrite <- spec_mod_gt; auto with zarith. @@ -273,7 +523,7 @@ Module Make (Import W0:CyclicType) <: NType. 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 := + Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) : t := gcd_gt_body a b (fun a b => match p with @@ -310,12 +560,7 @@ Module Make (Import W0:CyclicType) <: NType. (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. + apply Zpower_le_monotone2; auto with zarith. intros n a b cont H H2 H3. simpl gcd_gt_aux. apply Zspec_gcd_gt_body with (n + 1); auto with zarith. @@ -345,7 +590,7 @@ Module Make (Import W0:CyclicType) <: NType. intros; apply False_ind; auto with zarith. Qed. - Definition gcd a b := + Definition gcd (a b : t) : t := match compare a b with | Eq => a | Lt => gcd_gt b a @@ -357,7 +602,7 @@ Module Make (Import W0:CyclicType) <: NType. 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. + unfold gcd. rewrite spec_compare. case Zcompare_spec. intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto. apply Zis_gcd_refl. intros; apply trans_equal with (Zgcd [b] [a]). @@ -365,13 +610,53 @@ Module Make (Import W0:CyclicType) <: NType. 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. + intros; apply spec_gcd_gt; auto with zarith. Qed. - (** * Conversion *) - Definition of_N x := + Definition pheight p := + Peano.pred (nat_of_P (get_height (ZnZ.digits W0.ops) (plength p))). + + Theorem pheight_correct: forall p, + Zpos p < 2 ^ (Zpos (ZnZ.digits W0.ops) * 2 ^ (Z_of_nat (pheight p))). + Proof. + intros p; unfold pheight. + assert (F1: forall x, Z_of_nat (Peano.pred (nat_of_P x)) = Zpos x - 1). + intros x. + assert (Zsucc (Z_of_nat (Peano.pred (nat_of_P x))) = Zpos x); auto with zarith. + rewrite <- inj_S. + rewrite <- (fun x => S_pred x 0); auto with zarith. + rewrite Zpos_eq_Z_of_nat_o_nat_of_P; auto. + apply lt_le_trans with 1%nat; auto with zarith. + exact (le_Pmult_nat x 1). + rewrite F1; clear F1. + assert (F2:= (get_height_correct (ZnZ.digits W0.ops) (plength p))). + apply Zlt_le_trans with (Zpos (Psucc p)). + rewrite Zpos_succ_morphism; auto with zarith. + apply Zle_trans with (1 := plength_pred_correct (Psucc p)). + rewrite Ppred_succ. + apply Zpower_le_monotone2; auto with zarith. + Qed. + + Definition of_pos (x:positive) : t := + let n := pheight x in + reduce n (snd (ZnZ.of_pos x)). + + Theorem spec_of_pos: forall x, + [of_pos x] = Zpos x. + Proof. + intros x; unfold of_pos. + rewrite spec_reduce. + simpl. + apply ZnZ.of_pos_correct. + unfold base. + apply Zlt_le_trans with (1 := pheight_correct x). + apply Zpower_le_monotone2; auto with zarith. + rewrite digits_dom_op; auto with zarith. + Qed. + + Definition of_N (x:N) : t := match x with | BinNat.N0 => zero | Npos p => of_pos p @@ -381,37 +666,398 @@ Module Make (Import W0:CyclicType) <: NType. [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. + simpl of_N. exact spec_0. intros p; exact (spec_of_pos p). Qed. + Definition to_N (x : t) := Zabs_N (to_Z x). - (** * Shift *) + (** * [head0] and [tail0] - Definition shiftr n x := - match compare n (Ndigits x) with - | Lt => unsafe_shiftr n x - | _ => N0 w_0 - end. + Number of zero at the beginning and at the end of + the representation of the number. + NB: these functions are not morphism for setoid [eq]. + *) + + Local Notation head0n := (fun n x => reduce n (ZnZ.head0 x)). + + Definition head0 : t -> t := Eval red_t in iter_t head0n. + + Lemma head0_fold : head0 = iter_t head0n. + Proof. red_t; reflexivity. Qed. + + Theorem spec_head00: forall x, [x] = 0 -> [head0 x] = Zpos (digits x). + Proof. + intros x. rewrite head0_fold, digits_fold. + apply spec_iter_t_2 with (P:=fun z u v => z=0 -> [u] = Zpos v). clear x. + intros n x; rewrite spec_reduce; exact (ZnZ.spec_head00 x). + Qed. + + Lemma pow2_pos_minus_1 : forall z, 0<z -> 2^(z-1) = 2^z / 2. + Proof. + intros. apply Zdiv_unique with 0; auto with zarith. + change 2 with (2^1) at 2. + rewrite <- Zpower_exp; auto with zarith. + rewrite Zplus_0_r. f_equal. auto with zarith. + Qed. + + Theorem spec_head0: forall x, 0 < [x] -> + 2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x). + Proof. + intros x. rewrite pow2_pos_minus_1 by (red; auto). + rewrite head0_fold, digits_fold. + apply spec_iter_t_2 with + (P:=fun z u v => 0<z -> 2^(Zpos v) / 2 <= 2^[u] * z < 2^(Zpos v)). + clear x. intros n x. rewrite spec_reduce. + exact (ZnZ.spec_head0 x). + Qed. + + Local Notation tail0n := (fun n x => reduce n (ZnZ.tail0 x)). + + Definition tail0 : t -> t := Eval red_t in iter_t tail0n. + + Lemma tail0_fold : tail0 = iter_t tail0n. + Proof. red_t; reflexivity. Qed. + + Theorem spec_tail00: forall x, [x] = 0 -> [tail0 x] = Zpos (digits x). + Proof. + intros x. rewrite tail0_fold, digits_fold. + apply spec_iter_t_2 with (P:=fun z u v => z=0 -> [u] = Zpos v). clear x. + intros n x; rewrite spec_reduce; exact (ZnZ.spec_tail00 x). + Qed. + + Theorem spec_tail0: forall x, + 0 < [x] -> exists y, 0 <= y /\ [x] = (2 * y + 1) * 2 ^ [tail0 x]. + Proof. + intros x. rewrite tail0_fold. apply spec_iter_t. clear x. + intros n x. rewrite spec_reduce. exact (ZnZ.spec_tail0 x). + Qed. + + (** * [Ndigits] + + Same as [digits] but encoded using large integers + NB: this function is not a morphism for setoid [eq]. + *) + + Local Notation Ndigitsn := (fun n _ => reduce n (ZnZ.zdigits (dom_op n))). + + Definition Ndigits : t -> t := Eval red_t in iter_t Ndigitsn. + + Lemma Ndigits_fold : Ndigits = iter_t Ndigitsn. + Proof. red_t; reflexivity. Qed. + + Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x). + Proof. + intros x. rewrite Ndigits_fold, digits_fold. + apply spec_iter_t_2 with (P:=fun z u v => [u] = Zpos v). clear x. + intros n x. rewrite spec_reduce. apply ZnZ.spec_zdigits. + Qed. + + (** * Binary logarithm *) + + Local Notation log2n := (fun n x => + let op := dom_op n in + reduce n (ZnZ.sub_carry (ZnZ.zdigits op) (ZnZ.head0 x))). + + Definition log2 : t -> t := Eval red_t in + fun x => if eq_bool x zero then zero else iter_t log2n x. + + Lemma log2_fold : + log2 = fun x => if eq_bool x zero then zero else iter_t log2n x. + Proof. red_t; reflexivity. Qed. + + Lemma spec_log2_0 : forall x, [x] = 0 -> [log2 x] = 0. + Proof. + intros x H. rewrite log2_fold. + rewrite spec_eq_bool, H. rewrite spec_0. simpl. + exact ZnZ.spec_0. + Qed. + + Lemma head0_zdigits : forall n (x : dom_t n), + 0 < ZnZ.to_Z x -> + ZnZ.to_Z (ZnZ.head0 x) < ZnZ.to_Z (ZnZ.zdigits (dom_op n)). + Proof. + intros n x H. + destruct (ZnZ.spec_head0 x H) as (_,H0). + intros. + assert (H1 := ZnZ.spec_to_Z (ZnZ.head0 x)). + assert (H2 := ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))). + unfold base in *. + rewrite ZnZ.spec_zdigits in H2 |- *. + set (h := ZnZ.to_Z (ZnZ.head0 x)) in *; clearbody h. + set (d := ZnZ.digits (dom_op n)) in *; clearbody d. + destruct (Z_lt_le_dec h (Zpos d)); auto. exfalso. + assert (1 * 2^Zpos d <= ZnZ.to_Z x * 2^h). + apply Zmult_le_compat; auto with zarith. + apply Zpower_le_monotone2; auto with zarith. + rewrite Zmult_comm in H0. auto with zarith. + Qed. + + Lemma spec_log2 : forall x, [x]<>0 -> + 2^[log2 x] <= [x] < 2^([log2 x]+1). + Proof. + intros x H. rewrite log2_fold. + rewrite spec_eq_bool. rewrite spec_0. + generalize (Zeq_bool_if [x] 0). destruct Zeq_bool. + auto with zarith. + apply spec_iter_t. clear x H. intros n x H. simpl. + rewrite spec_reduce, ZnZ.spec_sub_carry. + assert (H0 := ZnZ.spec_to_Z x). + assert (H1 := ZnZ.spec_to_Z (ZnZ.head0 x)). + assert (H2 := ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))). + assert (H3 := head0_zdigits n x). + rewrite Zmod_small by auto with zarith. + rewrite (ZBinary.ZBinPropMod.mul_lt_mono_pos_l (2^(ZnZ.to_Z (ZnZ.head0 x)))); + auto with zarith. + rewrite (ZBinary.ZBinPropMod.mul_le_mono_pos_l _ _ (2^(ZnZ.to_Z (ZnZ.head0 x)))); + auto with zarith. + rewrite <- 2 Zpower_exp; auto with zarith. + rewrite ZBinary.ZBinPropMod.add_sub_assoc, Zplus_minus. + rewrite ZBinary.ZBinPropMod.sub_simpl_r, Zplus_minus. + rewrite ZnZ.spec_zdigits. + rewrite pow2_pos_minus_1 by (red; auto). + apply ZnZ.spec_head0; auto with zarith. + Qed. + + Lemma log2_digits_head0 : forall x, 0 < [x] -> + [log2 x] = Zpos (digits x) - [head0 x] - 1. + Proof. + intros. + rewrite log2_fold. + rewrite spec_eq_bool. rewrite spec_0. + generalize (Zeq_bool_if [x] 0). destruct Zeq_bool. + auto with zarith. + intros _. revert H. + rewrite digits_fold, head0_fold. + apply spec_iter_t_3 with (P:=fun z a b c => 0<z -> [a] = Zpos b - [c] -1). + clear x. intros n x. rewrite 2 spec_reduce. + rewrite ZnZ.spec_sub_carry. + intros. + generalize (head0_zdigits n x H). + generalize (ZnZ.spec_to_Z (ZnZ.head0 x)). + generalize (ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))). + rewrite ZnZ.spec_zdigits. intros. apply Zmod_small. + auto with zarith. + Qed. + + (** * Right shift *) + + Local Notation shiftrn := (fun n (p x : dom_t n) => + let op := dom_op n in + match ZnZ.sub_c (ZnZ.zdigits op) p with + | C0 d => reduce n (ZnZ.add_mul_div d ZnZ.zero x) + | C1 _ => zero + end). + + Definition shiftr : t -> t -> t := Eval red_t in + same_level shiftrn. + + Lemma shiftr_fold : shiftr = same_level shiftrn. + Proof. red_t; reflexivity. Qed. + + Lemma div_pow2_bound :forall x y z, + 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z. + Proof. + intros x y z HH HH1 HH2. + split; auto with zarith. + apply Zle_lt_trans with (2 := HH2); auto with zarith. + apply Zdiv_le_upper_bound; auto with zarith. + pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith. + apply Zmult_le_compat_l; auto. + apply Zpower_le_monotone2; auto with zarith. + rewrite Zpower_0_r; ring. + Qed. 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. + [shiftr n x] = [x] / 2 ^ [n]. + Proof. + intros x y. rewrite shiftr_fold. apply spec_same_level. clear x y. + intros n p x. simpl. + assert (Hx := ZnZ.spec_to_Z p). + assert (Hy := ZnZ.spec_to_Z x). + generalize (ZnZ.spec_sub_c (ZnZ.zdigits (dom_op n)) p). + case ZnZ.sub_c; intros d H; unfold interp_carry in *; simpl. + (** Subtraction without underflow : [ p <= digits ] *) + rewrite spec_reduce. + rewrite ZnZ.spec_zdigits in H. + rewrite ZnZ.spec_add_mul_div by auto with zarith. + rewrite ZnZ.spec_0, Zmult_0_l, Zplus_0_l. + rewrite Zmod_small. + f_equal. f_equal. auto with zarith. + split. auto with zarith. + apply div_pow2_bound; auto with zarith. + (** Subtraction with underflow : [ digits < p ] *) + rewrite ZnZ.spec_0. symmetry. + apply Zdiv_small. + split; auto with zarith. + apply Zlt_le_trans with (base (ZnZ.digits (dom_op n))); auto with zarith. + unfold base. apply Zpower_le_monotone2; auto with zarith. + rewrite ZnZ.spec_zdigits in H. + generalize (ZnZ.spec_to_Z d); auto with zarith. + Qed. + + (** * Left shift *) + + (** First an unsafe version, working correctly only if + the representation is large enough *) + + Local Notation unsafe_shiftln := (fun n p x => + let ops := dom_op n in + reduce n (ZnZ.add_mul_div p x ZnZ.zero)). + + Definition unsafe_shiftl : t -> t -> t := Eval red_t in + same_level unsafe_shiftln. + + Lemma unsafe_shiftl_fold : unsafe_shiftl = same_level unsafe_shiftln. + Proof. red_t; reflexivity. Qed. + + Theorem spec_unsafe_shiftl_aux : forall p x K, + 0 <= K -> + [x] < 2^K -> + [p] + K <= Zpos (digits x) -> + [unsafe_shiftl p x] = [x] * 2 ^ [p]. + Proof. + intros p x. + rewrite unsafe_shiftl_fold. rewrite digits_level. + apply spec_same_level_dep. + intros n m z z' r LE H K HK H1 H2. apply (H K); auto. + transitivity (Zpos (ZnZ.digits (dom_op n))); auto. + apply digits_dom_op_incr; auto. + clear p x. + intros n p x K HK Hx Hp. lazy zeta. rewrite spec_reduce. + destruct (ZnZ.spec_to_Z x). + destruct (ZnZ.spec_to_Z p). + rewrite ZnZ.spec_add_mul_div by (omega with *). + rewrite ZnZ.spec_0, Zdiv_0_l, Zplus_0_r. + apply Zmod_small. unfold base. + split; auto with zarith. + rewrite Zmult_comm. + apply Zlt_le_trans with (2^(ZnZ.to_Z p + K)). + rewrite Zpower_exp; auto with zarith. + apply Zmult_lt_compat_l; auto with zarith. + apply Zpower_le_monotone2; auto with zarith. + Qed. + + Theorem spec_unsafe_shiftl: forall p x, + [p] <= [head0 x] -> [unsafe_shiftl p x] = [x] * 2 ^ [p]. + Proof. + intros. + destruct (Z_eq_dec [x] 0) as [EQ|NEQ]. + (* [x] = 0 *) + apply spec_unsafe_shiftl_aux with 0; auto with zarith. + now rewrite EQ. + rewrite spec_head00 in *; auto with zarith. + (* [x] <> 0 *) + apply spec_unsafe_shiftl_aux with ([log2 x] + 1); auto with zarith. + generalize (spec_pos (log2 x)); auto with zarith. + destruct (spec_log2 x); auto with zarith. + rewrite log2_digits_head0; auto with zarith. + generalize (spec_pos x); auto with zarith. Qed. + (** Then we define a function doubling the size of the representation + but without changing the value of the number. *) + + Local Notation double_size_n := + (fun n x => mk_t_S n (WW ZnZ.zero x)). + + Definition double_size : t -> t := Eval red_t in + iter_t double_size_n. + + Lemma double_size_fold : double_size = iter_t double_size_n. + Proof. red_t; reflexivity. Qed. + + Theorem spec_double_size_digits: + forall x, digits (double_size x) = xO (digits x). + Proof. + intros x; case x; unfold double_size, digits; clear x; auto. + intros n x; rewrite make_op_S; auto. + Qed. + + Theorem spec_double_size: forall x, [double_size x] = [x]. + Proof. + intros x. rewrite double_size_fold. apply spec_iter_t. clear x. + intros n x. rewrite spec_mk_t_S. simpl. rewrite ZnZ.spec_0. + auto with zarith. + Qed. + + Theorem spec_double_size_head0: + forall x, 2 * [head0 x] <= [head0 (double_size x)]. + Proof. + intros x. + assert (F1:= spec_pos (head0 x)). + assert (F2: 0 < Zpos (digits x)). + red; auto. + case (Zle_lt_or_eq _ _ (spec_pos x)); intros HH. + generalize HH; rewrite <- (spec_double_size x); intros HH1. + case (spec_head0 x HH); intros _ HH2. + case (spec_head0 _ HH1). + rewrite (spec_double_size x); rewrite (spec_double_size_digits x). + intros HH3 _. + case (Zle_or_lt ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4. + absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto. + apply Zle_not_lt. + apply Zmult_le_compat_r; auto with zarith. + apply Zpower_le_monotone2; auto; auto with zarith. + assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1)). + case (Zle_lt_or_eq 1 [x]); auto with zarith; intros HH5. + apply Zmult_le_reg_r with (2 ^ 1); auto with zarith. + rewrite <- (fun x y z => Zpower_exp x (y - z)); auto with zarith. + assert (tmp: forall x, x - 1 + 1 = x); [intros; ring | rewrite tmp; clear tmp]. + apply Zle_trans with (2 := Zlt_le_weak _ _ HH2). + apply Zmult_le_compat_l; auto with zarith. + rewrite Zpower_1_r; auto with zarith. + apply Zpower_le_monotone2; auto with zarith. + case (Zle_or_lt (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6. + absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith. + rewrite <- HH5; rewrite Zmult_1_r. + apply Zpower_le_monotone2; auto with zarith. + rewrite (Zmult_comm 2). + rewrite Zpower_mult; auto with zarith. + rewrite Zpower_2. + apply Zlt_le_trans with (2 := HH3). + rewrite <- Zmult_assoc. + replace (Zpos (xO (digits x)) - 1) with + ((Zpos (digits x) - 1) + (Zpos (digits x))). + rewrite Zpower_exp; auto with zarith. + apply Zmult_lt_compat2; auto with zarith. + split; auto with zarith. + apply Zmult_lt_0_compat; auto with zarith. + rewrite Zpos_xO; ring. + apply Zlt_le_weak; auto. + repeat rewrite spec_head00; auto. + rewrite spec_double_size_digits. + rewrite Zpos_xO; auto with zarith. + rewrite spec_double_size; auto. + Qed. + + Theorem spec_double_size_head0_pos: + forall x, 0 < [head0 (double_size x)]. + Proof. + intros x. + assert (F: 0 < Zpos (digits x)). + red; auto. + case (Zle_lt_or_eq _ _ (spec_pos (head0 (double_size x)))); auto; intros F0. + case (Zle_lt_or_eq _ _ (spec_pos (head0 x))); intros F1. + apply Zlt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith. + case (Zle_lt_or_eq _ _ (spec_pos x)); intros F3. + generalize F3; rewrite <- (spec_double_size x); intros F4. + absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x))). + apply Zle_not_lt. + apply Zpower_le_monotone2; auto with zarith. + rewrite Zpos_xO; auto with zarith. + case (spec_head0 x F3). + rewrite <- F1; rewrite Zpower_0_r; rewrite Zmult_1_l; intros _ HH. + apply Zle_lt_trans with (2 := HH). + case (spec_head0 _ F4). + rewrite (spec_double_size x); rewrite (spec_double_size_digits x). + rewrite <- F0; rewrite Zpower_0_r; rewrite Zmult_1_l; auto. + generalize F1; rewrite (spec_head00 _ (sym_equal F3)); auto with zarith. + Qed. + + (** Finally we iterate [double_size] enough before [unsafe_shiftl] + in order to get a fully correct [shiftl]. *) + Definition shiftl_aux_body cont n x := match compare n (head0 x) with Gt => cont n (double_size x) @@ -425,7 +1071,7 @@ Module Make (Import W0:CyclicType) <: NType. [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. + rewrite spec_compare; case Zcompare_spec; intros H. apply spec_unsafe_shiftl; auto with zarith. apply spec_unsafe_shiftl; auto with zarith. rewrite H2. @@ -435,7 +1081,7 @@ Module Make (Import W0:CyclicType) <: NType. rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith. Qed. - Fixpoint shiftl_aux p cont n x {struct p} := + Fixpoint shiftl_aux p cont n x := shiftl_aux_body (fun n x => match p with | xH => cont n x @@ -465,7 +1111,7 @@ Module Make (Import W0:CyclicType) <: NType. 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. + apply Zpower_le_monotone2; auto with zarith. intros x2 H4; apply Hrec with (p + q)%positive; auto. intros x3 H5; apply H2. rewrite (Zpos_xO p). @@ -486,11 +1132,11 @@ Module Make (Import W0:CyclicType) <: NType. [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. + rewrite spec_compare; case Zcompare_spec; 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. + rewrite spec_compare; case Zcompare_spec; intros H1. apply spec_unsafe_shiftl; auto with zarith. apply spec_unsafe_shiftl; auto with zarith. rewrite <- (spec_double_size (double_size x)). @@ -504,21 +1150,22 @@ Module Make (Import W0:CyclicType) <: NType. 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. + apply Zpower_le_monotone2; auto with zarith. Qed. + (** * Parity test *) - (** * Zero and One *) + Definition is_even : t -> bool := Eval red_t in + iter_t (fun n x => ZnZ.is_even x). - Theorem spec_0: [zero] = 0. - Proof. - exact (spec_0 w0_spec). - Qed. + Lemma is_even_fold : is_even = iter_t (fun n x => ZnZ.is_even x). + Proof. red_t; reflexivity. Qed. - Theorem spec_1: [one] = 1. + Theorem spec_is_even: forall x, + if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1. Proof. - exact (spec_1 w0_spec). + intros x. rewrite is_even_fold. apply spec_iter_t. clear x. + intros n x; exact (ZnZ.spec_is_even x). Qed. - End Make. diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml index b8552a39b5..cd87982366 100644 --- a/theories/Numbers/Natural/BigN/NMake_gen.ml +++ b/theories/Numbers/Natural/BigN/NMake_gen.ml @@ -24,7 +24,7 @@ let gen_proof = true (* should we generate proofs ? *) let t = "t" let c = "N" -let pz n = if n == 0 then "w_0" else "W0" +let pz n = if n == 0 then "ZnZ.zero" 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 = @@ -73,35 +73,52 @@ let _ = pr " DoubleType DoubleMul DoubleDivn1 DoubleCyclic Nbasic"; pr " Wf_nat StreamMemo."; pr ""; - pr "Module Make (Import W0:CyclicType)."; + pr "Module Make (W0:CyclicType)."; pr ""; - pr " Definition w0 := W0.w."; + pr " Implicit Arguments mk_zn2z_ops [t]."; + pr " Implicit Arguments mk_zn2z_ops_karatsuba [t]."; + pr " Implicit Arguments mk_zn2z_specs [t ops]."; + pr " Implicit Arguments mk_zn2z_specs_karatsuba [t ops]."; + pr " Implicit Arguments ZnZ.digits [t]."; + pr " Implicit Arguments ZnZ.zdigits [t]."; + pr ""; + + pr " (** * The word types *)"; + pr ""; + + pr " Local Notation w0 := W0.t."; for i = 1 to size do pr " Definition w%i := zn2z w%i." i (i-1) done; pr ""; - pr " Definition w0_op := W0.w_op."; + pr " (** * The operation type classes for the word types *)"; + pr ""; + + pr " Local Notation w0_op := W0.ops."; for i = 1 to 3 do - pr " Definition w%i_op := mk_zn2z_op w%i_op." i (i-1) + pr " Instance w%i_op : ZnZ.Ops w%i := mk_zn2z_ops w%i_op." i i (i-1) done; - for i = 4 to size + 3 do - pr " Definition w%i_op := mk_zn2z_op_karatsuba w%i_op." i (i-1) + for i = 4 to size do + pr " Instance w%i_op : ZnZ.Ops w%i := mk_zn2z_ops_karatsuba w%i_op." i i (i-1) + done; + for i = size+1 to size+3 do + pr " Instance w%i_op : ZnZ.Ops (word w%i %i%%nat) := mk_zn2z_ops_karatsuba w%i_op." i size (i-size) (i-1) done; pr ""; pr " Section Make_op."; - pr " Variable mk : forall w', znz_op w' -> znz_op (zn2z w')."; + pr " Variable mk : forall w', ZnZ.Ops w' -> ZnZ.Ops (zn2z w')."; pr ""; - pr " Fixpoint make_op_aux (n:nat) : znz_op (word w%i (S n)):=" size; - pr " match n return znz_op (word w%i (S n)) with" size; + pr " Fixpoint make_op_aux (n:nat) : ZnZ.Ops (word w%i (S n)):=" size; + pr " match n return ZnZ.Ops (word w%i (S n)) with" size; pr " | O => w%i_op" (size+1); pr " | S n1 =>"; - pr " match n1 return znz_op (word w%i (S (S n1))) with" size; + pr " match n1 return ZnZ.Ops (word w%i (S (S n1))) with" size; pr " | O => w%i_op" (size+2); pr " | S n2 =>"; - pr " match n2 return znz_op (word w%i (S (S (S n2)))) with" size; + pr " match n2 return ZnZ.Ops (word w%i (S (S (S n2)))) with" size; pr " | O => w%i_op" (size+3); pr " | S n3 => mk _ (mk _ (mk _ (make_op_aux n3)))"; pr " end"; @@ -110,12 +127,15 @@ let _ = pr ""; pr " End Make_op."; pr ""; - pr " Definition omake_op := make_op_aux mk_zn2z_op_karatsuba."; + pr " Definition omake_op := make_op_aux mk_zn2z_ops_karatsuba."; pr ""; pr ""; pr " Definition make_op_list := dmemo_list _ omake_op."; pr ""; - pr " Definition make_op n := dmemo_get _ omake_op n make_op_list."; + pr " Instance make_op n : ZnZ.Ops (word w6 (S n))"; + pr " := dmemo_get _ omake_op n make_op_list."; + pr ""; + pr ""; pr " Lemma make_op_omake: forall n, make_op n = omake_op n."; pr " intros n; unfold make_op, make_op_list."; @@ -123,6 +143,10 @@ let _ = pr " Qed."; pr ""; + + pr " (** * The main type [t], isomorphic with [exists n, word w0 n] *)"; + pr ""; + pr " Inductive %s_ :=" t; for i = 0 to size do pr " | %s%i : w%i -> %s_" c i i t @@ -131,49 +155,98 @@ let _ = pr ""; pr " Definition %s := %s_." t t; pr ""; - pr " Definition w_0 := w0_op.(znz_0)."; + + pr " Definition zero : t := %s0 ZnZ.zero." c; + pr " Definition one : t := %s0 ZnZ.one." c; + pr ""; + + pr " (** * A generic toolbox for building and deconstructing [t] *)"; pr ""; + let rec iter_str n s = if n = 0 then "" else (iter_str (n-1) s) ^ s + in + pr " Local Notation SizePlus n := %sn%s." + (iter_str size "(S ") (iter_str size ")"); + pr ""; + + pr " Definition dom_t n := match n with"; for i = 0 to size do - pr " Definition one%i := w%i_op.(znz_1)." i i + pr " | %i => w%i" i i; done; + pr " | SizePlus n => word w%i n" size; + pr " end."; pr ""; - - pr " Definition zero := %s0 w_0." c; - pr " Definition one := %s0 one0." c; + pr " Instance dom_op n : ZnZ.Ops (dom_t n) | 10."; + pa " Admitted."; + pp " Proof."; + pp " do %i (destruct n; [simpl;auto with *|])." (size+1); + pp " unfold dom_t. auto with *."; + pp " Defined."; pr ""; - pr " Definition to_Z x :="; + pr " Definition iter_t {A:Type}(f : forall n, dom_t n -> A)(x:t) : A :="; pr " match x with"; for i = 0 to size do - pr " | %s%i wx => w%i_op.(znz_to_Z) wx" c i i + pr " | %s%i wx => f %i wx" c i i; done; - pr " | %sn n wx => (make_op n).(znz_to_Z) wx" c; + pr " | %sn n wx => f (SizePlus (S n)) wx" c; pr " end."; pr ""; - pr " Open Scope Z_scope."; - pr " Notation \"[ x ]\" := (to_Z x)."; + pr " Definition mk_t (n:nat) : dom_t n -> t :="; + pr " match n as n' return dom_t n' -> t with"; + for i = 0 to size do + pr " | %i => %s%i" i c i; + done; + pr " | SizePlus (S n) => %sn n" c; + pr " end."; pr ""; - pr " Definition to_N x := Zabs_N (to_Z x)."; +pr " + Lemma dom_t_S : forall n, zn2z (dom_t n) = dom_t (S n). + Proof. + do %i (destruct n; try reflexivity). + Defined. +" (size+1); + +pr " + Definition cast w w' (H:w=w') (x:w) : w' := + match H in _=y return y with + | eq_refl => x + end. + + Definition mk_t_S n (x:zn2z (dom_t n)) : t := + Eval lazy beta delta [cast dom_t_S] in + mk_t (S n) (cast _ _ (dom_t_S n) x). +"; +pr " + + (** * Projection to ZArith *) + + Definition to_Z : t -> Z := + Eval lazy beta iota delta [iter_t dom_t dom_op] in + iter_t (fun _ x => ZnZ.to_Z x). +"; + + pr " Open Scope Z_scope."; + pr " Notation \"[ x ]\" := (to_Z x)."; pr ""; - pr " Definition eq x y := (to_Z x = to_Z y)."; + pr " Definition eq (x y : t) := (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 " znz_op (word ww n) :="; - pp " match n return znz_op (word ww n) with"; + pp " Fixpoint nmake_op (ww:Type) (ww_op: ZnZ.Ops ww) (n: nat) :"; + pp " ZnZ.Ops (word ww n) :="; + pp " match n return ZnZ.Ops (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_ops (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 " nmake_op _ w_op (S x) = mk_zn2z_op (nmake_op _ w_op x)."; + pp " Theorem nmake_op_S: forall ww (w_op: ZnZ.Ops ww) x,"; + pp " nmake_op _ w_op (S x) = mk_zn2z_ops (nmake_op _ w_op x)."; pp " auto."; pp " Qed."; pp ""; @@ -182,27 +255,27 @@ let _ = pr " (* Eval and extend functions for each level *)"; 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; + pp " Let eval%in n := ZnZ.to_Z (Ops:=nmake_op%i n)." i i; if i == 0 then - pr " Let extend%i := DoubleBase.extend (WW w_0)." i + pr " Let extend%i := DoubleBase.extend (WW (ZnZ.zero:w0))." i else - pr " Let extend%i := DoubleBase.extend (WW (W0: w%i))." i i; + pr " Let extend%i := DoubleBase.extend (WW (W0: w%i))." i i; done; pr ""; - 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 " Theorem digits_doubled:forall n ww (w_op: ZnZ.Ops 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."; pp " intros n Hrec ww ww_op; simpl DoubleBase.double_digits."; pp " rewrite <- Hrec; auto."; pp " Qed."; pp ""; - 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 " Theorem nmake_double: forall n ww (w_op: ZnZ.Ops ww),"; + pp " ZnZ.to_Z (Ops:=nmake_op _ w_op n) ="; + pp " @DoubleBase.double_to_Z _ (ZnZ.digits w_op) (ZnZ.to_Z (Ops:=w_op)) n."; pp " Proof."; pp " intros n; elim n; auto; clear n."; pp " intros n Hrec ww ww_op; simpl DoubleBase.double_to_Z; unfold zn2z_to_Z."; @@ -212,9 +285,9 @@ let _ = pp ""; - 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 " Theorem digits_nmake:forall n ww (w_op: ZnZ.Ops ww),"; + pp " ZnZ.digits (nmake_op _ w_op (S n)) ="; + pp " xO (ZnZ.digits (nmake_op _ w_op n))."; pp " Proof."; pp " auto."; pp " Qed."; @@ -222,17 +295,17 @@ let _ = pp " Theorem znz_nmake_op: forall ww ww_op n xh xl,"; - pp " znz_to_Z (nmake_op ww ww_op (S n)) (WW xh xl) ="; - pp " znz_to_Z (nmake_op ww ww_op n) xh *"; - pp " base (znz_digits (nmake_op ww ww_op n)) +"; - pp " znz_to_Z (nmake_op ww ww_op n) xl."; + pp " ZnZ.to_Z (Ops:=nmake_op ww ww_op (S n)) (WW xh xl) ="; + pp " ZnZ.to_Z (Ops:=nmake_op ww ww_op n) xh *"; + pp " base (ZnZ.digits (nmake_op ww ww_op n)) +"; + pp " ZnZ.to_Z (Ops:=nmake_op ww ww_op n) xl."; pp " Proof."; pp " auto."; pp " Qed."; pp ""; pp " Theorem make_op_S: forall n,"; - pp " make_op (S n) = mk_zn2z_op_karatsuba (make_op n)."; + pp " make_op (S n) = mk_zn2z_ops_karatsuba (make_op n)."; pp " intro n."; pp " do 2 rewrite make_op_omake."; pp " pattern n; apply lt_wf_ind; clear n."; @@ -244,71 +317,76 @@ let _ = pp " intros _; unfold omake_op, make_op_aux, w%i_op, w%i_op; apply refl_equal." (size + 3) (size + 2); pp " intros n Hrec."; pp " change (omake_op (S (S (S (S n))))) with"; - pp " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op (S n)))))."; + pp " (mk_zn2z_ops_karatsuba (mk_zn2z_ops_karatsuba (mk_zn2z_ops_karatsuba (omake_op (S n)))))."; pp " change (omake_op (S (S (S n)))) with"; - pp " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op n))))."; + pp " (mk_zn2z_ops_karatsuba (mk_zn2z_ops_karatsuba (mk_zn2z_ops_karatsuba (omake_op n))))."; pp " rewrite Hrec; auto with arith."; pp " Qed."; pp ""; + pr " (** * The specification proofs for the word operators *)"; + pr ""; - 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 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 ""; - 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 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 ""; + pr " Typeclasses Opaque w1 w2 w3 w4 w5 w6."; + pr ""; - pp " Let w0_spec: znz_spec w0_op := W0.w_spec."; + pp " Instance w0_spec: ZnZ.Specs w0_op := W0.specs."; 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 " Instance w%i_spec: ZnZ.Specs w%i_op := mk_zn2z_specs 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) + pp " Instance w%i_spec : ZnZ.Specs w%i_op := mk_zn2z_specs_karatsuba w%i_spec." i i (i-1) done; pp ""; - pp " Let wn_spec: forall n, znz_spec (make_op n)."; + pp " Instance wn_spec (n:nat) : ZnZ.Specs (make_op n)."; + pp " Proof."; pp " intros n; elim n; clear n."; pp " exact w%i_spec." (size + 1); pp " intros n Hrec; rewrite make_op_S."; - pp " exact (mk_znz2_karatsuba_spec Hrec)."; + pp " exact (mk_zn2z_specs_karatsuba Hrec)."; pp " Qed."; pp ""; - for i = 0 to size do - pr " Definition w%i_eq0 := w%i_op.(znz_eq0)." i i; - pr " Let spec_w%i_eq0: forall x, if w%i_eq0 x then [%s%i x] = 0 else True." i i c i; - pa " Admitted."; +pr " + Instance spec_dom n : ZnZ.Specs (dom_op n) | 10. + Proof. + do %i (destruct n; auto with *). apply wn_spec. + Qed. +" (size+1); + + for i = 1 to size + 2 do + pp " Let to_Z_%i: forall x y," i; + pp " ZnZ.to_Z (Ops:=w%i_op) (WW x y) =" i; + pp " ZnZ.to_Z (Ops:=w%i_op) x * base (ZnZ.digits w%i_op) + ZnZ.to_Z (Ops:=w%i_op) y." (i-1) (i-1) (i-1); pp " Proof."; - pp " intros x; unfold w%i_eq0, to_Z; generalize (spec_eq0 w%i_spec x);" i i; - pp " case znz_eq0; auto."; + pp " auto."; pp " Qed."; - pr ""; + pp ""; done; - pr ""; + pp " Let to_Z_n: forall n x y,"; + pp " ZnZ.to_Z (Ops:=make_op (S n)) (WW x y) ="; + pp " ZnZ.to_Z (Ops:=make_op n) x * base (ZnZ.digits (make_op n)) + ZnZ.to_Z (Ops:=make_op n) y."; + pp " Proof."; + pp " intros n x y; rewrite make_op_S; auto."; + pp " Qed."; + pp ""; + + let rec iter_name i j base sep = + if i = j then base^(string_of_int i) + else (iter_name i (j-1) base sep)^sep^" "^base^(string_of_int j) + in 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 (Ops:=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."; @@ -317,20 +395,20 @@ 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 pp " auto." else begin - pp " apply trans_equal with (xO (znz_digits w%i_op))." (i + j -1); + pp " apply trans_equal with (xO (ZnZ.digits w%i_op))." (i + j -1); pp " auto."; pp " unfold nmake_op; auto."; end else begin - pp " apply trans_equal with (xO (znz_digits w%i_op))." (i + j -1); + pp " apply trans_equal with (xO (ZnZ.digits w%i_op))." (i + j -1); pp " auto."; pp " rewrite digits_nmake."; pp " rewrite digits_w%in%i." i (j - 1); @@ -346,7 +424,7 @@ let _ = begin pp " intros x; case x."; pp " auto."; - pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (i + j); + pp " intros xh xl; unfold to_Z; rewrite to_Z_%i." (i + j); pp " rewrite digits_w%in%i." i (j - 1); pp " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH." i (j - 1); pp " unfold eval%in, nmake_op%i." i i; @@ -358,15 +436,15 @@ let _ = 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); - pp " unfold to_Z; rewrite znz_to_Z_%i." (i + j + 1); - pp " rewrite (spec_0 w%i_spec); auto." (i + j); + pp " intros x; change (extend%i 0 x) with (WW (ZnZ.zero (Ops:=w%i_op)) x)." i (i + j); + pp " unfold to_Z; rewrite to_Z_%i." (i + j + 1); + pp " rewrite ZnZ.spec_0; auto."; end else begin - pp " intros x; change (extend%i %i x) with (WW (znz_0 w%i_op) (extend%i %i x))." i j (i + j) i (j - 1); - pp " unfold to_Z; rewrite znz_to_Z_%i." (i + j + 1); - pp " rewrite (spec_0 w%i_spec)." (i + j); + pp " intros x; change (extend%i %i x) with (WW (ZnZ.zero (Ops:=w%i_op)) (extend%i %i x))." i j (i + j) i (j - 1); + pp " unfold to_Z; rewrite to_Z_%i." (i + j + 1); + pp " rewrite ZnZ.spec_0."; pp " generalize (spec_extend%in%i x); unfold to_Z." i (i + j); pp " intros HH; rewrite <- HH; auto."; end; @@ -375,9 +453,9 @@ let _ = end; done; - pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i (size - i + 1) (size + 1) i (size - i + 1); + pp " Theorem digits_w%in%i: ZnZ.digits w%i_op = ZnZ.digits (nmake_op _ w%i_op %i)." i (size - i + 1) (size + 1) i (size - i + 1); pp " Proof."; - pp " apply trans_equal with (xO (znz_digits w%i_op))." size; + pp " apply trans_equal with (xO (ZnZ.digits w%i_op))." size; pp " auto."; pp " rewrite digits_nmake."; pp " rewrite digits_w%in%i." i (size - i); @@ -389,7 +467,7 @@ let _ = pp " Proof."; pp " intros x; case x."; pp " auto."; - pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (size + 1); + pp " intros xh xl; unfold to_Z; rewrite to_Z_%i." (size + 1); pp " rewrite digits_w%in%i." i (size - i); pp " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH." i (size - i); pp " unfold eval%in, nmake_op%i." i i; @@ -400,7 +478,7 @@ let _ = 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); + pp " intros xh xl; unfold to_Z; rewrite to_Z_%i." (size + 2); pp " rewrite digits_w%in%i." i (size + 1 - i); pp " generalize (spec_eval%in%i); unfold to_Z; change (make_op 0) with (w%i_op); intros HH; repeat rewrite HH." i (size + 1 - i) (size + 1); pp " unfold eval%in, nmake_op%i." i i; @@ -410,12 +488,12 @@ let _ = done; pp " Let digits_w%in: forall n," size; - pp " znz_digits (make_op n) = znz_digits (nmake_op _ w%i_op (S n))." size; + pp " ZnZ.digits (make_op n) = ZnZ.digits (nmake_op _ w%i_op (S n))." size; pp " intros n; elim n; clear n."; - pp " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size; + pp " change (ZnZ.digits (make_op 0)) with (xO (ZnZ.digits w%i_op))." size; pp " rewrite nmake_op_S; apply sym_equal; auto."; pp " intros n Hrec."; - pp " replace (znz_digits (make_op (S n))) with (xO (znz_digits (make_op n)))."; + pp " replace (ZnZ.digits (make_op (S n))) with (xO (ZnZ.digits (make_op n)))."; pp " rewrite Hrec."; pp " rewrite nmake_op_S; apply sym_equal; auto."; pp " rewrite make_op_S; apply sym_equal; auto."; @@ -430,7 +508,7 @@ let _ = pp " rewrite make_op_S; rewrite nmake_op_S; auto."; pp " intros xh xl."; pp " unfold to_Z in Hrec |- *."; - pp " rewrite znz_to_Z_n."; + pp " rewrite to_Z_n."; pp " rewrite digits_w%in." size; pp " repeat rewrite Hrec."; pp " unfold eval%in, nmake_op%i." size size; @@ -440,29 +518,36 @@ let _ = 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 " intros x; change (extend%i 0 x) with (WW (ZnZ.zero (Ops:=w%i_op)) x)." size size; pp " unfold to_Z."; pp " change (make_op 0) with w%i_op." (size + 1); - pp " rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto." (size + 1) size; + pp " rewrite to_Z_%i; rewrite ZnZ.spec_0; auto." (size + 1); pp " intros n Hrec x."; pp " change (extend%i (S n) x) with (WW W0 (extend%i n x))." size size; - pp " unfold to_Z in Hrec |- *; rewrite znz_to_Z_n; auto."; + pp " unfold to_Z in Hrec |- *; rewrite to_Z_n; auto."; pp " rewrite <- Hrec."; - pp " replace (znz_to_Z (make_op n) W0) with 0; auto."; + pp " replace (ZnZ.to_Z (Ops:=make_op n) W0) with 0; auto."; pp " case n; auto; intros; rewrite make_op_S; auto."; pp " Qed."; pp ""; - pr " Theorem spec_pos: forall x, 0 <= [x]."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; clear x."; - for i = 0 to size do - pp " intros x; case (spec_to_Z w%i_spec x); auto." i; - done; - pp " intros n x; case (spec_to_Z (wn_spec n) x); auto."; - pp " Qed."; - pr ""; +pr " + Lemma digits_dom_op : forall n, + Zpos (ZnZ.digits (dom_op n)) = Zpos (ZnZ.digits W0.ops) * 2 ^ Z_of_nat n. + Proof. + intros. rewrite Zmult_comm. + do 7 (destruct n; try reflexivity). + simpl. + rewrite <- shift_pos_correct. f_equal. + rewrite shift_pos_nat. + rewrite !nat_of_P_succ_morphism, nat_of_P_o_P_of_succ_nat_eq_succ. + unfold shift_nat. simpl. + generalize (digits_w%in n); simpl; intros ->. + rewrite digits_doubled. + rewrite digits_w%i, !digits_nmake. simpl. + induction n; simpl; congruence. + Qed. +" size size; pp " Let spec_extendn_0: forall n wx, [%sn n (extend n _ wx)] = [%sn 0 wx]." c c; pp " intros n; elim n; auto."; @@ -474,8 +559,8 @@ let _ = pp " Let spec_extendn0_0: forall n wx, [%sn (S n) (WW W0 wx)] = [%sn n wx]." c c; pp " Proof."; pp " intros n x; unfold to_Z."; - pp " rewrite znz_to_Z_n."; - pp " rewrite <- (Zplus_0_l (znz_to_Z (make_op n) x))."; + pp " rewrite to_Z_n."; + pp " rewrite <- (Zplus_0_l (ZnZ.to_Z (Ops:=make_op n) x))."; pp " apply (f_equal2 Zplus); auto."; pp " case n; auto."; pp " intros n1; rewrite make_op_S; auto."; @@ -508,54 +593,29 @@ let _ = pp " Qed."; pp ""; - - pr " Section LevelAndIter."; + pr " Section SameLevel."; pr ""; pr " Variable res: Type."; - pr " Variable xxx: res."; - pr " Variable P: Z -> Z -> res -> Prop."; - pr " (* Abstraction function for each level *)"; + pr " Variable P : Z -> Z -> res -> Prop."; + pr " Variable f : forall n, dom_t n -> dom_t n -> res."; + pr " Variable Pf : forall n x y, P (ZnZ.to_Z x) (ZnZ.to_Z y) (f n x y)."; + pr ""; for i = 0 to size do - pr " Variable f%i: w%i -> w%i -> res." i i i; - pr " Variable f%in: forall n, w%i -> word w%i (S n) -> res." i i i; - pr " Variable fn%i: forall n, word w%i (S n) -> w%i -> res." i i i; - pp " Variable Pf%i: forall x y, P [%s%i x] [%s%i y] (f%i x y)." i c i c i i; - if i == size then - begin - pp " Variable Pf%in: forall n x y, P [%s%i x] (eval%in (S n) y) (f%in n x y)." i c i i i; - pp " Variable Pfn%i: forall n x y, P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i i c i i; - end - else - begin - pp " Variable Pf%in: forall n x y, Z_of_nat n <= %i -> P [%s%i x] (eval%in (S n) y) (f%in n x y)." i (size - i) c i i i; - pp " Variable Pfn%i: forall n x y, Z_of_nat n <= %i -> P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i (size - i) i c i i; - end; - pr ""; + pr " Let f%i : w%i -> w%i -> res := f %i." i i i i; done; - pr " Variable fnn: forall n, word w%i (S n) -> word w%i (S n) -> res." size size; - pp " Variable Pfnn: forall n x y, P [%sn n x] [%sn n y] (fnn n x y)." c c; - pr " Variable fnm: forall n m, word w%i (S n) -> word w%i (S m) -> res." size size; - pp " Variable Pfnm: forall n m x y, P [%sn n x] [%sn m y] (fnm n m x y)." c c; + pr " Let fn n := f (SizePlus (S n))."; pr ""; - pr " (* Special zero functions *)"; - pr " Variable f0t: t_ -> res."; - pp " Variable Pf0t: forall x, P 0 [x] (f0t x)."; - pr " Variable ft0: t_ -> res."; - pp " Variable Pft0: forall x, P [x] 0 (ft0 x)."; - pr ""; - - - pr " (* We level the two arguments before applying *)"; - pr " (* the functions at each leval *)"; - pr " Definition same_level (x y: t_): res :="; - pr0 " Eval lazy zeta beta iota delta ["; for i = 0 to size do - pr0 "extend%i " i; + pr " Let Pf%i : forall x y : w%i, P [%s%i x] [%s%i y] (f%i x y) := Pf %i." i i c i c i i i; done; + pr " Let Pfn n : forall x y, P [%sn n x] [%sn n y] (fn n x y) := Pf (SizePlus (S n))." c c; pr ""; - pr " DoubleBase.extend DoubleBase.extend_aux"; - pr " ] in"; - pr " match x, y with"; + pr " (* We level the two arguments before applying *)"; + pr " (* the functions at each level *)"; + pr ""; + pr " Definition same_level (x y: t_): res := Eval lazy zeta beta iota delta"; + pr " [ DoubleBase.extend DoubleBase.extend_aux %s ]" (iter_name 0 (size-1) "extend" ""); + pr " in match x, y with"; for i = 0 to size do for j = 0 to i - 1 do pr " | %s%i wx, %s%i wy => f%i wx (extend%i %i wy)" c i c j i j (i - j -1); @@ -565,20 +625,20 @@ 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 + pr " | %s%i wx, %sn m wy => fn 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); + pr " | %s%i wx, %sn m wy => fn 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 + pr " | %sn n wx, %s%i wy => fn 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); + pr " | %sn n wx, %s%i wy => fn 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; pr " let mn := Max.max n m in"; pr " let d := diff n m in"; - pr " fnn mn"; + pr " fn mn"; pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; pr " (castm (diff_l n m) (extend_tr wy (fst d)))"; pr " end."; @@ -597,126 +657,56 @@ let _ = pp " intros y; rewrite spec_extend%in%i; apply Pf%i." i j j; done; if i == size then - pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size + pp " intros m y; rewrite (spec_extend%in m); apply (Pfn m)." size else - pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size; + pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply (Pfn m)." 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 + pp " intros y; rewrite (spec_extend%in n); apply (Pfn n)." size else - pp " intros y; rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size; + pp " intros y; rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply (Pfn n)." i size size; done; pp " intros m y; rewrite <- (spec_cast_l n m x);"; - pp " rewrite <- (spec_cast_r n m y); apply Pfnn."; + pp " rewrite <- (spec_cast_r n m y); apply (Pfn (Max.max n m))."; pp " Qed."; pp ""; - pr " (* We level the two arguments before applying *)"; - pr " (* the functions at each level (special zero case) *)"; - pr " Definition same_level0 (x y: t_): res :="; - pr0 " Eval lazy zeta beta iota delta ["; - for i = 0 to size do - pr0 "extend%i " i; - done; + pr " End SameLevel."; pr ""; - pr " DoubleBase.extend DoubleBase.extend_aux"; - pr " ] in"; - pr " match x with"; - for i = 0 to size do - pr " | %s%i wx =>" c i; - if i == 0 then - pr " if w0_eq0 wx then f0t y else"; - pr " match y with"; - for j = 0 to i - 1 do - pr " | %s%i wy =>" c j; - 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; - pr " | %s%i wy => f%i wx wy" c i i; - for j = i + 1 to size do - 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 (extend%i %i wx)) wy" c size i (size - i - 1); - pr" end"; - done; - pr " | %sn n wx =>" c; - pr " match y with"; - for i = 0 to size do - pr " | %s%i wy =>" c i; - 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 (extend%i %i wy))" size i (size - i - 1); - done; - pr " | %sn m wy =>" c; - pr " let mn := Max.max n m in"; - pr " let d := diff n m in"; - pr " fnn mn"; - pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; - pr " (castm (diff_l n m) (extend_tr wy (fst d)))"; - pr " end"; - pr " end."; + pr " Implicit Arguments same_level [res]."; pr ""; - - pp " Lemma spec_same_level0: forall x y, P [x] [y] (same_level0 x y)."; - pp " Proof."; - pp " intros x; case x; clear x; unfold same_level0."; + pr " Section Iter."; + pr ""; + pr " Variable res: Type."; + pr " Variable P: Z -> Z -> res -> Prop."; + pr " (* Abstraction function for each level *)"; for i = 0 to size do - pp " intros x."; - if i == 0 then - begin - pp " generalize (spec_w0_eq0 x); case w0_eq0; intros H."; - pp " intros y; rewrite H; apply Pf0t."; - pp " clear H."; - end; - pp " intros y; case y; clear y."; - for j = 0 to i - 1 do - pp " intros y."; - if j == 0 then - begin - pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; - pp " rewrite H; apply Pft0."; - pp " clear H."; - end; - pp " rewrite spec_extend%in%i; apply Pf%i." j i i; - done; - pp " intros y; apply Pf%i." i; - for j = i + 1 to size do - pp " intros y; rewrite spec_extend%in%i; apply Pf%i." i j j; - done; + pr " Variable f%i: w%i -> w%i -> res." i i i; + pr " Variable f%in: forall n, w%i -> word w%i (S n) -> res." i i i; + pr " Variable fn%i: forall n, word w%i (S n) -> w%i -> res." i i i; + pp " Variable Pf%i: forall x y, P [%s%i x] [%s%i y] (f%i x y)." i c i c i i; if i == size then - pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size + begin + pp " Variable Pf%in: forall n x y, P [%s%i x] (eval%in (S n) y) (f%in n x y)." i c i i i; + pp " Variable Pfn%i: forall n x y, P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i i c i i; + end 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 - pp " intros y."; - if i = 0 then begin - pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; - pp " rewrite H; apply Pft0."; - pp " clear H."; + pp " Variable Pf%in: forall n x y, Z_of_nat n <= %i -> P [%s%i x] (eval%in (S n) y) (f%in n x y)." i (size - i) c i i i; + pp " Variable Pfn%i: forall n x y, Z_of_nat n <= %i -> P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i (size - i) i c i i; end; - if i == size then - pp " rewrite (spec_extend%in n); apply Pfnn." size - else - pp " rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size; + pr ""; done; - 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 " Variable fnn: forall n, word w%i (S n) -> word w%i (S n) -> res." size size; + pp " Variable Pfnn: forall n x y, P [%sn n x] [%sn n y] (fnn n x y)." c c; + pr " Variable fnm: forall n m, word w%i (S n) -> word w%i (S m) -> res." size size; + pp " Variable Pfnm: forall n m x y, P [%sn n x] [%sn m y] (fnm n m x y)." c c; + pr ""; pr " (* We iter the smaller argument with the bigger *)"; + pr ""; pr " Definition iter (x y: t_): res :="; pr0 " Eval lazy zeta beta iota delta ["; for i = 0 to size do @@ -748,7 +738,11 @@ let _ = pr " | %sn n wx, %sn m wy => fnm n m wx wy" c c; pr " end."; pr ""; - + let break_eq0 v = + pp " generalize (ZnZ.spec_eq0 %s); case ZnZ.eq0; intros H." v; + pp " intros; simpl [N0 %s]; rewrite H; trivial." v; + pp " clear H." + in pp " Ltac zg_tac := try"; pp " (red; simpl Zcompare; auto;"; pp " let t := fresh \"H\" in (intros t; discriminate t))."; @@ -782,7 +776,14 @@ let _ = pp ""; - pr " (* We iter the smaller argument with the bigger (zero case) *)"; + pr " (* We iter the smaller argument with the bigger *)"; + pr " (* with special zero functions *)"; + pr ""; + pr " Variable f0t: t_ -> res."; + pp " Variable Pf0t: forall x, P 0 [x] (f0t x)."; + pr " Variable ft0: t_ -> res."; + pp " Variable Pft0: forall x, P [x] 0 (ft0 x)."; + pr ""; pr " Definition iter0 (x y: t_): res :="; pr0 " Eval lazy zeta beta iota delta ["; for i = 0 to size do @@ -795,12 +796,12 @@ let _ = for i = 0 to size do pr " | %s%i wx =>" c i; if i == 0 then - pr " if w0_eq0 wx then f0t y else"; + pr " if ZnZ.eq0 wx then f0t y else"; pr " match y with"; for j = 0 to i - 1 do pr " | %s%i wy =>" c j; if j == 0 then - pr " if w0_eq0 wy then ft0 x else"; + pr " if ZnZ.eq0 wy then ft0 x else"; pr " fn%i %i wx wy" j (i - j - 1); done; pr " | %s%i wy => f%i wx wy" c i i; @@ -818,7 +819,7 @@ let _ = for i = 0 to size do pr " | %s%i wy =>" c i; if i == 0 then - pr " if w0_eq0 wy then ft0 x else"; + pr " if ZnZ.eq0 wy then ft0 x else"; if i == size then pr " fn%i n wx wy" size else @@ -834,21 +835,11 @@ let _ = pp " intros x; case x; clear x; unfold iter0."; for i = 0 to size do pp " intros x."; - if i == 0 then - begin - pp " generalize (spec_w0_eq0 x); case w0_eq0; intros H."; - pp " intros y; rewrite H; apply Pf0t."; - pp " clear H."; - end; + if i == 0 then break_eq0 "x"; pp " intros y; case y; clear y."; for j = 0 to i - 1 do pp " intros y."; - if j == 0 then - begin - pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; - pp " rewrite H; apply Pft0."; - pp " clear H."; - end; + if j == 0 then break_eq0 "y"; pp " rewrite spec_eval%in%i; apply (Pfn%i %i); zg_tac." j (i - j) j (i - j - 1); done; pp " intros y; apply Pf%i." i; @@ -863,12 +854,7 @@ let _ = pp " intros n x y; case y; clear y."; for i = 0 to size do pp " intros y."; - if i = 0 then - begin - pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; - pp " rewrite H; apply Pft0."; - pp " clear H."; - end; + if i = 0 then break_eq0 "y"; if i == size then pp " rewrite spec_eval%in; apply Pfn%i." size size else @@ -879,7 +865,7 @@ let _ = pp ""; - pr " End LevelAndIter."; + pr " End Iter."; pr ""; @@ -890,19 +876,19 @@ let _ = pr " (***************************************************************)"; pr ""; - pr " Definition reduce_0 (x:w) := %s0 x." c; + pr " Definition reduce_0 (x:w0) := %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; + pr " reduce_n1 _ _ zero (ZnZ.eq0 (Ops:=w0_op)) %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 (ZnZ.eq0 (Ops:=w%i_op)) 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)." + pr " reduce_n1 _ _ zero (ZnZ.eq0 (Ops:=w%i_op)) reduce_%i (%sn 0)." size size c; pr " Definition reduce_n n :="; @@ -924,13 +910,13 @@ let _ = pp " Let spec_reduce_%i: forall x, [reduce_%i x] = [%s%i x]." i i c i; pp " Proof."; pp " intros x; case x; unfold reduce_%i." i; - pp " exact (spec_0 w0_spec)."; + pp " exact ZnZ.spec_0."; pp " intros x1 y1."; - pp " generalize (spec_w%i_eq0 x1);" (i - 1); - pp " case w%i_eq0; intros H1; auto." (i - 1); + pp " generalize (ZnZ.spec_eq0 x1);"; + pp " case ZnZ.eq0; intros H1; auto."; 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; rewrite to_Z_%i." i; pp " unfold to_Z in H1; rewrite H1; auto."; pp " Qed."; pp ""; @@ -942,335 +928,31 @@ let _ = pp " intros x; rewrite <- spec_reduce_%i; auto." (size + 1); pp " intros n1 Hrec x; case x."; pp " unfold to_Z; rewrite make_op_S; auto."; - pp " exact (spec_0 w0_spec)."; + pp " exact ZnZ.spec_0."; pp " intros x1 y1; case x1; auto."; pp " rewrite Hrec."; pp " rewrite spec_extendn0_0; auto."; pp " Qed."; pp ""; - pr " (***************************************************************)"; - pr " (* *)"; - pr " (** * Successor *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - for i = 0 to size do - pr " Definition w%i_succ_c := w%i_op.(znz_succ_c)." i i - done; - pr ""; - - for i = 0 to size do - pr " Definition w%i_succ := w%i_op.(znz_succ)." i i - done; - pr ""; - - pr " Definition succ x :="; - pr " match x with"; - 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 " | 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 " | 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 " | C1 r => %sn (S n) (WW op.(znz_1) r)" c; - pr " end"; - pr " end."; - pr ""; - - pr " Theorem spec_succ: forall n, [succ n] = [n] + 1."; - pa " Admitted."; - pp " Proof."; - pp " intros n; case n; unfold succ, to_Z."; - for i = 0 to size do - pp " intros n1; generalize (spec_succ_c w%i_spec n1);" i; - pp " unfold succ, to_Z, w%i_succ_c; case znz_succ_c; auto." i; - 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; - done; - pp " intros k n1; generalize (spec_succ_c (wn_spec k) n1)."; - pp " unfold succ, to_Z; case znz_succ_c; auto."; - 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."; - pr ""; - - - pr " (***************************************************************)"; - pr " (* *)"; - 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 x y :=" i; - pr " match w%i_add_c x y with" i; - pr " | C0 r => %s%i r" c i; - if i == size then - pr " | C1 r => %sn 0 (WW one%i r)" c size - else - pr " | C1 r => %s%i (WW one%i r)" c (i + 1) i; - pr " end."; - pr ""; - done ; - pr " Definition addn n (x y : word w%i (S n)) :=" size; - pr " let op := make_op n in"; - pr " match op.(znz_add_c) x y with"; - pr " | C0 r => %sn n r" c; - pr " | C1 r => %sn (S n) (WW op.(znz_1) r) end." c; - pr ""; - - - for i = 0 to size do - pp " Let spec_w%i_add: forall x y, [w%i_add x y] = [%s%i x] + [%s%i y]." i i c i c i; - 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 " 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 ""; - 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 " 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."; - - pr " Definition add := Eval lazy beta delta [same_level] in"; - pr0 " (same_level t_ "; - for i = 0 to size do - pr0 "w%i_add " i; - done; - pr "addn)."; - pr ""; - - pr " Theorem spec_add: forall x y, [add x y] = [x] + [y]."; - pa " Admitted."; - pp " Proof."; - pp " unfold add."; - pp " generalize (spec_same_level t_ (fun x y res => [res] = x + y))."; - pp " unfold same_level; intros HH; apply HH; clear HH."; - for i = 0 to size do - pp " exact spec_w%i_add." i; - done; - pp " exact spec_wn_add."; - pp " Qed."; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (** * Predecessor *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - for i = 0 to size do - pr " Definition w%i_pred_c := w%i_op.(znz_pred_c)." i i - done; - pr ""; - - pr " Definition pred x :="; - pr " match x with"; - 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 " | 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 " | C1 r => zero"; - pr " end"; - pr " end."; - pr ""; - - 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 " 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."; - pp " case (spec_to_Z w%i_spec x1); intros HH1 HH2." i; - pp " case (spec_to_Z w%i_spec y1); intros HH3 HH4 HH5." i; - 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 " 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."; - pp " case (spec_to_Z (wn_spec n) x1); intros HH1 HH2."; - pp " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4 HH5."; - 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 " 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 " 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 " 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 " (** * Subtraction *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - for i = 0 to size do - pr " Definition w%i_sub_c := w%i_op.(znz_sub_c)." i i - done; - pr ""; - - 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; - pr " | C1 r => zero"; - pr " end." - done; - pr ""; - - pr " Definition subn n (x y : word w%i (S n)) :=" size; - pr " let op := make_op n in"; - pr " match op.(znz_sub_c) x y with"; - pr " | C0 r => %sn n r" c; - pr " | C1 r => N0 w_0"; - pr " end."; - pr ""; - - for i = 0 to size do - 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 " intros x; auto." - else - pp " intros x; try rewrite spec_reduce_%i; auto." i; - pp " unfold interp_carry; unfold zero, w_0, to_Z."; - pp " rewrite (spec_0 w0_spec)."; - pp " case (spec_to_Z w%i_spec x); intros; auto with zarith." i; - 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 " intros x; auto."; - pp " unfold interp_carry, to_Z."; - pp " case (spec_to_Z (wn_spec k) x); intros; auto with zarith."; - pp " Qed."; - pp ""; - - pr " Definition sub := Eval lazy beta delta [same_level] in"; - pr0 " (same_level t_ "; - for i = 0 to size do - pr0 "w%i_sub " i; - done; - pr "subn)."; - pr ""; - - pr " Theorem spec_sub_pos : forall x y, [y] <= [x] -> [sub x y] = [x] - [y]."; - pa " Admitted."; - pp " Proof."; - pp " unfold sub."; - pp " generalize (spec_same_level t_ (fun x y res => y <= x -> [res] = x - y))."; - pp " unfold same_level; intros HH; apply HH; clear HH."; - for i = 0 to size do - pp " exact spec_w%i_sub." i; - done; - pp " exact spec_wn_sub."; - pp " Qed."; - pr ""; - - for i = 0 to size do - 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 " 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."; - pp " Qed."; - pp ""; - done; - - 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 " 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."; - pp " Qed."; - pp ""; - - pr " Theorem spec_sub0: forall x y, [x] < [y] -> [sub x y] = 0."; - pa " Admitted."; - pp " Proof."; - pp " unfold sub."; - pp " generalize (spec_same_level t_ (fun x y res => x < y -> [res] = 0))."; - pp " unfold same_level; intros HH; apply HH; clear HH."; - for i = 0 to size do - pp " exact spec_w%i_sub0." i; - done; - pp " exact spec_wn_sub0."; - pp " Qed."; - pr ""; - +pr " Definition reduce n : dom_t n -> t :="; +pr " match n with"; +for i = 0 to size do +pr " | %i => reduce_%i" i i; + done; +pr " | SizePlus (S n) => reduce_n n"; +pr " end%%nat."; +pr ""; + +pr " Lemma spec_reduce : forall n (x:dom_t n), [reduce n x] = ZnZ.to_Z x."; +pa " Admitted"; +pp " Proof."; +for i = 0 to size do +pp " destruct n. apply spec_reduce_%i." i; +done; +pp " apply spec_reduce_n."; +pp " Qed."; +pr ""; pr " (***************************************************************)"; pr " (* *)"; @@ -1280,7 +962,7 @@ let _ = pr ""; for i = 0 to size do - pr " Definition compare_%i := w%i_op.(znz_compare)." i i; + pr " Definition compare_%i := ZnZ.compare (Ops:=w%i_op)." i i; 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; @@ -1290,95 +972,65 @@ let _ = pr " let mn := Max.max n m in"; pr " let d := diff n m in"; pr " let op := make_op mn in"; - pr " op.(znz_compare)"; + pr " ZnZ.compare"; pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; pr " (castm (diff_l n m) (extend_tr wy (fst d)))."; pr ""; - pr " Definition compare := Eval lazy beta delta [iter] in"; + pr " Local Notation compare_folded :="; 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; + pr " (fun n x y => CompOpp (comparen_%i (S n) y x))" i; pr " (fun n => comparen_%i (S n))" i; done; pr " comparenm)."; + pr " Definition compare : t -> t -> comparison :="; + pr " Eval lazy beta delta [iter] in compare_folded."; 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 " 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; - pp " end."; - pp " Proof."; - pp " unfold compare_%i, to_Z; exact (spec_compare w%i_spec)." i i; - pp " Qed."; + pp " compare_%i x y = Zcompare [%s%i x] [%s%i y]." i c i c i; + pp " Proof."; + pp " unfold compare_%i, to_Z; exact ZnZ.spec_compare." 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; - pp " | Eq => eval%in n x = [%s%i y]" i c i; - pp " | Lt => eval%in n x < [%s%i y]" i c i; - pp " | Gt => eval%in n x > [%s%i y]" i c i; - pp " end."; + pp " comparen_%i n x y = Zcompare (eval%in n x) [%s%i y]." i i c i; + pp " Proof."; pp " intros n x y."; pp " unfold comparen_%i, to_Z; rewrite spec_double_eval%in." i i; pp " apply spec_compare_mn_1."; - pp " exact (spec_0 w%i_spec)." i; - pp " intros x1; exact (spec_compare w%i_spec %s x1)." i (pz i); - pp " exact (spec_to_Z w%i_spec)." i; - pp " exact (spec_compare w%i_spec)." i; - pp " exact (spec_compare w%i_spec)." i; - pp " exact (spec_to_Z w%i_spec)." i; + pp " exact ZnZ.spec_0."; + pp " intros x1; exact (ZnZ.spec_compare %s x1)." (pz i); + pp " exact ZnZ.spec_to_Z."; + pp " exact ZnZ.spec_compare."; + pp " exact ZnZ.spec_compare."; + pp " exact ZnZ.spec_to_Z."; pp " Qed."; pp ""; done; - pp " Let spec_opp_compare: forall c (u v: Z),"; - pp " match c with Eq => u = v | Lt => u < v | Gt => u > v end ->"; - pp " match opp_compare c with Eq => v = u | Lt => v < u | Gt => v > u end."; - pp " Proof."; - pp " intros c u v; case c; unfold opp_compare; auto with zarith."; - pp " Qed."; - pp ""; - - - 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."; + pr " Theorem spec_compare : forall x y,"; + pr " compare x y = Zcompare [x] [y]."; pa " Admitted."; pp " Proof."; - pp " refine (spec_iter _ (fun x y res =>"; - pp " match res with"; - pp " Eq => x = y"; - pp " | Lt => x < y"; - pp " | Gt => x > y"; - pp " end)"; - for i = 0 to size do - pp " compare_%i" i; - pp " (fun n x y => opp_compare (comparen_%i (S n) y x))" i; - pp " (fun n => comparen_%i (S n)) _ _ _" i; - done; - pp " comparenm _)."; - + pp " intros x y. change compare with compare_folded. apply spec_iter; clear x y."; 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; rewrite spec_comparen_%i; apply Zcompare_antisym." i; pp " intros n x y H; exact (spec_comparen_%i (S n) x y)." i; done; pp " exact spec_compare_%i." size; - pp " intros n x y;apply spec_opp_compare; apply spec_comparen_%i." size; + pp " intros n x y; rewrite spec_comparen_%i; apply Zcompare_antisym." size; pp " intros n; exact (spec_comparen_%i (S n))." size; pp " intros n m x y; unfold comparenm."; pp " rewrite <- (spec_cast_l n m x); rewrite <- (spec_cast_r n m y)."; - pp " unfold to_Z; apply (spec_compare (wn_spec (Max.max n m)))."; - pp " Qed."; + pp " unfold to_Z; apply ZnZ.spec_compare."; + pp " Qed."; pr ""; pr " (***************************************************************)"; @@ -1389,24 +1041,19 @@ let _ = pr ""; for i = 0 to size do - pr " Definition w%i_mul_c := w%i_op.(znz_mul_c)." i i - done; - pr ""; - - for i = 0 to size do pr " Definition w%i_mul_add :=" i; pr " Eval lazy beta delta [w_mul_add] in"; - pr " @w_mul_add w%i %s w%i_succ w%i_add_c w%i_mul_c." i (pz i) i i i + pr " @w_mul_add w%i %s ZnZ.succ ZnZ.add_c ZnZ.mul_c." i (pz i) done; pr ""; for i = 0 to size do - pr " Definition w%i_0W := znz_0W w%i_op." i i + pr " Definition w%i_0W := ZnZ.OW (ops:=w%i_op)." i i done; pr ""; for i = 0 to size do - pr " Definition w%i_WW := znz_WW w%i_op." i i + pr " Definition w%i_WW := ZnZ.WW (ops:=w%i_op)." i i done; pr ""; @@ -1428,7 +1075,7 @@ let _ = else pr " | %i%s => fun x => %s%i x" j "%nat" c (i + j + 1) done; - pr " | _ => fun _ => N0 w_0"; + pr " | _ => fun _ => zero"; pr " end."; pr ""; done; @@ -1436,7 +1083,7 @@ let _ = for i = 0 to size - 1 do pp "Theorem to_Z%i_spec:" i; - pp " forall n x, Z_of_nat n <= %i -> [to_Z%i n x] = znz_to_Z (nmake_op _ w%i_op (S n)) x." (size + 1 - i) i i; + pp " forall n x, Z_of_nat n <= %i -> [to_Z%i n x] = ZnZ.to_Z (Ops:=nmake_op _ w%i_op (S n)) x." (size + 1 - i) i i; for j = 1 to size + 2 - i do pp " intros n; case n; clear n."; pp " unfold to_Z%i." i; @@ -1454,12 +1101,12 @@ let _ = pr " let (w,r) := w%i_mul_add_n1 (S n) x y %s in" i (pz i); if i == size then begin - pr " if w%i_eq0 w then %sn n r" i c; + pr " if ZnZ.eq0 w then %sn n r" c; pr " else %sn (S n) (WW (extend%i n w) r)." c i; end else begin - pr " if w%i_eq0 w then to_Z%i n r" i i; + pr " if ZnZ.eq0 w then to_Z%i n r" i; pr " else to_Z%i (S n) (WW (extend%i n w) r)." i i; end; pr ""; @@ -1469,84 +1116,87 @@ let _ = pr " let mn := Max.max n m in"; pr " let d := diff n m in"; pr " let op := make_op mn in"; - pr " reduce_n (S mn) (op.(znz_mul_c)"; + pr " reduce_n (S mn) (ZnZ.mul_c"; pr " (castm (diff_r n m) (extend_tr x (snd d)))"; pr " (castm (diff_l n m) (extend_tr y (fst d))))."; pr ""; - pr " Definition mul := Eval lazy beta delta [iter0] in"; + pr " Local Notation mul_folded :="; 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 (ZnZ.mul_c x y))" (i + 1); pr " (fun n x y => w%i_mul n y x)" i; pr " w%i_mul" i; done; pr " mulnm"; - pr " (fun _ => N0 w_0)"; - pr " (fun _ => N0 w_0)"; + pr " (fun _ => zero)"; + pr " (fun _ => zero)"; pr " )."; + pr " Definition mul : t -> t -> t :="; + pr " Eval lazy beta delta [iter0] in mul_folded."; pr ""; for i = 0 to size do pp " Let spec_w%i_mul_add: forall x y z," i; pp " let (q,r) := w%i_mul_add x y z in" i; - pp " znz_to_Z w%i_op q * (base (znz_digits w%i_op)) + znz_to_Z w%i_op r =" i i i; - pp " znz_to_Z w%i_op x * znz_to_Z w%i_op y + znz_to_Z w%i_op z :=" i i i ; - pp " (spec_mul_add w%i_spec)." i; + pp " ZnZ.to_Z (Ops:=w%i_op) q * (base (ZnZ.digits w%i_op)) + ZnZ.to_Z (Ops:=w%i_op) r =" i i i; + pp " ZnZ.to_Z (Ops:=w%i_op) x * ZnZ.to_Z (Ops:=w%i_op) y + ZnZ.to_Z (Ops:=w%i_op) z :=" i i i ; + pp " spec_mul_add."; pp ""; done; for i = 0 to size do pp " Theorem spec_w%i_mul_add_n1: forall n x y z," i; pp " let (q,r) := w%i_mul_add_n1 n x y z in" i; - pp " znz_to_Z w%i_op q * (base (znz_digits (nmake_op _ w%i_op n))) +" i i; - pp " znz_to_Z (nmake_op _ w%i_op n) r =" i; - pp " znz_to_Z (nmake_op _ w%i_op n) x * znz_to_Z w%i_op y +" i i; - pp " znz_to_Z w%i_op z." i; + pp " ZnZ.to_Z (Ops:=w%i_op) q * (base (ZnZ.digits (nmake_op _ w%i_op n))) +" i i; + pp " ZnZ.to_Z (Ops:=nmake_op _ w%i_op n) r =" i; + pp " ZnZ.to_Z (Ops:=nmake_op _ w%i_op n) x * ZnZ.to_Z (Ops:=w%i_op) y +" i i; + pp " ZnZ.to_Z (Ops:=w%i_op) z." i; pp " Proof."; pp " intros n x y z; unfold w%i_mul_add_n1." i; pp " rewrite nmake_double."; pp " rewrite digits_doubled."; - pp " change (base (DoubleBase.double_digits (znz_digits w%i_op) n)) with" i; - pp " (DoubleBase.double_wB (znz_digits w%i_op) n)." i; + pp " change (base (DoubleBase.double_digits (ZnZ.digits w%i_op) n)) with" i; + pp " (DoubleBase.double_wB (ZnZ.digits w%i_op) n)." i; pp " apply spec_double_mul_add_n1; auto."; - if i == 0 then pp " exact (spec_0 w%i_spec)." i; - pp " exact (spec_WW w%i_spec)." i; - pp " exact (spec_0W w%i_spec)." i; - pp " exact (spec_mul_add w%i_spec)." i; + if i == 0 then pp " exact ZnZ.spec_0."; + pp " exact ZnZ.spec_WW."; + pp " exact ZnZ.spec_OW."; + pp " exact spec_mul_add."; 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)) +"; - pp " znz_to_Z (nmake_op ww ww1 n) y."; + pp " ZnZ.to_Z (Ops:=nmake_op ww ww1 (S n)) (WW x y) ="; + pp " ZnZ.to_Z (Ops:=nmake_op ww ww1 n) x * base (ZnZ.digits (nmake_op ww ww1 n)) +"; + pp " ZnZ.to_Z (Ops:=nmake_op ww ww1 n) y."; + pp " Proof."; 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 w%i_op x1." i; + pp " ZnZ.to_Z (Ops:=nmake_op _ w%i_op (S n)) (extend%i n x1) =" i i; + pp " ZnZ.to_Z (Ops:=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 - pp " intros l; simpl; unfold w_0; rewrite (spec_0 w0_spec); ring."; + pp " intros l; simpl; unfold zero; rewrite ZnZ.spec_0; 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; + pp " [%sn (S n) (ZnZ.mul_c (Ops:=make_op n) x y)] = [%sn n x] * [%sn n y]." c c c; pp " Proof."; pp " intros n x y; unfold to_Z."; - pp " rewrite <- (spec_mul_c (wn_spec n))."; + pp " rewrite <- ZnZ.spec_mul_c."; pp " rewrite make_op_S."; - pp " case znz_mul_c; auto."; + pp " case ZnZ.mul_c; auto."; pp " Qed."; pr ""; @@ -1565,15 +1215,15 @@ let _ = pp " intros n x y H; unfold w%i_mul." i; pp " generalize (spec_w%i_mul_add_n1 (S n) x y %s)." i (pz i); pp " case w%i_mul_add_n1; intros x1 y1." i; - pp " change (znz_to_Z (nmake_op _ w%i_op (S n)) x) with (eval%in (S n) x)." i i; - pp " change (znz_to_Z w%i_op y) with ([%s%i y])." i c i; + pp " change (ZnZ.to_Z x) with (eval%in (S n) x)." i; + pp " change (ZnZ.to_Z y) with ([%s%i y])." c i; if i == 0 then - pp " unfold w_0; rewrite (spec_0 w0_spec); rewrite Zplus_0_r." + pp " rewrite ZnZ.spec_0; rewrite Zplus_0_r." else - pp " change (znz_to_Z w%i_op W0) with 0; rewrite Zplus_0_r." i; + pp " change (ZnZ.to_Z W0) with 0; rewrite Zplus_0_r."; pp " intros H1; rewrite <- H1; clear H1."; - pp " generalize (spec_w%i_eq0 x1); case w%i_eq0; intros HH." i i; - pp " unfold to_Z in HH; rewrite HH."; + pp " generalize (ZnZ.spec_eq0 x1); case ZnZ.eq0; intros HH."; + pp " unfold to_Z in HH; rewrite HH by trivial."; if i == size then begin pp " rewrite spec_eval%in; unfold eval%in, nmake_op%i; auto." i i i; @@ -1586,20 +1236,11 @@ let _ = end; pp " rewrite nmake_op_WW; rewrite extend%in_spec; auto." i; 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 n x y => w%i_mul n y x)" i; - pp " w%i_mul _ _ _" i; - done; - pp " mulnm _"; - pp " (fun _ => N0 w_0) _"; - pp " (fun _ => N0 w_0) _"; - pp " )."; + pp " intros x y. change mul with mul_folded. apply spec_iter0; clear x y."; for i = 0 to size do pp " intros x y; rewrite spec_reduce_%i." (i + 1); - pp " unfold w%i_mul_c, to_Z." i; - pp " generalize (spec_mul_c w%i_spec x y)." i; + pp " unfold to_Z."; + pp " generalize (ZnZ.spec_mul_c x y)."; pp " intros HH; rewrite <- HH; clear HH; auto."; if i == size then begin @@ -1617,125 +1258,44 @@ let _ = pp " rewrite <- (spec_cast_l n m x)."; pp " rewrite <- (spec_cast_r n m y)."; pp " rewrite spec_muln; rewrite spec_cast_l; rewrite spec_cast_r; auto."; - pp " intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring."; - pp " intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring."; + pp " intros x; simpl; rewrite ZnZ.spec_0; ring."; + pp " intros x; simpl; rewrite ZnZ.spec_0; ring."; pp " Qed."; pr ""; pr " (***************************************************************)"; pr " (* *)"; - pr " (** * Square *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - for i = 0 to size do - pr " Definition w%i_square_c := w%i_op.(znz_square_c)." i i - done; - pr ""; - - pr " Definition square x :="; - pr " match x with"; - pr " | %s0 wx => reduce_1 (w0_square_c wx)" c; - for i = 1 to size - 1 do - pr " | %s%i wx => %s%i (w%i_square_c wx)" c i c (i+1) i - done; - pr " | %s%i wx => %sn 0 (w%i_square_c wx)" c size c size; - pr " | %sn n wx =>" c; - pr " let op := make_op n in"; - pr " %sn (S n) (op.(znz_square_c) wx)" c; - pr " end."; - pr ""; - - pr " Theorem spec_square: forall x, [square x] = [x] * [x]."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; unfold square; clear x."; - pp " intros x; rewrite spec_reduce_1; unfold to_Z."; - pp " exact (spec_square_c w%i_spec x)." 0; - for i = 1 to size do - pp " intros x; unfold to_Z."; - pp " exact (spec_square_c w%i_spec x)." i; - done; - pp " intros n x; unfold to_Z."; - pp " rewrite make_op_S."; - pp " exact (spec_square_c (wn_spec n) x)."; - pp "Qed."; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (** * Square root *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - for i = 0 to size do - pr " Definition w%i_sqrt := w%i_op.(znz_sqrt)." i i - done; - pr ""; - - pr " Definition sqrt x :="; - pr " match x with"; - for i = 0 to size do - pr " | %s%i wx => reduce_%i (w%i_sqrt wx)" c i i i; - done; - pr " | %sn n wx =>" c; - pr " let op := make_op n in"; - pr " reduce_n n (op.(znz_sqrt) wx)"; - pr " end."; - pr ""; - - pr " Theorem spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2."; - pa " Admitted."; - pp " Proof."; - pp " intros x; unfold sqrt; case x; clear x."; - for i = 0 to size do - pp " intros x; rewrite spec_reduce_%i; exact (spec_sqrt w%i_spec x)." i i; - done; - pp " intros n x; rewrite spec_reduce_n; exact (spec_sqrt (wn_spec n) x)."; - pp " Qed."; - pr ""; - - - pr " (***************************************************************)"; - pr " (* *)"; pr " (** * Division *)"; 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 " Let spec_divn1 ww (ww_op: ZnZ.Ops ww) (ww_spec: ZnZ.Specs 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_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 " (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec))."; + pp " (ZnZ.zdigits ww_op) ZnZ.zero"; + pp " ZnZ.WW ZnZ.head0"; + pp " ZnZ.add_mul_div ZnZ.div21"; + pp " ZnZ.compare ZnZ.sub ZnZ.to_Z"; + pp " ZnZ.spec_to_Z"; + pp " ZnZ.spec_zdigits"; + pp " ZnZ.spec_0 ZnZ.spec_WW ZnZ.spec_head0"; + pp " ZnZ.spec_add_mul_div ZnZ.spec_div21"; + pp " ZnZ.spec_compare ZnZ.spec_sub)."; pp ""; for i = 0 to size do pr " Definition w%i_divn1 n x y :=" i; pr " let (u, v) :="; - pr " double_divn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)" i i; - pr " (znz_WW w%i_op) w%i_op.(znz_head0)" i i; - pr " w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)" i i; - pr " w%i_op.(znz_compare) w%i_op.(znz_sub) (S n) x y in" i i; + pr " double_divn1 (ZnZ.zdigits w%i_op) ZnZ.zero" i; + pr " ZnZ.WW ZnZ.head0"; + pr " ZnZ.add_mul_div ZnZ.div21"; + pr " ZnZ.compare ZnZ.sub (S n) x y in"; if i == size then pr " (%sn _ u, %s%i v)." c c i else pr " (to_Z%i _ u, %s%i v)." i c i; + pr ""; done; - pr ""; for i = 0 to size do pp " Lemma spec_get_end%i: forall n x y," i; @@ -1745,17 +1305,17 @@ let _ = pp " intros n x y H."; pp " rewrite spec_double_eval%in; unfold to_Z." i; pp " apply DoubleBase.spec_get_low."; - pp " exact (spec_0 w%i_spec)." i; - pp " exact (spec_to_Z w%i_spec)." i; + pp " exact ZnZ.spec_0."; + pp " exact ZnZ.spec_to_Z."; pp " apply Zle_lt_trans with [%s%i y]; auto." c i; pp " rewrite <- spec_double_eval%in; auto." i; - pp " unfold to_Z; case (spec_to_Z w%i_spec y); auto." i; + pp " unfold to_Z; case (ZnZ.spec_to_Z y); auto."; pp " Qed."; pp ""; done; for i = 0 to size do - pr " Let div_gt%i x y := let (u,v) := (w%i_div_gt x y) in (reduce_%i u, reduce_%i v)." i i i i; + pr " Let div_gt%i (x y:w%i) := let (u,v) := ZnZ.div_gt x y in (reduce_%i u, reduce_%i v)." i i i i; done; pr ""; @@ -1764,13 +1324,13 @@ let _ = pr " let mn := Max.max n m in"; pr " let d := diff n m in"; pr " let op := make_op mn in"; - pr " let (q, r):= op.(znz_div_gt)"; + pr " let (q, r):= ZnZ.div_gt"; pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; pr " (castm (diff_l n m) (extend_tr wy (fst d))) in"; pr " (reduce_n mn q, reduce_n mn r)."; pr ""; - pr " Definition div_gt := Eval lazy beta delta [iter] in"; + pr " Local Notation div_gt_folded :="; pr " (iter _"; for i = 0 to size do pr " div_gt%i" i; @@ -1778,6 +1338,7 @@ let _ = pr " w%i_divn1" i; done; pr " div_gtnm)."; + pr " Definition div_gt := Eval lazy beta delta [iter] in div_gt_folded."; pr ""; pr " Theorem spec_div_gt: forall x y,"; @@ -1790,44 +1351,29 @@ 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 " let (q,r) := res in"; - pp " x = [q] * y + [r] /\\ 0 <= [r] < y)"; - 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; - done; - pp " div_gtnm _)."; + pp " intros x y. change div_gt with div_gt_folded. apply spec_iter; clear x y."; for i = 0 to size do - pp " intros x y H1 H2; unfold div_gt%i, w%i_div_gt." i i; - pp " generalize (spec_div_gt w%i_spec x y H1 H2); case znz_div_gt." i; + pp " (* %i *)" i; + pp " intros x y H1 H2; unfold div_gt%i." i; + pp " generalize (ZnZ.spec_div_gt x y H1 H2); case ZnZ.div_gt."; pp " intros xx yy; repeat rewrite spec_reduce_%i; auto." i; if i == size then - pp " intros n x y H2 H3; unfold div_gt%i, w%i_div_gt." i i + pp " intros n x y H2 H3; unfold 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 " intros n x y H1 H2 H3; unfold div_gt%i." i; + pp " generalize (ZnZ.spec_div_gt x"; pp " (DoubleBase.get_low %s (S n) y))." (pz i); - pp0 ""; - for j = 0 to i do - pp0 "unfold w%i; " (i-j); - done; - pp "case znz_div_gt."; + pp " case ZnZ.div_gt."; pp " intros xx yy H4; repeat rewrite spec_reduce_%i." i; pp " generalize (spec_get_end%i (S n) y x); unfold to_Z; intros H5." i; pp " unfold to_Z in H2; rewrite H5 in H4; auto with zarith."; if i == size then - pp " intros n x y H2 H3." + pp " intros n x y H2 H3." else - pp " intros n x y H1 H2 H3."; + pp " intros n x y H1 H2 H3."; pp " generalize"; 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); - done; - pp "case double_divn1."; + pp " unfold w%i_divn1; case double_divn1." i; pp " intros xx yy H4."; if i == size then begin @@ -1840,13 +1386,13 @@ let _ = pp " repeat rewrite <- spec_double_eval%in in H4; auto." i; end; done; - pp " intros n m x y H1 H2; unfold div_gtnm."; - pp " generalize (spec_div_gt (wn_spec (Max.max n m))"; + pp " intros n m x y H1 H2; unfold div_gtnm."; + pp " generalize (ZnZ.spec_div_gt"; pp " (castm (diff_r n m)"; pp " (extend_tr x (snd (diff n m))))"; pp " (castm (diff_l n m)"; pp " (extend_tr y (fst (diff n m)))))."; - pp " case znz_div_gt."; + pp " case ZnZ.div_gt."; pp " intros xx yy HH."; pp " repeat rewrite spec_reduce_n."; pp " rewrite <- (spec_cast_l n m x)."; @@ -1872,15 +1418,10 @@ let _ = pr ""; for i = 0 to size do - pr " Definition w%i_mod_gt := w%i_op.(znz_mod_gt)." i i - done; - pr ""; - - for i = 0 to size do pr " Definition w%i_modn1 :=" i; - pr " double_modn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)" i i; - pr " w%i_op.(znz_head0) w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)" i i i; - pr " w%i_op.(znz_compare) w%i_op.(znz_sub)." i i; + pr " double_modn1 (ZnZ.zdigits w%i_op) (ZnZ.zero (Ops:=w%i_op))" i i; + pr " ZnZ.head0 ZnZ.add_mul_div ZnZ.div21"; + pr " ZnZ.compare ZnZ.sub."; done; pr ""; @@ -1888,56 +1429,49 @@ let _ = pr " let mn := Max.max n m in"; pr " let d := diff n m in"; pr " let op := make_op mn in"; - pr " reduce_n mn (op.(znz_mod_gt)"; + pr " reduce_n mn (ZnZ.modulo_gt"; pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; pr " (castm (diff_l n m) (extend_tr wy (fst d))))."; pr ""; - pr " Definition mod_gt := Eval lazy beta delta[iter] in"; + pr " Local Notation mod_gt_folded :="; 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); + pr " (fun x y => reduce_%i (ZnZ.modulo_gt x y))" i; + pr " (fun n x y => reduce_%i (ZnZ.modulo_gt x (DoubleBase.get_low %s (S n) y)))" i (pz i); pr " (fun n x y => reduce_%i (w%i_modn1 (S n) x y))" i i; done; 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 " 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_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 " (CyclicAxioms.spec_compare ww_spec) (CyclicAxioms.spec_sub ww_spec))."; + pr " Definition mod_gt := Eval lazy beta delta[iter] in mod_gt_folded."; + pr ""; + + pp " Let spec_modn1 ww (ww_op: ZnZ.Ops ww) (ww_spec: ZnZ.Specs ww_op) :="; + pp " spec_double_modn1"; + pp " (ZnZ.zdigits ww_op) ZnZ.zero"; + pp " ZnZ.WW ZnZ.head0"; + pp " ZnZ.add_mul_div ZnZ.div21"; + pp " ZnZ.compare ZnZ.sub ZnZ.to_Z"; + pp " ZnZ.spec_to_Z"; + pp " ZnZ.spec_zdigits"; + pp " ZnZ.spec_0 ZnZ.spec_WW ZnZ.spec_head0"; + pp " ZnZ.spec_add_mul_div ZnZ.spec_div21"; + pp " ZnZ.spec_compare ZnZ.spec_sub."; pp ""; pr " Theorem spec_mod_gt:"; pr " forall x y, [x] > [y] -> 0 < [y] -> [mod_gt x y] = [x] mod [y]."; pa " Admitted."; pp " Proof."; - pp " refine (spec_iter _ (fun x y res => x > y -> 0 < y ->"; - pp " [res] = x mod y)"; - for i = 0 to size do - pp " (fun x y => reduce_%i (w%i_mod_gt x y))" i i; - pp " (fun n x y => reduce_%i (w%i_mod_gt x (DoubleBase.get_low %s (S n) y)))" i i (pz i); - pp " (fun n x y => reduce_%i (w%i_modn1 (S n) x y)) _ _ _" i i; - done; - pp " mod_gtnm _)."; + pp " intros x y. change mod_gt with mod_gt_folded. apply spec_iter; clear x y."; for i = 0 to size do pp " intros x y H1 H2; rewrite spec_reduce_%i." i; - pp " exact (spec_mod_gt w%i_spec x y H1 H2)." i; + pp " exact (ZnZ.spec_modulo_gt x y H1 H2)."; if i == size then pp " intros n x y H2 H3; rewrite spec_reduce_%i." i else pp " intros n x y H1 H2 H3; rewrite spec_reduce_%i." i; - pp " unfold w%i_mod_gt." i; pp " rewrite <- (spec_get_end%i (S n) y x); auto with zarith." i; - pp " unfold to_Z; apply (spec_mod_gt w%i_spec); auto." i; + pp " unfold to_Z; apply ZnZ.spec_modulo_gt; auto."; pp " rewrite <- (spec_get_end%i (S n) y x) in H2; auto with zarith." i; pp " rewrite <- (spec_get_end%i (S n) y x) in H3; auto with zarith." i; if i == size then @@ -1951,399 +1485,15 @@ let _ = pp " repeat rewrite spec_reduce_n."; pp " rewrite <- (spec_cast_l n m x)."; pp " rewrite <- (spec_cast_r n m y)."; - pp " unfold to_Z; apply (spec_mod_gt (wn_spec (Max.max n m)))."; + pp " unfold to_Z; apply ZnZ.spec_modulo_gt."; pp " rewrite <- (spec_cast_l n m x) in H1; auto."; pp " rewrite <- (spec_cast_r n m y) in H1; auto."; pp " rewrite <- (spec_cast_r n m y) in H2; auto."; pp " Qed."; pr ""; - pr " (** digits: a measure for gcd *)"; - pr ""; - - pr " Definition digits x :="; - pr " match x with"; - for i = 0 to size do - pr " | %s%i _ => w%i_op.(znz_digits)" c i i; - done; - pr " | %sn n _ => (make_op n).(znz_digits)" c; - pr " end."; - pr ""; - - pr " Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x)."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; clear x."; - for i = 0 to size do - pp " intros x; unfold to_Z, digits;"; - pp " generalize (spec_to_Z w%i_spec x); unfold base; intros H; exact H." i; - done; - pp " intros n x; unfold to_Z, digits;"; - pp " generalize (spec_to_Z (wn_spec n) x); unfold base; intros H; exact H."; - pp " Qed."; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (** * Conversion *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - 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 " Zpos p < 2 ^ (Zpos (znz_digits w0_op) * 2 ^ (Z_of_nat (pheight p)))."; - pr " Proof."; - pr " intros p; unfold pheight."; - pr " assert (F1: forall x, Z_of_nat (Peano.pred (nat_of_P x)) = Zpos x - 1)."; - pr " intros x."; - pr " assert (Zsucc (Z_of_nat (Peano.pred (nat_of_P x))) = Zpos x); auto with zarith."; - pr " rewrite <- inj_S."; - pr " rewrite <- (fun x => S_pred x 0); auto with zarith."; - pr " rewrite Zpos_eq_Z_of_nat_o_nat_of_P; auto."; - pr " apply lt_le_trans with 1%snat; auto with zarith." "%"; - pr " exact (le_Pmult_nat x 1)."; - pr " rewrite F1; clear F1."; - pr " assert (F2:= (get_height_correct (znz_digits w0_op) (plength p)))."; - pr " apply Zlt_le_trans with (Zpos (Psucc p))."; - pr " rewrite Zpos_succ_morphism; auto with zarith."; - pr " apply Zle_trans with (1 := plength_pred_correct (Psucc p))."; - pr " rewrite Ppred_succ."; - pr " apply Zpower_le_monotone; auto with zarith."; - pr " Qed."; - pr ""; - - pr " Definition of_pos x :="; - pr " let h := pheight x in"; - pr " match h with"; - for i = 0 to size do - pr " | %i%snat => reduce_%i (snd (w%i_op.(znz_of_pos) x))" i "%" i i; - done; - pr " | _ =>"; - pr " let n := minus h %i in" (size + 1); - pr " reduce_n n (snd ((make_op n).(znz_of_pos) x))"; - pr " end."; - pr ""; - - pr " Theorem spec_of_pos: forall x,"; - pr " [of_pos x] = Zpos x."; - pa " Admitted."; - pp " Proof."; - pp " assert (F := spec_more_than_1_digit w0_spec)."; - pp " intros x; unfold of_pos; case_eq (pheight x)."; - for i = 0 to size do - if i <> 0 then - pp " intros n; case n; clear n."; - pp " intros H1; rewrite spec_reduce_%i; unfold to_Z." i; - pp " apply (znz_of_pos_correct w%i_spec)." i; - pp " apply Zlt_le_trans with (1 := pheight_correct x)."; - pp " rewrite H1; simpl Z_of_nat; change (2^%i) with (%s)." i (gen2 i); - pp " unfold base."; - pp " apply Zpower_le_monotone; split; auto with zarith."; - if i <> 0 then - begin - pp " rewrite Zmult_comm; repeat rewrite <- Zmult_assoc."; - pp " repeat rewrite <- Zpos_xO."; - pp " refine (Zle_refl _)."; - end; - done; - pp " intros n."; - pp " intros H1; rewrite spec_reduce_n; unfold to_Z."; - pp " simpl minus; rewrite <- minus_n_O."; - pp " apply (znz_of_pos_correct (wn_spec n))."; - pp " apply Zlt_le_trans with (1 := pheight_correct x)."; - pp " unfold base."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " split; auto with zarith."; - pp " rewrite H1."; - pp " elim n; clear n H1."; - pp " simpl Z_of_nat; change (2^%i) with (%s)." (size + 1) (gen2 (size + 1)); - pp " rewrite Zmult_comm; repeat rewrite <- Zmult_assoc."; - pp " repeat rewrite <- Zpos_xO."; - pp " refine (Zle_refl _)."; - pp " intros n Hrec."; - pp " rewrite make_op_S."; - pp " change (@znz_digits (word _ (S (S n))) (mk_zn2z_op_karatsuba (make_op n))) with"; - pp " (xO (znz_digits (make_op n)))."; - pp " rewrite (fun x y => (Zpos_xO (@znz_digits x y)))."; - pp " rewrite inj_S; unfold Zsucc."; - pp " rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith."; - pp " rewrite Zpower_1_r."; - pp " assert (tmp: forall x y z, x * (y * z) = y * (x * z));"; - pp " [intros; ring | rewrite tmp; clear tmp]."; - pp " apply Zmult_le_compat_l; auto with zarith."; - pp " Qed."; - pr ""; - - pr " (***************************************************************)"; - pr " (* *)"; - pr " (** * Shift *)"; - pr " (* *)"; - pr " (***************************************************************)"; - pr ""; - - (* Head0 *) - pr " Definition head0 w := match w with"; - for i = 0 to size do - pr " | %s%i w=> reduce_%i (w%i_op.(znz_head0) w)" c i i i; - done; - pr " | %sn n w=> reduce_n n ((make_op n).(znz_head0) w)" c; - pr " end."; - pr ""; - - pr " Theorem spec_head00: forall x, [x] = 0 ->[head0 x] = Zpos (digits x)."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; unfold head0; clear x."; - for i = 0 to size do - pp " intros x; rewrite spec_reduce_%i; exact (spec_head00 w%i_spec x)." i i; - done; - pp " intros n x; rewrite spec_reduce_n; exact (spec_head00 (wn_spec n) x)."; - pp " Qed."; - 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 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 " 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."; - done; - pp " intros n x Hx; rewrite spec_reduce_n."; - 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 " 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."; - pp " Qed."; - pr ""; - - - (* Tail0 *) - pr " Definition tail0 w := match w with"; - for i = 0 to size do - pr " | %s%i w=> reduce_%i (w%i_op.(znz_tail0) w)" c i i i; - done; - pr " | %sn n w=> reduce_n n ((make_op n).(znz_tail0) w)" c; - pr " end."; - pr ""; - - - pr " Theorem spec_tail00: forall x, [x] = 0 ->[tail0 x] = Zpos (digits x)."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; unfold tail0; clear x."; - for i = 0 to size do - pp " intros x; rewrite spec_reduce_%i; exact (spec_tail00 w%i_spec x)." i i; - done; - pp " intros n x; rewrite spec_reduce_n; exact (spec_tail00 (wn_spec n) x)."; - pp " Qed."; - pr ""; - - - pr " Theorem spec_tail0: forall x,"; - pr " 0 < [x] -> exists y, 0 <= y /\\ [x] = (2 * y + 1) * 2 ^ [tail0 x]."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; clear x; unfold tail0."; - for i = 0 to size do - pp " intros x Hx; rewrite spec_reduce_%i; exact (spec_tail0 w%i_spec x Hx)." i i; - done; - pp " intros n x Hx; rewrite spec_reduce_n; exact (spec_tail0 (wn_spec n) x Hx)."; - pp " Qed."; - pr ""; - - - (* Number of digits *) - pr " Definition %sdigits x :=" c; - pr " match x with"; - pr " | %s0 _ => %s0 w0_op.(znz_zdigits)" c c; - 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; - pr " end."; - pr ""; - - pr " Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x)."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; clear x; unfold Ndigits, digits."; - for i = 0 to size do - pp " intros _; try rewrite spec_reduce_%i; exact (spec_zdigits w%i_spec)." i i; - done; - pp " intros n _; try rewrite spec_reduce_n; exact (spec_zdigits (wn_spec n))."; - pp " Qed."; - pr ""; - - - (* Shiftr *) - for i = 0 to size do - 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 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 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 (unsafe_shiftr%i n x))" i i; - done; - pr " (fun n p x => reduce_n n (unsafe_shiftrn n p x))."; - pr ""; - - - 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)."; - pp " intros; ring."; - pp " assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z)."; - pp " intros x y z HH HH1 HH2."; - pp " split; auto with zarith."; - pp " apply Zle_lt_trans with (2 := HH2); auto with zarith."; - pp " apply Zdiv_le_upper_bound; auto with zarith."; - pp " pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith."; - pp " apply Zmult_le_compat_l; auto."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " rewrite Zpower_0_r; ring."; - pp " assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x)."; - pp " intros xx y HH HH1."; - 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 " (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) ->"; - pp " znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->"; - pp " znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->"; - pp " znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->"; - pp " znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->"; - pp " znz_to_Z ww_op"; - pp " (znz_add_mul_div ww_op (znz_sub ww_op (znz_zdigits ww_op) yy1)"; - pp " (znz_0 ww_op) xx1) = znz_to_Z ww1_op xx / 2 ^ znz_to_Z ww2_op yy)."; - pp " intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy."; - pp " case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2."; - pp " case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4."; - pp " rewrite <- Hx."; - 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 " yy1)"; - pp " )."; - pp " rewrite (spec_0 Hw)."; - pp " rewrite Zmult_0_l; rewrite Zplus_0_l."; - pp " rewrite (CyclicAxioms.spec_sub Hw)."; - pp " rewrite Zmod_small; auto with zarith."; - pp " rewrite (spec_zdigits Hw)."; - pp " rewrite F0."; - pp " rewrite Zmod_small; auto with zarith."; - pp " unfold base; rewrite (spec_zdigits Hw) in Hl1 |- *;"; - pp " auto with zarith."; - pp " assert (F5: forall n m, (n <= m)%snat ->" "%"; - pp " Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m)))."; - pp " intros n m HH; elim HH; clear m HH; auto with zarith."; - pp " intros m HH Hrec; apply Zle_trans with (1 := Hrec)."; - pp " rewrite make_op_S."; - pp " match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end."; - pp " rewrite Zpos_xO."; - pp " assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith."; - pp " assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n)))." size; - pp " intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0)))."; - pp " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size; - 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 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 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; - pp " rewrite (spec_zdigits w%i_spec)." j; - pp " change (znz_digits w%i_op) with %s." i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)")); - pp " repeat rewrite (fun x => Zpos_xO (xO x))."; - pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; - 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 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 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 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 - begin - 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; - pp " rewrite <- (spec_extend%in m); rewrite <- spec_extend%in%i; auto." size i size; - end - done; - pp " intros n x y; case y; clear y;"; - 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; - pp " rewrite (spec_zdigits w%i_spec)." i; - pp " rewrite (spec_zdigits (wn_spec n))."; - pp " apply Zle_trans with (2 := F6 n)."; - pp " change (znz_digits w%i_op) with %s." size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)")); - pp " repeat rewrite (fun x => Zpos_xO (xO x))."; - pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; - pp " assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith." i; - if i == size then - pp " change ([Nn n (extend%i n y)] = [N%i y])." size i - else - pp " change ([Nn n (extend%i n (extend%i %i y))] = [N%i y])." size i (size - i - 1) i; - pp " rewrite <- (spec_extend%in n); auto." size; - if i <> size then - pp " try (rewrite <- spec_extend%in%i; auto)." i size; - done; - pp " generalize y; clear y; intros m y."; - pp " rewrite spec_reduce_n; unfold to_Z; intros H1."; - pp " apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith."; - pp " rewrite (spec_zdigits (wn_spec m))."; - pp " rewrite (spec_zdigits (wn_spec (Max.max n m)))."; - pp " apply F5; auto with arith."; - pp " exact (spec_cast_r n m y)."; - pp " exact (spec_cast_l n m x)."; - pp " Qed."; - pr ""; +(* (* Unsafe_Shiftl *) for i = 0 to size do pr " Definition unsafe_shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0)." i i i @@ -2380,35 +1530,35 @@ let _ = 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 " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)"; + pp " (ww_op: ZnZ.Ops ww) (ww1_op: ZnZ.Ops ww1) (ww2_op: ZnZ.Ops ww2)"; pp " xx yy xx1 yy1,"; - pp " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_head0 ww1_op xx) ->"; - pp " znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->"; + pp " ZnZ.to_Z ww2_op yy <= ZnZ.to_Z ww1_op (znz_head0 ww1_op xx) ->"; + pp " ZnZ.to_Z ww1_op (ZnZ.zdigits ww1_op) <= ZnZ.to_Z ww_op (ZnZ.zdigits ww_op) ->"; pp " znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->"; - pp " znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->"; - pp " znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->"; - pp " znz_to_Z ww_op"; + pp " ZnZ.to_Z ww_op xx1 = ZnZ.to_Z ww1_op xx ->"; + pp " ZnZ.to_Z ww_op yy1 = ZnZ.to_Z ww2_op yy ->"; + pp " ZnZ.to_Z ww_op"; pp " (znz_add_mul_div ww_op yy1"; - pp " xx1 (znz_0 ww_op)) = znz_to_Z ww1_op xx * 2 ^ znz_to_Z ww2_op yy)."; + pp " xx1 (znz_0 ww_op)) = ZnZ.to_Z ww1_op xx * 2 ^ ZnZ.to_Z ww2_op yy)."; pp " intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy."; pp " case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2."; pp " case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4."; pp " rewrite <- Hx."; pp " rewrite <- Hy."; pp " generalize (spec_add_mul_div Hw xx1 (znz_0 ww_op) yy1)."; - pp " rewrite (spec_0 Hw)."; - pp " assert (F1: znz_to_Z ww1_op (znz_head0 ww1_op xx) <= Zpos (znz_digits ww1_op))."; + pp " rewrite ZnZ.spec_0."; + pp " assert (F1: ZnZ.to_Z ww1_op (znz_head0 ww1_op xx) <= Zpos (ZnZ.digits ww1_op))."; pp " case (Zle_lt_or_eq _ _ HH1); intros HH5."; pp " apply Zlt_le_weak."; pp " case (CyclicAxioms.spec_head0 Hw1 xx)."; pp " rewrite <- Hx; auto."; pp " intros _ Hu; unfold base in Hu."; - pp " case (Zle_or_lt (Zpos (znz_digits ww1_op))"; - pp " (znz_to_Z ww1_op (znz_head0 ww1_op xx))); auto; intros H1."; - pp " absurd (2 ^ (Zpos (znz_digits ww1_op)) <= 2 ^ (znz_to_Z ww1_op (znz_head0 ww1_op xx)))."; + pp " case (Zle_or_lt (Zpos (ZnZ.digits ww1_op))"; + pp " (ZnZ.to_Z ww1_op (znz_head0 ww1_op xx))); auto; intros H1."; + pp " absurd (2 ^ (Zpos (ZnZ.digits ww1_op)) <= 2 ^ (ZnZ.to_Z ww1_op (znz_head0 ww1_op xx)))."; pp " apply Zlt_not_le."; pp " case (spec_to_Z Hw1 xx); intros HHx3 HHx4."; - pp " rewrite <- (Zmult_1_r (2 ^ znz_to_Z ww1_op (znz_head0 ww1_op xx)))."; + pp " rewrite <- (Zmult_1_r (2 ^ ZnZ.to_Z ww1_op (znz_head0 ww1_op xx)))."; pp " apply Zle_lt_trans with (2 := Hu)."; pp " apply Zmult_le_compat_l; auto with zarith."; pp " apply Zpower_le_monotone; auto with zarith."; @@ -2423,7 +1573,7 @@ let _ = pp " apply Zle_trans with (2 := Hl1); auto."; pp " rewrite (spec_zdigits Hw1); auto with zarith."; pp " split; auto with zarith ."; - pp " apply Zlt_le_trans with (base (znz_digits ww1_op))."; + pp " apply Zlt_le_trans with (base (ZnZ.digits ww1_op))."; pp " rewrite Hx."; pp " case (CyclicAxioms.spec_head0 Hw1 xx); auto."; pp " rewrite <- Hx; auto."; @@ -2444,18 +1594,18 @@ let _ = pp " rewrite <- (spec_zdigits Hw); auto with zarith."; pp " rewrite <- (spec_zdigits Hw1); auto with zarith."; pp " assert (F5: forall n m, (n <= m)%snat ->" "%"; - pp " Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m)))."; + pp " Zpos (ZnZ.digits (make_op n)) <= Zpos (ZnZ.digits (make_op m)))."; pp " intros n m HH; elim HH; clear m HH; auto with zarith."; pp " intros m HH Hrec; apply Zle_trans with (1 := Hrec)."; pp " rewrite make_op_S."; pp " match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end."; pp " rewrite Zpos_xO."; - pp " assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith."; - pp " assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n)))." size; - pp " intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0)))."; - pp " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size; + pp " assert (0 <= Zpos (ZnZ.digits (make_op n))); auto with zarith."; + pp " assert (F6: forall n, Zpos (ZnZ.digits w%i_op) <= Zpos (ZnZ.digits (make_op n)))." size; + pp " intros n ; apply Zle_trans with (Zpos (ZnZ.digits (make_op 0)))."; + pp " change (ZnZ.digits (make_op 0)) with (xO (ZnZ.digits w%i_op))." size; pp " rewrite Zpos_xO."; - pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size; + 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 unsafe_shiftl, same_level."; for i = 0 to size do @@ -2466,10 +1616,10 @@ let _ = 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; pp " rewrite (spec_zdigits w%i_spec)." j; - pp " change (znz_digits w%i_op) with %s." i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)")); + pp " change (ZnZ.digits w%i_op) with %s." i (genxO (i - j) (" (ZnZ.digits w"^(string_of_int j)^"_op)")); pp " repeat rewrite (fun x => Zpos_xO (xO x))."; - pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; - pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." j; + pp " repeat rewrite (fun x y => Zpos_xO (@ZnZ.digits x y))."; + 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 unsafe_shiftl%i, head0." i; @@ -2505,10 +1655,10 @@ let _ = pp " rewrite (spec_zdigits w%i_spec)." i; pp " rewrite (spec_zdigits (wn_spec n))."; pp " apply Zle_trans with (2 := F6 n)."; - pp " change (znz_digits w%i_op) with %s." size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)")); + pp " change (ZnZ.digits w%i_op) with %s." size (genxO (size - i) ("(ZnZ.digits w" ^ (string_of_int i) ^ "_op)")); pp " repeat rewrite (fun x => Zpos_xO (xO x))."; - pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; - pp " assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith." i; + pp " repeat rewrite (fun x y => Zpos_xO (@ZnZ.digits x y))."; + pp " assert (H: 0 <= Zpos (ZnZ.digits w%i_op)); auto with zarith." i; if i == size then pp " change ([Nn n (extend%i n y)] = [N%i y])." size i else @@ -2527,147 +1677,7 @@ let _ = pp " exact (spec_cast_l n m x)."; pp " Qed."; pr ""; - - (* Double size *) - pr " Definition double_size w := match w with"; - for i = 0 to size-1 do - pr " | %s%i x => %s%i (WW (znz_0 w%i_op) x)" c i c (i + 1) i; - done; - pr " | %s%i x => %sn 0 (WW (znz_0 w%i_op) x)" c size c size; - pr " | %sn n x => %sn (S n) (WW (znz_0 (make_op n)) x)" c c; - pr " end."; - pr ""; - - pr " Theorem spec_double_size_digits:"; - pr " forall x, digits (double_size x) = xO (digits x)."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; unfold double_size, digits; clear x; auto."; - pp " intros n x; rewrite make_op_S; auto."; - pp " Qed."; - pr ""; - - - pr " Theorem spec_double_size: forall x, [double_size x] = [x]."; - pa " Admitted."; - 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 " 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;"; - pp " generalize (znz_to_Z_n n); simpl word."; - pp " intros HH; rewrite HH; clear HH."; - pp " generalize (spec_0 (wn_spec n)); simpl word."; - pp " intros HH; rewrite HH; clear HH; auto with zarith."; - pp " Qed."; - pr ""; - - - pr " Theorem spec_double_size_head0:"; - pr " forall x, 2 * [head0 x] <= [head0 (double_size x)]."; - pa " Admitted."; - pp " Proof."; - pp " intros x."; - pp " assert (F1:= spec_pos (head0 x))."; - pp " assert (F2: 0 < Zpos (digits x))."; - pp " red; auto."; - pp " case (Zle_lt_or_eq _ _ (spec_pos x)); intros HH."; - pp " generalize HH; rewrite <- (spec_double_size x); intros HH1."; - pp " case (spec_head0 x HH); intros _ HH2."; - pp " case (spec_head0 _ HH1)."; - pp " rewrite (spec_double_size x); rewrite (spec_double_size_digits x)."; - pp " intros HH3 _."; - pp " case (Zle_or_lt ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4."; - pp " absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto."; - pp " apply Zle_not_lt."; - pp " apply Zmult_le_compat_r; auto with zarith."; - pp " apply Zpower_le_monotone; auto; auto with zarith."; - pp " generalize (spec_pos (head0 (double_size x))); auto with zarith."; - pp " assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1))."; - pp " case (Zle_lt_or_eq 1 [x]); auto with zarith; intros HH5."; - pp " apply Zmult_le_reg_r with (2 ^ 1); auto with zarith."; - pp " rewrite <- (fun x y z => Zpower_exp x (y - z)); auto with zarith."; - pp " assert (tmp: forall x, x - 1 + 1 = x); [intros; ring | rewrite tmp; clear tmp]."; - pp " apply Zle_trans with (2 := Zlt_le_weak _ _ HH2)."; - 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 " 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."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " rewrite (Zmult_comm 2)."; - pp " rewrite Zpower_mult; auto with zarith."; - pp " rewrite Zpower_2."; - pp " apply Zlt_le_trans with (2 := HH3)."; - pp " rewrite <- Zmult_assoc."; - pp " replace (Zpos (xO (digits x)) - 1) with"; - pp " ((Zpos (digits x) - 1) + (Zpos (digits x)))."; - pp " rewrite Zpower_exp; auto with zarith."; - pp " apply Zmult_lt_compat2; auto with zarith."; - pp " split; auto with zarith."; - pp " apply Zmult_lt_0_compat; auto with zarith."; - pp " rewrite Zpos_xO; ring."; - pp " apply Zlt_le_weak; auto."; - pp " repeat rewrite spec_head00; auto."; - pp " rewrite spec_double_size_digits."; - pp " rewrite Zpos_xO; auto with zarith."; - pp " rewrite spec_double_size; auto."; - pp " Qed."; - pr ""; - - pr " Theorem spec_double_size_head0_pos:"; - pr " forall x, 0 < [head0 (double_size x)]."; - pa " Admitted."; - pp " Proof."; - pp " intros x."; - pp " assert (F: 0 < Zpos (digits x))."; - pp " red; auto."; - pp " case (Zle_lt_or_eq _ _ (spec_pos (head0 (double_size x)))); auto; intros F0."; - pp " case (Zle_lt_or_eq _ _ (spec_pos (head0 x))); intros F1."; - pp " apply Zlt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith."; - pp " case (Zle_lt_or_eq _ _ (spec_pos x)); intros F3."; - pp " generalize F3; rewrite <- (spec_double_size x); intros F4."; - pp " absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x)))."; - pp " apply Zle_not_lt."; - pp " apply Zpower_le_monotone; auto with zarith."; - pp " split; auto with zarith."; - pp " rewrite Zpos_xO; auto with zarith."; - pp " case (spec_head0 x F3)."; - pp " rewrite <- F1; rewrite Zpower_0_r; rewrite Zmult_1_l; intros _ HH."; - pp " apply Zle_lt_trans with (2 := HH)."; - pp " case (spec_head0 _ F4)."; - pp " rewrite (spec_double_size x); rewrite (spec_double_size_digits x)."; - pp " rewrite <- F0; rewrite Zpower_0_r; rewrite Zmult_1_l; auto."; - pp " generalize F1; rewrite (spec_head00 _ (sym_equal F3)); auto with zarith."; - pp " Qed."; - pr ""; - - (* even *) - pr " Definition is_even x :="; - pr " match x with"; - for i = 0 to size do - pr " | %s%i wx => w%i_op.(znz_is_even) wx" c i i - done; - pr " | %sn n wx => (make_op n).(znz_is_even) wx" c; - pr " end."; - pr ""; - - - pr " Theorem spec_is_even: forall x,"; - pr " if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1."; - pa " Admitted."; - pp " Proof."; - pp " intros x; case x; unfold is_even, to_Z; clear x."; - for i = 0 to size do - pp " intros x; exact (spec_is_even w%i_spec x)." i; - done; - pp " intros n x; exact (spec_is_even (wn_spec n) x)."; - pp " Qed."; - pr ""; +*) pr "End Make."; pr ""; diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v index d42db97d57..e6e4130b3e 100644 --- a/theories/Numbers/Natural/BigN/Nbasic.v +++ b/theories/Numbers/Natural/BigN/Nbasic.v @@ -260,13 +260,6 @@ Section ReduceRec. End ReduceRec. -Definition opp_compare cmp := - match cmp with - | Lt => Gt - | Eq => Eq - | Gt => Lt - end. - Section CompareRec. Variable wm w : Type. @@ -294,11 +287,7 @@ Section CompareRec. Variable w_to_Z: w -> Z. Variable w_to_Z_0: w_to_Z w_0 = 0. 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 - | Gt => w_to_Z w_0 > wm_to_Z x - end. + compare0_m x = (w_to_Z w_0 ?= wm_to_Z x). Variable wm_to_Z_pos: forall x, 0 <= wm_to_Z x < base wm_base. Let double_to_Z := double_to_Z wm_base wm_to_Z. @@ -315,29 +304,25 @@ Section CompareRec. Lemma spec_compare0_mn: forall n x, - match compare0_mn n x with - Eq => 0 = double_to_Z n x - | Lt => 0 < double_to_Z n x - | Gt => 0 > double_to_Z n x - end. - Proof. + compare0_mn n x = (0 ?= double_to_Z n x). + Proof. intros n; elim n; clear n; auto. - intros x; generalize (spec_compare0_m x); rewrite w_to_Z_0; auto. + intros x; rewrite spec_compare0_m; rewrite w_to_Z_0; auto. intros n Hrec x; case x; unfold compare0_mn; fold compare0_mn; auto. + fold word in *. intros xh xl. - generalize (Hrec xh); case compare0_mn; auto. - generalize (Hrec xl); case compare0_mn; auto. - simpl double_to_Z; intros H1 H2; rewrite H1; rewrite <- H2; auto. - simpl double_to_Z; intros H1 H2; rewrite <- H2; auto. - case (double_to_Z_pos n xl); auto with zarith. - intros H1; simpl double_to_Z. - set (u := DoubleBase.double_wB wm_base n). - case (double_to_Z_pos n xl); intros H2 H3. - assert (0 < u); auto with zarith. - unfold u, DoubleBase.double_wB, base; auto with zarith. + rewrite 2 Hrec. + simpl double_to_Z. + set (wB := DoubleBase.double_wB wm_base n). + case Zcompare_spec; intros Cmp. + rewrite <- Cmp. reflexivity. + symmetry. apply Zgt_lt, Zlt_gt. (* ;-) *) + assert (0 < wB). + unfold wB, DoubleBase.double_wB, base; auto with zarith. change 0 with (0 + 0); apply Zplus_lt_le_compat; auto with zarith. apply Zmult_lt_0_compat; auto with zarith. - case (double_to_Z_pos n xh); auto with zarith. + case (double_to_Z_pos n xl); auto with zarith. + case (double_to_Z_pos n xh); intros; exfalso; omega. Qed. Fixpoint compare_mn_1 (n:nat) : word wm n -> w -> comparison := @@ -355,17 +340,9 @@ Section CompareRec. end. Variable spec_compare: forall x y, - match compare x y with - Eq => w_to_Z x = w_to_Z y - | Lt => w_to_Z x < w_to_Z y - | Gt => w_to_Z x > w_to_Z y - end. + compare x y = Zcompare (w_to_Z x) (w_to_Z y). Variable spec_compare_m: forall x y, - match compare_m x y with - Eq => wm_to_Z x = w_to_Z y - | Lt => wm_to_Z x < w_to_Z y - | Gt => wm_to_Z x > w_to_Z y - end. + compare_m x y = Zcompare (wm_to_Z x) (w_to_Z y). Variable wm_base_lt: forall x, 0 <= w_to_Z x < base (wm_base). @@ -387,26 +364,23 @@ Section CompareRec. 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 - | Lt => double_to_Z n x < w_to_Z y - | Gt => double_to_Z n x > w_to_Z y - end. + compare_mn_1 n x y = Zcompare (double_to_Z n x) (w_to_Z y). Proof. intros n; elim n; simpl; auto; clear n. intros n Hrec x; case x; clear x; auto. - intros y; generalize (spec_compare w_0 y); rewrite w_to_Z_0; case compare; auto. - intros xh xl y; simpl; generalize (spec_compare0_mn n xh); case compare0_mn; intros H1b. + intros y; rewrite spec_compare; rewrite w_to_Z_0. reflexivity. + intros xh xl y; simpl; + rewrite spec_compare0_mn, Hrec. case Zcompare_spec. + intros H1b. rewrite <- H1b; rewrite Zmult_0_l; rewrite Zplus_0_l; auto. - apply Hrec. - apply Zlt_gt. + symmetry. apply Zlt_gt. case (double_wB_lt n y); intros _ H0. apply Zlt_le_trans with (1:= H0). fold double_wB. case (double_to_Z_pos n xl); intros H1 H2. apply Zle_trans with (double_to_Z n xh * double_wB n); auto with zarith. apply Zle_trans with (1 * double_wB n); auto with zarith. - case (double_to_Z_pos n xh); auto with zarith. + case (double_to_Z_pos n xh); intros; exfalso; omega. Qed. End CompareRec. @@ -440,22 +414,6 @@ Section AddS. End AddS. - - Lemma spec_opp: forall u x y, - match u with - | Eq => y = x - | Lt => y < x - | Gt => y > x - end -> - match opp_compare u with - | Eq => x = y - | Lt => x < y - | Gt => x > y - end. - Proof. - intros u x y; case u; simpl; auto with zarith. - Qed. - Fixpoint length_pos x := match x with xH => O | xO x1 => S (length_pos x1) | xI x1 => S (length_pos x1) end. @@ -481,33 +439,37 @@ End AddS. Variable w: Type. - Theorem digits_zop: forall w (x: znz_op w), - znz_digits (mk_zn2z_op x) = xO (znz_digits x). + Theorem digits_zop: forall t (ops : ZnZ.Ops t), + @ZnZ.digits _ mk_zn2z_ops = xO ZnZ.digits. + Proof. intros ww x; auto. Qed. - Theorem digits_kzop: forall w (x: znz_op w), - znz_digits (mk_zn2z_op_karatsuba x) = xO (znz_digits x). + Theorem digits_kzop: forall t (ops : ZnZ.Ops t), + @ZnZ.digits _ mk_zn2z_ops_karatsuba = xO (@ZnZ.digits _ ops). + Proof. intros ww x; auto. Qed. - Theorem make_zop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op x) = + Theorem make_zop: forall t (ops : ZnZ.Ops t), + @ZnZ.to_Z _ mk_zn2z_ops = fun z => match z with - W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) - + znz_to_Z x xl + | W0 => 0 + | WW xh xl => ZnZ.to_Z xh * base ZnZ.digits + + ZnZ.to_Z xl end. + Proof. intros ww x; auto. Qed. - Theorem make_kzop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op_karatsuba x) = + Theorem make_kzop: forall t (x: ZnZ.Ops t), + @ZnZ.to_Z _ mk_zn2z_ops_karatsuba = fun z => match z with - W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) - + znz_to_Z x xl + | W0 => 0 + | WW xh xl => ZnZ.to_Z xh * base ZnZ.digits + + ZnZ.to_Z xl end. + Proof. intros ww x; auto. Qed. diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v index 85639aa6ae..3f60cbf1a7 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSig.v +++ b/theories/Numbers/Natural/SpecViaZ/NSig.v @@ -51,6 +51,7 @@ Module Type NType. Parameter power_pos : t -> positive -> t. Parameter power : t -> N -> t. Parameter sqrt : t -> t. + Parameter log2 : t -> t. Parameter div_eucl : t -> t -> t * t. Parameter div : t -> t -> t. Parameter modulo : t -> t -> t. @@ -74,6 +75,8 @@ Module Type NType. 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_log2_0: forall x, [x] = 0 -> [log2 x] = 0. + Parameter spec_log2: forall x, [x]<>0 -> 2^[log2 x] <= [x] < 2^([log2 x]+1). 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]. |