diff options
Diffstat (limited to 'theories/Ints/num')
| -rw-r--r-- | theories/Ints/num/BigQ.v | 32 | ||||
| -rw-r--r-- | theories/Ints/num/GenAdd.v | 321 | ||||
| -rw-r--r-- | theories/Ints/num/GenBase.v | 454 | ||||
| -rw-r--r-- | theories/Ints/num/GenDiv.v | 1536 | ||||
| -rw-r--r-- | theories/Ints/num/GenDivn1.v | 524 | ||||
| -rw-r--r-- | theories/Ints/num/GenLift.v | 483 | ||||
| -rw-r--r-- | theories/Ints/num/GenMul.v | 624 | ||||
| -rw-r--r-- | theories/Ints/num/GenSqrt.v | 1385 | ||||
| -rw-r--r-- | theories/Ints/num/GenSub.v | 353 | ||||
| -rw-r--r-- | theories/Ints/num/MemoFn.v | 185 | ||||
| -rw-r--r-- | theories/Ints/num/NMake.v | 6809 | ||||
| -rw-r--r-- | theories/Ints/num/Nbasic.v | 510 | ||||
| -rw-r--r-- | theories/Ints/num/Q0Make.v | 1349 | ||||
| -rw-r--r-- | theories/Ints/num/QMake_base.v | 38 | ||||
| -rw-r--r-- | theories/Ints/num/QbiMake.v | 1058 | ||||
| -rw-r--r-- | theories/Ints/num/QifMake.v | 971 | ||||
| -rw-r--r-- | theories/Ints/num/QpMake.v | 888 | ||||
| -rw-r--r-- | theories/Ints/num/QvMake.v | 1143 | ||||
| -rw-r--r-- | theories/Ints/num/ZMake.v | 558 | ||||
| -rw-r--r-- | theories/Ints/num/Zn2Z.v | 917 | ||||
| -rw-r--r-- | theories/Ints/num/ZnZ.v | 323 | ||||
| -rw-r--r-- | theories/Ints/num/genN.ml | 3407 |
22 files changed, 0 insertions, 23868 deletions
diff --git a/theories/Ints/num/BigQ.v b/theories/Ints/num/BigQ.v deleted file mode 100644 index 33e5f669cd..0000000000 --- a/theories/Ints/num/BigQ.v +++ /dev/null @@ -1,32 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(* *) - -Require Export QMake_base. -Require Import QpMake. -Require Import QvMake. -Require Import Q0Make. -Require Import QifMake. -Require Import QbiMake. - -(* We choose for Q the implemention with - multiple representation of 0: 0, 1/0, 2/0 etc *) -Module BigQ := Q0. - -Definition bigQ := BigQ.t. - -Delimit Scope bigQ_scope with bigQ. -Bind Scope bigQ_scope with bigQ. -Bind Scope bigQ_scope with BigQ.t. - -Notation " i + j " := (BigQ.add i j) : bigQ_scope. -Notation " i - j " := (BigQ.sub i j) : bigQ_scope. -Notation " i * j " := (BigQ.mul i j) : bigQ_scope. -Notation " i / j " := (BigQ.div i j) : bigQ_scope. -Notation " i ?= j " := (BigQ.compare i j) : bigQ_scope. diff --git a/theories/Ints/num/GenAdd.v b/theories/Ints/num/GenAdd.v deleted file mode 100644 index fae16aad69..0000000000 --- a/theories/Ints/num/GenAdd.v +++ /dev/null @@ -1,321 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. - -Open Local Scope Z_scope. - -Section GenAdd. - Variable w : Set. - Variable w_0 : w. - Variable w_1 : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_W0 : w -> zn2z w. - Variable ww_1 : zn2z w. - Variable w_succ_c : w -> carry w. - Variable w_add_c : w -> w -> carry w. - Variable w_add_carry_c : w -> w -> carry w. - Variable w_succ : w -> w. - Variable w_add : w -> w -> w. - Variable w_add_carry : w -> w -> w. - - Definition ww_succ_c x := - match x with - | W0 => C0 ww_1 - | WW xh xl => - match w_succ_c xl with - | C0 l => C0 (WW xh l) - | C1 l => - match w_succ_c xh with - | C0 h => C0 (WW h w_0) - | C1 h => C1 W0 - end - end - end. - - Definition ww_succ x := - match x with - | W0 => ww_1 - | WW xh xl => - match w_succ_c xl with - | C0 l => WW xh l - | C1 l => w_W0 (w_succ xh) - end - end. - - Definition ww_add_c x y := - match x, y with - | W0, _ => C0 y - | _, W0 => C0 x - | WW xh xl, WW yh yl => - match w_add_c xl yl with - | C0 l => - match w_add_c xh yh with - | C0 h => C0 (WW h l) - | C1 h => C1 (w_WW h l) - end - | C1 l => - match w_add_carry_c xh yh with - | C0 h => C0 (WW h l) - | C1 h => C1 (w_WW h l) - end - end - end. - - Variable R : Set. - Variable f0 f1 : zn2z w -> R. - - Definition ww_add_c_cont x y := - match x, y with - | W0, _ => f0 y - | _, W0 => f0 x - | WW xh xl, WW yh yl => - match w_add_c xl yl with - | C0 l => - match w_add_c xh yh with - | C0 h => f0 (WW h l) - | C1 h => f1 (w_WW h l) - end - | C1 l => - match w_add_carry_c xh yh with - | C0 h => f0 (WW h l) - | C1 h => f1 (w_WW h l) - end - end - end. - - (* ww_add et ww_add_carry conserve la forme normale s'il n'y a pas - de debordement *) - Definition ww_add x y := - match x, y with - | W0, _ => y - | _, W0 => x - | WW xh xl, WW yh yl => - match w_add_c xl yl with - | C0 l => WW (w_add xh yh) l - | C1 l => WW (w_add_carry xh yh) l - end - end. - - Definition ww_add_carry_c x y := - match x, y with - | W0, W0 => C0 ww_1 - | W0, WW yh yl => ww_succ_c (WW yh yl) - | WW xh xl, W0 => ww_succ_c (WW xh xl) - | WW xh xl, WW yh yl => - match w_add_carry_c xl yl with - | C0 l => - match w_add_c xh yh with - | C0 h => C0 (WW h l) - | C1 h => C1 (WW h l) - end - | C1 l => - match w_add_carry_c xh yh with - | C0 h => C0 (WW h l) - | C1 h => C1 (w_WW h l) - end - end - end. - - Definition ww_add_carry x y := - match x, y with - | W0, W0 => ww_1 - | W0, WW yh yl => ww_succ (WW yh yl) - | WW xh xl, W0 => ww_succ (WW xh xl) - | WW xh xl, WW yh yl => - match w_add_carry_c xl yl with - | C0 l => WW (w_add xh yh) l - | C1 l => WW (w_add_carry xh yh) l - end - end. - - (*Section GenProof.*) - Variable w_digits : positive. - Variable w_to_Z : w -> Z. - - - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[+| c |]" := - (interp_carry 1 wB w_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). - - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_w_1 : [|w_1|] = 1. - Variable spec_ww_1 : [[ww_1]] = 1. - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. - Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. - Variable spec_w_succ_c : forall x, [+|w_succ_c x|] = [|x|] + 1. - Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. - Variable spec_w_add_carry_c : - forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1. - Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB. - Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. - Variable spec_w_add_carry : - forall x y, [|w_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB. - - Lemma spec_ww_succ_c : forall x, [+[ww_succ_c x]] = [[x]] + 1. - Proof. - destruct x as [ |xh xl];simpl. apply spec_ww_1. - generalize (spec_w_succ_c xl);destruct (w_succ_c xl) as [l|l]; - intro H;unfold interp_carry in H. simpl;rewrite H;ring. - rewrite <- Zplus_assoc;rewrite <- H;rewrite Zmult_1_l. - assert ([|l|] = 0). generalize (spec_to_Z xl)(spec_to_Z l);omega. - rewrite H0;generalize (spec_w_succ_c xh);destruct (w_succ_c xh) as [h|h]; - intro H1;unfold interp_carry in H1. - simpl;rewrite H1;rewrite spec_w_0;ring. - unfold interp_carry;simpl ww_to_Z;rewrite wwB_wBwB. - assert ([|xh|] = wB - 1). generalize (spec_to_Z xh)(spec_to_Z h);omega. - rewrite H2;ring. - Qed. - - Lemma spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]]. - Proof. - destruct x as [ |xh xl];simpl;trivial. - destruct y as [ |yh yl];simpl. rewrite Zplus_0_r;trivial. - replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) - with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring. - generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; - intros H;unfold interp_carry in H;rewrite <- H. - generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; - intros H1;unfold interp_carry in *;rewrite <- H1. trivial. - repeat rewrite Zmult_1_l;rewrite spec_w_WW;rewrite wwB_wBwB; ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) - as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1. - simpl;ring. - repeat rewrite Zmult_1_l;rewrite wwB_wBwB;rewrite spec_w_WW;ring. - Qed. - - Section Cont. - Variable P : zn2z w -> zn2z w -> R -> Prop. - Variable x y : zn2z w. - Variable spec_f0 : forall r, [[r]] = [[x]] + [[y]] -> P x y (f0 r). - Variable spec_f1 : forall r, wwB + [[r]] = [[x]] + [[y]] -> P x y (f1 r). - - Lemma spec_ww_add_c_cont : P x y (ww_add_c_cont x y). - Proof. - destruct x as [ |xh xl];simpl;trivial. - apply spec_f0;trivial. - destruct y as [ |yh yl];simpl. - apply spec_f0;simpl;rewrite Zplus_0_r;trivial. - generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; - intros H;unfold interp_carry in H. - generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; - intros H1;unfold interp_carry in *. - apply spec_f0. simpl;rewrite H;rewrite H1;ring. - apply spec_f1. simpl;rewrite spec_w_WW;rewrite H. - rewrite Zplus_assoc;rewrite wwB_wBwB. rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. - rewrite Zmult_1_l in H1;rewrite H1;ring. - generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) - as [h|h]; intros H1;unfold interp_carry in *. - apply spec_f0;simpl;rewrite H1. rewrite Zmult_plus_distr_l. - rewrite <- Zplus_assoc;rewrite H;ring. - apply spec_f1. simpl;rewrite spec_w_WW;rewrite wwB_wBwB. - rewrite Zplus_assoc; rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. - rewrite Zmult_1_l in H1;rewrite H1. rewrite Zmult_plus_distr_l. - rewrite <- Zplus_assoc;rewrite H;ring. - Qed. - - End Cont. - - Lemma spec_ww_add_carry_c : - forall x y, [+[ww_add_carry_c x y]] = [[x]] + [[y]] + 1. - Proof. - destruct x as [ |xh xl];intro y;simpl. - exact (spec_ww_succ_c y). - destruct y as [ |yh yl];simpl. - rewrite Zplus_0_r;exact (spec_ww_succ_c (WW xh xl)). - replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) - with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. - generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) - as [l|l];intros H;unfold interp_carry in H;rewrite <- H. - generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; - intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. - unfold interp_carry;repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) - as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. - unfold interp_carry;rewrite spec_w_WW; - repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. - Qed. - - Lemma spec_ww_succ : forall x, [[ww_succ x]] = ([[x]] + 1) mod wwB. - Proof. - destruct x as [ |xh xl];simpl. - rewrite spec_ww_1;rewrite Zmod_small;trivial. - split;[intro;discriminate|apply wwB_pos]. - rewrite <- Zplus_assoc;generalize (spec_w_succ_c xl); - destruct (w_succ_c xl) as[l|l];intro H;unfold interp_carry in H;rewrite <-H. - rewrite Zmod_small;trivial. - rewrite wwB_wBwB;apply beta_mult;apply spec_to_Z. - assert ([|l|] = 0). clear spec_ww_1 spec_w_1 spec_w_0. - assert (H1:= spec_to_Z l); assert (H2:= spec_to_Z xl); omega. - rewrite H0;rewrite Zplus_0_r;rewrite <- Zmult_plus_distr_l;rewrite wwB_wBwB. - rewrite Zpower_2; rewrite Zmult_mod_distr_r;try apply lt_0_wB. - rewrite spec_w_W0;rewrite spec_w_succ;trivial. - Qed. - - Lemma spec_ww_add : forall x y, [[ww_add x y]] = ([[x]] + [[y]]) mod wwB. - Proof. - destruct x as [ |xh xl];intros y;simpl. - rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial. - destruct y as [ |yh yl]. - change [[W0]] with 0;rewrite Zplus_0_r. - rewrite Zmod_small;trivial. - exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)). - simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) - with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring. - generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; - unfold interp_carry;intros H;simpl;rewrite <- H. - rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial. - Qed. - - Lemma spec_ww_add_carry : - forall x y, [[ww_add_carry x y]] = ([[x]] + [[y]] + 1) mod wwB. - Proof. - destruct x as [ |xh xl];intros y;simpl. - exact (spec_ww_succ y). - destruct y as [ |yh yl]. - change [[W0]] with 0;rewrite Zplus_0_r. exact (spec_ww_succ (WW xh xl)). - simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) - with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. - generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) - as [l|l];unfold interp_carry;intros H;rewrite <- H;simpl ww_to_Z. - rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial. - Qed. - -(* End GenProof. *) -End GenAdd. diff --git a/theories/Ints/num/GenBase.v b/theories/Ints/num/GenBase.v deleted file mode 100644 index e93e3a4893..0000000000 --- a/theories/Ints/num/GenBase.v +++ /dev/null @@ -1,454 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(* $Id:$ *) - -(** * *) - -(** -- Authors: Benjamin Grégoire, Laurent Théry -- Institution: INRIA -- Date: 2007 -- Remark: File automatically generated -*) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import JMeq. - -Open Local Scope Z_scope. - -Section GenBase. - Variable w : Set. - Variable w_0 : w. - Variable w_1 : w. - Variable w_Bm1 : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_0W : w -> zn2z w. - Variable w_digits : positive. - Variable w_zdigits: w. - Variable w_add: w -> w -> zn2z w. - Variable w_to_Z : w -> Z. - Variable w_compare : w -> w -> comparison. - - Definition ww_digits := xO w_digits. - - Definition ww_zdigits := w_add w_zdigits w_zdigits. - - Definition ww_to_Z := zn2z_to_Z (base w_digits) w_to_Z. - - Definition ww_1 := WW w_0 w_1. - - Definition ww_Bm1 := WW w_Bm1 w_Bm1. - - Definition ww_WW xh xl : zn2z (zn2z w) := - match xh, xl with - | W0, W0 => W0 - | _, _ => WW xh xl - end. - - Definition ww_W0 h : zn2z (zn2z w) := - match h with - | W0 => W0 - | _ => WW h W0 - end. - - Definition ww_0W l : zn2z (zn2z w) := - match l with - | W0 => W0 - | _ => WW W0 l - end. - - Definition gen_WW (n:nat) := - match n return word w n -> word w n -> word w (S n) with - | O => w_WW - | S n => - fun (h l : zn2z (word w n)) => - match h, l with - | W0, W0 => W0 - | _, _ => WW h l - end - end. - - Fixpoint gen_digits (n:nat) : positive := - match n with - | O => w_digits - | S n => xO (gen_digits n) - end. - - Definition gen_wB n := base (gen_digits n). - - Fixpoint gen_to_Z (n:nat) : word w n -> Z := - match n return word w n -> Z with - | O => w_to_Z - | S n => zn2z_to_Z (gen_wB n) (gen_to_Z n) - end. - - Fixpoint extend_aux (n:nat) (x:zn2z w) {struct n}: word w (S n) := - match n return word w (S n) with - | O => x - | S n1 => WW W0 (extend_aux n1 x) - end. - - Definition extend (n:nat) (x:w) : word w (S n) := - let r := w_0W x in - match r with - | W0 => W0 - | _ => extend_aux n r - end. - - Definition gen_0 n : word w n := - match n return word w n with - | O => w_0 - | S _ => W0 - end. - - Definition gen_split (n:nat) (x:zn2z (word w n)) := - match x with - | W0 => - match n return word w n * word w n with - | O => (w_0,w_0) - | S _ => (W0, W0) - end - | WW h l => (h,l) - end. - - Definition ww_compare x y := - match x, y with - | W0, W0 => Eq - | W0, WW yh yl => - match w_compare w_0 yh with - | Eq => w_compare w_0 yl - | _ => Lt - end - | WW xh xl, W0 => - match w_compare xh w_0 with - | Eq => w_compare xl w_0 - | _ => Gt - end - | WW xh xl, WW yh yl => - match w_compare xh yh with - | Eq => w_compare xl yl - | Lt => Lt - | Gt => Gt - end - end. - - - (* Return the low part of the composed word*) - Fixpoint get_low (n : nat) {struct n}: - word w n -> w := - match n return (word w n -> w) with - | 0%nat => fun x => x - | S n1 => - fun x => - match x with - | W0 => w_0 - | WW _ x1 => get_low n1 x1 - end - end. - - - Section GenProof. - Notation wB := (base w_digits). - Notation wwB := (base ww_digits). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[[ x ]]" := (ww_to_Z x) (at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB ww_to_Z c) (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB ww_to_Z c) (at level 0, x at level 99). - Notation "[! n | x !]" := (gen_to_Z n x) (at level 0, x at level 99). - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_w_1 : [|w_1|] = 1. - Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1. - 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_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. - - Lemma wwB_wBwB : wwB = wB^2. - Proof. - unfold base, ww_digits;rewrite Zpower_2; rewrite (Zpos_xO w_digits). - replace (2 * Zpos w_digits) with (Zpos w_digits + Zpos w_digits). - apply Zpower_exp; unfold Zge;simpl;intros;discriminate. - ring. - Qed. - - Lemma spec_ww_1 : [[ww_1]] = 1. - Proof. simpl;rewrite spec_w_0;rewrite spec_w_1;ring. Qed. - - Lemma spec_ww_Bm1 : [[ww_Bm1]] = wwB - 1. - Proof. simpl;rewrite spec_w_Bm1;rewrite wwB_wBwB;ring. Qed. - - Lemma lt_0_wB : 0 < wB. - Proof. - unfold base;apply Zpower_gt_0. unfold Zlt;reflexivity. - unfold Zle;intros H;discriminate H. - Qed. - - Lemma lt_0_wwB : 0 < wwB. - Proof. rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_lt_0_compat;apply lt_0_wB. Qed. - - Lemma wB_pos: 1 < wB. - Proof. - unfold base;apply Zlt_le_trans with (2^1). unfold Zlt;reflexivity. - apply Zpower_le_monotone. unfold Zlt;reflexivity. - split;unfold Zle;intros H. discriminate H. - clear spec_w_0W w_0W spec_w_Bm1 spec_to_Z spec_w_WW w_WW. - destruct w_digits; discriminate H. - Qed. - - Lemma wwB_pos: 1 < wwB. - Proof. - assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Zmult_1_r 1). - rewrite Zpower_2. - apply Zmult_lt_compat2;(split;[unfold Zlt;reflexivity|trivial]). - apply Zlt_le_weak;trivial. - Qed. - - Theorem wB_div_2: 2 * (wB / 2) = wB. - Proof. - clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W - spec_to_Z;unfold base. - assert (2 ^ Zpos w_digits = 2 * (2 ^ (Zpos w_digits - 1))). - pattern 2 at 2; rewrite <- Zpower_1_r. - rewrite <- Zpower_exp; auto with zarith. - f_equal; auto with zarith. - case w_digits; compute; intros; discriminate. - rewrite H; f_equal; auto with zarith. - rewrite Zmult_comm; apply Z_div_mult; auto with zarith. - Qed. - - Theorem wwB_div_2 : wwB / 2 = wB / 2 * wB. - Proof. - clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W - spec_to_Z. - rewrite wwB_wBwB; rewrite Zpower_2. - pattern wB at 1; rewrite <- wB_div_2; auto. - rewrite <- Zmult_assoc. - repeat (rewrite (Zmult_comm 2); rewrite Z_div_mult); auto with zarith. - Qed. - - Lemma mod_wwB : forall z x, - (z*wB + [|x|]) mod wwB = (z mod wB)*wB + [|x|]. - Proof. - intros z x. - rewrite Zplus_mod. - pattern wwB at 1;rewrite wwB_wBwB; rewrite Zpower_2. - rewrite Zmult_mod_distr_r;try apply lt_0_wB. - rewrite (Zmod_small [|x|]). - apply Zmod_small;rewrite wwB_wBwB;apply beta_mult;try apply spec_to_Z. - apply Z_mod_lt;apply Zlt_gt;apply lt_0_wB. - destruct (spec_to_Z x);split;trivial. - change [|x|] with (0*wB+[|x|]). rewrite wwB_wBwB. - rewrite Zpower_2;rewrite <- (Zplus_0_r (wB*wB));apply beta_lex_inv. - apply lt_0_wB. apply spec_to_Z. split;[apply Zle_refl | apply lt_0_wB]. - Qed. - - Lemma wB_div : forall x y, ([|x|] * wB + [|y|]) / wB = [|x|]. - Proof. - clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. - intros x y;unfold base;rewrite Zdiv_shift_r;auto with zarith. - rewrite Z_div_mult;auto with zarith. - destruct (spec_to_Z x);trivial. - Qed. - - Lemma wB_div_plus : forall x y p, - 0 <= p -> - ([|x|]*wB + [|y|]) / 2^(Zpos w_digits + p) = [|x|] / 2^p. - Proof. - clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. - intros x y p Hp;rewrite Zpower_exp;auto with zarith. - rewrite <- Zdiv_Zdiv;auto with zarith. - rewrite wB_div;trivial. - Qed. - - Lemma lt_wB_wwB : wB < wwB. - Proof. - clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. - unfold base;apply Zpower_lt_monotone;auto with zarith. - assert (0 < Zpos w_digits). compute;reflexivity. - unfold ww_digits;rewrite Zpos_xO;auto with zarith. - Qed. - - Lemma w_to_Z_wwB : forall x, x < wB -> x < wwB. - Proof. - intros x H;apply Zlt_trans with wB;trivial;apply lt_wB_wwB. - Qed. - - Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB. - Proof. - clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. - destruct x as [ |h l];simpl. - split;[apply Zle_refl|apply lt_0_wwB]. - assert (H:=spec_to_Z h);assert (L:=spec_to_Z l);split. - apply Zplus_le_0_compat;auto with zarith. - rewrite <- (Zplus_0_r wwB);rewrite wwB_wBwB; rewrite Zpower_2; - apply beta_lex_inv;auto with zarith. - Qed. - - Lemma gen_wB_wwB : forall n, gen_wB n * gen_wB n = gen_wB (S n). - Proof. - intros n;unfold gen_wB;simpl. - unfold base;rewrite (Zpos_xO (gen_digits n)). - replace (2 * Zpos (gen_digits n)) with - (Zpos (gen_digits n) + Zpos (gen_digits n)). - symmetry; apply Zpower_exp;intro;discriminate. - ring. - Qed. - - Lemma gen_wB_pos: - forall n, 0 <= gen_wB n. - Proof. - intros n; unfold gen_wB, base; auto with zarith. - Qed. - - Lemma gen_wB_more_digits: - forall n, wB <= gen_wB n. - Proof. - clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. - intros n; elim n; clear n; auto. - unfold gen_wB, gen_digits; auto with zarith. - intros n H1; rewrite <- gen_wB_wwB. - apply Zle_trans with (wB * 1). - rewrite Zmult_1_r; apply Zle_refl. - apply Zmult_le_compat; auto with zarith. - apply Zle_trans with wB; auto with zarith. - unfold base. - rewrite <- (Zpower_0_r 2). - apply Zpower_le_monotone2; auto with zarith. - unfold base; auto with zarith. - Qed. - - Lemma spec_gen_to_Z : - forall n (x:word w n), 0 <= [!n | x!] < gen_wB n. - Proof. - clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. - induction n;intros. exact (spec_to_Z x). - unfold gen_to_Z;fold gen_to_Z. - destruct x;unfold zn2z_to_Z. - unfold gen_wB,base;split;auto with zarith. - assert (U0:= IHn w0);assert (U1:= IHn w1). - split;auto with zarith. - apply Zlt_le_trans with ((gen_wB n - 1) * gen_wB n + gen_wB n). - assert (gen_to_Z n w0*gen_wB n <= (gen_wB n - 1)*gen_wB n). - apply Zmult_le_compat_r;auto with zarith. - auto with zarith. - rewrite <- gen_wB_wwB. - replace ((gen_wB n - 1) * gen_wB n + gen_wB n) with (gen_wB n * gen_wB n); - [auto with zarith | ring]. - Qed. - - Lemma spec_get_low: - forall n x, - [!n | x!] < wB -> [|get_low n x|] = [!n | x!]. - Proof. - clear spec_w_1 spec_w_Bm1. - intros n; elim n; auto; clear n. - intros n Hrec x; case x; clear x; auto. - intros xx yy H1; simpl in H1. - assert (F1: [!n | xx!] = 0). - case (Zle_lt_or_eq 0 ([!n | xx!])); auto. - case (spec_gen_to_Z n xx); auto. - intros F2. - assert (F3 := gen_wB_more_digits n). - assert (F4: 0 <= [!n | yy!]). - case (spec_gen_to_Z n yy); auto. - assert (F5: 1 * wB <= [!n | xx!] * gen_wB n); - auto with zarith. - apply Zmult_le_compat; auto with zarith. - unfold base; auto with zarith. - simpl get_low; simpl gen_to_Z. - generalize H1; clear H1. - rewrite F1; rewrite Zmult_0_l; rewrite Zplus_0_l. - intros H1; apply Hrec; auto. - Qed. - - Lemma spec_gen_WW : forall n (h l : word w n), - [!S n|gen_WW n h l!] = [!n|h!] * gen_wB n + [!n|l!]. - Proof. - induction n;simpl;intros;trivial. - destruct h;auto. - destruct l;auto. - Qed. - - Lemma spec_extend_aux : forall n x, [!S n|extend_aux n x!] = [[x]]. - Proof. induction n;simpl;trivial. Qed. - - Lemma spec_extend : forall n x, [!S n|extend n x!] = [|x|]. - Proof. - intros n x;assert (H:= spec_w_0W x);unfold extend. - destruct (w_0W x);simpl;trivial. - rewrite <- H;exact (spec_extend_aux n (WW w0 w1)). - Qed. - - Lemma spec_gen_0 : forall n, [!n|gen_0 n!] = 0. - Proof. destruct n;trivial. Qed. - - Lemma spec_gen_split : forall n x, - let (h,l) := gen_split n x in - [!S n|x!] = [!n|h!] * gen_wB n + [!n|l!]. - Proof. - destruct x;simpl;auto. - destruct n;simpl;trivial. - rewrite spec_w_0;trivial. - Qed. - - Lemma wB_lex_inv: forall a b c d, - a < c -> - a * wB + [|b|] < c * wB + [|d|]. - Proof. - intros a b c d H1; apply beta_lex_inv with (1 := H1); auto. - Qed. - - Lemma spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. - 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. - apply wB_lex_inv;trivial. - absurd (0 <= [|yh|]). apply Zgt_not_le;trivial. - destruct (spec_to_Z yh);trivial. - generalize (spec_w_compare xh w_0);destruct (w_compare xh w_0); - 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. - 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. - apply wB_lex_inv;trivial. - apply Zlt_gt;apply wB_lex_inv;apply Zgt_lt;trivial. - Qed. - - - End GenProof. - -End GenBase. - diff --git a/theories/Ints/num/GenDiv.v b/theories/Ints/num/GenDiv.v deleted file mode 100644 index ea6868a901..0000000000 --- a/theories/Ints/num/GenDiv.v +++ /dev/null @@ -1,1536 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. -Require Import GenDivn1. -Require Import GenAdd. -Require Import GenSub. - -Open Local Scope Z_scope. - -Ltac zarith := auto with zarith. - - -Section POS_MOD. - - Variable w:Set. - Variable w_0 : w. - Variable w_digits : positive. - Variable w_zdigits : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_pos_mod : w -> w -> w. - Variable w_compare : w -> w -> comparison. - Variable ww_compare : zn2z w -> zn2z w -> comparison. - Variable w_0W : w -> zn2z w. - Variable low: zn2z w -> w. - Variable ww_sub: zn2z w -> zn2z w -> zn2z w. - Variable ww_zdigits : zn2z w. - - - Definition ww_pos_mod p x := - let zdigits := w_0W w_zdigits in - match x with - | W0 => W0 - | WW xh xl => - match ww_compare p zdigits with - | Eq => w_WW w_0 xl - | Lt => w_WW w_0 (w_pos_mod (low p) xl) - | Gt => - match ww_compare p ww_zdigits with - | Lt => - let n := low (ww_sub p zdigits) in - w_WW (w_pos_mod n xh) xl - | _ => x - end - end - end. - - - Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - - - Variable spec_w_0 : [|w_0|] = 0. - - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - - Variable spec_to_w_Z : forall x, 0 <= [[x]] < wwB. - - Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. - - Variable spec_pos_mod : forall w p, - [|w_pos_mod p w|] = [|w|] mod (2 ^ [|p|]). - - 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. - Variable spec_ww_sub: forall x y, - [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. - - Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits. - Variable spec_low: forall x, [| low x|] = [[x]] mod wB. - Variable spec_ww_zdigits : [[ww_zdigits]] = 2 * [|w_zdigits|]. - Variable spec_ww_digits : ww_digits w_digits = xO w_digits. - - - Hint Rewrite spec_w_0 spec_w_WW : w_rewrite. - - Lemma spec_ww_pos_mod : forall w p, - [[ww_pos_mod p w]] = [[w]] mod (2 ^ [[p]]). - assert (HHHHH:= lt_0_wB w_digits). - assert (F0: forall x y, x - y + y = x); auto with zarith. - 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; - rewrite spec_w_0W; rewrite spec_zdigits; fold wB; - intros H1. - rewrite H1; simpl ww_to_Z. - autorewrite with w_rewrite rm10. - rewrite Zplus_mod; auto with zarith. - rewrite Z_mod_mult; auto with zarith. - autorewrite with rm10. - rewrite Zmod_mod; auto with zarith. - rewrite Zmod_small; auto with zarith. - autorewrite with w_rewrite rm10. - simpl ww_to_Z. - rewrite spec_pos_mod. - assert (HH0: [|low p|] = [[p]]). - rewrite spec_low. - apply Zmod_small; auto with zarith. - case (spec_to_w_Z p); intros HHH1 HHH2; split; auto with zarith. - apply Zlt_le_trans with (1 := H1). - unfold base; apply Zpower2_le_lin; auto with zarith. - rewrite HH0. - rewrite Zplus_mod; auto with zarith. - unfold base. - rewrite <- (F0 (Zpos w_digits) [[p]]). - rewrite Zpower_exp; auto with zarith. - rewrite Zmult_assoc. - 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_zdigits; intros H2. - replace (2^[[p]]) with wwB. - rewrite Zmod_small; auto with zarith. - unfold base; rewrite H2. - rewrite spec_ww_digits; auto. - assert (HH0: [|low (ww_sub p (w_0W w_zdigits))|] = - [[p]] - Zpos w_digits). - rewrite spec_low. - rewrite spec_ww_sub. - rewrite spec_w_0W; rewrite spec_zdigits. - rewrite <- Zmod_div_mod; auto with zarith. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - apply Zlt_le_trans with (Zpos w_digits); auto with zarith. - unfold base; apply Zpower2_le_lin; auto with zarith. - exists wB; unfold base; rewrite <- Zpower_exp; auto with zarith. - rewrite spec_ww_digits; - apply f_equal with (f := Zpower 2); rewrite Zpos_xO; auto with zarith. - simpl ww_to_Z; autorewrite with w_rewrite. - rewrite spec_pos_mod; rewrite HH0. - pattern [|xh|] at 2; - rewrite Z_div_mod_eq with (b := 2 ^ ([[p]] - Zpos w_digits)); - auto with zarith. - rewrite (fun x => (Zmult_comm (2 ^ x))); rewrite Zmult_plus_distr_l. - unfold base; rewrite <- Zmult_assoc; rewrite <- Zpower_exp; - auto with zarith. - rewrite F0; auto with zarith. - rewrite <- Zplus_assoc; rewrite Zplus_mod; auto with zarith. - rewrite Z_mod_mult; auto with zarith. - autorewrite with rm10. - rewrite Zmod_mod; auto with zarith. - apply sym_equal; apply Zmod_small; auto with zarith. - case (spec_to_Z xh); intros U1 U2. - case (spec_to_Z xl); intros U3 U4. - split; auto with zarith. - apply Zplus_le_0_compat; auto with zarith. - apply Zmult_le_0_compat; auto with zarith. - match goal with |- 0 <= ?X mod ?Y => - case (Z_mod_lt X Y); auto with zarith - end. - match goal with |- ?X mod ?Y * ?U + ?Z < ?T => - apply Zle_lt_trans with ((Y - 1) * U + Z ); - [case (Z_mod_lt X Y); auto with zarith | idtac] - end. - match goal with |- ?X * ?U + ?Y < ?Z => - apply Zle_lt_trans with (X * U + (U - 1)) - end. - apply Zplus_le_compat_l; auto with zarith. - case (spec_to_Z xl); unfold base; auto with zarith. - rewrite Zmult_minus_distr_r; rewrite <- Zpower_exp; auto with zarith. - rewrite F0; auto with zarith. - rewrite Zmod_small; auto with zarith. - case (spec_to_w_Z (WW xh xl)); intros U1 U2. - split; auto with zarith. - apply Zlt_le_trans with (1:= U2). - unfold base; rewrite spec_ww_digits. - apply Zpower_le_monotone; auto with zarith. - split; auto with zarith. - rewrite Zpos_xO; auto with zarith. - Qed. - -End POS_MOD. - -Section GenDiv32. - - Variable w : Set. - Variable w_0 : w. - Variable w_Bm1 : w. - Variable w_Bm2 : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_compare : w -> w -> comparison. - Variable w_add_c : w -> w -> carry w. - Variable w_add_carry_c : w -> w -> carry w. - Variable w_add : w -> w -> w. - Variable w_add_carry : w -> w -> w. - Variable w_pred : w -> w. - Variable w_sub : w -> w -> w. - Variable w_mul_c : w -> w -> zn2z w. - Variable w_div21 : w -> w -> w -> w*w. - Variable ww_sub_c : zn2z w -> zn2z w -> carry (zn2z w). - - Definition w_div32 a1 a2 a3 b1 b2 := - Eval lazy beta iota delta [ww_add_c_cont ww_add] in - match w_compare a1 b1 with - | Lt => - let (q,r) := w_div21 a1 a2 b1 in - match ww_sub_c (w_WW r a3) (w_mul_c q b2) with - | C0 r1 => (q,r1) - | C1 r1 => - let q := w_pred q in - ww_add_c_cont w_WW w_add_c w_add_carry_c - (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2))) - (fun r2 => (q,r2)) - r1 (WW b1 b2) - end - | Eq => - ww_add_c_cont w_WW w_add_c w_add_carry_c - (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2))) - (fun r => (w_Bm1,r)) - (WW (w_sub a2 b2) a3) (WW b1 b2) - | Gt => (w_0, W0) (* cas absurde *) - end. - - (* Proof *) - - Variable w_digits : positive. - Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[+| c |]" := - (interp_carry 1 wB w_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). - - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1. - Variable spec_w_Bm2 : [|w_Bm2|] = wB - 2. - - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - - 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. - 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. - - Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. - Variable spec_w_add_carry : - forall x y, [|w_add_carry x y|] = ([|x|] + [|y|] + 1) mod wB. - - Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB. - Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. - - Variable spec_mul_c : forall x y, [[ w_mul_c x y ]] = [|x|] * [|y|]. - Variable spec_div21 : forall a1 a2 b, - wB/2 <= [|b|] -> - [|a1|] < [|b|] -> - let (q,r) := w_div21 a1 a2 b in - [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]. - - Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]]. - - Ltac Spec_w_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_to_Z x). - Ltac Spec_ww_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x). - - Theorem wB_div2: forall x, wB/2 <= x -> wB <= 2 * x. - intros x H; rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith. - Qed. - - Lemma Zmult_lt_0_reg_r_2 : forall n m : Z, 0 <= n -> 0 < m * n -> 0 < m. - Proof. - intros n m H1 H2;apply Zmult_lt_0_reg_r with n;trivial. - destruct (Zle_lt_or_eq _ _ H1);trivial. - subst;rewrite Zmult_0_r in H2;discriminate H2. - Qed. - - Theorem spec_w_div32 : forall a1 a2 a3 b1 b2, - wB/2 <= [|b1|] -> - [[WW a1 a2]] < [[WW b1 b2]] -> - let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ - 0 <= [[r]] < [|b1|] * wB + [|b2|]. - Proof. - intros a1 a2 a3 b1 b2 Hle Hlt. - assert (U:= lt_0_wB w_digits); assert (U1:= lt_0_wwB w_digits). - Spec_w_to_Z a1;Spec_w_to_Z a2;Spec_w_to_Z a3;Spec_w_to_Z b1;Spec_w_to_Z b2. - rewrite wwB_wBwB; rewrite Zpower_2; rewrite Zmult_assoc;rewrite <- Zmult_plus_distr_l. - change (w_div32 a1 a2 a3 b1 b2) with - match w_compare a1 b1 with - | Lt => - let (q,r) := w_div21 a1 a2 b1 in - match ww_sub_c (w_WW r a3) (w_mul_c q b2) with - | C0 r1 => (q,r1) - | C1 r1 => - let q := w_pred q in - ww_add_c_cont w_WW w_add_c w_add_carry_c - (fun r2=>(w_pred q, ww_add w_add_c w_add w_add_carry r2 (WW b1 b2))) - (fun r2 => (q,r2)) - r1 (WW b1 b2) - end - | Eq => - ww_add_c_cont w_WW w_add_c w_add_carry_c - (fun r => (w_Bm2, ww_add w_add_c w_add w_add_carry r (WW b1 b2))) - (fun r => (w_Bm1,r)) - (WW (w_sub a2 b2) a3) (WW b1 b2) - | Gt => (w_0, W0) (* cas absurde *) - end. - assert (Hcmp:=spec_compare a1 b1);destruct (w_compare a1 b1). - simpl in Hlt. - rewrite Hcmp in Hlt;assert ([|a2|] < [|b2|]). omega. - assert ([[WW (w_sub a2 b2) a3]] = ([|a2|]-[|b2|])*wB + [|a3|] + wwB). - simpl;rewrite spec_sub. - assert ([|a2|] - [|b2|] = wB*(-1) + ([|a2|] - [|b2|] + wB)). ring. - assert (0 <= [|a2|] - [|b2|] + wB < wB). omega. - rewrite <-(Zmod_unique ([|a2|]-[|b2|]) wB (-1) ([|a2|]-[|b2|]+wB) H1 H0). - rewrite wwB_wBwB;ring. - assert (U2 := wB_pos w_digits). - eapply spec_ww_add_c_cont with (P := - fun (x y:zn2z w) (res:w*zn2z w) => - let (q, r) := res in - ([|a1|] * wB + [|a2|]) * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ - 0 <= [[r]] < [|b1|] * wB + [|b2|]);eauto. - rewrite H0;intros r. - repeat - (rewrite spec_ww_add;eauto || rewrite spec_w_Bm1 || rewrite spec_w_Bm2); - simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. - assert (0<= ([[r]] + ([|b1|] * wB + [|b2|])) - wwB < [|b1|] * wB + [|b2|]). - Spec_ww_to_Z r;split;zarith. - rewrite H1. - assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB). - rewrite wwB_wBwB; rewrite Zpower_2; zarith. - assert (-wwB < ([|a2|] - [|b2|]) * wB + [|a3|] < 0). - split. apply Zlt_le_trans with (([|a2|] - [|b2|]) * wB);zarith. - rewrite wwB_wBwB;replace (-(wB^2)) with (-wB*wB);[zarith | ring]. - apply Zmult_lt_compat_r;zarith. - apply Zle_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith. - replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with - (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith | ring]. - assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith. - replace 0 with (0*wB);zarith. - replace (([|a2|] - [|b2|]) * wB + [|a3|] + wwB + ([|b1|] * wB + [|b2|]) + - ([|b1|] * wB + [|b2|]) - wwB) with - (([|a2|] - [|b2|]) * wB + [|a3|] + 2*[|b1|] * wB + 2*[|b2|]); - [zarith | ring]. - rewrite <- (Zmod_unique ([[r]] + ([|b1|] * wB + [|b2|])) wwB - 1 ([[r]] + ([|b1|] * wB + [|b2|]) - wwB));zarith;try (ring;fail). - split. rewrite H1;rewrite Hcmp;ring. trivial. - Spec_ww_to_Z (WW b1 b2). simpl in HH4;zarith. - rewrite H0;intros r;repeat - (rewrite spec_w_Bm1 || rewrite spec_w_Bm2); - simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. - assert ([[r]]=([|a2|]-[|b2|])*wB+[|a3|]+([|b1|]*wB+[|b2|])). zarith. - split. rewrite H2;rewrite Hcmp;ring. - split. Spec_ww_to_Z r;zarith. - rewrite H2. - assert (([|a2|] - [|b2|]) * wB + [|a3|] < 0);zarith. - apply Zle_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith. - replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with - (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith|ring]. - assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith. - replace 0 with (0*wB);zarith. - (* Cas Lt *) - assert (Hdiv21 := spec_div21 a2 Hle Hcmp); - destruct (w_div21 a1 a2 b1) as (q, r);destruct Hdiv21. - rewrite H. - assert (Hq := spec_to_Z q). - generalize - (spec_ww_sub_c (w_WW r a3) (w_mul_c q b2)); - destruct (ww_sub_c (w_WW r a3) (w_mul_c q b2)) - as [r1|r1];repeat (rewrite spec_w_WW || rewrite spec_mul_c); - unfold interp_carry;intros H1. - rewrite H1. - split. ring. split. - rewrite <- H1;destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z r1);trivial. - apply Zle_lt_trans with ([|r|] * wB + [|a3|]). - assert ( 0 <= [|q|] * [|b2|]);zarith. - apply beta_lex_inv;zarith. - assert ([[r1]] = [|r|] * wB + [|a3|] - [|q|] * [|b2|] + wwB). - rewrite <- H1;ring. - Spec_ww_to_Z r1; assert (0 <= [|r|]*wB). zarith. - assert (0 < [|q|] * [|b2|]). zarith. - assert (0 < [|q|]). - apply Zmult_lt_0_reg_r_2 with [|b2|];zarith. - eapply spec_ww_add_c_cont with (P := - fun (x y:zn2z w) (res:w*zn2z w) => - let (q0, r0) := res in - ([|q|] * [|b1|] + [|r|]) * wB + [|a3|] = - [|q0|] * ([|b1|] * wB + [|b2|]) + [[r0]] /\ - 0 <= [[r0]] < [|b1|] * wB + [|b2|]);eauto. - intros r2;repeat (rewrite spec_pred || rewrite spec_ww_add;eauto); - simpl ww_to_Z;intros H7. - assert (0 < [|q|] - 1). - assert (1 <= [|q|]). zarith. - destruct (Zle_lt_or_eq _ _ H6);zarith. - rewrite <- H8 in H2;rewrite H2 in H7. - assert (0 < [|b1|]*wB). apply Zmult_lt_0_compat;zarith. - Spec_ww_to_Z r2. zarith. - rewrite (Zmod_small ([|q|] -1));zarith. - rewrite (Zmod_small ([|q|] -1 -1));zarith. - assert ([[r2]] + ([|b1|] * wB + [|b2|]) = - wwB * 1 + - ([|r|] * wB + [|a3|] - [|q|] * [|b2|] + 2 * ([|b1|] * wB + [|b2|]))). - rewrite H7;rewrite H2;ring. - assert - ([|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) - < [|b1|]*wB + [|b2|]). - Spec_ww_to_Z r2;omega. - Spec_ww_to_Z (WW b1 b2). simpl in HH5. - assert - (0 <= [|r|]*wB + [|a3|] - [|q|]*[|b2|] + 2 * ([|b1|]*wB + [|b2|]) - < wwB). split;try omega. - replace (2*([|b1|]*wB+[|b2|])) with ((2*[|b1|])*wB+2*[|b2|]). 2:ring. - assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB). - rewrite wwB_wBwB; rewrite Zpower_2; zarith. omega. - rewrite <- (Zmod_unique - ([[r2]] + ([|b1|] * wB + [|b2|])) - wwB - 1 - ([|r|] * wB + [|a3|] - [|q|] * [|b2|] + 2*([|b1|] * wB + [|b2|])) - H10 H8). - split. ring. zarith. - intros r2;repeat (rewrite spec_pred);simpl ww_to_Z;intros H7. - rewrite (Zmod_small ([|q|] -1));zarith. - split. - replace [[r2]] with ([[r1]] + ([|b1|] * wB + [|b2|]) -wwB). - rewrite H2; ring. rewrite <- H7; ring. - Spec_ww_to_Z r2;Spec_ww_to_Z r1. omega. - simpl in Hlt. - assert ([|a1|] * wB + [|a2|] <= [|b1|] * wB + [|b2|]). zarith. - assert (H1 := beta_lex _ _ _ _ _ H HH0 HH3). rewrite spec_w_0;simpl;zarith. - Qed. - - -End GenDiv32. - -Section GenDiv21. - Variable w : Set. - Variable w_0 : w. - - Variable w_0W : w -> zn2z w. - Variable w_div32 : w -> w -> w -> w -> w -> w * zn2z w. - - Variable ww_1 : zn2z w. - Variable ww_compare : zn2z w -> zn2z w -> comparison. - Variable ww_sub : zn2z w -> zn2z w -> zn2z w. - - - Definition ww_div21 a1 a2 b := - match a1 with - | W0 => - match ww_compare a2 b with - | Gt => (ww_1, ww_sub a2 b) - | Eq => (ww_1, W0) - | Lt => (W0, a2) - end - | WW a1h a1l => - match a2 with - | W0 => - match b with - | W0 => (W0,W0) (* cas absurde *) - | WW b1 b2 => - let (q1, r) := w_div32 a1h a1l w_0 b1 b2 in - match r with - | W0 => (WW q1 w_0, W0) - | WW r1 r2 => - let (q2, s) := w_div32 r1 r2 w_0 b1 b2 in - (WW q1 q2, s) - end - end - | WW a2h a2l => - match b with - | W0 => (W0,W0) (* cas absurde *) - | WW b1 b2 => - let (q1, r) := w_div32 a1h a1l a2h b1 b2 in - match r with - | W0 => (WW q1 w_0, w_0W a2l) - | WW r1 r2 => - let (q2, s) := w_div32 r1 r2 a2l b1 b2 in - (WW q1 q2, s) - end - end - end - end. - - (* Proof *) - - Variable w_digits : positive. - Variable w_to_Z : w -> Z. - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. - Variable spec_w_div32 : forall a1 a2 a3 b1 b2, - wB/2 <= [|b1|] -> - [[WW a1 a2]] < [[WW b1 b2]] -> - let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ - 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. - Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. - - Theorem wwB_div: wwB = 2 * (wwB / 2). - Proof. - rewrite wwB_div_2; rewrite Zmult_assoc; rewrite wB_div_2; auto. - rewrite <- Zpower_2; apply wwB_wBwB. - Qed. - - Ltac Spec_w_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_to_Z x). - Ltac Spec_ww_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x). - - Theorem spec_ww_div21 : forall a1 a2 b, - wwB/2 <= [[b]] -> - [[a1]] < [[b]] -> - let (q,r) := ww_div21 a1 a2 b in - [[a1]] *wwB+[[a2]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]. - Proof. - assert (U:= lt_0_wB w_digits). - assert (U1:= lt_0_wwB w_digits). - 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. - rewrite spec_ww_sub;simpl. rewrite Zmod_small;zarith. - split. ring. - assert (wwB <= 2*[[b]]);zarith. - rewrite wwB_div;zarith. - intros a1h a1l. Spec_w_to_Z a1h;Spec_w_to_Z a1l. Spec_ww_to_Z a2. - destruct a2 as [ |a3 a4]; - (destruct b as [ |b1 b2];[unfold Zle in Eq;discriminate Eq|idtac]); - try (Spec_w_to_Z a3; Spec_w_to_Z a4); Spec_w_to_Z b1; Spec_w_to_Z b2; - intros Hlt H; match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] => - generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U); - intros q1 r H0 - end; (assert (Eq1: wB / 2 <= [|b1|]);[ - apply (@beta_lex (wB / 2) 0 [|b1|] [|b2|] wB); auto with zarith; - autorewrite with rm10;repeat rewrite (Zmult_comm wB); - rewrite <- wwB_div_2; trivial - | generalize (H0 Eq1 Hlt);clear H0;destruct r as [ |r1 r2];simpl; - try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Zplus_0_r; - intros (H1,H2) ]). - split;[rewrite wwB_wBwB; rewrite Zpower_2 | trivial]. - rewrite Zmult_assoc;rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc; - rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H1;ring. - destruct H2 as (H2,H3);match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] => - generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U); - intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end. - split;[rewrite wwB_wBwB | trivial]. - rewrite Zpower_2. - rewrite Zmult_assoc;rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc; - rewrite <- Zpower_2. - rewrite <- wwB_wBwB;rewrite H1. - rewrite spec_w_0 in H4;rewrite Zplus_0_r in H4. - repeat rewrite Zmult_plus_distr_l. rewrite <- (Zmult_assoc [|r1|]). - rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H4;simpl;ring. - split;[rewrite wwB_wBwB | split;zarith]. - replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|])) - with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]). - rewrite H1;ring. rewrite wwB_wBwB;ring. - change [|a4|] with (0*wB+[|a4|]);apply beta_lex_inv;zarith. - assert (1 <= wB/2);zarith. - assert (H_:= wB_pos w_digits);apply Zdiv_le_lower_bound;zarith. - destruct H2 as (H2,H3);match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] => - generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U); - intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end. - split;trivial. - replace (([|a1h|] * wB + [|a1l|]) * wwB + ([|a3|] * wB + [|a4|])) with - (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB + [|a4|]); - [rewrite H1 | rewrite wwB_wBwB;ring]. - replace (([|q1|]*([|b1|]*wB+[|b2|])+([|r1|]*wB+[|r2|]))*wB+[|a4|]) with - (([|q1|]*([|b1|]*wB+[|b2|]))*wB+([|r1|]*wwB+[|r2|]*wB+[|a4|])); - [rewrite H4;simpl|rewrite wwB_wBwB];ring. - Qed. - -End GenDiv21. - -Section GenDivGt. - Variable w : Set. - Variable w_digits : positive. - Variable w_0 : w. - - Variable w_WW : w -> w -> zn2z w. - Variable w_0W : w -> zn2z w. - Variable w_compare : w -> w -> comparison. - Variable w_eq0 : w -> bool. - Variable w_opp_c : w -> carry w. - Variable w_opp w_opp_carry : w -> w. - Variable w_sub_c : w -> w -> carry w. - Variable w_sub w_sub_carry : w -> w -> w. - - Variable w_div_gt : w -> w -> w*w. - Variable w_mod_gt : w -> w -> w. - Variable w_gcd_gt : w -> w -> w. - Variable w_add_mul_div : w -> w -> w -> w. - Variable w_head0 : w -> w. - Variable w_div21 : w -> w -> w -> w * w. - Variable w_div32 : w -> w -> w -> w -> w -> w * zn2z w. - - - Variable _ww_zdigits : zn2z w. - Variable ww_1 : zn2z w. - Variable ww_add_mul_div : zn2z w -> zn2z w -> zn2z w -> zn2z w. - - Variable w_zdigits : w. - - Definition ww_div_gt_aux ah al bh bl := - Eval lazy beta iota delta [ww_sub ww_opp] in - let p := w_head0 bh in - match w_compare p w_0 with - | Gt => - let b1 := w_add_mul_div p bh bl in - let b2 := w_add_mul_div p bl w_0 in - let a1 := w_add_mul_div p w_0 ah in - let a2 := w_add_mul_div p ah al in - let a3 := w_add_mul_div p al w_0 in - let (q,r) := w_div32 a1 a2 a3 b1 b2 in - (WW w_0 q, ww_add_mul_div - (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c - w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r) - | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c - w_opp w_sub w_sub_carry (WW ah al) (WW bh bl)) - end. - - Definition ww_div_gt a b := - Eval lazy beta iota delta [ww_div_gt_aux gen_divn1 - gen_divn1_p gen_divn1_p_aux gen_divn1_0 gen_divn1_0_aux - gen_split gen_0 gen_WW] in - match a, b with - | W0, _ => (W0,W0) - | _, W0 => (W0,W0) - | WW ah al, WW bh bl => - if w_eq0 ah then - let (q,r) := w_div_gt al bl in - (WW w_0 q, w_0W r) - else - match w_compare w_0 bh with - | Eq => - let(q,r):= - gen_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 a bl in - (q, w_0W r) - | Lt => ww_div_gt_aux ah al bh bl - | Gt => (W0,W0) (* cas absurde *) - end - end. - - Definition ww_mod_gt_aux ah al bh bl := - Eval lazy beta iota delta [ww_sub ww_opp] in - let p := w_head0 bh in - match w_compare p w_0 with - | Gt => - let b1 := w_add_mul_div p bh bl in - let b2 := w_add_mul_div p bl w_0 in - let a1 := w_add_mul_div p w_0 ah in - let a2 := w_add_mul_div p ah al in - let a3 := w_add_mul_div p al w_0 in - let (q,r) := w_div32 a1 a2 a3 b1 b2 in - ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c - w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r - | _ => - ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c - w_opp w_sub w_sub_carry (WW ah al) (WW bh bl) - end. - - Definition ww_mod_gt a b := - Eval lazy beta iota delta [ww_mod_gt_aux gen_modn1 - gen_modn1_p gen_modn1_p_aux gen_modn1_0 gen_modn1_0_aux - gen_split gen_0 gen_WW snd] in - match a, b with - | W0, _ => W0 - | _, W0 => W0 - | WW ah al, WW bh bl => - if w_eq0 ah then w_0W (w_mod_gt al bl) - else - match w_compare w_0 bh with - | Eq => - w_0W (gen_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 a bl) - | Lt => ww_mod_gt_aux ah al bh bl - | Gt => W0 (* cas absurde *) - end - end. - - Definition ww_gcd_gt_body (cont: w->w->w->w->zn2z w) (ah al bh bl: w) := - Eval lazy beta iota delta [ww_mod_gt_aux gen_modn1 - gen_modn1_p gen_modn1_p_aux gen_modn1_0 gen_modn1_0_aux - gen_split gen_0 gen_WW snd] in - match w_compare w_0 bh with - | Eq => - match w_compare w_0 bl with - | Eq => WW ah al (* normalement n'arrive pas si forme normale *) - | Lt => - let m := gen_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 (WW ah al) bl in - WW w_0 (w_gcd_gt bl m) - | Gt => W0 (* absurde *) - end - | Lt => - let m := ww_mod_gt_aux ah al bh bl in - match m with - | W0 => WW bh bl - | WW mh ml => - match w_compare w_0 mh with - | Eq => - match w_compare w_0 ml with - | Eq => WW bh bl - | _ => - let r := gen_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 (WW bh bl) ml in - WW w_0 (w_gcd_gt ml r) - end - | Lt => - let r := ww_mod_gt_aux bh bl mh ml in - match r with - | W0 => m - | WW rh rl => cont mh ml rh rl - end - | Gt => W0 (* absurde *) - end - end - | Gt => W0 (* absurde *) - end. - - Fixpoint ww_gcd_gt_aux - (p:positive) (cont: w -> w -> w -> w -> zn2z w) (ah al bh bl : w) - {struct p} : zn2z w := - ww_gcd_gt_body - (fun mh ml rh rl => match p with - | xH => cont mh ml rh rl - | xO p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl - | xI p => ww_gcd_gt_aux p (ww_gcd_gt_aux p cont) mh ml rh rl - end) ah al bh bl. - - - (* Proof *) - - Variable w_to_Z : w -> Z. - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[-| c |]" := - (interp_carry (-1) wB w_to_Z c) (at level 0, x at level 99). - - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - Variable spec_to_w_Z : forall x, 0 <= [[x]] < wwB. - - 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. - Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. - - Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|]. - Variable spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB. - Variable spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1. - - Variable spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|]. - Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. - Variable spec_sub_carry : - forall x y, [|w_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB. - - Variable spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> - let (q,r) := w_div_gt a b in - [|a|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]. - Variable spec_mod_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> - [|w_mod_gt a b|] = [|a|] mod [|b|]. - Variable spec_gcd_gt : forall a b, [|a|] > [|b|] -> - Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]. - - Variable spec_add_mul_div : forall x y p, - [|p|] <= Zpos w_digits -> - [| w_add_mul_div p x y |] = - ([|x|] * (2 ^ ([|p|])) + - [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB. - Variable spec_head0 : forall x, 0 < [|x|] -> - wB/ 2 <= 2 ^ [|w_head0 x|] * [|x|] < wB. - - Variable spec_div21 : forall a1 a2 b, - wB/2 <= [|b|] -> - [|a1|] < [|b|] -> - let (q,r) := w_div21 a1 a2 b in - [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]. - - Variable spec_w_div32 : forall a1 a2 a3 b1 b2, - wB/2 <= [|b1|] -> - [[WW a1 a2]] < [[WW b1 b2]] -> - let (q,r) := w_div32 a1 a2 a3 b1 b2 in - [|a1|] * wwB + [|a2|] * wB + [|a3|] = - [|q|] * ([|b1|] * wB + [|b2|]) + [[r]] /\ - 0 <= [[r]] < [|b1|] * wB + [|b2|]. - - Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits. - - Variable spec_ww_digits_ : [[_ww_zdigits]] = Zpos (xO w_digits). - Variable spec_ww_1 : [[ww_1]] = 1. - Variable spec_ww_add_mul_div : forall x y p, - [[p]] <= Zpos (xO w_digits) -> - [[ ww_add_mul_div p x y ]] = - ([[x]] * (2^[[p]]) + - [[y]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB. - - Ltac Spec_w_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_to_Z x). - - Ltac Spec_ww_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x). - - Lemma to_Z_div_minus_p : forall x p, - 0 < [|p|] < Zpos w_digits -> - 0 <= [|x|] / 2 ^ (Zpos w_digits - [|p|]) < 2 ^ [|p|]. - Proof. - intros x p H;Spec_w_to_Z x. - split. apply Zdiv_le_lower_bound;zarith. - apply Zdiv_lt_upper_bound;zarith. - rewrite <- Zpower_exp;zarith. - ring_simplify ([|p|] + (Zpos w_digits - [|p|])); unfold base in HH;zarith. - Qed. - Hint Resolve to_Z_div_minus_p : zarith. - - Lemma spec_ww_div_gt_aux : forall ah al bh bl, - [[WW ah al]] > [[WW bh bl]] -> - 0 < [|bh|] -> - let (q,r) := ww_div_gt_aux ah al bh bl in - [[WW ah al]] = [[q]] * [[WW bh bl]] + [[r]] /\ - 0 <= [[r]] < [[WW bh bl]]. - Proof. - intros ah al bh bl Hgt Hpos;unfold ww_div_gt_aux. - change - (let (q, r) := let p := w_head0 bh in - match w_compare p w_0 with - | Gt => - let b1 := w_add_mul_div p bh bl in - let b2 := w_add_mul_div p bl w_0 in - let a1 := w_add_mul_div p w_0 ah in - let a2 := w_add_mul_div p ah al in - let a3 := w_add_mul_div p al w_0 in - let (q,r) := w_div32 a1 a2 a3 b1 b2 in - (WW w_0 q, ww_add_mul_div - (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c - w_opp w_sub w_sub_carry _ww_zdigits (w_0W p)) W0 r) - | _ => (ww_1, ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c - w_opp w_sub w_sub_carry (WW ah al) (WW bh bl)) - end 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_w_0; intros HH. - generalize Hh; rewrite HH; simpl Zpower; - rewrite Zmult_1_l; intros (HH1, HH2); clear HH. - assert (wwB <= 2*[[WW bh bl]]). - apply Zle_trans with (2*[|bh|]*wB). - rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat_r; zarith. - rewrite <- wB_div_2; apply Zmult_le_compat_l; zarith. - simpl ww_to_Z;rewrite Zmult_plus_distr_r;rewrite Zmult_assoc. - Spec_w_to_Z bl;zarith. - Spec_ww_to_Z (WW ah al). - rewrite spec_ww_sub;eauto. - simpl;rewrite spec_ww_1;rewrite Zmult_1_l;simpl. - simpl ww_to_Z in Hgt, H, HH;rewrite Zmod_small;split;zarith. - case (spec_to_Z (w_head0 bh)); auto with zarith. - assert ([|w_head0 bh|] < Zpos w_digits). - destruct (Z_lt_ge_dec [|w_head0 bh|] (Zpos w_digits));trivial. - elimtype False. - assert (2 ^ [|w_head0 bh|] * [|bh|] >= wB);auto with zarith. - apply Zle_ge; replace wB with (wB * 1);try ring. - Spec_w_to_Z bh;apply Zmult_le_compat;zarith. - unfold base;apply Zpower_le_monotone;zarith. - assert (HHHH : 0 < [|w_head0 bh|] < Zpos w_digits); auto with zarith. - assert (Hb:= Zlt_le_weak _ _ H). - generalize (spec_add_mul_div w_0 ah Hb) - (spec_add_mul_div ah al Hb) - (spec_add_mul_div al w_0 Hb) - (spec_add_mul_div bh bl Hb) - (spec_add_mul_div bl w_0 Hb); - rewrite spec_w_0; repeat rewrite Zmult_0_l;repeat rewrite Zplus_0_l; - rewrite Zdiv_0_l;repeat rewrite Zplus_0_r. - Spec_w_to_Z ah;Spec_w_to_Z bh. - unfold base;repeat rewrite Zmod_shift_r;zarith. - assert (H3:=to_Z_div_minus_p ah HHHH);assert(H4:=to_Z_div_minus_p al HHHH); - assert (H5:=to_Z_div_minus_p bl HHHH). - rewrite Zmult_comm in Hh. - assert (2^[|w_head0 bh|] < wB). unfold base;apply Zpower_lt_monotone;zarith. - unfold base in H0;rewrite Zmod_small;zarith. - fold wB; rewrite (Zmod_small ([|bh|] * 2 ^ [|w_head0 bh|]));zarith. - intros U1 U2 U3 V1 V2. - generalize (@spec_w_div32 (w_add_mul_div (w_head0 bh) w_0 ah) - (w_add_mul_div (w_head0 bh) ah al) - (w_add_mul_div (w_head0 bh) al w_0) - (w_add_mul_div (w_head0 bh) bh bl) - (w_add_mul_div (w_head0 bh) bl w_0)). - destruct (w_div32 (w_add_mul_div (w_head0 bh) w_0 ah) - (w_add_mul_div (w_head0 bh) ah al) - (w_add_mul_div (w_head0 bh) al w_0) - (w_add_mul_div (w_head0 bh) bh bl) - (w_add_mul_div (w_head0 bh) bl w_0)) as (q,r). - rewrite V1;rewrite V2. rewrite Zmult_plus_distr_l. - rewrite <- (Zplus_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)). - unfold base;rewrite <- shift_unshift_mod;zarith. fold wB. - replace ([|bh|] * 2 ^ [|w_head0 bh|] * wB + [|bl|] * 2 ^ [|w_head0 bh|]) with - ([[WW bh bl]] * 2^[|w_head0 bh|]). 2:simpl;ring. - fold wwB. rewrite wwB_wBwB. rewrite Zpower_2. rewrite U1;rewrite U2;rewrite U3. - rewrite Zmult_assoc. rewrite Zmult_plus_distr_l. - rewrite (Zplus_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)). - rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. - unfold base;repeat rewrite <- shift_unshift_mod;zarith. fold wB. - replace ([|ah|] * 2 ^ [|w_head0 bh|] * wB + [|al|] * 2 ^ [|w_head0 bh|]) with - ([[WW ah al]] * 2^[|w_head0 bh|]). 2:simpl;ring. - intros Hd;destruct Hd;zarith. - simpl. apply beta_lex_inv;zarith. rewrite U1;rewrite V1. - assert ([|ah|] / 2 ^ (Zpos (w_digits) - [|w_head0 bh|]) < wB/2);zarith. - apply Zdiv_lt_upper_bound;zarith. - unfold base. - replace (2^Zpos (w_digits)) with (2^(Zpos (w_digits) - 1)*2). - rewrite Z_div_mult;zarith. rewrite <- Zpower_exp;zarith. - apply Zlt_le_trans with wB;zarith. - unfold base;apply Zpower_le_monotone;zarith. - pattern 2 at 2;replace 2 with (2^1);trivial. - rewrite <- Zpower_exp;zarith. ring_simplify (Zpos (w_digits) - 1 + 1);trivial. - change [[WW w_0 q]] with ([|w_0|]*wB+[|q|]);rewrite spec_w_0;rewrite - Zmult_0_l;rewrite Zplus_0_l. - replace [[ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry - _ww_zdigits (w_0W (w_head0 bh))) W0 r]] with ([[r]]/2^[|w_head0 bh|]). - assert (0 < 2^[|w_head0 bh|]). apply Zpower_gt_0;zarith. - split. - rewrite <- (Z_div_mult [[WW ah al]] (2^[|w_head0 bh|]));zarith. - rewrite H1;rewrite Zmult_assoc;apply Z_div_plus_l;trivial. - split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith. - rewrite spec_ww_add_mul_div. - rewrite spec_ww_sub; auto with zarith. - rewrite spec_ww_digits_. - change (Zpos (xO (w_digits))) with (2*Zpos (w_digits));zarith. - simpl ww_to_Z;rewrite Zmult_0_l;rewrite Zplus_0_l. - rewrite spec_w_0W. - rewrite (fun x y => Zmod_small (x-y)); auto with zarith. - ring_simplify (2 * Zpos w_digits - (2 * Zpos w_digits - [|w_head0 bh|])). - rewrite Zmod_small;zarith. - split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith. - Spec_ww_to_Z r. - apply Zlt_le_trans with wwB;zarith. - rewrite <- (Zmult_1_r wwB);apply Zmult_le_compat;zarith. - split; auto with zarith. - apply Zle_lt_trans with (2 * Zpos w_digits); auto with zarith. - unfold base, ww_digits; rewrite (Zpos_xO w_digits). - apply Zpower2_lt_lin; auto with zarith. - rewrite spec_ww_sub; auto with zarith. - rewrite spec_ww_digits_; rewrite spec_w_0W. - rewrite Zmod_small;zarith. - rewrite Zpos_xO; split; auto with zarith. - apply Zle_lt_trans with (2 * Zpos w_digits); auto with zarith. - unfold base, ww_digits; rewrite (Zpos_xO w_digits). - apply Zpower2_lt_lin; auto with zarith. - Qed. - - Lemma spec_ww_div_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> - let (q,r) := ww_div_gt a b in - [[a]] = [[q]] * [[b]] + [[r]] /\ - 0 <= [[r]] < [[b]]. - Proof. - intros a b Hgt Hpos;unfold ww_div_gt. - change (let (q,r) := match a, b with - | W0, _ => (W0,W0) - | _, W0 => (W0,W0) - | WW ah al, WW bh bl => - if w_eq0 ah then - let (q,r) := w_div_gt al bl in - (WW w_0 q, w_0W r) - else - match w_compare w_0 bh with - | Eq => - let(q,r):= - gen_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 a bl in - (q, w_0W r) - | Lt => ww_div_gt_aux ah al bh bl - | Gt => (W0,W0) (* cas absurde *) - end - end in [[a]] = [[q]] * [[b]] + [[r]] /\ 0 <= [[r]] < [[b]]). - destruct a as [ |ah al]. simpl in Hgt;omega. - destruct b as [ |bh bl]. simpl in Hpos;omega. - Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl. - assert (H:=@spec_eq0 ah);destruct (w_eq0 ah). - simpl ww_to_Z;rewrite H;trivial. simpl in Hgt;rewrite H in Hgt;trivial. - assert ([|bh|] <= 0). - apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. - assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;rewrite H1;simpl in Hgt. - simpl. simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos. - 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_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. - assert (H2:= @spec_gen_divn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div - w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 - spec_add_mul_div spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hpos). - unfold gen_to_Z,gen_wB,gen_digits in H2. - destruct (gen_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 - (WW ah al) bl). - rewrite spec_w_0W;unfold ww_to_Z;trivial. - apply spec_ww_div_gt_aux;trivial. rewrite spec_w_0 in Hcmp;trivial. - rewrite spec_w_0 in Hcmp;elimtype False;omega. - Qed. - - Lemma spec_ww_mod_gt_aux_eq : forall ah al bh bl, - ww_mod_gt_aux ah al bh bl = snd (ww_div_gt_aux ah al bh bl). - Proof. - intros ah al bh bl. unfold ww_mod_gt_aux, ww_div_gt_aux. - case w_compare; auto. - case w_div32; auto. - Qed. - - Lemma spec_ww_mod_gt_aux : forall ah al bh bl, - [[WW ah al]] > [[WW bh bl]] -> - 0 < [|bh|] -> - [[ww_mod_gt_aux ah al bh bl]] = [[WW ah al]] mod [[WW bh bl]]. - Proof. - intros. rewrite spec_ww_mod_gt_aux_eq;trivial. - assert (H3 := spec_ww_div_gt_aux ah al bl H H0). - destruct (ww_div_gt_aux ah al bh bl) as (q,r);simpl. simpl in H,H3. - destruct H3;apply Zmod_unique with [[q]];zarith. - rewrite H1;ring. - Qed. - - Lemma spec_w_mod_gt_eq : forall a b, [|a|] > [|b|] -> 0 <[|b|] -> - [|w_mod_gt a b|] = [|snd (w_div_gt a b)|]. - Proof. - intros a b Hgt Hpos. - rewrite spec_mod_gt;trivial. - assert (H:=spec_div_gt Hgt Hpos). - destruct (w_div_gt a b) as (q,r);simpl. - rewrite Zmult_comm in H;destruct H. - symmetry;apply Zmod_unique with [|q|];trivial. - Qed. - - Lemma spec_ww_mod_gt_eq : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> - [[ww_mod_gt a b]] = [[snd (ww_div_gt a b)]]. - Proof. - intros a b Hgt Hpos. - change (ww_mod_gt a b) with - (match a, b with - | W0, _ => W0 - | _, W0 => W0 - | WW ah al, WW bh bl => - if w_eq0 ah then w_0W (w_mod_gt al bl) - else - match w_compare w_0 bh with - | Eq => - w_0W (gen_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 a bl) - | Lt => ww_mod_gt_aux ah al bh bl - | Gt => W0 (* cas absurde *) - end end). - change (ww_div_gt a b) with - (match a, b with - | W0, _ => (W0,W0) - | _, W0 => (W0,W0) - | WW ah al, WW bh bl => - if w_eq0 ah then - let (q,r) := w_div_gt al bl in - (WW w_0 q, w_0W r) - else - match w_compare w_0 bh with - | Eq => - let(q,r):= - gen_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 a bl in - (q, w_0W r) - | Lt => ww_div_gt_aux ah al bh bl - | Gt => (W0,W0) (* cas absurde *) - end - end). - destruct a as [ |ah al];trivial. - destruct b as [ |bh bl];trivial. - Spec_w_to_Z ah; Spec_w_to_Z al; Spec_w_to_Z bh; Spec_w_to_Z bl. - assert (H:=@spec_eq0 ah);destruct (w_eq0 ah). - simpl in Hgt;rewrite H in Hgt;trivial. - assert ([|bh|] <= 0). - apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. - assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt. - simpl in Hpos;rewrite H1 in Hpos;simpl in Hpos. - 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_gen_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 (gen_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 - (WW ah al) bl);simpl;trivial. - rewrite spec_ww_mod_gt_aux_eq;trivial;symmetry;trivial. - trivial. - Qed. - - Lemma spec_ww_mod_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> - [[ww_mod_gt a b]] = [[a]] mod [[b]]. - Proof. - intros a b Hgt Hpos. - assert (H:= spec_ww_div_gt a b Hgt Hpos). - rewrite (spec_ww_mod_gt_eq a b Hgt Hpos). - destruct (ww_div_gt a b)as(q,r);destruct H. - apply Zmod_unique with[[q]];simpl;trivial. - rewrite Zmult_comm;trivial. - Qed. - - Lemma Zis_gcd_mod : forall a b d, - 0 < b -> Zis_gcd b (a mod b) d -> Zis_gcd a b d. - Proof. - intros a b d H H1; apply Zis_gcd_for_euclid with (a/b). - pattern a at 1;rewrite (Z_div_mod_eq a b). - ring_simplify (b * (a / b) + a mod b - a / b * b);trivial. zarith. - Qed. - - Lemma spec_ww_gcd_gt_aux_body : - forall ah al bh bl n cont, - [[WW bh bl]] <= 2^n -> - [[WW ah al]] > [[WW bh bl]] -> - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> [[WW yh yl]] <= 2^(n-1) -> - Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> - Zis_gcd [[WW ah al]] [[WW bh bl]] [[ww_gcd_gt_body cont ah al bh bl]]. - Proof. - intros ah al bh bl n cont Hlog Hgt Hcont. - change (ww_gcd_gt_body cont ah al bh bl) with (match w_compare w_0 bh with - | Eq => - match w_compare w_0 bl with - | Eq => WW ah al (* normalement n'arrive pas si forme normale *) - | Lt => - let m := gen_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 (WW ah al) bl in - WW w_0 (w_gcd_gt bl m) - | Gt => W0 (* absurde *) - end - | Lt => - let m := ww_mod_gt_aux ah al bh bl in - match m with - | W0 => WW bh bl - | WW mh ml => - match w_compare w_0 mh with - | Eq => - match w_compare w_0 ml with - | Eq => WW bh bl - | _ => - let r := gen_modn1 w_zdigits w_0 w_head0 w_add_mul_div w_div21 - w_compare w_sub 1 (WW bh bl) ml in - WW w_0 (w_gcd_gt ml r) - end - | Lt => - let r := ww_mod_gt_aux bh bl mh ml in - match r with - | W0 => m - | WW rh rl => cont mh ml rh rl - end - | Gt => W0 (* absurde *) - end - 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 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. - 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 (gen_to_Z w_digits w_to_Z 1 (WW ah al)). - rewrite <- (@spec_gen_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div - w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div - spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hbl). - apply spec_gcd_gt. - rewrite (@spec_gen_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => - destruct (Z_mod_lt x y);zarith end. - rewrite spec_w_0 in Hbl;Spec_w_to_Z bl;elimtype False;omega. - rewrite spec_w_0 in Hbh;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. - change ([|bh|] * wB + [|bl|]) with (gen_to_Z w_digits w_to_Z 1 (WW bh bl)). - rewrite <- (@spec_gen_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div - w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 spec_add_mul_div - spec_div21 spec_compare spec_sub 1 (WW bh bl) ml Hml). - apply spec_gcd_gt. - rewrite (@spec_gen_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => - destruct (Z_mod_lt x y);zarith end. - rewrite spec_w_0 in Hml;Spec_w_to_Z ml;elimtype False;omega. - rewrite spec_w_0 in Hmh. 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). - assert (H3 : 0 < [[WW mh ml]]). - simpl;Spec_w_to_Z ml. apply Zlt_le_trans with ([|mh|]*wB);zarith. - apply Zmult_lt_0_compat;zarith. - apply Zis_gcd_mod;zarith. simpl in *;rewrite <- H1. - destruct (ww_mod_gt_aux bh bl mh ml) as [ |rh rl]. simpl; apply Zis_gcd_0. - simpl;apply Hcont. simpl in H1;rewrite H1. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => - destruct (Z_mod_lt x y);zarith end. - apply Zle_trans with (2^n/2). - apply Zdiv_le_lower_bound;zarith. - apply Zle_trans with ([|bh|] * wB + [|bl|]);zarith. - assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Zlt_gt _ _ H3)). - assert (H4' : 0 <= [[WW bh bl]]/[[WW mh ml]]). - apply Zge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1. - pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3'. - destruct (Zle_lt_or_eq _ _ H4'). - assert (H6' : [[WW bh bl]] mod [[WW mh ml]] = - [[WW bh bl]] - [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). - simpl;pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3';ring. simpl in H6'. - assert ([[WW mh ml]] <= [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). - simpl;pattern ([|mh|]*wB+[|ml|]) at 1;rewrite <- Zmult_1_r;zarith. - simpl in *;assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in H8; - zarith. - assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in *;zarith. - rewrite <- H4 in H3';rewrite Zmult_0_r in H3';simpl in H3';zarith. - pattern n at 1;replace n with (n-1+1);try ring. - rewrite Zpower_exp;zarith. change (2^1) with 2. - rewrite Z_div_mult;zarith. - assert (2^1 <= 2^n). change (2^1) with 2;zarith. - assert (H7 := @Zpower_le_monotone_inv 2 1 n);zarith. - rewrite spec_w_0 in Hmh;Spec_w_to_Z mh;elimtype False;zarith. - rewrite spec_w_0 in Hbh;Spec_w_to_Z bh;elimtype False;zarith. - Qed. - - Lemma spec_ww_gcd_gt_aux : - forall p cont n, - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> - [[WW yh yl]] <= 2^n -> - Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> - forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] -> - [[WW bh bl]] <= 2^(Zpos p + n) -> - Zis_gcd [[WW ah al]] [[WW bh bl]] - [[ww_gcd_gt_aux p cont ah al bh bl]]. - Proof. - induction p;intros cont n Hcont ah al bh bl Hgt Hs;simpl ww_gcd_gt_aux. - assert (0 < Zpos p). unfold Zlt;reflexivity. - apply spec_ww_gcd_gt_aux_body with (n := Zpos (xI p) + n); - trivial;rewrite Zpos_xI. - intros. apply IHp with (n := Zpos p + n);zarith. - intros. apply IHp with (n := n );zarith. - apply Zle_trans with (2 ^ (2* Zpos p + 1+ n -1));zarith. - apply Zpower_le_monotone2;zarith. - assert (0 < Zpos p). unfold Zlt;reflexivity. - apply spec_ww_gcd_gt_aux_body with (n := Zpos (xO p) + n );trivial. - rewrite (Zpos_xO p). - intros. apply IHp with (n := Zpos p + n - 1);zarith. - intros. apply IHp with (n := n -1 );zarith. - intros;apply Hcont;zarith. - apply Zle_trans with (2^(n-1));zarith. - apply Zpower_le_monotone2;zarith. - apply Zle_trans with (2 ^ (Zpos p + n -1));zarith. - apply Zpower_le_monotone2;zarith. - apply Zle_trans with (2 ^ (2*Zpos p + n -1));zarith. - apply Zpower_le_monotone2;zarith. - apply spec_ww_gcd_gt_aux_body with (n := n+1);trivial. - rewrite Zplus_comm;trivial. - ring_simplify (n + 1 - 1);trivial. - Qed. - -End GenDivGt. - -Section GenDiv. - - Variable w : Set. - Variable w_digits : positive. - Variable ww_1 : zn2z w. - Variable ww_compare : zn2z w -> zn2z w -> comparison. - - Variable ww_div_gt : zn2z w -> zn2z w -> zn2z w * zn2z w. - Variable ww_mod_gt : zn2z w -> zn2z w -> zn2z w. - - Definition ww_div a b := - match ww_compare a b with - | Gt => ww_div_gt a b - | Eq => (ww_1, W0) - | Lt => (W0, a) - end. - - Definition ww_mod a b := - match ww_compare a b with - | Gt => ww_mod_gt a b - | Eq => W0 - | Lt => a - end. - - Variable w_to_Z : w -> Z. - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - 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. - 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]] /\ - 0 <= [[r]] < [[b]]. - Variable spec_ww_mod_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> - [[ww_mod_gt a b]] = [[a]] mod [[b]]. - - Ltac Spec_w_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_to_Z x). - - Ltac Spec_ww_to_Z x := - let H:= fresh "HH" in - assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x). - - Lemma spec_ww_div : forall a b, 0 < [[b]] -> - let (q,r) := ww_div a b in - [[a]] = [[q]] * [[b]] + [[r]] /\ - 0 <= [[r]] < [[b]]. - Proof. - intros a b Hpos;unfold ww_div. - assert (H:=spec_ww_compare a b);destruct (ww_compare a b). - simpl;rewrite spec_ww_1;split;zarith. - simpl;split;[ring|Spec_ww_to_Z a;zarith]. - apply spec_ww_div_gt;trivial. - 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). - 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. - Qed. - - - Variable w_0 : w. - Variable w_1 : w. - Variable w_compare : w -> w -> comparison. - Variable w_eq0 : w -> bool. - Variable w_gcd_gt : w -> w -> w. - Variable _ww_digits : positive. - Variable spec_ww_digits_ : _ww_digits = xO w_digits. - Variable ww_gcd_gt_fix : - positive -> (w -> w -> w -> w -> zn2z w) -> - w -> w -> w -> w -> zn2z w. - - 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. - Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. - Variable spec_gcd_gt : forall a b, [|a|] > [|b|] -> - Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]. - Variable spec_gcd_gt_fix : - forall p cont n, - (forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> - [[WW yh yl]] <= 2^n -> - Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]) -> - forall ah al bh bl , [[WW ah al]] > [[WW bh bl]] -> - [[WW bh bl]] <= 2^(Zpos p + n) -> - Zis_gcd [[WW ah al]] [[WW bh bl]] - [[ww_gcd_gt_fix p cont ah al bh bl]]. - - Definition gcd_cont (xh xl yh yl:w) := - match w_compare w_1 yl with - | Eq => ww_1 - | _ => WW xh xl - end. - - Lemma spec_gcd_cont : forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> - [[WW yh yl]] <= 1 -> - Zis_gcd [[WW xh xl]] [[WW yh yl]] [[gcd_cont xh xl yh yl]]. - Proof. - intros xh xl yh yl Hgt' Hle. simpl in Hle. - assert ([|yh|] = 0). - change 1 with (0*wB+1) in Hle. - 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). - rewrite spec_ww_1;rewrite <- Hcmpy;apply Zis_gcd_mod;zarith. - rewrite <- (Zmod_unique ([|xh|]*wB+[|xl|]) 1 ([|xh|]*wB+[|xl|]) 0);zarith. - rewrite H in Hle; elimtype False;zarith. - assert ([|yl|] = 0). Spec_w_to_Z yl;zarith. - rewrite H0;simpl;apply Zis_gcd_0;trivial. - Qed. - - - Variable cont : w -> w -> w -> w -> zn2z w. - Variable spec_cont : forall xh xl yh yl, - [[WW xh xl]] > [[WW yh yl]] -> - [[WW yh yl]] <= 1 -> - Zis_gcd [[WW xh xl]] [[WW yh yl]] [[cont xh xl yh yl]]. - - Definition ww_gcd_gt a b := - match a, b with - | W0, _ => b - | _, W0 => a - | WW ah al, WW bh bl => - if w_eq0 ah then (WW w_0 (w_gcd_gt al bl)) - else ww_gcd_gt_fix _ww_digits cont ah al bh bl - end. - - Definition ww_gcd a b := - Eval lazy beta delta [ww_gcd_gt] in - match ww_compare a b with - | Gt => ww_gcd_gt a b - | Eq => a - | Lt => ww_gcd_gt b a - end. - - Lemma spec_ww_gcd_gt : forall a b, [[a]] > [[b]] -> - Zis_gcd [[a]] [[b]] [[ww_gcd_gt a b]]. - Proof. - intros a b Hgt;unfold ww_gcd_gt. - destruct a as [ |ah al]. simpl;apply Zis_gcd_sym;apply Zis_gcd_0. - destruct b as [ |bh bl]. simpl;apply Zis_gcd_0. - simpl in Hgt. generalize (@spec_eq0 ah);destruct (w_eq0 ah);intros. - simpl;rewrite H in Hgt;trivial;rewrite H;trivial;rewrite spec_w_0;simpl. - assert ([|bh|] <= 0). - apply beta_lex with (d:=[|al|])(b:=[|bl|]) (beta := wB);zarith. - Spec_w_to_Z bh;assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt. - rewrite H1;simpl;auto. clear H. - apply spec_gcd_gt_fix with (n:= 0);trivial. - rewrite Zplus_0_r;rewrite spec_ww_digits_. - change (2 ^ Zpos (xO w_digits)) with wwB. Spec_ww_to_Z (WW bh bl);zarith. - Qed. - - Lemma spec_ww_gcd : forall a b, Zis_gcd [[a]] [[b]] [[ww_gcd a b]]. - Proof. - intros a b. - change (ww_gcd a b) with - (match ww_compare a b with - | Gt => ww_gcd_gt a b - | Eq => a - | Lt => ww_gcd_gt b a - end). - assert (Hcmp := spec_ww_compare a b);destruct (ww_compare a b). - 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. - apply Zis_gcd_sym;apply spec_ww_gcd_gt;zarith. - apply spec_ww_gcd_gt;zarith. - Qed. - -End GenDiv. - diff --git a/theories/Ints/num/GenDivn1.v b/theories/Ints/num/GenDivn1.v deleted file mode 100644 index 3c70adb615..0000000000 --- a/theories/Ints/num/GenDivn1.v +++ /dev/null @@ -1,524 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. - -Open Local Scope Z_scope. - -Section GENDIVN1. - - Variable w : Set. - Variable w_digits : positive. - Variable w_zdigits : w. - Variable w_0 : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_head0 : w -> w. - Variable w_add_mul_div : w -> w -> w -> w. - Variable w_div21 : w -> w -> w -> w * w. - Variable w_compare : w -> w -> comparison. - Variable w_sub : w -> w -> w. - - - - (* ** For proofs ** *) - Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). - - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[! n | x !]" := (gen_to_Z w_digits w_to_Z n x) - (at level 0, x at level 99). - Notation "[[ x ]]" := (zn2z_to_Z wB w_to_Z x) (at level 0, x at level 99). - - Variable spec_to_Z : forall x, 0 <= [| x |] < wB. - Variable spec_w_zdigits: [|w_zdigits|] = Zpos w_digits. - Variable spec_0 : [|w_0|] = 0. - Variable spec_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. - Variable spec_head0 : forall x, 0 < [|x|] -> - wB/ 2 <= 2 ^ [|w_head0 x|] * [|x|] < wB. - Variable spec_add_mul_div : forall x y p, - [|p|] <= Zpos w_digits -> - [| w_add_mul_div p x y |] = - ([|x|] * (2 ^ [|p|]) + - [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB. - Variable spec_div21 : forall a1 a2 b, - wB/2 <= [|b|] -> - [|a1|] < [|b|] -> - let (q,r) := w_div21 a1 a2 b in - [|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. - Variable spec_sub: forall x y, - [|w_sub x y|] = ([|x|] - [|y|]) mod wB. - - - - Section DIVAUX. - Variable b2p : w. - Variable b2p_le : wB/2 <= [|b2p|]. - - Definition gen_divn1_0_aux n (divn1: w -> word w n -> word w n * w) r h := - let (hh,hl) := gen_split w_0 n h in - let (qh,rh) := divn1 r hh in - let (ql,rl) := divn1 rh hl in - (gen_WW w_WW n qh ql, rl). - - Fixpoint gen_divn1_0 (n:nat) : w -> word w n -> word w n * w := - match n return w -> word w n -> word w n * w with - | O => fun r x => w_div21 r x b2p - | S n => gen_divn1_0_aux n (gen_divn1_0 n) - end. - - Lemma spec_split : forall (n : nat) (x : zn2z (word w n)), - let (h, l) := gen_split w_0 n x in - [!S n | x!] = [!n | h!] * gen_wB w_digits n + [!n | l!]. - Proof (spec_gen_split w_0 w_digits w_to_Z spec_0). - - Lemma spec_gen_divn1_0 : forall n r a, - [|r|] < [|b2p|] -> - let (q,r') := gen_divn1_0 n r a in - [|r|] * gen_wB w_digits n + [!n|a!] = [!n|q!] * [|b2p|] + [|r'|] /\ - 0 <= [|r'|] < [|b2p|]. - Proof. - induction n;intros. - exact (spec_div21 a b2p_le H). - simpl (gen_divn1_0 (S n) r a); unfold gen_divn1_0_aux. - assert (H1 := spec_split n a);destruct (gen_split w_0 n a) as (hh,hl). - rewrite H1. - assert (H2 := IHn r hh H);destruct (gen_divn1_0 n r hh) as (qh,rh). - destruct H2. - assert ([|rh|] < [|b2p|]). omega. - assert (H4 := IHn rh hl H3);destruct (gen_divn1_0 n rh hl) as (ql,rl). - destruct H4;split;trivial. - rewrite spec_gen_WW;trivial. - rewrite <- gen_wB_wwB. - rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - rewrite H0;rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc. - rewrite H4;ring. - Qed. - - Definition gen_modn1_0_aux n (modn1:w -> word w n -> w) r h := - let (hh,hl) := gen_split w_0 n h in modn1 (modn1 r hh) hl. - - Fixpoint gen_modn1_0 (n:nat) : w -> word w n -> w := - match n return w -> word w n -> w with - | O => fun r x => snd (w_div21 r x b2p) - | S n => gen_modn1_0_aux n (gen_modn1_0 n) - end. - - Lemma spec_gen_modn1_0 : forall n r x, - gen_modn1_0 n r x = snd (gen_divn1_0 n r x). - Proof. - induction n;simpl;intros;trivial. - unfold gen_modn1_0_aux, gen_divn1_0_aux. - destruct (gen_split w_0 n x) as (hh,hl). - rewrite (IHn r hh). - destruct (gen_divn1_0 n r hh) as (qh,rh);simpl. - rewrite IHn. destruct (gen_divn1_0 n rh hl);trivial. - Qed. - - Variable p : w. - Variable p_bounded : [|p|] <= Zpos w_digits. - - Lemma spec_add_mul_divp : forall x y, - [| w_add_mul_div p x y |] = - ([|x|] * (2 ^ [|p|]) + - [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB. - Proof. - intros;apply spec_add_mul_div;auto. - Qed. - - Definition gen_divn1_p_aux n - (divn1 : w -> word w n -> word w n -> word w n * w) r h l := - let (hh,hl) := gen_split w_0 n h in - let (lh,ll) := gen_split w_0 n l in - let (qh,rh) := divn1 r hh hl in - let (ql,rl) := divn1 rh hl lh in - (gen_WW w_WW n qh ql, rl). - - Fixpoint gen_divn1_p (n:nat) : w -> word w n -> word w n -> word w n * w := - match n return w -> word w n -> word w n -> word w n * w with - | O => fun r h l => w_div21 r (w_add_mul_div p h l) b2p - | S n => gen_divn1_p_aux n (gen_divn1_p n) - end. - - Lemma p_lt_gen_digits : forall n, [|p|] <= Zpos (gen_digits w_digits n). - Proof. -(* - induction n;simpl. destruct p_bounded;trivial. - case (spec_to_Z p); rewrite Zpos_xO;auto with zarith. -*) - induction n;simpl. trivial. - case (spec_to_Z p); rewrite Zpos_xO;auto with zarith. - Qed. - - Lemma spec_gen_divn1_p : forall n r h l, - [|r|] < [|b2p|] -> - let (q,r') := gen_divn1_p n r h l in - [|r|] * gen_wB w_digits n + - ([!n|h!]*2^[|p|] + - [!n|l!] / (2^(Zpos(gen_digits w_digits n) - [|p|]))) - mod gen_wB w_digits n = [!n|q!] * [|b2p|] + [|r'|] /\ - 0 <= [|r'|] < [|b2p|]. - Proof. - case (spec_to_Z p); intros HH0 HH1. - induction n;intros. - simpl (gen_divn1_p 0 r h l). - unfold gen_to_Z, gen_wB, gen_digits. - rewrite <- spec_add_mul_divp. - exact (spec_div21 (w_add_mul_div p h l) b2p_le H). - simpl (gen_divn1_p (S n) r h l). - unfold gen_divn1_p_aux. - assert (H1 := spec_split n h);destruct (gen_split w_0 n h) as (hh,hl). - rewrite H1. rewrite <- gen_wB_wwB. - assert (H2 := spec_split n l);destruct (gen_split w_0 n l) as (lh,ll). - rewrite H2. - replace ([|r|] * (gen_wB w_digits n * gen_wB w_digits n) + - (([!n|hh!] * gen_wB w_digits n + [!n|hl!]) * 2 ^ [|p|] + - ([!n|lh!] * gen_wB w_digits n + [!n|ll!]) / - 2^(Zpos (gen_digits w_digits (S n)) - [|p|])) mod - (gen_wB w_digits n * gen_wB w_digits n)) with - (([|r|] * gen_wB w_digits n + ([!n|hh!] * 2^[|p|] + - [!n|hl!] / 2^(Zpos (gen_digits w_digits n) - [|p|])) mod - gen_wB w_digits n) * gen_wB w_digits n + - ([!n|hl!] * 2^[|p|] + - [!n|lh!] / 2^(Zpos (gen_digits w_digits n) - [|p|])) mod - gen_wB w_digits n). - generalize (IHn r hh hl H);destruct (gen_divn1_p n r hh hl) as (qh,rh); - intros (H3,H4);rewrite H3. - assert ([|rh|] < [|b2p|]). omega. - replace (([!n|qh!] * [|b2p|] + [|rh|]) * gen_wB w_digits n + - ([!n|hl!] * 2 ^ [|p|] + - [!n|lh!] / 2 ^ (Zpos (gen_digits w_digits n) - [|p|])) mod - gen_wB w_digits n) with - ([!n|qh!] * [|b2p|] *gen_wB w_digits n + ([|rh|]*gen_wB w_digits n + - ([!n|hl!] * 2 ^ [|p|] + - [!n|lh!] / 2 ^ (Zpos (gen_digits w_digits n) - [|p|])) mod - gen_wB w_digits n)). 2:ring. - generalize (IHn rh hl lh H0);destruct (gen_divn1_p n rh hl lh) as (ql,rl); - intros (H5,H6);rewrite H5. - split;[rewrite spec_gen_WW;trivial;ring|trivial]. - assert (Uhh := spec_gen_to_Z w_digits w_to_Z spec_to_Z n hh); - unfold gen_wB,base in Uhh. - assert (Uhl := spec_gen_to_Z w_digits w_to_Z spec_to_Z n hl); - unfold gen_wB,base in Uhl. - assert (Ulh := spec_gen_to_Z w_digits w_to_Z spec_to_Z n lh); - unfold gen_wB,base in Ulh. - assert (Ull := spec_gen_to_Z w_digits w_to_Z spec_to_Z n ll); - unfold gen_wB,base in Ull. - unfold gen_wB,base. - assert (UU:=p_lt_gen_digits n). - rewrite Zdiv_shift_r;auto with zarith. - 2:change (Zpos (gen_digits w_digits (S n))) - with (2*Zpos (gen_digits w_digits n));auto with zarith. - replace (2 ^ (Zpos (gen_digits w_digits (S n)) - [|p|])) with - (2^(Zpos (gen_digits w_digits n) - [|p|])*2^Zpos (gen_digits w_digits n)). - rewrite Zdiv_mult_cancel_r;auto with zarith. - rewrite Zmult_plus_distr_l with (p:= 2^[|p|]). - pattern ([!n|hl!] * 2^[|p|]) at 2; - rewrite (shift_unshift_mod (Zpos(gen_digits w_digits n))([|p|])([!n|hl!])); - auto with zarith. - rewrite Zplus_assoc. - replace - ([!n|hh!] * 2^Zpos (gen_digits w_digits n)* 2^[|p|] + - ([!n|hl!] / 2^(Zpos (gen_digits w_digits n)-[|p|])* - 2^Zpos(gen_digits w_digits n))) - with - (([!n|hh!] *2^[|p|] + gen_to_Z w_digits w_to_Z n hl / - 2^(Zpos (gen_digits w_digits n)-[|p|])) - * 2^Zpos(gen_digits w_digits n));try (ring;fail). - rewrite <- Zplus_assoc. - rewrite <- (Zmod_shift_r ([|p|]));auto with zarith. - replace - (2 ^ Zpos (gen_digits w_digits n) * 2 ^ Zpos (gen_digits w_digits n)) with - (2 ^ (Zpos (gen_digits w_digits n) + Zpos (gen_digits w_digits n))). - rewrite (Zmod_shift_r (Zpos (gen_digits w_digits n)));auto with zarith. - replace (2 ^ (Zpos (gen_digits w_digits n) + Zpos (gen_digits w_digits n))) - with (2^Zpos(gen_digits w_digits n) *2^Zpos(gen_digits w_digits n)). - rewrite (Zmult_comm (([!n|hh!] * 2 ^ [|p|] + - [!n|hl!] / 2 ^ (Zpos (gen_digits w_digits n) - [|p|])))). - rewrite Zmult_mod_distr_l;auto with zarith. - ring. - rewrite Zpower_exp;auto with zarith. - assert (0 < Zpos (gen_digits w_digits n)). unfold Zlt;reflexivity. - auto with zarith. - apply Z_mod_lt;auto with zarith. - rewrite Zpower_exp;auto with zarith. - split;auto with zarith. - apply Zdiv_lt_upper_bound;auto with zarith. - rewrite <- Zpower_exp;auto with zarith. - replace ([|p|] + (Zpos (gen_digits w_digits n) - [|p|])) with - (Zpos(gen_digits w_digits n));auto with zarith. - rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (gen_digits w_digits (S n)) - [|p|]) with - (Zpos (gen_digits w_digits n) - [|p|] + - Zpos (gen_digits w_digits n));trivial. - change (Zpos (gen_digits w_digits (S n))) with - (2*Zpos (gen_digits w_digits n)). ring. - Qed. - - Definition gen_modn1_p_aux n (modn1 : w -> word w n -> word w n -> w) r h l:= - let (hh,hl) := gen_split w_0 n h in - let (lh,ll) := gen_split w_0 n l in - modn1 (modn1 r hh hl) hl lh. - - Fixpoint gen_modn1_p (n:nat) : w -> word w n -> word w n -> w := - match n return w -> word w n -> word w n -> w with - | O => fun r h l => snd (w_div21 r (w_add_mul_div p h l) b2p) - | S n => gen_modn1_p_aux n (gen_modn1_p n) - end. - - Lemma spec_gen_modn1_p : forall n r h l , - gen_modn1_p n r h l = snd (gen_divn1_p n r h l). - Proof. - induction n;simpl;intros;trivial. - unfold gen_modn1_p_aux, gen_divn1_p_aux. - destruct(gen_split w_0 n h)as(hh,hl);destruct(gen_split w_0 n l) as (lh,ll). - rewrite (IHn r hh hl);destruct (gen_divn1_p n r hh hl) as (qh,rh). - rewrite IHn;simpl;destruct (gen_divn1_p n rh hl lh);trivial. - Qed. - - End DIVAUX. - - Fixpoint high (n:nat) : word w n -> w := - match n return word w n -> w with - | O => fun a => a - | S n => - fun (a:zn2z (word w n)) => - match a with - | W0 => w_0 - | WW h l => high n h - end - end. - - Lemma spec_gen_digits:forall n, Zpos w_digits <= Zpos (gen_digits w_digits n). - Proof. - induction n;simpl;auto with zarith. - change (Zpos (xO (gen_digits w_digits n))) with - (2*Zpos (gen_digits w_digits n)). - assert (0 < Zpos w_digits);auto with zarith. - exact (refl_equal Lt). - Qed. - - Lemma spec_high : forall n (x:word w n), - [|high n x|] = [!n|x!] / 2^(Zpos (gen_digits w_digits n) - Zpos w_digits). - Proof. - induction n;intros. - unfold high,gen_digits,gen_to_Z. - replace (Zpos w_digits - Zpos w_digits) with 0;try ring. - simpl. rewrite <- (Zdiv_unique [|x|] 1 [|x|] 0);auto with zarith. - assert (U2 := spec_gen_digits n). - assert (U3 : 0 < Zpos w_digits). exact (refl_equal Lt). - destruct x;unfold high;fold high. - unfold gen_to_Z,zn2z_to_Z;rewrite spec_0. - rewrite Zdiv_0_l;trivial. - assert (U0 := spec_gen_to_Z w_digits w_to_Z spec_to_Z n w0); - assert (U1 := spec_gen_to_Z w_digits w_to_Z spec_to_Z n w1). - simpl [!S n|WW w0 w1!]. - unfold gen_wB,base;rewrite Zdiv_shift_r;auto with zarith. - replace (2 ^ (Zpos (gen_digits w_digits (S n)) - Zpos w_digits)) with - (2^(Zpos (gen_digits w_digits n) - Zpos w_digits) * - 2^Zpos (gen_digits w_digits n)). - rewrite Zdiv_mult_cancel_r;auto with zarith. - rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (gen_digits w_digits n) - Zpos w_digits + - Zpos (gen_digits w_digits n)) with - (Zpos (gen_digits w_digits (S n)) - Zpos w_digits);trivial. - change (Zpos (gen_digits w_digits (S n))) with - (2*Zpos (gen_digits w_digits n));ring. - change (Zpos (gen_digits w_digits (S n))) with - (2*Zpos (gen_digits w_digits n)); auto with zarith. - Qed. - - Definition gen_divn1 (n:nat) (a:word w n) (b:w) := - let p := w_head0 b in - match w_compare p w_0 with - | Gt => - let b2p := w_add_mul_div p b w_0 in - let ha := high n a in - let k := w_sub w_zdigits p in - let lsr_n := w_add_mul_div k w_0 in - let r0 := w_add_mul_div p w_0 ha in - let (q,r) := gen_divn1_p b2p p n r0 a (gen_0 w_0 n) in - (q, lsr_n r) - | _ => gen_divn1_0 b n w_0 a - end. - - Lemma spec_gen_divn1 : forall n a b, - 0 < [|b|] -> - let (q,r) := gen_divn1 n a b in - [!n|a!] = [!n|q!] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]. - Proof. - intros n a b H. unfold gen_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_0; intros H2; auto with zarith. - assert (Hv1: wB/2 <= [|b|]). - generalize H0; rewrite H2; rewrite Zpower_0_r; - rewrite Zmult_1_l; auto. - assert (Hv2: [|w_0|] < [|b|]). - rewrite spec_0; auto. - generalize (spec_gen_divn1_0 Hv1 n a Hv2). - rewrite spec_0;rewrite Zmult_0_l; rewrite Zplus_0_l; auto. - contradict H2; auto with zarith. - assert (HHHH : 0 < [|w_head0 b|]); auto with zarith. - assert ([|w_head0 b|] < Zpos w_digits). - case (Zle_or_lt (Zpos w_digits) [|w_head0 b|]); auto; intros HH. - assert (2 ^ [|w_head0 b|] < wB). - apply Zle_lt_trans with (2 ^ [|w_head0 b|] * [|b|]);auto with zarith. - replace (2 ^ [|w_head0 b|]) with (2^[|w_head0 b|] * 1);try (ring;fail). - apply Zmult_le_compat;auto with zarith. - assert (wB <= 2^[|w_head0 b|]). - unfold base;apply Zpower_le_monotone;auto with zarith. omega. - assert ([|w_add_mul_div (w_head0 b) b w_0|] = - 2 ^ [|w_head0 b|] * [|b|]). - rewrite (spec_add_mul_div b w_0); auto with zarith. - rewrite spec_0;rewrite Zdiv_0_l; try omega. - rewrite Zplus_0_r; rewrite Zmult_comm. - rewrite Zmod_small; auto with zarith. - assert (H5 := spec_to_Z (high n a)). - assert - ([|w_add_mul_div (w_head0 b) w_0 (high n a)|] - <[|w_add_mul_div (w_head0 b) b w_0|]). - rewrite H4. - rewrite spec_add_mul_div;auto with zarith. - rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. - assert (([|high n a|]/2^(Zpos w_digits - [|w_head0 b|])) < wB). - apply Zdiv_lt_upper_bound;auto with zarith. - apply Zlt_le_trans with wB;auto with zarith. - pattern wB at 1;replace wB with (wB*1);try ring. - apply Zmult_le_compat;auto with zarith. - assert (H6 := Zpower_gt_0 2 (Zpos w_digits - [|w_head0 b|])); - auto with zarith. - rewrite Zmod_small;auto with zarith. - apply Zdiv_lt_upper_bound;auto with zarith. - apply Zlt_le_trans with wB;auto with zarith. - apply Zle_trans with (2 ^ [|w_head0 b|] * [|b|] * 2). - rewrite <- wB_div_2; try omega. - apply Zmult_le_compat;auto with zarith. - pattern 2 at 1;rewrite <- Zpower_1_r. - apply Zpower_le_monotone;split;auto with zarith. - rewrite <- H4 in H0. - assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith. - assert (H7:= spec_gen_divn1_p H0 Hb3 n a (gen_0 w_0 n) H6). - destruct (gen_divn1_p (w_add_mul_div (w_head0 b) b w_0) (w_head0 b) n - (w_add_mul_div (w_head0 b) w_0 (high n a)) a - (gen_0 w_0 n)) as (q,r). - assert (U:= spec_gen_digits n). - rewrite spec_gen_0 in H7;trivial;rewrite Zdiv_0_l in H7. - rewrite Zplus_0_r in H7. - rewrite spec_add_mul_div in H7;auto with zarith. - rewrite spec_0 in H7;rewrite Zmult_0_l in H7;rewrite Zplus_0_l in H7. - assert (([|high n a|] / 2 ^ (Zpos w_digits - [|w_head0 b|])) mod wB - = [!n|a!] / 2^(Zpos (gen_digits w_digits n) - [|w_head0 b|])). - rewrite Zmod_small;auto with zarith. - rewrite spec_high. rewrite Zdiv_Zdiv;auto with zarith. - rewrite <- Zpower_exp;auto with zarith. - replace (Zpos (gen_digits w_digits n) - Zpos w_digits + - (Zpos w_digits - [|w_head0 b|])) - with (Zpos (gen_digits w_digits n) - [|w_head0 b|]);trivial;ring. - assert (H8 := Zpower_gt_0 2 (Zpos w_digits - [|w_head0 b|]));auto with zarith. - split;auto with zarith. - apply Zle_lt_trans with ([|high n a|]);auto with zarith. - apply Zdiv_le_upper_bound;auto with zarith. - pattern ([|high n a|]) at 1;rewrite <- Zmult_1_r. - apply Zmult_le_compat;auto with zarith. - rewrite H8 in H7;unfold gen_wB,base in H7. - rewrite <- shift_unshift_mod in H7;auto with zarith. - rewrite H4 in H7. - assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|] - = [|r|]/2^[|w_head0 b|]). - rewrite spec_add_mul_div. - rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. - replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|]) - with ([|w_head0 b|]). - rewrite Zmod_small;auto with zarith. - assert (H9 := spec_to_Z r). - split;auto with zarith. - apply Zle_lt_trans with ([|r|]);auto with zarith. - apply Zdiv_le_upper_bound;auto with zarith. - pattern ([|r|]) at 1;rewrite <- Zmult_1_r. - apply Zmult_le_compat;auto with zarith. - assert (H10 := Zpower_gt_0 2 ([|w_head0 b|]));auto with zarith. - rewrite spec_sub. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - case (spec_to_Z w_zdigits); auto with zarith. - rewrite spec_sub. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - case (spec_to_Z w_zdigits); auto with zarith. - case H7; intros H71 H72. - split. - rewrite <- (Z_div_mult [!n|a!] (2^[|w_head0 b|]));auto with zarith. - rewrite H71;rewrite H9. - replace ([!n|q!] * (2 ^ [|w_head0 b|] * [|b|])) - with ([!n|q!] *[|b|] * 2^[|w_head0 b|]); - try (ring;fail). - rewrite Z_div_plus_l;auto with zarith. - assert (H10 := spec_to_Z - (w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r));split; - auto with zarith. - rewrite H9. - apply Zdiv_lt_upper_bound;auto with zarith. - rewrite Zmult_comm;auto with zarith. - exact (spec_gen_to_Z w_digits w_to_Z spec_to_Z n a). - Qed. - - - Definition gen_modn1 (n:nat) (a:word w n) (b:w) := - let p := w_head0 b in - match w_compare p w_0 with - | Gt => - let b2p := w_add_mul_div p b w_0 in - let ha := high n a in - let k := w_sub w_zdigits p in - let lsr_n := w_add_mul_div k w_0 in - let r0 := w_add_mul_div p w_0 ha in - let r := gen_modn1_p b2p p n r0 a (gen_0 w_0 n) in - lsr_n r - | _ => gen_modn1_0 b n w_0 a - end. - - Lemma spec_gen_modn1_aux : forall n a b, - gen_modn1 n a b = snd (gen_divn1 n a b). - Proof. - intros n a b;unfold gen_divn1,gen_modn1. - generalize (spec_compare (w_head0 b) w_0); case w_compare; - rewrite spec_0; intros H2; auto with zarith. - apply spec_gen_modn1_0. - apply spec_gen_modn1_0. - rewrite spec_gen_modn1_p. - destruct (gen_divn1_p (w_add_mul_div (w_head0 b) b w_0) (w_head0 b) n - (w_add_mul_div (w_head0 b) w_0 (high n a)) a (gen_0 w_0 n));simpl;trivial. - Qed. - - Lemma spec_gen_modn1 : forall n a b, 0 < [|b|] -> - [|gen_modn1 n a b|] = [!n|a!] mod [|b|]. - Proof. - intros n a b H;assert (H1 := spec_gen_divn1 n a H). - assert (H2 := spec_gen_modn1_aux n a b). - rewrite H2;destruct (gen_divn1 n a b) as (q,r). - simpl;apply Zmod_unique with (gen_to_Z w_digits w_to_Z n q);auto with zarith. - destruct H1 as (h1,h2);rewrite h1;ring. - Qed. - -End GENDIVN1. diff --git a/theories/Ints/num/GenLift.v b/theories/Ints/num/GenLift.v deleted file mode 100644 index f74cdc30bb..0000000000 --- a/theories/Ints/num/GenLift.v +++ /dev/null @@ -1,483 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. - -Open Local Scope Z_scope. - -Section GenLift. - Variable w : Set. - Variable w_0 : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_W0 : w -> zn2z w. - Variable w_0W : w -> zn2z w. - Variable w_compare : w -> w -> comparison. - Variable ww_compare : zn2z w -> zn2z w -> comparison. - Variable w_head0 : w -> w. - Variable w_tail0 : w -> w. - Variable w_add: w -> w -> zn2z w. - Variable w_add_mul_div : w -> w -> w -> w. - Variable ww_sub: zn2z w -> zn2z w -> zn2z w. - Variable w_digits : positive. - Variable ww_Digits : positive. - Variable w_zdigits : w. - Variable ww_zdigits : zn2z w. - Variable low: zn2z w -> w. - - Definition ww_head0 x := - match x with - | W0 => ww_zdigits - | WW xh xl => - match w_compare w_0 xh with - | Eq => w_add w_zdigits (w_head0 xl) - | _ => w_0W (w_head0 xh) - end - end. - - - Definition ww_tail0 x := - match x with - | W0 => ww_zdigits - | WW xh xl => - match w_compare w_0 xl with - | Eq => w_add w_zdigits (w_tail0 xh) - | _ => w_0W (w_tail0 xl) - end - end. - - - (* 0 < p < ww_digits *) - Definition ww_add_mul_div p x y := - let zdigits := w_0W w_zdigits in - match x, y with - | W0, W0 => W0 - | W0, WW yh yl => - match ww_compare p zdigits with - | Eq => w_0W yh - | Lt => w_0W (w_add_mul_div (low p) w_0 yh) - | Gt => - let n := low (ww_sub p zdigits) in - w_WW (w_add_mul_div n w_0 yh) (w_add_mul_div n yh yl) - end - | WW xh xl, W0 => - match ww_compare p zdigits with - | Eq => w_W0 xl - | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl w_0) - | Gt => - let n := low (ww_sub p zdigits) in - w_W0 (w_add_mul_div n xl w_0) - end - | WW xh xl, WW yh yl => - match ww_compare p zdigits with - | Eq => w_WW xl yh - | Lt => w_WW (w_add_mul_div (low p) xh xl) (w_add_mul_div (low p) xl yh) - | Gt => - let n := low (ww_sub p zdigits) in - w_WW (w_add_mul_div n xl yh) (w_add_mul_div n yh yl) - end - end. - - Section GenProof. - Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - Variable spec_to_w_Z : forall x, 0 <= [[x]] < wwB. - Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. - 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. - Variable spec_ww_compare : forall x y, - match ww_compare x y with - | Eq => [[x]] = [[y]] - | Lt => [[x]] < [[y]] - | Gt => [[x]] > [[y]] - end. - 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|] -> - wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB. - Variable spec_w_tail00 : forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits. - Variable spec_w_tail0 : forall x, 0 < [|x|] -> - exists y, 0 <= y /\ [|x|] = (2* y + 1) * (2 ^ [|w_tail0 x|]). - Variable spec_w_add_mul_div : forall x y p, - [|p|] <= Zpos w_digits -> - [| w_add_mul_div p x y |] = - ([|x|] * (2 ^ [|p|]) + - [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB. - Variable spec_w_add: forall x y, - [[w_add x y]] = [|x|] + [|y|]. - Variable spec_ww_sub: forall x y, - [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. - - Variable spec_zdigits : [| w_zdigits |] = Zpos w_digits. - Variable spec_low: forall x, [| low x|] = [[x]] mod wB. - - Variable spec_ww_zdigits : [[ww_zdigits]] = Zpos ww_Digits. - - Hint Resolve div_le_0 div_lt w_to_Z_wwB: lift. - Ltac zarith := auto with zarith lift. - - Lemma spec_ww_head00 : forall x, [[x]] = 0 -> [[ww_head0 x]] = Zpos ww_Digits. - Proof. - intros x; case x; unfold ww_head0. - intros HH; rewrite spec_ww_zdigits; auto. - intros xh xl; simpl; intros Hx. - case (spec_to_Z xh); intros Hx1 Hx2. - case (spec_to_Z xl); intros Hy1 Hy2. - assert (F1: [|xh|] = 0). - case (Zle_lt_or_eq _ _ Hy1); auto; intros Hy3. - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. - apply Zlt_le_trans with (1 := Hy3); auto with zarith. - pattern [|xl|] at 1; rewrite <- (Zplus_0_l [|xl|]). - apply Zplus_le_compat_r; auto with zarith. - case (Zle_lt_or_eq _ _ Hx1); auto; intros Hx3. - 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. - intros H; simpl. - rewrite spec_w_add; rewrite spec_w_head00. - rewrite spec_zdigits; rewrite spec_ww_digits. - rewrite Zpos_xO; auto with zarith. - rewrite F1 in Hx; auto with zarith. - rewrite spec_w_0; auto with zarith. - rewrite spec_w_0; auto with zarith. - Qed. - - Lemma spec_ww_head0 : forall x, 0 < [[x]] -> - wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB. - Proof. - clear spec_ww_zdigits. - 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. - case (spec_to_Z w_zdigits); - case (spec_to_Z (w_head0 xl)); intros HH1 HH2 HH3 HH4. - rewrite spec_w_add. - rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith. - case (spec_w_head0 H); intros H1 H2. - rewrite Zpower_2; fold wB; rewrite <- Zmult_assoc; split. - apply Zmult_le_compat_l; auto with zarith. - apply Zmult_lt_compat_l; auto with zarith. - assert (H1 := spec_w_head0 H0). - rewrite spec_w_0W. - split. - rewrite Zmult_plus_distr_r;rewrite Zmult_assoc. - apply Zle_trans with (2 ^ [|w_head0 xh|] * [|xh|] * wB). - rewrite Zmult_comm; zarith. - assert (0 <= 2 ^ [|w_head0 xh|] * [|xl|]);zarith. - assert (H2:=spec_to_Z xl);apply Zmult_le_0_compat;zarith. - case (spec_to_Z (w_head0 xh)); intros H2 _. - generalize ([|w_head0 xh|]) H1 H2;clear H1 H2; - intros p H1 H2. - assert (Eq1 : 2^p < wB). - rewrite <- (Zmult_1_r (2^p));apply Zle_lt_trans with (2^p*[|xh|]);zarith. - assert (Eq2: p < Zpos w_digits). - destruct (Zle_or_lt (Zpos w_digits) p);trivial;contradict Eq1. - apply Zle_not_lt;unfold base;apply Zpower_le_monotone;zarith. - assert (Zpos w_digits = p + (Zpos w_digits - p)). ring. - rewrite Zpower_2. - unfold base at 2;rewrite H3;rewrite Zpower_exp;zarith. - rewrite <- Zmult_assoc; apply Zmult_lt_compat_l; zarith. - rewrite <- (Zplus_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith. - apply Zmult_lt_reg_r with (2 ^ p); zarith. - rewrite <- Zpower_exp;zarith. - rewrite Zmult_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith. - assert (H1 := spec_to_Z xh);zarith. - Qed. - - Lemma spec_ww_tail00 : forall x, [[x]] = 0 -> [[ww_tail0 x]] = Zpos ww_Digits. - Proof. - intros x; case x; unfold ww_tail0. - intros HH; rewrite spec_ww_zdigits; auto. - intros xh xl; simpl; intros Hx. - case (spec_to_Z xh); intros Hx1 Hx2. - case (spec_to_Z xl); intros Hy1 Hy2. - assert (F1: [|xh|] = 0). - case (Zle_lt_or_eq _ _ Hy1); auto; intros Hy3. - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. - apply Zlt_le_trans with (1 := Hy3); auto with zarith. - pattern [|xl|] at 1; rewrite <- (Zplus_0_l [|xl|]). - apply Zplus_le_compat_r; auto with zarith. - case (Zle_lt_or_eq _ _ Hx1); auto; intros Hx3. - 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. - assert (F2: [|xl|] = 0). - rewrite F1 in Hx; auto with zarith. - generalize (spec_compare w_0 xl); case w_compare. - intros H; simpl. - rewrite spec_w_add; rewrite spec_w_tail00; auto. - rewrite spec_zdigits; rewrite spec_ww_digits. - rewrite Zpos_xO; auto with zarith. - rewrite spec_w_0; auto with zarith. - rewrite spec_w_0; auto with zarith. - Qed. - - Lemma spec_ww_tail0 : forall x, 0 < [[x]] -> - exists y, 0 <= y /\ [[x]] = (2 * y + 1) * 2 ^ [[ww_tail0 x]]. - Proof. - 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 <- 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. - case (@spec_w_tail0 xh). - apply Zmult_lt_reg_r with wB; auto with zarith. - unfold base; auto with zarith. - intros z (Hz1, Hz2); exists z; split; auto. - rewrite spec_w_add; rewrite (fun x => Zplus_comm [|x|]). - rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith. - rewrite Zmult_assoc; rewrite <- Hz2; auto. - - case (spec_to_Z (w_tail0 xh)); intros HH1 HH2. - case (spec_w_tail0 H0); intros z (Hz1, Hz2). - assert (Hp: [|w_tail0 xl|] < Zpos w_digits). - case (Zle_or_lt (Zpos w_digits) [|w_tail0 xl|]); auto; intros H1. - absurd (2 ^ (Zpos w_digits) <= 2 ^ [|w_tail0 xl|]). - apply Zlt_not_le. - case (spec_to_Z xl); intros HH3 HH4. - apply Zle_lt_trans with (2 := HH4). - apply Zle_trans with (1 * 2 ^ [|w_tail0 xl|]); auto with zarith. - rewrite Hz2. - apply Zmult_le_compat_r; auto with zarith. - apply Zpower_le_monotone; auto with zarith. - exists ([|xh|] * (2 ^ ((Zpos w_digits - [|w_tail0 xl|]) - 1)) + z); split. - apply Zplus_le_0_compat; auto. - apply Zmult_le_0_compat; auto with zarith. - case (spec_to_Z xh); auto. - rewrite spec_w_0W. - rewrite (Zmult_plus_distr_r 2); rewrite <- Zplus_assoc. - rewrite Zmult_plus_distr_l; rewrite <- Hz2. - apply f_equal2 with (f := Zplus); auto. - rewrite (Zmult_comm 2). - repeat rewrite <- Zmult_assoc. - apply f_equal2 with (f := Zmult); auto. - case (spec_to_Z (w_tail0 xl)); intros HH3 HH4. - pattern 2 at 2; rewrite <- Zpower_1_r. - lazy beta; repeat rewrite <- Zpower_exp; auto with zarith. - unfold base; apply f_equal with (f := Zpower 2); auto with zarith. - - contradict H0; case (spec_to_Z xl); auto with zarith. - Qed. - - Hint Rewrite Zdiv_0_l Zmult_0_l Zplus_0_l Zmult_0_r Zplus_0_r - spec_w_W0 spec_w_0W spec_w_WW spec_w_0 - (wB_div w_digits w_to_Z spec_to_Z) - (wB_div_plus w_digits w_to_Z spec_to_Z) : w_rewrite. - Ltac w_rewrite := autorewrite with w_rewrite;trivial. - - Lemma spec_ww_add_mul_div_aux : forall xh xl yh yl p, - let zdigits := w_0W w_zdigits in - [[p]] <= Zpos (xO w_digits) -> - [[match ww_compare p zdigits with - | Eq => w_WW xl yh - | Lt => w_WW (w_add_mul_div (low p) xh xl) - (w_add_mul_div (low p) xl yh) - | Gt => - let n := low (ww_sub p zdigits) in - w_WW (w_add_mul_div n xl yh) (w_add_mul_div n yh yl) - end]] = - ([[WW xh xl]] * (2^[[p]]) + - [[WW yh yl]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB. - Proof. - clear spec_ww_zdigits. - intros xh xl yh yl p zdigits;assert (HwwB := wwB_pos w_digits). - case (spec_to_w_Z p); intros Hv1 Hv2. - replace (Zpos (xO w_digits)) with (Zpos w_digits + Zpos w_digits). - 2 : rewrite Zpos_xO;ring. - replace (Zpos w_digits + Zpos w_digits - [[p]]) with - (Zpos w_digits + (Zpos w_digits - [[p]])). 2:ring. - intros Hp; assert (Hxh := spec_to_Z xh);assert (Hxl:=spec_to_Z xl); - assert (Hx := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)); - 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 H1; unfold zdigits; rewrite spec_w_0W. - rewrite spec_zdigits; rewrite Zminus_diag; rewrite Zplus_0_r. - simpl ww_to_Z; w_rewrite;zarith. - fold wB. - rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc;rewrite <- Zplus_assoc. - rewrite <- Zpower_2. - rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|]. - exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xl yh)). ring. - simpl ww_to_Z; w_rewrite;zarith. - assert (HH0: [|low p|] = [[p]]). - rewrite spec_low. - apply Zmod_small. - case (spec_to_w_Z p); intros HH1 HH2; split; auto. - generalize H1; unfold zdigits; rewrite spec_w_0W; - rewrite spec_zdigits; intros tmp. - apply Zlt_le_trans with (1 := tmp). - unfold base. - apply Zpower2_le_lin; auto with zarith. - 2: generalize H1; unfold zdigits; rewrite spec_w_0W; - rewrite spec_zdigits; auto with zarith. - generalize H1; unfold zdigits; rewrite spec_w_0W; - rewrite spec_zdigits; auto; clear H1; intros H1. - assert (HH: [|low p|] <= Zpos w_digits). - rewrite HH0; auto with zarith. - repeat rewrite spec_w_add_mul_div with (1 := HH). - rewrite HH0. - rewrite Zmult_plus_distr_l. - pattern ([|xl|] * 2 ^ [[p]]) at 2; - rewrite shift_unshift_mod with (n:= Zpos w_digits);fold wB;zarith. - replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. - unfold base at 5;rewrite <- Zmod_shift_r;zarith. - unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); - fold wB;fold wwB;zarith. - rewrite wwB_wBwB;rewrite Zpower_2; rewrite Zmult_mod_distr_r;zarith. - unfold ww_digits;rewrite Zpos_xO;zarith. apply Z_mod_lt;zarith. - split;zarith. apply Zdiv_lt_upper_bound;zarith. - rewrite <- Zpower_exp;zarith. - 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. - clear H1. - assert (HH0: [|low (ww_sub p zdigits)|] = [[p]] - Zpos w_digits). - rewrite spec_low. - rewrite spec_ww_sub. - unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits. - rewrite <- Zmod_div_mod; auto with zarith. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. - unfold base; apply Zpower2_lt_lin; auto with zarith. - exists wB; unfold base. - unfold ww_digits; rewrite (Zpos_xO w_digits). - rewrite <- Zpower_exp; auto with zarith. - apply f_equal with (f := fun x => 2 ^ x); auto with zarith. - assert (HH: [|low (ww_sub p zdigits)|] <= Zpos w_digits). - rewrite HH0; auto with zarith. - replace (Zpos w_digits + (Zpos w_digits - [[p]])) with - (Zpos w_digits - ([[p]] - Zpos w_digits)); zarith. - lazy zeta; simpl ww_to_Z; w_rewrite;zarith. - repeat rewrite spec_w_add_mul_div;zarith. - rewrite HH0. - pattern wB at 5;replace wB with - (2^(([[p]] - Zpos w_digits) - + (Zpos w_digits - ([[p]] - Zpos w_digits)))). - rewrite Zpower_exp;zarith. rewrite Zmult_assoc. - rewrite Z_div_plus_l;zarith. - rewrite shift_unshift_mod with (a:= [|yh|]) (p:= [[p]] - Zpos w_digits) - (n := Zpos w_digits);zarith. fold wB. - set (u := [[p]] - Zpos w_digits). - replace [[p]] with (u + Zpos w_digits);zarith. - rewrite Zpower_exp;zarith. rewrite Zmult_assoc. fold wB. - repeat rewrite Zplus_assoc. rewrite <- Zmult_plus_distr_l. - repeat rewrite <- Zplus_assoc. - unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); - fold wB;fold wwB;zarith. - unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits) - (b:= Zpos w_digits);fold wB;fold wwB;zarith. - rewrite wwB_wBwB; rewrite Zpower_2; rewrite Zmult_mod_distr_r;zarith. - rewrite Zmult_plus_distr_l. - replace ([|xh|] * wB * 2 ^ u) with - ([|xh|]*2^u*wB). 2:ring. - repeat rewrite <- Zplus_assoc. - rewrite (Zplus_comm ([|xh|] * 2 ^ u * wB)). - rewrite Z_mod_plus;zarith. rewrite Z_mod_mult;zarith. - unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. - unfold u; split;zarith. - split;zarith. unfold u; apply Zdiv_lt_upper_bound;zarith. - rewrite <- Zpower_exp;zarith. - fold u. - ring_simplify (u + (Zpos w_digits - u)); fold - wB;zarith. unfold ww_digits;rewrite Zpos_xO;zarith. - unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. - unfold u; split;zarith. - unfold u; split;zarith. - apply Zdiv_lt_upper_bound;zarith. - rewrite <- Zpower_exp;zarith. - fold u. - ring_simplify (u + (Zpos w_digits - u)); fold wB; auto with zarith. - unfold u;zarith. - unfold u;zarith. - set (u := [[p]] - Zpos w_digits). - ring_simplify (u + (Zpos w_digits - u)); fold wB; auto with zarith. - Qed. - - Lemma spec_ww_add_mul_div : forall x y p, - [[p]] <= Zpos (xO w_digits) -> - [[ ww_add_mul_div p x y ]] = - ([[x]] * (2^[[p]]) + - [[y]] / (2^(Zpos (xO w_digits) - [[p]]))) mod wwB. - Proof. - clear spec_ww_zdigits. - intros x y p H. - destruct x as [ |xh xl]; - [assert (H1 := @spec_ww_add_mul_div_aux w_0 w_0) - |assert (H1 := @spec_ww_add_mul_div_aux xh xl)]; - (destruct y as [ |yh yl]; - [generalize (H1 w_0 w_0 p H) | generalize (H1 yh yl p H)]; - 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_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]]). - rewrite spec_low. - apply Zmod_small. - case (spec_to_w_Z p); intros HH1 HH2; split; auto. - apply Zlt_le_trans with (1 := H1). - unfold base; apply Zpower2_le_lin; auto with zarith. - rewrite HH0; auto with zarith. - replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial]. - intros Heq;rewrite <- Heq;clear Heq. - generalize (spec_ww_compare p (w_0W w_zdigits)); - case ww_compare; intros H1; w_rewrite. - rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. - rewrite Zpos_xO in H;zarith. - assert (HH: [|low (ww_sub p (w_0W w_zdigits)) |] = [[p]] - Zpos w_digits). - generalize H1; clear H1. - rewrite spec_low. - rewrite spec_ww_sub; w_rewrite; intros H1. - rewrite <- Zmod_div_mod; auto with zarith. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. - unfold base; apply Zpower2_lt_lin; auto with zarith. - unfold base; auto with zarith. - unfold base; auto with zarith. - exists wB; unfold base. - unfold ww_digits; rewrite (Zpos_xO w_digits). - rewrite <- Zpower_exp; auto with zarith. - apply f_equal with (f := fun x => 2 ^ x); auto with zarith. - case (spec_to_Z xh); auto with zarith. - Qed. - - End GenProof. - -End GenLift. - diff --git a/theories/Ints/num/GenMul.v b/theories/Ints/num/GenMul.v deleted file mode 100644 index 9a56f1ee3c..0000000000 --- a/theories/Ints/num/GenMul.v +++ /dev/null @@ -1,624 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. - -Open Local Scope Z_scope. - -Section GenMul. - Variable w : Set. - Variable w_0 : w. - Variable w_1 : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_W0 : w -> zn2z w. - Variable w_0W : w -> zn2z w. - Variable w_compare : w -> w -> comparison. - Variable w_succ : w -> w. - Variable w_add_c : w -> w -> carry w. - Variable w_add : w -> w -> w. - Variable w_sub: w -> w -> w. - Variable w_mul_c : w -> w -> zn2z w. - Variable w_mul : w -> w -> w. - Variable w_square_c : w -> zn2z w. - Variable ww_add_c : zn2z w -> zn2z w -> carry (zn2z w). - Variable ww_add : zn2z w -> zn2z w -> zn2z w. - Variable ww_add_carry : zn2z w -> zn2z w -> zn2z w. - Variable ww_sub_c : zn2z w -> zn2z w -> carry (zn2z w). - Variable ww_sub : zn2z w -> zn2z w -> zn2z w. - - (* ** Multiplication ** *) - - (* (xh*B+xl) (yh*B + yl) - xh*yh = hh = |hhh|hhl|B2 - xh*yl +xl*yh = cc = |cch|ccl|B - xl*yl = ll = |llh|lll - *) - - Definition gen_mul_c (cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w) x y := - match x, y with - | W0, _ => W0 - | _, W0 => W0 - | WW xh xl, WW yh yl => - let hh := w_mul_c xh yh in - let ll := w_mul_c xl yl in - let (wc,cc) := cross xh xl yh yl hh ll in - match cc with - | W0 => WW (ww_add hh (w_W0 wc)) ll - | WW cch ccl => - match ww_add_c (w_W0 ccl) ll with - | C0 l => WW (ww_add hh (w_WW wc cch)) l - | C1 l => WW (ww_add_carry hh (w_WW wc cch)) l - end - end - end. - - Definition ww_mul_c := - gen_mul_c - (fun xh xl yh yl hh ll=> - match ww_add_c (w_mul_c xh yl) (w_mul_c xl yh) with - | C0 cc => (w_0, cc) - | C1 cc => (w_1, cc) - end). - - Definition w_2 := w_add w_1 w_1. - - Definition kara_prod xh xl yh yl hh ll := - match ww_add_c hh ll with - C0 m => - match w_compare xl xh with - Eq => (w_0, m) - | Lt => - match w_compare yl yh with - Eq => (w_0, m) - | Lt => (w_0, ww_sub m (w_mul_c (w_sub xh xl) (w_sub yh yl))) - | Gt => match ww_add_c m (w_mul_c (w_sub xh xl) (w_sub yl yh)) with - C1 m1 => (w_1, m1) | C0 m1 => (w_0, m1) - end - end - | Gt => - match w_compare yl yh with - Eq => (w_0, m) - | Lt => match ww_add_c m (w_mul_c (w_sub xl xh) (w_sub yh yl)) with - C1 m1 => (w_1, m1) | C0 m1 => (w_0, m1) - end - | Gt => (w_0, ww_sub m (w_mul_c (w_sub xl xh) (w_sub yl yh))) - end - end - | C1 m => - match w_compare xl xh with - Eq => (w_1, m) - | Lt => - match w_compare yl yh with - Eq => (w_1, m) - | Lt => match ww_sub_c m (w_mul_c (w_sub xh xl) (w_sub yh yl)) with - C0 m1 => (w_1, m1) | C1 m1 => (w_0, m1) - end - | Gt => match ww_add_c m (w_mul_c (w_sub xh xl) (w_sub yl yh)) with - C1 m1 => (w_2, m1) | C0 m1 => (w_1, m1) - end - end - | Gt => - match w_compare yl yh with - Eq => (w_1, m) - | Lt => match ww_add_c m (w_mul_c (w_sub xl xh) (w_sub yh yl)) with - C1 m1 => (w_2, m1) | C0 m1 => (w_1, m1) - end - | Gt => match ww_sub_c m (w_mul_c (w_sub xl xh) (w_sub yl yh)) with - C1 m1 => (w_0, m1) | C0 m1 => (w_1, m1) - end - end - end - end. - - Definition ww_karatsuba_c := gen_mul_c kara_prod. - - Definition ww_mul x y := - match x, y with - | W0, _ => W0 - | _, W0 => W0 - | WW xh xl, WW yh yl => - let ccl := w_add (w_mul xh yl) (w_mul xl yh) in - ww_add (w_W0 ccl) (w_mul_c xl yl) - end. - - Definition ww_square_c x := - match x with - | W0 => W0 - | WW xh xl => - let hh := w_square_c xh in - let ll := w_square_c xl in - let xhxl := w_mul_c xh xl in - let (wc,cc) := - match ww_add_c xhxl xhxl with - | C0 cc => (w_0, cc) - | C1 cc => (w_1, cc) - end in - match cc with - | W0 => WW (ww_add hh (w_W0 wc)) ll - | WW cch ccl => - match ww_add_c (w_W0 ccl) ll with - | C0 l => WW (ww_add hh (w_WW wc cch)) l - | C1 l => WW (ww_add_carry hh (w_WW wc cch)) l - end - end - end. - - Section GenMulAddn1. - Variable w_mul_add : w -> w -> w -> w * w. - - Fixpoint gen_mul_add_n1 (n:nat) : word w n -> w -> w -> w * word w n := - match n return word w n -> w -> w -> w * word w n with - | O => w_mul_add - | S n1 => - let mul_add := gen_mul_add_n1 n1 in - fun x y r => - match x with - | W0 => (w_0,extend w_0W n1 r) - | WW xh xl => - let (rl,l) := mul_add xl y r in - let (rh,h) := mul_add xh y rl in - (rh, gen_WW w_WW n1 h l) - end - end. - - End GenMulAddn1. - - Section GenMulAddmn1. - Variable wn: Set. - Variable extend_n : w -> wn. - Variable wn_0W : wn -> zn2z wn. - Variable wn_WW : wn -> wn -> zn2z wn. - Variable w_mul_add_n1 : wn -> w -> w -> w*wn. - Fixpoint gen_mul_add_mn1 (m:nat) : - word wn m -> w -> w -> w*word wn m := - match m return word wn m -> w -> w -> w*word wn m with - | O => w_mul_add_n1 - | S m1 => - let mul_add := gen_mul_add_mn1 m1 in - fun x y r => - match x with - | W0 => (w_0,extend wn_0W m1 (extend_n r)) - | WW xh xl => - let (rl,l) := mul_add xl y r in - let (rh,h) := mul_add xh y rl in - (rh, gen_WW wn_WW m1 h l) - end - end. - - End GenMulAddmn1. - - Definition w_mul_add x y r := - match w_mul_c x y with - | W0 => (w_0, r) - | WW h l => - match w_add_c l r with - | C0 lr => (h,lr) - | C1 lr => (w_succ h, lr) - end - end. - - - (*Section GenProof. *) - Variable w_digits : positive. - Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[+| c |]" := - (interp_carry 1 wB w_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). - - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - - Notation "[|| x ||]" := - (zn2z_to_Z wwB (ww_to_Z w_digits w_to_Z) x) (at level 0, x at level 99). - - Notation "[! n | x !]" := (gen_to_Z w_digits w_to_Z n x) - (at level 0, x at level 99). - - Variable spec_more_than_1_digit: 1 < Zpos w_digits. - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_w_1 : [|w_1|] = 1. - - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - - Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. - 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. - 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. - Variable spec_w_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. - - Variable spec_w_mul_c : forall x y, [[ w_mul_c x y ]] = [|x|] * [|y|]. - Variable spec_w_mul : forall x y, [|w_mul x y|] = ([|x|] * [|y|]) mod wB. - Variable spec_w_square_c : forall x, [[ w_square_c x]] = [|x|] * [|x|]. - - Variable spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]]. - Variable spec_ww_add : forall x y, [[ww_add x y]] = ([[x]] + [[y]]) mod wwB. - Variable spec_ww_add_carry : - forall x y, [[ww_add_carry x y]] = ([[x]] + [[y]] + 1) mod wwB. - Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. - Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]]. - - - Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB. - Proof. intros x;apply spec_ww_to_Z;auto. Qed. - - Lemma spec_ww_to_Z_wBwB : forall x, 0 <= [[x]] < wB^2. - Proof. rewrite <- wwB_wBwB;apply spec_ww_to_Z. Qed. - - Hint Resolve spec_ww_to_Z spec_ww_to_Z_wBwB : mult. - Ltac zarith := auto with zarith mult. - - Lemma wBwB_lex: forall a b c d, - a * wB^2 + [[b]] <= c * wB^2 + [[d]] -> - a <= c. - Proof. - intros a b c d H; apply beta_lex with [[b]] [[d]] (wB^2);zarith. - Qed. - - Lemma wBwB_lex_inv: forall a b c d, - a < c -> - a * wB^2 + [[b]] < c * wB^2 + [[d]]. - Proof. - intros a b c d H; apply beta_lex_inv; zarith. - Qed. - - Lemma sum_mul_carry : forall xh xl yh yl wc cc, - [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] -> - 0 <= [|wc|] <= 1. - Proof. - intros. - apply (sum_mul_carry [|xh|] [|xl|] [|yh|] [|yl|] [|wc|][[cc]] wB);zarith. - apply wB_pos. - Qed. - - Theorem mult_add_ineq: forall xH yH crossH, - 0 <= [|xH|] * [|yH|] + [|crossH|] < wwB. - Proof. - intros;rewrite wwB_wBwB;apply mult_add_ineq;zarith. - Qed. - - Hint Resolve mult_add_ineq : mult. - - Lemma spec_mul_aux : forall xh xl yh yl wc (cc:zn2z w) hh ll, - [[hh]] = [|xh|] * [|yh|] -> - [[ll]] = [|xl|] * [|yl|] -> - [|wc|]*wB^2 + [[cc]] = [|xh|] * [|yl|] + [|xl|] * [|yh|] -> - [||match cc with - | W0 => WW (ww_add hh (w_W0 wc)) ll - | WW cch ccl => - match ww_add_c (w_W0 ccl) ll with - | C0 l => WW (ww_add hh (w_WW wc cch)) l - | C1 l => WW (ww_add_carry hh (w_WW wc cch)) l - end - end||] = ([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|]). - Proof. - intros;assert (U1 := wB_pos w_digits). - replace (([|xh|] * wB + [|xl|]) * ([|yh|] * wB + [|yl|])) with - ([|xh|]*[|yh|]*wB^2 + ([|xh|]*[|yl|] + [|xl|]*[|yh|])*wB + [|xl|]*[|yl|]). - 2:ring. rewrite <- H1;rewrite <- H;rewrite <- H0. - assert (H2 := sum_mul_carry _ _ _ _ _ _ H1). - destruct cc as [ | cch ccl]; simpl zn2z_to_Z; simpl ww_to_Z. - rewrite spec_ww_add;rewrite spec_w_W0;rewrite Zmod_small; - rewrite wwB_wBwB. ring. - rewrite <- (Zplus_0_r ([|wc|]*wB));rewrite H;apply mult_add_ineq3;zarith. - simpl ww_to_Z in H1. assert (U:=spec_to_Z cch). - assert ([|wc|]*wB + [|cch|] <= 2*wB - 3). - destruct (Z_le_gt_dec ([|wc|]*wB + [|cch|]) (2*wB - 3));trivial. - assert ([|xh|] * [|yl|] + [|xl|] * [|yh|] <= (2*wB - 4)*wB + 2). - ring_simplify ((2*wB - 4)*wB + 2). - assert (H4 := Zmult_lt_b _ _ _ (spec_to_Z xh) (spec_to_Z yl)). - assert (H5 := Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)). - omega. - generalize H3;clear H3;rewrite <- H1. - rewrite Zplus_assoc; rewrite Zpower_2; rewrite Zmult_assoc; - rewrite <- Zmult_plus_distr_l. - assert (((2 * wB - 4) + 2)*wB <= ([|wc|] * wB + [|cch|])*wB). - apply Zmult_le_compat;zarith. - rewrite Zmult_plus_distr_l in H3. - intros. assert (U2 := spec_to_Z ccl);omega. - generalize (spec_ww_add_c (w_W0 ccl) ll);destruct (ww_add_c (w_W0 ccl) ll) - as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Zmult_1_l; - simpl zn2z_to_Z; - try rewrite spec_ww_add;try rewrite spec_ww_add_carry;rewrite spec_w_WW; - rewrite Zmod_small;rewrite wwB_wBwB;intros. - rewrite H4;ring. rewrite H;apply mult_add_ineq2;zarith. - rewrite Zplus_assoc;rewrite Zmult_plus_distr_l. - rewrite Zmult_1_l;rewrite <- Zplus_assoc;rewrite H4;ring. - repeat rewrite <- Zplus_assoc;rewrite H;apply mult_add_ineq2;zarith. - Qed. - - Lemma spec_gen_mul_c : forall cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w, - (forall xh xl yh yl hh ll, - [[hh]] = [|xh|]*[|yh|] -> - [[ll]] = [|xl|]*[|yl|] -> - let (wc,cc) := cross xh xl yh yl hh ll in - [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]) -> - forall x y, [||gen_mul_c cross x y||] = [[x]] * [[y]]. - Proof. - intros cross Hcross x y;destruct x as [ |xh xl];simpl;trivial. - destruct y as [ |yh yl];simpl. rewrite Zmult_0_r;trivial. - assert (H1:= spec_w_mul_c xh yh);assert (H2:= spec_w_mul_c xl yl). - generalize (Hcross _ _ _ _ _ _ H1 H2). - destruct (cross xh xl yh yl (w_mul_c xh yh) (w_mul_c xl yl)) as (wc,cc). - intros;apply spec_mul_aux;trivial. - rewrite <- wwB_wBwB;trivial. - Qed. - - Lemma spec_ww_mul_c : forall x y, [||ww_mul_c x y||] = [[x]] * [[y]]. - Proof. - intros x y;unfold ww_mul_c;apply spec_gen_mul_c. - intros xh xl yh yl hh ll H1 H2. - generalize (spec_ww_add_c (w_mul_c xh yl) (w_mul_c xl yh)); - destruct (ww_add_c (w_mul_c xh yl) (w_mul_c xl yh)) as [c|c]; - unfold interp_carry;repeat rewrite spec_w_mul_c;intros H; - (rewrite spec_w_0 || rewrite spec_w_1);rewrite H;ring. - Qed. - - Lemma spec_w_2: [|w_2|] = 2. - unfold w_2; rewrite spec_w_add; rewrite spec_w_1; simpl. - apply Zmod_small; split; auto with zarith. - rewrite <- (Zpower_1_r 2); unfold base; apply Zpower_lt_monotone; auto with zarith. - Qed. - - Lemma kara_prod_aux : forall xh xl yh yl, - xh*yh + xl*yl - (xh-xl)*(yh-yl) = xh*yl + xl*yh. - Proof. intros;ring. Qed. - - Lemma spec_kara_prod : forall xh xl yh yl hh ll, - [[hh]] = [|xh|]*[|yh|] -> - [[ll]] = [|xl|]*[|yl|] -> - let (wc,cc) := kara_prod xh xl yh yl hh ll in - [|wc|]*wwB + [[cc]] = [|xh|]*[|yl|] + [|xl|]*[|yh|]. - Proof. - intros xh xl yh yl hh ll H H0; rewrite <- kara_prod_aux; - rewrite <- H; rewrite <- H0; unfold kara_prod. - assert (Hxh := (spec_to_Z xh)); assert (Hxl := (spec_to_Z xl)); - assert (Hyh := (spec_to_Z yh)); assert (Hyl := (spec_to_Z yl)). - generalize (spec_ww_add_c hh ll); case (ww_add_c hh ll); - intros z Hz; rewrite <- Hz; unfold interp_carry; assert (Hz1 := (spec_ww_to_Z z)). - generalize (spec_w_compare xl xh); case (w_compare xl xh); 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 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). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - split; auto with zarith. - simpl in Hz; rewrite Hz; rewrite H; rewrite H0. - rewrite kara_prod_aux; apply Zplus_le_0_compat; apply Zmult_le_0_compat; auto with zarith. - apply Zle_lt_trans with ([[z]]-0); auto with zarith. - unfold Zminus; apply Zplus_le_compat_l; apply Zle_left_rev; simpl; rewrite Zopp_involutive. - apply Zmult_le_0_compat; auto with zarith. - 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; - intros z1 Hz2 - end. - simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - 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 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; - intros z1 Hz2 - end. - simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - 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). - rewrite spec_w_0; try (ring; fail). - repeat (rewrite spec_ww_sub || rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - split. - match goal with |- context[(?x - ?y) * (?z - ?t)] => - replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring] - end. - simpl in Hz; rewrite Hz; rewrite H; rewrite H0. - rewrite kara_prod_aux; apply Zplus_le_0_compat; apply Zmult_le_0_compat; auto with zarith. - apply Zle_lt_trans with ([[z]]-0); auto with zarith. - unfold Zminus; apply Zplus_le_compat_l; apply Zle_left_rev; simpl; rewrite Zopp_involutive. - 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; - try rewrite Hxlh; try rewrite spec_w_1; try (ring; fail). - generalize (spec_w_compare yl yh); case (w_compare yl yh); 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; - intros z1 Hz2 - end. - simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_0; rewrite Zmult_0_l; rewrite Zplus_0_l. - generalize Hz2; clear Hz2; unfold interp_carry. - repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; 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; - intros z1 Hz2 - end. - simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_2; unfold interp_carry in Hz2. - apply trans_equal with (wwB + (1 * wwB + [[z1]])). - 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; - 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; - intros z1 Hz2 - end. - simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_2; unfold interp_carry in Hz2. - apply trans_equal with (wwB + (1 * wwB + [[z1]])). - ring. - rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; 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; - intros z1 Hz2 - end. - simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_0; rewrite Zmult_0_l; rewrite Zplus_0_l. - match goal with |- context[(?x - ?y) * (?z - ?t)] => - replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring] - end. - generalize Hz2; clear Hz2; unfold interp_carry. - repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). - repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - Qed. - - Lemma sub_carry : forall xh xl yh yl z, - 0 <= z -> - [|xh|]*[|yl|] + [|xl|]*[|yh|] = wwB + z -> - z < wwB. - Proof. - intros xh xl yh yl z Hle Heq. - destruct (Z_le_gt_dec wwB z);auto with zarith. - generalize (Zmult_lt_b _ _ _ (spec_to_Z xh) (spec_to_Z yl)). - generalize (Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)). - rewrite <- wwB_wBwB;intros H1 H2. - assert (H3 := wB_pos w_digits). - assert (2*wB <= wwB). - rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat;zarith. - omega. - Qed. - - Ltac Spec_ww_to_Z x := - let H:= fresh "H" in - assert (H:= spec_ww_to_Z x). - - Ltac Zmult_lt_b x y := - let H := fresh "H" in - assert (H := Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)). - - Lemma spec_ww_karatsuba_c : forall x y, [||ww_karatsuba_c x y||]=[[x]]*[[y]]. - Proof. - intros x y; unfold ww_karatsuba_c;apply spec_gen_mul_c. - intros; apply spec_kara_prod; auto. - Qed. - - Lemma spec_ww_mul : forall x y, [[ww_mul x y]] = [[x]]*[[y]] mod wwB. - Proof. - assert (U:= lt_0_wB w_digits). - assert (U1:= lt_0_wwB w_digits). - intros x y; case x; auto; intros xh xl. - case y; auto. - simpl; rewrite Zmult_0_r; rewrite Zmod_small; auto with zarith. - intros yh yl;simpl. - repeat (rewrite spec_ww_add || rewrite spec_w_W0 || rewrite spec_w_mul_c - || rewrite spec_w_add || rewrite spec_w_mul). - rewrite <- Zplus_mod; auto with zarith. - repeat (rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r). - rewrite <- Zmult_mod_distr_r; auto with zarith. - rewrite <- Zpower_2; rewrite <- wwB_wBwB; auto with zarith. - rewrite Zplus_mod; auto with zarith. - rewrite Zmod_mod; auto with zarith. - rewrite <- Zplus_mod; auto with zarith. - match goal with |- ?X mod _ = _ => - rewrite <- Z_mod_plus with (a := X) (b := [|xh|] * [|yh|]) - end; auto with zarith. - f_equal; auto; rewrite wwB_wBwB; ring. - Qed. - - Lemma spec_ww_square_c : forall x, [||ww_square_c x||] = [[x]]*[[x]]. - Proof. - destruct x as [ |xh xl];simpl;trivial. - case_eq match ww_add_c (w_mul_c xh xl) (w_mul_c xh xl) with - | C0 cc => (w_0, cc) - | C1 cc => (w_1, cc) - end;intros wc cc Heq. - apply (spec_mul_aux xh xl xh xl wc cc);trivial. - generalize Heq (spec_ww_add_c (w_mul_c xh xl) (w_mul_c xh xl));clear Heq. - rewrite spec_w_mul_c;destruct (ww_add_c (w_mul_c xh xl) (w_mul_c xh xl)); - unfold interp_carry;try rewrite Zmult_1_l;intros Heq Heq';inversion Heq; - rewrite (Zmult_comm [|xl|]);subst. - rewrite spec_w_0;rewrite Zmult_0_l;rewrite Zplus_0_l;trivial. - rewrite spec_w_1;rewrite Zmult_1_l;rewrite <- wwB_wBwB;trivial. - Qed. - - Section GenMulAddn1Proof. - - Variable w_mul_add : w -> w -> w -> w * w. - Variable spec_w_mul_add : forall x y r, - let (h,l):= w_mul_add x y r in - [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. - - Lemma spec_gen_mul_add_n1 : forall n x y r, - let (h,l) := gen_mul_add_n1 w_mul_add n x y r in - [|h|]*gen_wB w_digits n + [!n|l!] = [!n|x!]*[|y|]+[|r|]. - Proof. - induction n;intros x y r;trivial. - exact (spec_w_mul_add x y r). - unfold gen_mul_add_n1;destruct x as[ |xh xl]; - fold(gen_mul_add_n1 w_mul_add). - rewrite spec_w_0;rewrite spec_extend;simpl;trivial. - assert(H:=IHn xl y r);destruct (gen_mul_add_n1 w_mul_add n xl y r)as(rl,l). - assert(U:=IHn xh y rl);destruct(gen_mul_add_n1 w_mul_add n xh y rl)as(rh,h). - rewrite <- gen_wB_wwB. rewrite spec_gen_WW;simpl;trivial. - rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc;rewrite <- H. - rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - rewrite U;ring. - Qed. - - End GenMulAddn1Proof. - - Lemma spec_w_mul_add : forall x y r, - let (h,l):= w_mul_add x y r in - [|h|]*wB+[|l|] = [|x|]*[|y|] + [|r|]. - Proof. - intros x y r;unfold w_mul_add;assert (H:=spec_w_mul_c x y); - destruct (w_mul_c x y) as [ |h l];simpl;rewrite <- H. - rewrite spec_w_0;trivial. - assert (U:=spec_w_add_c l r);destruct (w_add_c l r) as [lr|lr];unfold - interp_carry in U;try rewrite Zmult_1_l in H;simpl. - rewrite U;ring. rewrite spec_w_succ. rewrite Zmod_small. - rewrite <- Zplus_assoc;rewrite <- U;ring. - simpl in H;assert (H1:= Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)). - rewrite <- H in H1. - assert (H2:=spec_to_Z h);split;zarith. - case H1;clear H1;intro H1;clear H1. - replace (wB ^ 2 - 2 * wB) with ((wB - 2)*wB). 2:ring. - intros H0;assert (U1:= wB_pos w_digits). - assert (H1 := beta_lex _ _ _ _ _ H0 (spec_to_Z l));zarith. - Qed. - -(* End GenProof. *) - -End GenMul. diff --git a/theories/Ints/num/GenSqrt.v b/theories/Ints/num/GenSqrt.v deleted file mode 100644 index 63a0930edc..0000000000 --- a/theories/Ints/num/GenSqrt.v +++ /dev/null @@ -1,1385 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. - -Open Local Scope Z_scope. - -Section GenSqrt. - Variable w : Set. - Variable w_is_even : w -> bool. - Variable w_compare : w -> w -> comparison. - Variable w_0 : w. - Variable w_1 : w. - Variable w_Bm1 : w. - Variable w_WW : w -> w -> zn2z w. - Variable w_W0 : w -> zn2z w. - Variable w_0W : w -> zn2z w. - Variable w_sub : w -> w -> w. - Variable w_sub_c : w -> w -> carry w. - Variable w_square_c : w -> zn2z w. - Variable w_div21 : w -> w -> w -> w * w. - Variable w_add_mul_div : w -> w -> w -> w. - Variable w_digits : positive. - Variable w_zdigits : w. - Variable ww_zdigits : zn2z w. - Variable w_add_c : w -> w -> carry w. - Variable w_sqrt2 : w -> w -> w * carry w. - Variable w_pred : w -> w. - Variable ww_pred_c : zn2z w -> carry (zn2z w). - Variable ww_pred : zn2z w -> zn2z w. - Variable ww_add_c : zn2z w -> zn2z w -> carry (zn2z w). - Variable ww_add : zn2z w -> zn2z w -> zn2z w. - Variable ww_sub_c : zn2z w -> zn2z w -> carry (zn2z w). - Variable ww_add_mul_div : zn2z w -> zn2z w -> zn2z w -> zn2z w. - Variable ww_head0 : zn2z w -> zn2z w. - Variable ww_compare : zn2z w -> zn2z w -> comparison. - Variable low : zn2z w -> w. - - Let wwBm1 := ww_Bm1 w_Bm1. - - Definition ww_is_even x := - match x with - | W0 => true - | WW xh xl => w_is_even xl - end. - - Let w_div21c x y z := - match w_compare x z with - | Eq => - match w_compare y z with - Eq => (C1 w_1, w_0) - | Gt => (C1 w_1, w_sub y z) - | Lt => (C1 w_0, y) - end - | Gt => - let x1 := w_sub x z in - let (q, r) := w_div21 x1 y z in - (C1 q, r) - | Lt => - let (q, r) := w_div21 x y z in - (C0 q, r) - end. - - Let w_div2s x y s := - match x with - C1 x1 => - let x2 := w_sub x1 s in - let (q, r) := w_div21c x2 y s in - match q with - C0 q1 => - if w_is_even q1 then - (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), C0 r) - else - (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), w_add_c r s) - | C1 q1 => - if w_is_even q1 then - (C1 (w_add_mul_div (w_pred w_zdigits) w_0 q1), C0 r) - else - (C1 (w_add_mul_div (w_pred w_zdigits) w_0 q1), w_add_c r s) - end - | C0 x1 => - let (q, r) := w_div21c x1 y s in - match q with - C0 q1 => - if w_is_even q1 then - (C0 (w_add_mul_div (w_pred w_zdigits) w_0 q1), C0 r) - else - (C0 (w_add_mul_div (w_pred w_zdigits) w_0 q1), w_add_c r s) - | C1 q1 => - if w_is_even q1 then - (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), C0 r) - else - (C0 (w_add_mul_div (w_pred w_zdigits) w_1 q1), w_add_c r s) - end - end. - - Definition split x := - match x with - | W0 => (w_0,w_0) - | WW h l => (h,l) - end. - - Definition ww_sqrt2 x y := - let (x1, x2) := split x in - let (y1, y2) := split y in - let ( q, r) := w_sqrt2 x1 x2 in - let (q1, r1) := w_div2s r y1 q in - match q1 with - C0 q1 => - let q2 := w_square_c q1 in - let a := WW q q1 in - match r1 with - C1 r2 => - match ww_sub_c (WW r2 y2) q2 with - C0 r3 => (a, C1 r3) - | C1 r3 => (a, C0 r3) - end - | C0 r2 => - match ww_sub_c (WW r2 y2) q2 with - C0 r3 => (a, C0 r3) - | C1 r3 => - let a2 := ww_add_mul_div (w_0W w_1) a W0 in - match ww_pred_c a2 with - C0 a3 => - (ww_pred a, ww_add_c a3 r3) - | C1 a3 => - (ww_pred a, C0 (ww_add a3 r3)) - end - end - end - | C1 q1 => - let a1 := WW q w_Bm1 in - let a2 := ww_add_mul_div (w_0W w_1) a1 wwBm1 in - (a1, ww_add_c a2 y) - end. - - Definition ww_is_zero x := - match ww_compare W0 x with - Eq => true - | _ => false - end. - - Definition ww_head1 x := - let p := ww_head0 x in - if (ww_is_even p) then p else ww_pred p. - - Definition ww_sqrt x := - if (ww_is_zero x) then W0 - else - let p := ww_head1 x in - match ww_compare p W0 with - | Gt => - match ww_add_mul_div p x W0 with - W0 => W0 - | WW x1 x2 => - let (r, _) := w_sqrt2 x1 x2 in - WW w_0 (w_add_mul_div - (w_sub w_zdigits - (low (ww_add_mul_div (ww_pred ww_zdigits) - W0 p))) w_0 r) - end - | _ => - match x with - W0 => W0 - | WW x1 x2 => WW w_0 (fst (w_sqrt2 x1 x2)) - end - end. - - - Variable w_to_Z : w -> Z. - - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[+| c |]" := - (interp_carry 1 wB w_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). - - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - - Notation "[|| x ||]" := - (zn2z_to_Z wwB (ww_to_Z w_digits w_to_Z) x) (at level 0, x at level 99). - - Notation "[! n | x !]" := (gen_to_Z w_digits w_to_Z n x) - (at level 0, x at level 99). - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_w_1 : [|w_1|] = 1. - Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1. - Variable spec_w_zdigits : [|w_zdigits|] = Zpos w_digits. - Variable spec_more_than_1_digit: 1 < Zpos w_digits. - - Variable spec_ww_zdigits : [[ww_zdigits]] = Zpos (xO w_digits). - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - Variable spec_to_w_Z : forall x, 0 <= [[x]] < wwB. - - Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. - Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. - 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_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, - wB/2 <= [|b|] -> - [|a1|] < [|b|] -> - let (q,r) := w_div21 a1 a2 b in - [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]. - Variable spec_w_add_mul_div : forall x y p, - [|p|] <= Zpos w_digits -> - [| w_add_mul_div p x y |] = - ([|x|] * (2 ^ [|p|]) + - [|y|] / (Zpower 2 ((Zpos w_digits) - [|p|]))) mod wB. - Variable spec_ww_add_mul_div : forall x y p, - [[p]] <= Zpos (xO w_digits) -> - [[ ww_add_mul_div p x y ]] = - ([[x]] * (2^ [[p]]) + - [[y]] / (2^ (Zpos (xO w_digits) - [[p]]))) mod wwB. - Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. - Variable spec_ww_add : forall x y, [[ww_add x y]] = ([[x]] + [[y]]) mod wwB. - Variable spec_w_sqrt2 : forall x y, - wB/ 4 <= [|x|] -> - let (s,r) := w_sqrt2 x y in - [[WW x y]] = [|s|] ^ 2 + [+|r|] /\ - [+|r|] <= 2 * [|s|]. - Variable spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]]. - Variable spec_ww_pred_c : forall x, [-[ww_pred_c x]] = [[x]] - 1. - Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB. - 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. - 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. - - Let spec_ww_Bm1 : [[wwBm1]] = wwB - 1. - Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed. - - - Hint Rewrite spec_w_0 spec_w_1 w_Bm1 spec_w_WW spec_w_sub - spec_w_div21 spec_w_add_mul_div spec_ww_Bm1 - spec_w_add_c spec_w_sqrt2: w_rewrite. - - Lemma spec_ww_is_even : forall x, - if ww_is_even x then [[x]] mod 2 = 0 else [[x]] mod 2 = 1. -clear spec_more_than_1_digit. -intros x; case x; simpl ww_is_even. - simpl. - rewrite Zmod_small; auto with zarith. - intros w1 w2; simpl. - unfold base. - rewrite Zplus_mod; auto with zarith. - rewrite (fun x y => (Zdivide_mod (x * y))); auto with zarith. - rewrite Zplus_0_l; rewrite Zmod_mod; auto with zarith. - apply spec_w_is_even; auto with zarith. - apply Zdivide_mult_r; apply Zpower_divide; auto with zarith. - red; simpl; auto. - Qed. - - - Theorem spec_w_div21c : forall a1 a2 b, - wB/2 <= [|b|] -> - let (q,r) := w_div21c a1 a2 b in - [|a1|] * wB + [|a2|] = [+|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. - intros a1 a2 b Hb; unfold w_div21c. - assert (H: 0 < [|b|]); auto with zarith. - assert (U := wB_pos w_digits). - 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. - intros H1 H2; split. - unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith. - rewrite H1; rewrite H2; ring. - autorewrite with w_rewrite; auto with zarith. - intros H1 H2; split. - unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith. - rewrite H2; ring. - destruct (spec_to_Z a2);auto with zarith. - intros H1 H2; split. - unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith. - rewrite H2; rewrite Zmod_small; auto with zarith. - ring. - destruct (spec_to_Z a2);auto with zarith. - rewrite spec_w_sub; auto with zarith. - destruct (spec_to_Z a2) as [H3 H4];auto with zarith. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - assert ([|a2|] < 2 * [|b|]); auto with zarith. - apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith. - rewrite wB_div_2; auto. - intros H1. - match goal with |- context[w_div21 ?y ?z ?t] => - generalize (@spec_w_div21 y z t Hb H1); - case (w_div21 y z t); simpl; autorewrite with w_rewrite; - auto - end. - intros H1. - assert (H2: [|w_sub a1 b|] < [|b|]). - rewrite spec_w_sub; auto with zarith. - rewrite Zmod_small; auto with zarith. - assert ([|a1|] < 2 * [|b|]); auto with zarith. - apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith. - rewrite wB_div_2; auto. - destruct (spec_to_Z a1);auto with zarith. - destruct (spec_to_Z a1);auto with zarith. - match goal with |- context[w_div21 ?y ?z ?t] => - generalize (@spec_w_div21 y z t Hb H2); - case (w_div21 y z t); autorewrite with w_rewrite; - auto - end. - intros w0 w1; replace [+|C1 w0|] with (wB + [|w0|]). - rewrite Zmod_small; auto with zarith. - intros (H3, H4); split; auto. - rewrite Zmult_plus_distr_l. - rewrite <- Zplus_assoc; rewrite <- H3; ring. - split; auto with zarith. - assert ([|a1|] < 2 * [|b|]); auto with zarith. - apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith. - rewrite wB_div_2; auto. - destruct (spec_to_Z a1);auto with zarith. - destruct (spec_to_Z a1);auto with zarith. - simpl; case wB; auto. - Qed. - - Theorem C0_id: forall p, [+|C0 p|] = [|p|]. - intros p; simpl; auto. - Qed. - - Theorem add_mult_div_2: forall w, - [|w_add_mul_div (w_pred w_zdigits) w_0 w|] = [|w|] / 2. - intros w1. - assert (Hp: [|w_pred w_zdigits|] = Zpos w_digits - 1). - rewrite spec_pred; rewrite spec_w_zdigits. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - apply Zlt_le_trans with (Zpos w_digits); auto with zarith. - unfold base; apply Zpower2_le_lin; auto with zarith. - rewrite spec_w_add_mul_div; auto with zarith. - autorewrite with w_rewrite rm10. - match goal with |- context[?X - ?Y] => - replace (X - Y) with 1 - end. - rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. - destruct (spec_to_Z w1) as [H1 H2];auto with zarith. - split; auto with zarith. - apply Zdiv_lt_upper_bound; auto with zarith. - rewrite Hp; ring. - Qed. - - Theorem add_mult_div_2_plus_1: forall w, - [|w_add_mul_div (w_pred w_zdigits) w_1 w|] = - [|w|] / 2 + 2 ^ Zpos (w_digits - 1). - intros w1. - assert (Hp: [|w_pred w_zdigits|] = Zpos w_digits - 1). - rewrite spec_pred; rewrite spec_w_zdigits. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - apply Zlt_le_trans with (Zpos w_digits); auto with zarith. - unfold base; apply Zpower2_le_lin; auto with zarith. - autorewrite with w_rewrite rm10; auto with zarith. - match goal with |- context[?X - ?Y] => - replace (X - Y) with 1 - end; rewrite Hp; try ring. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. - rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. - destruct (spec_to_Z w1) as [H1 H2];auto with zarith. - split; auto with zarith. - unfold base. - match goal with |- _ < _ ^ ?X => - assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp - end. - rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. - assert (tmp: forall p, 1 + (p -1) - 1 = p - 1); auto with zarith; - rewrite tmp; clear tmp; auto with zarith. - match goal with |- ?X + ?Y < _ => - assert (Y < X); auto with zarith - end. - apply Zdiv_lt_upper_bound; auto with zarith. - pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp; - auto with zarith. - assert (tmp: forall p, (p - 1) + 1 = p); auto with zarith; - rewrite tmp; clear tmp; auto with zarith. - Qed. - - Theorem add_mult_mult_2: forall w, - [|w_add_mul_div w_1 w w_0|] = 2 * [|w|] mod wB. - intros w1. - autorewrite with w_rewrite rm10; auto with zarith. - rewrite Zpower_1_r; auto with zarith. - rewrite Zmult_comm; auto. - Qed. - - Theorem ww_add_mult_mult_2: forall w, - [[ww_add_mul_div (w_0W w_1) w W0]] = 2 * [[w]] mod wwB. - intros w1. - rewrite spec_ww_add_mul_div; auto with zarith. - autorewrite with w_rewrite rm10. - rewrite spec_w_0W; rewrite spec_w_1. - rewrite Zpower_1_r; auto with zarith. - rewrite Zmult_comm; auto. - rewrite spec_w_0W; rewrite spec_w_1; auto with zarith. - red; simpl; intros; discriminate. - Qed. - - Theorem ww_add_mult_mult_2_plus_1: forall w, - [[ww_add_mul_div (w_0W w_1) w wwBm1]] = - (2 * [[w]] + 1) mod wwB. - intros w1. - rewrite spec_ww_add_mul_div; auto with zarith. - rewrite spec_w_0W; rewrite spec_w_1; auto with zarith. - rewrite Zpower_1_r; auto with zarith. - f_equal; auto. - rewrite Zmult_comm; f_equal; auto. - autorewrite with w_rewrite rm10. - unfold ww_digits, base. - apply sym_equal; apply Zdiv_unique with (r := 2 ^ (Zpos (ww_digits w_digits) - 1) -1); - auto with zarith. - unfold ww_digits; split; auto with zarith. - match goal with |- 0 <= ?X - 1 => - assert (0 < X); auto with zarith - end. - apply Zpower_gt_0; auto with zarith. - match goal with |- 0 <= ?X - 1 => - assert (0 < X); auto with zarith; red; reflexivity - end. - unfold ww_digits; autorewrite with rm10. - assert (tmp: forall p q r, p + (q - r) = p + q - r); auto with zarith; - rewrite tmp; clear tmp. - assert (tmp: forall p, p + p = 2 * p); auto with zarith; - rewrite tmp; clear tmp. - f_equal; auto. - pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp; - auto with zarith. - assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite tmp; clear tmp; auto. - match goal with |- ?X - 1 >= 0 => - assert (0 < X); auto with zarith; red; reflexivity - end. - rewrite spec_w_0W; rewrite spec_w_1; auto with zarith. - red; simpl; intros; discriminate. - Qed. - - Theorem Zplus_mod_one: forall a1 b1, 0 < b1 -> (a1 + b1) mod b1 = a1 mod b1. - intros a1 b1 H; rewrite Zplus_mod; auto with zarith. - rewrite Z_mod_same; try rewrite Zplus_0_r; auto with zarith. - apply Zmod_mod; auto. - Qed. - - Lemma C1_plus_wB: forall x, [+|C1 x|] = wB + [|x|]. - unfold interp_carry; auto with zarith. - Qed. - - Theorem spec_w_div2s : forall a1 a2 b, - wB/2 <= [|b|] -> [+|a1|] <= 2 * [|b|] -> - let (q,r) := w_div2s a1 a2 b in - [+|a1|] * wB + [|a2|] = [+|q|] * (2 * [|b|]) + [+|r|] /\ 0 <= [+|r|] < 2 * [|b|]. - intros a1 a2 b H. - assert (HH: 0 < [|b|]); auto with zarith. - assert (U := wB_pos w_digits). - apply Zlt_le_trans with (2 := H); auto with zarith. - apply Zlt_le_trans with 1; auto with zarith. - apply Zdiv_le_lower_bound; auto with zarith. - unfold w_div2s; case a1; intros w0 H0. - match goal with |- context[w_div21c ?y ?z ?t] => - generalize (@spec_w_div21c y z t H); - case (w_div21c y z t); autorewrite with w_rewrite; - auto - end. - intros c w1; case c. - simpl interp_carry; intros w2 (Hw1, Hw2). - match goal with |- context[w_is_even ?y] => - generalize (spec_w_is_even y); - case (w_is_even y) - end. - repeat rewrite C0_id. - rewrite add_mult_div_2. - intros H1; split; auto with zarith. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1; ring. - repeat rewrite C0_id. - rewrite add_mult_div_2. - rewrite spec_w_add_c; auto with zarith. - intros H1; split; auto with zarith. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1; ring. - intros w2; rewrite C1_plus_wB. - intros (Hw1, Hw2). - match goal with |- context[w_is_even ?y] => - generalize (spec_w_is_even y); - case (w_is_even y) - end. - repeat rewrite C0_id. - intros H1; split; auto with zarith. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1. - repeat rewrite C0_id. - rewrite add_mult_div_2_plus_1; unfold base. - match goal with |- context[_ ^ ?X] => - assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith - end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. - ring. - repeat rewrite C0_id. - rewrite spec_w_add_c; auto with zarith. - intros H1; split; auto with zarith. - rewrite add_mult_div_2_plus_1. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1. - unfold base. - match goal with |- context[_ ^ ?X] => - assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith - end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. - ring. - repeat rewrite C1_plus_wB in H0. - rewrite C1_plus_wB. - match goal with |- context[w_div21c ?y ?z ?t] => - generalize (@spec_w_div21c y z t H); - case (w_div21c y z t); autorewrite with w_rewrite; - auto - end. - intros c w1; case c. - intros w2 (Hw1, Hw2); rewrite C0_id in Hw1. - rewrite <- Zplus_mod_one in Hw1; auto with zarith. - rewrite Zmod_small in Hw1; auto with zarith. - match goal with |- context[w_is_even ?y] => - generalize (spec_w_is_even y); - case (w_is_even y) - end. - repeat rewrite C0_id. - intros H1; split; auto with zarith. - rewrite add_mult_div_2_plus_1. - replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); - auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1; unfold base. - match goal with |- context[_ ^ ?X] => - assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith - end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. - ring. - repeat rewrite C0_id. - rewrite add_mult_div_2_plus_1. - rewrite spec_w_add_c; auto with zarith. - intros H1; split; auto with zarith. - replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); - auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1; unfold base. - match goal with |- context[_ ^ ?X] => - assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; - rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith - end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. - ring. - split; auto with zarith. - destruct (spec_to_Z b);auto with zarith. - destruct (spec_to_Z w0);auto with zarith. - destruct (spec_to_Z b);auto with zarith. - destruct (spec_to_Z b);auto with zarith. - intros w2; rewrite C1_plus_wB. - rewrite <- Zplus_mod_one; auto with zarith. - rewrite Zmod_small; auto with zarith. - intros (Hw1, Hw2). - match goal with |- context[w_is_even ?y] => - generalize (spec_w_is_even y); - case (w_is_even y) - end. - repeat (rewrite C0_id || rewrite C1_plus_wB). - intros H1; split; auto with zarith. - rewrite add_mult_div_2. - replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); - auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1; ring. - repeat (rewrite C0_id || rewrite C1_plus_wB). - rewrite spec_w_add_c; auto with zarith. - intros H1; split; auto with zarith. - rewrite add_mult_div_2. - replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); - auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. - rewrite Hw1. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); - auto with zarith. - rewrite H1; ring. - split; auto with zarith. - destruct (spec_to_Z b);auto with zarith. - destruct (spec_to_Z w0);auto with zarith. - destruct (spec_to_Z b);auto with zarith. - destruct (spec_to_Z b);auto with zarith. - Qed. - - Theorem wB_div_4: 4 * (wB / 4) = wB. - Proof. - unfold base. - assert (2 ^ Zpos w_digits = - 4 * (2 ^ (Zpos w_digits - 2))). - change 4 with (2 ^ 2). - rewrite <- Zpower_exp; auto with zarith. - f_equal; auto with zarith. - rewrite H. - rewrite (fun x => (Zmult_comm 4 (2 ^x))). - rewrite Z_div_mult; auto with zarith. - Qed. - - Theorem Zsquare_mult: forall p, p ^ 2 = p * p. - intros p; change 2 with (1 + 1); rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith. - Qed. - - Theorem Zsquare_pos: forall p, 0 <= p ^ 2. - intros p; case (Zle_or_lt 0 p); intros H1. - rewrite Zsquare_mult; apply Zmult_le_0_compat; auto with zarith. - rewrite Zsquare_mult; replace (p * p) with ((- p) * (- p)); try ring. - apply Zmult_le_0_compat; auto with zarith. - Qed. - - Lemma spec_split: forall x, - [|fst (split x)|] * wB + [|snd (split x)|] = [[x]]. - intros x; case x; simpl; autorewrite with w_rewrite; - auto with zarith. - Qed. - - Theorem mult_wwB: forall x y, [|x|] * [|y|] < wwB. - Proof. - intros x y; rewrite wwB_wBwB; rewrite Zpower_2. - generalize (spec_to_Z x); intros U. - generalize (spec_to_Z y); intros U1. - apply Zle_lt_trans with ((wB -1 ) * (wB - 1)); auto with zarith. - apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_r || rewrite Zmult_minus_distr_l); - auto with zarith. - Qed. - Hint Resolve mult_wwB. - - Lemma spec_ww_sqrt2 : forall x y, - wwB/ 4 <= [[x]] -> - let (s,r) := ww_sqrt2 x y in - [||WW x y||] = [[s]] ^ 2 + [+[r]] /\ - [+[r]] <= 2 * [[s]]. - intros x y H; unfold ww_sqrt2. - repeat match goal with |- context[split ?x] => - generalize (spec_split x); case (split x) - end; simpl fst; simpl snd. - intros w0 w1 Hw0 w2 w3 Hw1. - assert (U: wB/4 <= [|w2|]). - case (Zle_or_lt (wB / 4) [|w2|]); auto; intros H1. - contradict H; apply Zlt_not_le. - rewrite wwB_wBwB; rewrite Zpower_2. - pattern wB at 1; rewrite <- wB_div_4; rewrite <- Zmult_assoc; - rewrite Zmult_comm. - rewrite Z_div_mult; auto with zarith. - rewrite <- Hw1. - match goal with |- _ < ?X => - pattern X; rewrite <- Zplus_0_r; apply beta_lex_inv; - auto with zarith - end. - destruct (spec_to_Z w3);auto with zarith. - generalize (@spec_w_sqrt2 w2 w3 U); case (w_sqrt2 w2 w3). - intros w4 c (H1, H2). - assert (U1: wB/2 <= [|w4|]). - case (Zle_or_lt (wB/2) [|w4|]); auto with zarith. - intros U1. - assert (U2 : [|w4|] <= wB/2 -1); auto with zarith. - assert (U3 : [|w4|] ^ 2 <= wB/4 * wB - wB + 1); auto with zarith. - match goal with |- ?X ^ 2 <= ?Y => - rewrite Zsquare_mult; - replace Y with ((wB/2 - 1) * (wB/2 -1)) - end. - apply Zmult_le_compat; auto with zarith. - destruct (spec_to_Z w4);auto with zarith. - destruct (spec_to_Z w4);auto with zarith. - pattern wB at 4 5; rewrite <- wB_div_2. - rewrite Zmult_assoc. - replace ((wB / 4) * 2) with (wB / 2). - ring. - pattern wB at 1; rewrite <- wB_div_4. - change 4 with (2 * 2). - rewrite <- Zmult_assoc; rewrite (Zmult_comm 2). - rewrite Z_div_mult; try ring; auto with zarith. - assert (U4 : [+|c|] <= wB -2); auto with zarith. - apply Zle_trans with (1 := H2). - match goal with |- ?X <= ?Y => - replace Y with (2 * (wB/ 2 - 1)); auto with zarith - end. - pattern wB at 2; rewrite <- wB_div_2; auto with zarith. - match type of H1 with ?X = _ => - assert (U5: X < wB / 4 * wB) - end. - rewrite H1; auto with zarith. - contradict U; apply Zlt_not_le. - apply Zmult_lt_reg_r with wB; auto with zarith. - destruct (spec_to_Z w4);auto with zarith. - apply Zle_lt_trans with (2 := U5). - unfold ww_to_Z, zn2z_to_Z. - destruct (spec_to_Z w3);auto with zarith. - generalize (@spec_w_div2s c w0 w4 U1 H2). - case (w_div2s c w0 w4). - intros c0; case c0; intros w5; - repeat (rewrite C0_id || rewrite C1_plus_wB). - intros c1; case c1; intros w6; - repeat (rewrite C0_id || rewrite C1_plus_wB). - intros (H3, H4). - match goal with |- context [ww_sub_c ?y ?z] => - generalize (spec_ww_sub_c y z); case (ww_sub_c y z) - end. - intros z; change [-[C0 z]] with ([[z]]). - change [+[C0 z]] with ([[z]]). - intros H5; rewrite spec_w_square_c in H5; - auto. - split. - unfold zn2z_to_Z; rewrite <- Hw1. - unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1. - rewrite <- Hw0. - match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) - end. - repeat rewrite Zsquare_mult. - rewrite wwB_wBwB; ring. - rewrite H3. - rewrite H5. - unfold ww_to_Z, zn2z_to_Z. - repeat rewrite Zsquare_mult; ring. - rewrite H5. - unfold ww_to_Z, zn2z_to_Z. - match goal with |- ?X - ?Y * ?Y <= _ => - assert (V := Zsquare_pos Y); - rewrite Zsquare_mult in V; - apply Zle_trans with X; auto with zarith; - clear V - end. - match goal with |- ?X * wB + ?Y <= 2 * (?Z * wB + ?T) => - apply Zle_trans with ((2 * Z - 1) * wB + wB); auto with zarith - end. - destruct (spec_to_Z w1);auto with zarith. - match goal with |- ?X <= _ => - replace X with (2 * [|w4|] * wB); auto with zarith - end. - rewrite Zmult_plus_distr_r; rewrite Zmult_assoc. - destruct (spec_to_Z w5); auto with zarith. - ring. - intros z; replace [-[C1 z]] with (- wwB + [[z]]). - 2: simpl; case wwB; auto with zarith. - intros H5; rewrite spec_w_square_c in H5; - auto. - match goal with |- context [ww_pred_c ?y] => - generalize (spec_ww_pred_c y); case (ww_pred_c y) - end. - intros z1; change [-[C0 z1]] with ([[z1]]). - rewrite ww_add_mult_mult_2. - rewrite spec_ww_add_c. - rewrite spec_ww_pred. - rewrite <- Zmod_unique with (q := 1) (r := -wwB + 2 * [[WW w4 w5]]); - auto with zarith. - intros Hz1; rewrite Zmod_small; auto with zarith. - match type of H5 with -?X + ?Y = ?Z => - assert (V: Y = Z + X); - try (rewrite <- H5; ring) - end. - split. - unfold zn2z_to_Z; rewrite <- Hw1. - unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1. - rewrite <- Hw0. - match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) - end. - repeat rewrite Zsquare_mult. - rewrite wwB_wBwB; ring. - rewrite H3. - rewrite V. - rewrite Hz1. - unfold ww_to_Z; simpl zn2z_to_Z. - repeat rewrite Zsquare_mult; ring. - rewrite Hz1. - destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith. - assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)). - assert (0 < [[WW w4 w5]]); auto with zarith. - apply Zlt_le_trans with (wB/ 2 * wB + 0); auto with zarith. - autorewrite with rm10; apply Zmult_lt_0_compat; auto with zarith. - apply Zmult_lt_reg_r with 2; auto with zarith. - autorewrite with rm10. - rewrite Zmult_comm; rewrite wB_div_2; auto with zarith. - case (spec_to_Z w5);auto with zarith. - case (spec_to_Z w5);auto with zarith. - simpl. - assert (V2 := spec_to_Z w5);auto with zarith. - assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith. - split; auto with zarith. - assert (wwB <= 2 * [[WW w4 w5]]); auto with zarith. - apply Zle_trans with (2 * ([|w4|] * wB)). - rewrite wwB_wBwB; rewrite Zpower_2. - rewrite Zmult_assoc; apply Zmult_le_compat_r; auto with zarith. - rewrite <- wB_div_2; auto with zarith. - assert (V2 := spec_to_Z w5);auto with zarith. - simpl ww_to_Z; assert (V2 := spec_to_Z w5);auto with zarith. - assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith. - intros z1; change [-[C1 z1]] with (-wwB + [[z1]]). - match goal with |- context[([+[C0 ?z]])] => - change [+[C0 z]] with ([[z]]) - end. - rewrite spec_ww_add; auto with zarith. - rewrite spec_ww_pred; auto with zarith. - rewrite ww_add_mult_mult_2. - rename V1 into VV1. - assert (VV2: 0 < [[WW w4 w5]]); auto with zarith. - apply Zlt_le_trans with (wB/ 2 * wB + 0); auto with zarith. - autorewrite with rm10; apply Zmult_lt_0_compat; auto with zarith. - apply Zmult_lt_reg_r with 2; auto with zarith. - autorewrite with rm10. - rewrite Zmult_comm; rewrite wB_div_2; auto with zarith. - assert (VV3 := spec_to_Z w5);auto with zarith. - assert (VV3 := spec_to_Z w5);auto with zarith. - simpl. - assert (VV3 := spec_to_Z w5);auto with zarith. - assert (VV3: wwB <= 2 * [[WW w4 w5]]); auto with zarith. - apply Zle_trans with (2 * ([|w4|] * wB)). - rewrite wwB_wBwB; rewrite Zpower_2. - rewrite Zmult_assoc; apply Zmult_le_compat_r; auto with zarith. - rewrite <- wB_div_2; auto with zarith. - case (spec_to_Z w5);auto with zarith. - simpl ww_to_Z; assert (V4 := spec_to_Z w5);auto with zarith. - rewrite <- Zmod_unique with (q := 1) (r := -wwB + 2 * [[WW w4 w5]]); - auto with zarith. - intros Hz1; rewrite Zmod_small; auto with zarith. - match type of H5 with -?X + ?Y = ?Z => - assert (V: Y = Z + X); - try (rewrite <- H5; ring) - end. - match type of Hz1 with -?X + ?Y = -?X + ?Z - 1 => - assert (V1: Y = Z - 1); - [replace (Z - 1) with (X + (-X + Z -1)); - [rewrite <- Hz1 | idtac]; ring - | idtac] - end. - rewrite <- Zmod_unique with (q := 1) (r := -wwB + [[z1]] + [[z]]); - auto with zarith. - unfold zn2z_to_Z; rewrite <- Hw1. - unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1. - rewrite <- Hw0. - split. - match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) - end. - repeat rewrite Zsquare_mult. - rewrite wwB_wBwB; ring. - rewrite H3. - rewrite V. - rewrite Hz1. - unfold ww_to_Z; simpl zn2z_to_Z. - repeat rewrite Zsquare_mult; ring. - assert (V2 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith. - assert (V2 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith. - assert (V3 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z1);auto with zarith. - split; auto with zarith. - rewrite (Zplus_comm (-wwB)); rewrite <- Zplus_assoc. - rewrite H5. - match goal with |- 0 <= ?X + (?Y - ?Z) => - apply Zle_trans with (X - Z); auto with zarith - end. - 2: generalize (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w6 w1)); unfold ww_to_Z; auto with zarith. - rewrite V1. - match goal with |- 0 <= ?X - 1 - ?Y => - assert (Y < X); auto with zarith - end. - apply Zlt_le_trans with wwB; auto with zarith. - intros (H3, H4). - match goal with |- context [ww_sub_c ?y ?z] => - generalize (spec_ww_sub_c y z); case (ww_sub_c y z) - end. - intros z; change [-[C0 z]] with ([[z]]). - match goal with |- context[([+[C1 ?z]])] => - replace [+[C1 z]] with (wwB + [[z]]) - end. - 2: simpl; case wwB; auto. - intros H5; rewrite spec_w_square_c in H5; - auto. - split. - change ([||WW x y||]) with ([[x]] * wwB + [[y]]). - rewrite <- Hw1. - unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1. - rewrite <- Hw0. - match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) - end. - repeat rewrite Zsquare_mult. - rewrite wwB_wBwB; ring. - rewrite H3. - rewrite H5. - unfold ww_to_Z; simpl zn2z_to_Z. - rewrite wwB_wBwB. - repeat rewrite Zsquare_mult; ring. - simpl ww_to_Z. - rewrite H5. - simpl ww_to_Z. - rewrite wwB_wBwB; rewrite Zpower_2. - match goal with |- ?X * ?Y + (?Z * ?Y + ?T - ?U) <= _ => - apply Zle_trans with (X * Y + (Z * Y + T - 0)); - auto with zarith - end. - assert (V := Zsquare_pos [|w5|]); - rewrite Zsquare_mult in V; auto with zarith. - autorewrite with rm10. - match goal with |- _ <= 2 * (?U * ?V + ?W) => - apply Zle_trans with (2 * U * V + 0); - auto with zarith - end. - match goal with |- ?X * ?Y + (?Z * ?Y + ?T) <= _ => - replace (X * Y + (Z * Y + T)) with ((X + Z) * Y + T); - try ring - end. - apply Zlt_le_weak; apply beta_lex_inv; auto with zarith. - destruct (spec_to_Z w1);auto with zarith. - destruct (spec_to_Z w5);auto with zarith. - rewrite Zmult_plus_distr_r; auto with zarith. - rewrite Zmult_assoc; auto with zarith. - intros z; replace [-[C1 z]] with (- wwB + [[z]]). - 2: simpl; case wwB; auto with zarith. - intros H5; rewrite spec_w_square_c in H5; - auto. - match goal with |- context[([+[C0 ?z]])] => - change [+[C0 z]] with ([[z]]) - end. - match type of H5 with -?X + ?Y = ?Z => - assert (V: Y = Z + X); - try (rewrite <- H5; ring) - end. - change ([||WW x y||]) with ([[x]] * wwB + [[y]]). - simpl ww_to_Z. - rewrite <- Hw1. - simpl ww_to_Z in H1; rewrite H1. - rewrite <- Hw0. - split. - match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) - end. - repeat rewrite Zsquare_mult. - rewrite wwB_wBwB; ring. - rewrite H3. - rewrite V. - simpl ww_to_Z. - rewrite wwB_wBwB. - repeat rewrite Zsquare_mult; ring. - rewrite V. - simpl ww_to_Z. - rewrite wwB_wBwB; rewrite Zpower_2. - match goal with |- (?Z * ?Y + ?T - ?U) + ?X * ?Y <= _ => - apply Zle_trans with ((Z * Y + T - 0) + X * Y); - auto with zarith - end. - assert (V1 := Zsquare_pos [|w5|]); - rewrite Zsquare_mult in V1; auto with zarith. - autorewrite with rm10. - match goal with |- _ <= 2 * (?U * ?V + ?W) => - apply Zle_trans with (2 * U * V + 0); - auto with zarith - end. - match goal with |- (?Z * ?Y + ?T) + ?X * ?Y <= _ => - replace ((Z * Y + T) + X * Y) with ((X + Z) * Y + T); - try ring - end. - apply Zlt_le_weak; apply beta_lex_inv; auto with zarith. - destruct (spec_to_Z w1);auto with zarith. - destruct (spec_to_Z w5);auto with zarith. - rewrite Zmult_plus_distr_r; auto with zarith. - rewrite Zmult_assoc; auto with zarith. - case Zle_lt_or_eq with (1 := H2); clear H2; intros H2. - intros c1 (H3, H4). - match type of H3 with ?X = ?Y => - absurd (X < Y) - end. - apply Zle_not_lt; rewrite <- H3; auto with zarith. - rewrite Zmult_plus_distr_l. - apply Zlt_le_trans with ((2 * [|w4|]) * wB + 0); - auto with zarith. - apply beta_lex_inv; auto with zarith. - destruct (spec_to_Z w0);auto with zarith. - assert (V1 := spec_to_Z w5);auto with zarith. - rewrite (Zmult_comm wB); auto with zarith. - assert (0 <= [|w5|] * (2 * [|w4|])); auto with zarith. - intros c1 (H3, H4); rewrite H2 in H3. - match type of H3 with ?X + ?Y = (?Z + ?T) * ?U + ?V => - assert (VV: (Y = (T * U) + V)); - [replace Y with ((X + Y) - X); - [rewrite H3; ring | ring] | idtac] - end. - assert (V1 := spec_to_Z w0);auto with zarith. - assert (V2 := spec_to_Z w5);auto with zarith. - case (Zle_lt_or_eq 0 [|w5|]); auto with zarith; intros V3. - match type of VV with ?X = ?Y => - absurd (X < Y) - end. - apply Zle_not_lt; rewrite <- VV; auto with zarith. - apply Zlt_le_trans with wB; auto with zarith. - match goal with |- _ <= ?X + _ => - apply Zle_trans with X; auto with zarith - end. - match goal with |- _ <= _ * ?X => - apply Zle_trans with (1 * X); auto with zarith - end. - autorewrite with rm10. - rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith. - rewrite <- V3 in VV; generalize VV; autorewrite with rm10; - clear VV; intros VV. - rewrite spec_ww_add_c; auto with zarith. - rewrite ww_add_mult_mult_2_plus_1. - match goal with |- context[?X mod wwB] => - rewrite <- Zmod_unique with (q := 1) (r := -wwB + X) - end; auto with zarith. - simpl ww_to_Z. - rewrite spec_w_Bm1; auto with zarith. - split. - change ([||WW x y||]) with ([[x]] * wwB + [[y]]). - rewrite <- Hw1. - simpl ww_to_Z in H1; rewrite H1. - rewrite <- Hw0. - match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) - end. - repeat rewrite Zsquare_mult. - rewrite wwB_wBwB; ring. - rewrite H2. - rewrite wwB_wBwB. - repeat rewrite Zsquare_mult; ring. - assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z y);auto with zarith. - assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z y);auto with zarith. - simpl ww_to_Z; unfold ww_to_Z. - rewrite spec_w_Bm1; auto with zarith. - split. - rewrite wwB_wBwB; rewrite Zpower_2. - match goal with |- _ <= -?X + (2 * (?Z * ?T + ?U) + ?V) => - assert (X <= 2 * Z * T); auto with zarith - end. - apply Zmult_le_compat_r; auto with zarith. - rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith. - rewrite Zmult_plus_distr_r; auto with zarith. - rewrite Zmult_assoc; auto with zarith. - match goal with |- _ + ?X < _ => - replace X with ((2 * (([|w4|]) + 1) * wB) - 1); try ring - end. - assert (2 * ([|w4|] + 1) * wB <= 2 * wwB); auto with zarith. - rewrite <- Zmult_assoc; apply Zmult_le_compat_l; auto with zarith. - rewrite wwB_wBwB; rewrite Zpower_2. - apply Zmult_le_compat_r; auto with zarith. - case (spec_to_Z w4);auto with zarith. - Qed. - - 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); - auto with zarith. - simpl ww_to_Z. - assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z x);auto with zarith. - Qed. - - Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2. - pattern wwB at 1; rewrite wwB_wBwB; rewrite Zpower_2. - rewrite <- wB_div_2. - match goal with |- context[(2 * ?X) * (2 * ?Z)] => - replace ((2 * X) * (2 * Z)) with ((X * Z) * 4); try ring - end. - rewrite Z_div_mult; auto with zarith. - rewrite Zmult_assoc; rewrite wB_div_2. - rewrite wwB_div_2; ring. - Qed. - - - Lemma spec_ww_head1 - : forall x : zn2z w, - (ww_is_even (ww_head1 x) = true) /\ - (0 < [[x]] -> wwB / 4 <= 2 ^ [[ww_head1 x]] * [[x]] < wwB). - assert (U := wB_pos w_digits). - intros x; unfold ww_head1. - generalize (spec_ww_is_even (ww_head0 x)); case_eq (ww_is_even (ww_head0 x)). - intros HH H1; rewrite HH; split; auto. - intros H2. - generalize (spec_ww_head0 x H2); case (ww_head0 x); autorewrite with rm10. - intros (H3, H4); split; auto with zarith. - apply Zle_trans with (2 := H3). - apply Zdiv_le_compat_l; auto with zarith. - intros xh xl (H3, H4); split; auto with zarith. - apply Zle_trans with (2 := H3). - apply Zdiv_le_compat_l; auto with zarith. - intros H1. - case (spec_to_w_Z (ww_head0 x)); intros Hv1 Hv2. - assert (Hp0: 0 < [[ww_head0 x]]). - generalize (spec_ww_is_even (ww_head0 x)); rewrite H1. - generalize Hv1; case [[ww_head0 x]]. - rewrite Zmod_small; auto with zarith. - intros; assert (0 < Zpos p); auto with zarith. - red; simpl; auto. - intros p H2; case H2; auto. - assert (Hp: [[ww_pred (ww_head0 x)]] = [[ww_head0 x]] - 1). - rewrite spec_ww_pred. - rewrite Zmod_small; auto with zarith. - intros H2; split. - generalize (spec_ww_is_even (ww_pred (ww_head0 x))); - case ww_is_even; auto. - rewrite Hp. - rewrite Zminus_mod; auto with zarith. - rewrite H2; repeat rewrite Zmod_small; auto with zarith. - intros H3; rewrite Hp. - case (spec_ww_head0 x); auto; intros Hv3 Hv4. - assert (Hu: forall u, 0 < u -> 2 * 2 ^ (u - 1) = 2 ^u). - intros u Hu. - pattern 2 at 1; rewrite <- Zpower_1_r. - rewrite <- Zpower_exp; auto with zarith. - ring_simplify (1 + (u - 1)); auto with zarith. - split; auto with zarith. - apply Zmult_le_reg_r with 2; auto with zarith. - repeat rewrite (fun x => Zmult_comm x 2). - rewrite wwB_4_2. - rewrite Zmult_assoc; rewrite Hu; auto with zarith. - apply Zle_lt_trans with (2 * 2 ^ ([[ww_head0 x]] - 1) * [[x]]); auto with zarith; - rewrite Hu; auto with zarith. - apply Zmult_le_compat_r; auto with zarith. - apply Zpower_le_monotone; auto with zarith. - Qed. - - Theorem wwB_4_wB_4: wwB / 4 = wB / 4 * wB. - apply sym_equal; apply Zdiv_unique with 0; - auto with zarith. - rewrite Zmult_assoc; rewrite wB_div_4; auto with zarith. - rewrite wwB_wBwB; ring. - Qed. - - Lemma spec_ww_sqrt : forall x, - [[ww_sqrt x]] ^ 2 <= [[x]] < ([[ww_sqrt x]] + 1) ^ 2. - assert (U := wB_pos w_digits). - intro x; unfold ww_sqrt. - generalize (spec_ww_is_zero x); case (ww_is_zero x). - simpl ww_to_Z; simpl Zpower; unfold Zpower_pos; simpl; - auto with zarith. - intros H1. - generalize (spec_ww_compare (ww_head1 x) W0); case ww_compare; - simpl ww_to_Z; autorewrite with rm10. - generalize H1; case x. - intros HH; contradict HH; simpl ww_to_Z; auto with zarith. - intros w0 w1; simpl ww_to_Z; autorewrite with w_rewrite rm10. - intros H2; case (spec_ww_head1 (WW w0 w1)); intros H3 H4 H5. - generalize (H4 H2); clear H4; rewrite H5; clear H5; autorewrite with rm10. - intros (H4, H5). - assert (V: wB/4 <= [|w0|]). - apply beta_lex with 0 [|w1|] wB; auto with zarith; autorewrite with rm10. - rewrite <- wwB_4_wB_4; auto. - generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith. - case (w_sqrt2 w0 w1); intros w2 c. - simpl ww_to_Z; simpl fst. - case c; unfold interp_carry; autorewrite with rm10. - intros w3 (H6, H7); rewrite H6. - assert (V1 := spec_to_Z w3);auto with zarith. - split; auto with zarith. - apply Zle_lt_trans with ([|w2|] ^2 + 2 * [|w2|]); auto with zarith. - match goal with |- ?X < ?Z => - replace Z with (X + 1); auto with zarith - end. - repeat rewrite Zsquare_mult; ring. - intros w3 (H6, H7); rewrite H6. - assert (V1 := spec_to_Z w3);auto with zarith. - split; auto with zarith. - apply Zle_lt_trans with ([|w2|] ^2 + 2 * [|w2|]); auto with zarith. - match goal with |- ?X < ?Z => - replace Z with (X + 1); auto with zarith - end. - repeat rewrite Zsquare_mult; ring. - intros HH; case (spec_to_w_Z (ww_head1 x)); auto with zarith. - intros Hv1. - case (spec_ww_head1 x); intros Hp1 Hp2. - generalize (Hp2 H1); clear Hp2; intros Hp2. - assert (Hv2: [[ww_head1 x]] <= Zpos (xO w_digits)). - case (Zle_or_lt (Zpos (xO w_digits)) [[ww_head1 x]]); auto with zarith; intros HH1. - case Hp2; intros _ HH2; contradict HH2. - apply Zle_not_lt; unfold base. - apply Zle_trans with (2 ^ [[ww_head1 x]]). - apply Zpower_le_monotone; auto with zarith. - pattern (2 ^ [[ww_head1 x]]) at 1; - rewrite <- (Zmult_1_r (2 ^ [[ww_head1 x]])). - apply Zmult_le_compat_l; auto with zarith. - generalize (spec_ww_add_mul_div x W0 (ww_head1 x) Hv2); - case ww_add_mul_div. - simpl ww_to_Z; autorewrite with w_rewrite rm10. - rewrite Zmod_small; auto with zarith. - intros H2; case (Zmult_integral _ _ (sym_equal H2)); clear H2; intros H2. - rewrite H2; unfold Zpower, Zpower_pos; simpl; auto with zarith. - match type of H2 with ?X = ?Y => - absurd (Y < X); try (rewrite H2; auto with zarith; fail) - end. - apply Zpower_gt_0; auto with zarith. - split; auto with zarith. - case Hp2; intros _ tmp; apply Zle_lt_trans with (2 := tmp); - clear tmp. - rewrite Zmult_comm; apply Zmult_le_compat_r; auto with zarith. - assert (Hv0: [[ww_head1 x]] = 2 * ([[ww_head1 x]]/2)). - pattern [[ww_head1 x]] at 1; rewrite (Z_div_mod_eq [[ww_head1 x]] 2); - auto with zarith. - generalize (spec_ww_is_even (ww_head1 x)); rewrite Hp1; - intros tmp; rewrite tmp; rewrite Zplus_0_r; auto. - intros w0 w1; autorewrite with w_rewrite rm10. - rewrite Zmod_small; auto with zarith. - 2: rewrite Zmult_comm; auto with zarith. - intros H2. - assert (V: wB/4 <= [|w0|]). - apply beta_lex with 0 [|w1|] wB; auto with zarith; autorewrite with rm10. - simpl ww_to_Z in H2; rewrite H2. - rewrite <- wwB_4_wB_4; auto with zarith. - rewrite Zmult_comm; auto with zarith. - assert (V1 := spec_to_Z w1);auto with zarith. - generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith. - case (w_sqrt2 w0 w1); intros w2 c. - case (spec_to_Z w2); intros HH1 HH2. - simpl ww_to_Z; simpl fst. - assert (Hv3: [[ww_pred ww_zdigits]] - = Zpos (xO w_digits) - 1). - rewrite spec_ww_pred; rewrite spec_ww_zdigits. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - apply Zlt_le_trans with (Zpos (xO w_digits)); auto with zarith. - unfold base; apply Zpower2_le_lin; auto with zarith. - assert (Hv4: [[ww_head1 x]]/2 < wB). - apply Zle_lt_trans with (Zpos w_digits). - apply Zmult_le_reg_r with 2; auto with zarith. - repeat rewrite (fun x => Zmult_comm x 2). - rewrite <- Hv0; rewrite <- Zpos_xO; auto. - unfold base; apply Zpower2_lt_lin; auto with zarith. - assert (Hv5: [[(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))]] - = [[ww_head1 x]]/2). - rewrite spec_ww_add_mul_div. - simpl ww_to_Z; autorewrite with rm10. - rewrite Hv3. - ring_simplify (Zpos (xO w_digits) - (Zpos (xO w_digits) - 1)). - rewrite Zpower_1_r. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - apply Zlt_le_trans with (1 := Hv4); auto with zarith. - unfold base; apply Zpower_le_monotone; auto with zarith. - split; unfold ww_digits; try rewrite Zpos_xO; auto with zarith. - rewrite Hv3; auto with zarith. - assert (Hv6: [|low(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))|] - = [[ww_head1 x]]/2). - rewrite spec_low. - rewrite Hv5; rewrite Zmod_small; auto with zarith. - rewrite spec_w_add_mul_div; auto with zarith. - rewrite spec_w_sub; auto with zarith. - rewrite spec_w_0. - simpl ww_to_Z; autorewrite with rm10. - rewrite Hv6; rewrite spec_w_zdigits. - rewrite (fun x y => Zmod_small (x - y)). - ring_simplify (Zpos w_digits - (Zpos w_digits - [[ww_head1 x]] / 2)). - rewrite Zmod_small. - simpl ww_to_Z in H2; rewrite H2; auto with zarith. - intros (H4, H5); split. - apply Zmult_le_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith. - rewrite H4. - apply Zle_trans with ([|w2|] ^ 2); auto with zarith. - rewrite Zmult_comm. - pattern [[ww_head1 x]] at 1; - rewrite Hv0; auto with zarith. - rewrite (Zmult_comm 2); rewrite Zpower_mult; - auto with zarith. - assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2); - try (intros; repeat rewrite Zsquare_mult; ring); - rewrite tmp; clear tmp. - apply Zpower_le_monotone3; auto with zarith. - split; auto with zarith. - pattern [|w2|] at 2; - rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]] / 2))); - auto with zarith. - match goal with |- ?X <= ?X + ?Y => - assert (0 <= Y); auto with zarith - end. - case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith. - case c; unfold interp_carry; autorewrite with rm10; - intros w3; assert (V3 := spec_to_Z w3);auto with zarith. - apply Zmult_lt_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith. - rewrite H4. - apply Zle_lt_trans with ([|w2|] ^ 2 + 2 * [|w2|]); auto with zarith. - apply Zlt_le_trans with (([|w2|] + 1) ^ 2); auto with zarith. - match goal with |- ?X < ?Y => - replace Y with (X + 1); auto with zarith - end. - repeat rewrite (Zsquare_mult); ring. - rewrite Zmult_comm. - pattern [[ww_head1 x]] at 1; rewrite Hv0. - rewrite (Zmult_comm 2); rewrite Zpower_mult; - auto with zarith. - assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2); - try (intros; repeat rewrite Zsquare_mult; ring); - rewrite tmp; clear tmp. - apply Zpower_le_monotone3; auto with zarith. - split; auto with zarith. - pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]]/2))); - auto with zarith. - rewrite <- Zplus_assoc; rewrite Zmult_plus_distr_r. - autorewrite with rm10; apply Zplus_le_compat_l; auto with zarith. - case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]]/2))); auto with zarith. - split; auto with zarith. - apply Zle_lt_trans with ([|w2|]); auto with zarith. - apply Zdiv_le_upper_bound; auto with zarith. - pattern [|w2|] at 1; replace [|w2|] with ([|w2|] * 2 ^0); - auto with zarith. - apply Zmult_le_compat_l; auto with zarith. - apply Zpower_le_monotone; auto with zarith. - rewrite Zpower_0_r; autorewrite with rm10; auto. - split; auto with zarith. - rewrite Hv0 in Hv2; rewrite (Zpos_xO w_digits) in Hv2; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. - unfold base; apply Zpower2_lt_lin; auto with zarith. - rewrite spec_w_sub; auto with zarith. - rewrite Hv6; rewrite spec_w_zdigits; auto with zarith. - assert (Hv7: 0 < [[ww_head1 x]]/2); auto with zarith. - rewrite Zmod_small; auto with zarith. - split; auto with zarith. - assert ([[ww_head1 x]]/2 <= Zpos w_digits); auto with zarith. - apply Zmult_le_reg_r with 2; auto with zarith. - repeat rewrite (fun x => Zmult_comm x 2). - rewrite <- Hv0; rewrite <- Zpos_xO; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. - unfold base; apply Zpower2_lt_lin; auto with zarith. - Qed. - -End GenSqrt. diff --git a/theories/Ints/num/GenSub.v b/theories/Ints/num/GenSub.v deleted file mode 100644 index 6ffb245757..0000000000 --- a/theories/Ints/num/GenSub.v +++ /dev/null @@ -1,353 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. - -Open Local Scope Z_scope. - -Section GenSub. - Variable w : Set. - Variable w_0 : w. - Variable w_Bm1 : w. - Variable w_WW : w -> w -> zn2z w. - Variable ww_Bm1 : zn2z w. - Variable w_opp_c : w -> carry w. - Variable w_opp_carry : w -> w. - Variable w_pred_c : w -> carry w. - Variable w_sub_c : w -> w -> carry w. - Variable w_sub_carry_c : w -> w -> carry w. - Variable w_opp : w -> w. - Variable w_pred : w -> w. - Variable w_sub : w -> w -> w. - Variable w_sub_carry : w -> w -> w. - - (* ** Opposites ** *) - Definition ww_opp_c x := - match x with - | W0 => C0 W0 - | WW xh xl => - match w_opp_c xl with - | C0 _ => - match w_opp_c xh with - | C0 h => C0 W0 - | C1 h => C1 (WW h w_0) - end - | C1 l => C1 (WW (w_opp_carry xh) l) - end - end. - - Definition ww_opp x := - match x with - | W0 => W0 - | WW xh xl => - match w_opp_c xl with - | C0 _ => WW (w_opp xh) w_0 - | C1 l => WW (w_opp_carry xh) l - end - end. - - Definition ww_opp_carry x := - match x with - | W0 => ww_Bm1 - | WW xh xl => w_WW (w_opp_carry xh) (w_opp_carry xl) - end. - - Definition ww_pred_c x := - match x with - | W0 => C1 ww_Bm1 - | WW xh xl => - match w_pred_c xl with - | C0 l => C0 (w_WW xh l) - | C1 _ => - match w_pred_c xh with - | C0 h => C0 (WW h w_Bm1) - | C1 _ => C1 ww_Bm1 - end - end - end. - - Definition ww_pred x := - match x with - | W0 => ww_Bm1 - | WW xh xl => - match w_pred_c xl with - | C0 l => w_WW xh l - | C1 l => WW (w_pred xh) w_Bm1 - end - end. - - Definition ww_sub_c x y := - match y, x with - | W0, _ => C0 x - | WW yh yl, W0 => ww_opp_c (WW yh yl) - | WW yh yl, WW xh xl => - match w_sub_c xl yl with - | C0 l => - match w_sub_c xh yh with - | C0 h => C0 (w_WW h l) - | C1 h => C1 (WW h l) - end - | C1 l => - match w_sub_carry_c xh yh with - | C0 h => C0 (WW h l) - | C1 h => C1 (WW h l) - end - end - end. - - Definition ww_sub x y := - match y, x with - | W0, _ => x - | WW yh yl, W0 => ww_opp (WW yh yl) - | WW yh yl, WW xh xl => - match w_sub_c xl yl with - | C0 l => w_WW (w_sub xh yh) l - | C1 l => WW (w_sub_carry xh yh) l - end - end. - - Definition ww_sub_carry_c x y := - match y, x with - | W0, W0 => C1 ww_Bm1 - | W0, WW xh xl => ww_pred_c (WW xh xl) - | WW yh yl, W0 => C1 (ww_opp_carry (WW yh yl)) - | WW yh yl, WW xh xl => - match w_sub_carry_c xl yl with - | C0 l => - match w_sub_c xh yh with - | C0 h => C0 (w_WW h l) - | C1 h => C1 (WW h l) - end - | C1 l => - match w_sub_carry_c xh yh with - | C0 h => C0 (w_WW h l) - | C1 h => C1 (w_WW h l) - end - end - end. - - Definition ww_sub_carry x y := - match y, x with - | W0, W0 => ww_Bm1 - | W0, WW xh xl => ww_pred (WW xh xl) - | WW yh yl, W0 => ww_opp_carry (WW yh yl) - | WW yh yl, WW xh xl => - match w_sub_carry_c xl yl with - | C0 l => w_WW (w_sub xh yh) l - | C1 l => w_WW (w_sub_carry xh yh) l - end - end. - - (*Section GenProof.*) - Variable w_digits : positive. - Variable w_to_Z : w -> Z. - - - Notation wB := (base w_digits). - Notation wwB := (base (ww_digits w_digits)). - Notation "[| x |]" := (w_to_Z x) (at level 0, x at level 99). - Notation "[+| c |]" := - (interp_carry 1 wB w_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). - - Notation "[[ x ]]" := (ww_to_Z w_digits w_to_Z x)(at level 0, x at level 99). - Notation "[+[ c ]]" := - (interp_carry 1 wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - Notation "[-[ c ]]" := - (interp_carry (-1) wwB (ww_to_Z w_digits w_to_Z) c) - (at level 0, x at level 99). - - Variable spec_w_0 : [|w_0|] = 0. - Variable spec_w_Bm1 : [|w_Bm1|] = wB - 1. - Variable spec_ww_Bm1 : [[ww_Bm1]] = wwB - 1. - Variable spec_to_Z : forall x, 0 <= [|x|] < wB. - Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. - - Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|]. - Variable spec_opp : forall x, [|w_opp x|] = (-[|x|]) mod wB. - Variable spec_opp_carry : forall x, [|w_opp_carry x|] = wB - [|x|] - 1. - - Variable spec_pred_c : forall x, [-|w_pred_c x|] = [|x|] - 1. - Variable spec_sub_c : forall x y, [-|w_sub_c x y|] = [|x|] - [|y|]. - Variable spec_sub_carry_c : - forall x y, [-|w_sub_carry_c x y|] = [|x|] - [|y|] - 1. - - Variable spec_pred : forall x, [|w_pred x|] = ([|x|] - 1) mod wB. - Variable spec_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. - Variable spec_sub_carry : - forall x y, [|w_sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB. - - - Lemma spec_ww_opp_c : forall x, [-[ww_opp_c x]] = -[[x]]. - Proof. - destruct x as [ |xh xl];simpl. reflexivity. - rewrite Zopp_plus_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl) - as [l|l];intros H;unfold interp_carry in H;rewrite <- H; - rewrite Zopp_mult_distr_l. - assert ([|l|] = 0). - assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. - rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh) - as [h|h];intros H1;unfold interp_carry in *;rewrite <- H1. - assert ([|h|] = 0). - assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega. - rewrite H2;reflexivity. - simpl ww_to_Z;rewrite wwB_wBwB;rewrite spec_w_0;ring. - unfold interp_carry;simpl ww_to_Z;rewrite wwB_wBwB;rewrite spec_opp_carry; - ring. - Qed. - - Lemma spec_ww_opp : forall x, [[ww_opp x]] = (-[[x]]) mod wwB. - Proof. - destruct x as [ |xh xl];simpl. reflexivity. - rewrite Zopp_plus_distr;rewrite Zopp_mult_distr_l. - generalize (spec_opp_c xl);destruct (w_opp_c xl) - as [l|l];intros H;unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. - rewrite spec_w_0;rewrite Zplus_0_r;rewrite wwB_wBwB. - assert ([|l|] = 0). - assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. - rewrite H0;rewrite Zplus_0_r; rewrite Zpower_2; - rewrite Zmult_mod_distr_r;try apply lt_0_wB. - rewrite spec_opp;trivial. - apply Zmod_unique with (q:= -1). - exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW (w_opp_carry xh) l)). - rewrite spec_opp_carry;rewrite wwB_wBwB;ring. - Qed. - - Lemma spec_ww_opp_carry : forall x, [[ww_opp_carry x]] = wwB - [[x]] - 1. - Proof. - destruct x as [ |xh xl];simpl. rewrite spec_ww_Bm1;ring. - rewrite spec_w_WW;simpl;repeat rewrite spec_opp_carry;rewrite wwB_wBwB;ring. - Qed. - - Lemma spec_ww_pred_c : forall x, [-[ww_pred_c x]] = [[x]] - 1. - Proof. - destruct x as [ |xh xl];unfold ww_pred_c. - unfold interp_carry;rewrite spec_ww_Bm1;simpl ww_to_Z;ring. - simpl ww_to_Z;replace (([|xh|]*wB+[|xl|])-1) with ([|xh|]*wB+([|xl|]-1)). - 2:ring. generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l]; - intros H;unfold interp_carry in H;rewrite <- H. simpl;apply spec_w_WW. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - assert ([|l|] = wB - 1). - assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. - rewrite H0;change ([|xh|] + -1) with ([|xh|] - 1). - generalize (spec_pred_c xh);destruct (w_pred_c xh) as [h|h]; - intros H1;unfold interp_carry in H1;rewrite <- H1. - simpl;rewrite spec_w_Bm1;ring. - assert ([|h|] = wB - 1). - assert (H3:= spec_to_Z h);assert (H2 := spec_to_Z xh);omega. - rewrite H2;unfold interp_carry;rewrite spec_ww_Bm1;rewrite wwB_wBwB;ring. - Qed. - - Lemma spec_ww_sub_c : forall x y, [-[ww_sub_c x y]] = [[x]] - [[y]]. - Proof. - destruct y as [ |yh yl];simpl. ring. - destruct x as [ |xh xl];simpl. exact (spec_ww_opp_c (WW yh yl)). - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) - with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|])). 2:ring. - generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl) as [l|l];intros H; - unfold interp_carry in H;rewrite <- H. - generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; - unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; - try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). - generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; - intros H1;unfold interp_carry in *;rewrite <- H1;simpl ww_to_Z; - try rewrite wwB_wBwB;ring. - Qed. - - Lemma spec_ww_sub_carry_c : - forall x y, [-[ww_sub_carry_c x y]] = [[x]] - [[y]] - 1. - Proof. - destruct y as [ |yh yl];simpl. - unfold Zminus;simpl;rewrite Zplus_0_r;exact (spec_ww_pred_c x). - destruct x as [ |xh xl]. - unfold interp_carry;rewrite spec_w_WW;simpl ww_to_Z;rewrite wwB_wBwB; - repeat rewrite spec_opp_carry;ring. - simpl ww_to_Z. - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) - with (([|xh|]-[|yh|])*wB + ([|xl|]-[|yl|]-1)). 2:ring. - generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl) - as [l|l];intros H;unfold interp_carry in H;rewrite <- H. - generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; - unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; - try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). - generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; - intros H1;unfold interp_carry in *;rewrite <- H1;try rewrite spec_w_WW; - simpl ww_to_Z; try rewrite wwB_wBwB;ring. - Qed. - - Lemma spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB. - Proof. - destruct x as [ |xh xl];simpl. - apply Zmod_unique with (-1). apply spec_ww_to_Z;trivial. - rewrite spec_ww_Bm1;ring. - replace ([|xh|]*wB + [|xl|] - 1) with ([|xh|]*wB + ([|xl|] - 1)). 2:ring. - generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l];intro H; - unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. - rewrite Zmod_small. apply spec_w_WW. - exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh l)). - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - change ([|xh|] + -1) with ([|xh|] - 1). - assert ([|l|] = wB - 1). - assert (H1:= spec_to_Z l);assert (H2:= spec_to_Z xl);omega. - rewrite (mod_wwB w_digits w_to_Z);trivial. - rewrite spec_pred;rewrite spec_w_Bm1;rewrite <- H0;trivial. - Qed. - - Lemma spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. - Proof. - destruct y as [ |yh yl];simpl. - ring_simplify ([[x]] - 0);rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial. - destruct x as [ |xh xl];simpl. exact (spec_ww_opp (WW yh yl)). - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|])) - with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|])). 2:ring. - generalize (spec_sub_c xl yl);destruct (w_sub_c xl yl)as[l|l];intros H; - unfold interp_carry in H;rewrite <- H. - rewrite spec_w_WW;rewrite (mod_wwB w_digits w_to_Z spec_to_Z). - rewrite spec_sub;trivial. - simpl ww_to_Z;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial. - Qed. - - Lemma spec_ww_sub_carry : - forall x y, [[ww_sub_carry x y]] = ([[x]] - [[y]] - 1) mod wwB. - Proof. - destruct y as [ |yh yl];simpl. - ring_simplify ([[x]] - 0);exact (spec_ww_pred x). - destruct x as [ |xh xl];simpl. - apply Zmod_unique with (-1). - apply spec_ww_to_Z;trivial. - fold (ww_opp_carry (WW yh yl)). - rewrite (spec_ww_opp_carry (WW yh yl));simpl ww_to_Z;ring. - replace ([|xh|] * wB + [|xl|] - ([|yh|] * wB + [|yl|]) - 1) - with (([|xh|] - [|yh|]) * wB + ([|xl|] - [|yl|] - 1)). 2:ring. - generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl)as[l|l]; - intros H;unfold interp_carry in H;rewrite <- H;rewrite spec_w_WW. - rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub;trivial. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial. - Qed. - -(* End GenProof. *) - -End GenSub. - - - - - diff --git a/theories/Ints/num/MemoFn.v b/theories/Ints/num/MemoFn.v deleted file mode 100644 index 7d2c7af015..0000000000 --- a/theories/Ints/num/MemoFn.v +++ /dev/null @@ -1,185 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import Eqdep_dec. - -Section MemoFunction. - -Variable A: Type. -Variable f: nat -> A. -Variable g: A -> A. - -Hypothesis Hg_correct: forall n, f (S n) = g (f n). - -(* Memo Stream *) -CoInductive MStream: Type := - MSeq : A -> MStream -> MStream. - -(* Hd and Tl function *) -Definition mhd (x: MStream) := - let (a,s) := x in a. -Definition mtl (x: MStream) := - let (a,s) := x in s. - -CoFixpoint memo_make (n: nat): MStream:= MSeq (f n) (memo_make (S n)). - -Definition memo_list := memo_make 0. - -Fixpoint memo_get (n: nat) (l: MStream) {struct n}: A := - match n with O => mhd l | S n1 => - memo_get n1 (mtl l) end. - -Theorem memo_get_correct: forall n, memo_get n memo_list = f n. -Proof. -assert (F1: forall n m, memo_get n (memo_make m) = f (n + m)). - induction n as [| n Hrec]; try (intros m; refine (refl_equal _)). - intros m; simpl; rewrite Hrec. - rewrite plus_n_Sm; auto. -intros n; apply trans_equal with (f (n + 0)); try exact (F1 n 0). -rewrite <- plus_n_O; auto. -Qed. - -(* Building with possible sharing using g *) -CoFixpoint imemo_make (fn: A): MStream := - let fn1 := g fn in - MSeq fn1 (imemo_make fn1). - -Definition imemo_list := let f0 := f 0 in - MSeq f0 (imemo_make f0). - -Theorem imemo_get_correct: forall n, memo_get n imemo_list = f n. -Proof. -assert (F1: forall n m, - memo_get n (imemo_make (f m)) = f (S (n + m))). - induction n as [| n Hrec]; try (intros m; exact (sym_equal (Hg_correct m))). - simpl; intros m; rewrite <- Hg_correct; rewrite Hrec; rewrite <- plus_n_Sm; auto. -destruct n as [| n]; try apply refl_equal. -unfold imemo_list; simpl; rewrite F1. -rewrite <- plus_n_O; auto. -Qed. - -End MemoFunction. - -Section DependentMemoFunction. - -Variable A: nat -> Type. -Variable f: forall n, A n. -Variable g: forall n, A n -> A (S n). - -Hypothesis Hg_correct: forall n, f (S n) = g n (f n). - -Inductive memo_val: Type := - memo_mval: forall n, A n -> memo_val. - -Fixpoint is_eq (n m : nat) {struct n}: {n = m} + {True} := - match n, m return {n = m} + {True} with - | 0, 0 =>left True (refl_equal 0) - | 0, S m1 => right (0 = S m1) I - | S n1, 0 => right (S n1 = 0) I - | S n1, S m1 => - match is_eq n1 m1 with - | left H => left True (f_equal S H) - | right _ => right (S n1 = S m1) I - end - end. - -Definition memo_get_val n (v: memo_val): A n := -match v with -| memo_mval m x => - match is_eq n m with - | left H => - match H in (@eq _ _ y) return (A y -> A n) with - | refl_equal => fun v1 : A n => v1 - end - | right _ => fun _ : A m => f n - end x -end. - -Let mf n := memo_mval n (f n). -Let mg v := match v with - memo_mval n1 v1 => memo_mval (S n1) (g n1 v1) end. - - -Definition dmemo_list := memo_list _ mf. - -Definition dmemo_get n l := memo_get_val n (memo_get _ n l). - -Definition dimemo_list := imemo_list _ mf mg. - -Theorem dmemo_get_correct: forall n, dmemo_get n dmemo_list = f n. -Proof. -intros n; unfold dmemo_get, dmemo_list. -rewrite (memo_get_correct memo_val mf n); simpl. -case (is_eq n n); simpl; auto; intros e. -assert (e = refl_equal n). - apply eq_proofs_unicity. - induction x as [| x Hx]; destruct y as [| y]. - left; auto. - right; intros HH; discriminate HH. - right; intros HH; discriminate HH. - case (Hx y). - intros HH; left; case HH; auto. - intros HH; right; intros HH1; case HH. - injection HH1; auto. -rewrite H; auto. -Qed. - -Theorem dimemo_get_correct: forall n, dmemo_get n dimemo_list = f n. -Proof. -intros n; unfold dmemo_get, dimemo_list. -rewrite (imemo_get_correct memo_val mf mg); simpl. -case (is_eq n n); simpl; auto; intros e. -assert (e = refl_equal n). - apply eq_proofs_unicity. - induction x as [| x Hx]; destruct y as [| y]. - left; auto. - right; intros HH; discriminate HH. - right; intros HH; discriminate HH. - case (Hx y). - intros HH; left; case HH; auto. - intros HH; right; intros HH1; case HH. - injection HH1; auto. -rewrite H; auto. -intros n1; unfold mf; rewrite Hg_correct; auto. -Qed. - -End DependentMemoFunction. - -(* An example with the memo function on factorial *) - -(* -Require Import ZArith. - -Fixpoint tfact (n: nat) {struct n} := - match n with O => 1%Z | - S n1 => (Z_of_nat n * tfact n1)%Z end. - -Definition lfact_list := - dimemo_list _ tfact (fun n z => (Z_of_nat (S n) * z)%Z). - -Definition lfact n := dmemo_get _ tfact n lfact_list. - -Theorem lfact_correct n: lfact n = tfact n. -Proof. -intros n; unfold lfact, lfact_list. -rewrite dimemo_get_correct; auto. -Qed. - -Fixpoint nop p := match p with -xH => 0 | xI p1 => nop p1 | xO p1 => nop p1 end. - -Fixpoint test z := match z with -Z0 => 0 | Zpos p1 => nop p1 | Zneg p1 => nop p1 end. - -Time Eval vm_compute in test (lfact 2000). -Time Eval vm_compute in test (lfact 2000). -Time Eval vm_compute in test (lfact 1500). -Time Eval vm_compute in (lfact 1500). - -*) - diff --git a/theories/Ints/num/NMake.v b/theories/Ints/num/NMake.v deleted file mode 100644 index 8cb779350a..0000000000 --- a/theories/Ints/num/NMake.v +++ /dev/null @@ -1,6809 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(* $Id$ *) - -(** * *) - -(** -- Authors: Benjamin Grégoire, Laurent Théry -- Institution: INRIA -- Date: 2007 -- Remark: File automatically generated -*) - -Require Import Zaux. -Require Import ZArith. -Require Import Basic_type. -Require Import ZnZ. -Require Import Zn2Z. -Require Import Nbasic. -Require Import GenMul. -Require Import GenDivn1. -Require Import Wf_nat. -Require Import MemoFn. - -Module Type W0Type. - Parameter w : Set. - Parameter w_op : znz_op w. - Parameter w_spec : znz_spec w_op. -End W0Type. - -Module Make (W0:W0Type). - Import W0. - - Definition w0 := W0.w. - Definition w1 := zn2z w0. - Definition w2 := zn2z w1. - Definition w3 := zn2z w2. - Definition w4 := zn2z w3. - Definition w5 := zn2z w4. - Definition w6 := zn2z w5. - - Definition w0_op := W0.w_op. - Definition w1_op := mk_zn2z_op w0_op. - Definition w2_op := mk_zn2z_op w1_op. - Definition w3_op := mk_zn2z_op w2_op. - Definition w4_op := mk_zn2z_op_karatsuba w3_op. - Definition w5_op := mk_zn2z_op_karatsuba w4_op. - Definition w6_op := mk_zn2z_op_karatsuba w5_op. - Definition w7_op := mk_zn2z_op_karatsuba w6_op. - Definition w8_op := mk_zn2z_op_karatsuba w7_op. - Definition w9_op := mk_zn2z_op_karatsuba w8_op. - - Section Make_op. - Variable mk : forall w', znz_op w' -> znz_op (zn2z w'). - - Fixpoint make_op_aux (n:nat) : znz_op (word w6 (S n)):= - match n return znz_op (word w6 (S n)) with - | O => w7_op - | S n1 => - match n1 return znz_op (word w6 (S (S n1))) with - | O => w8_op - | S n2 => - match n2 return znz_op (word w6 (S (S (S n2)))) with - | O => w9_op - | S n3 => mk _ (mk _ (mk _ (make_op_aux n3))) - end - end - end. - - End Make_op. - - Definition omake_op := make_op_aux mk_zn2z_op_karatsuba. - - - Definition make_op_list := dmemo_list _ omake_op. - - Definition make_op n := dmemo_get _ omake_op n make_op_list. - - Lemma make_op_omake: forall n, make_op n = omake_op n. - intros n; unfold make_op, make_op_list. - refine (dmemo_get_correct _ _ _). - Qed. - - Inductive t_ : Set := - | N0 : w0 -> t_ - | N1 : w1 -> t_ - | N2 : w2 -> t_ - | N3 : w3 -> t_ - | N4 : w4 -> t_ - | N5 : w5 -> t_ - | N6 : w6 -> t_ - | Nn : forall n, word w6 (S n) -> t_. - - Definition t := t_. - - Definition w_0 := w0_op.(znz_0). - - Definition one0 := w0_op.(znz_1). - Definition one1 := w1_op.(znz_1). - Definition one2 := w2_op.(znz_1). - Definition one3 := w3_op.(znz_1). - Definition one4 := w4_op.(znz_1). - Definition one5 := w5_op.(znz_1). - Definition one6 := w6_op.(znz_1). - - Definition zero := N0 w_0. - Definition one := N0 one0. - - Definition to_Z x := - match x with - | N0 wx => w0_op.(znz_to_Z) wx - | N1 wx => w1_op.(znz_to_Z) wx - | N2 wx => w2_op.(znz_to_Z) wx - | N3 wx => w3_op.(znz_to_Z) wx - | N4 wx => w4_op.(znz_to_Z) wx - | N5 wx => w5_op.(znz_to_Z) wx - | N6 wx => w6_op.(znz_to_Z) wx - | Nn n wx => (make_op n).(znz_to_Z) wx - end. - - Open Scope Z_scope. - Notation "[ x ]" := (to_Z x). - - (* Regular make op (no karatsuba) *) - Fixpoint nmake_op (ww:Set) (ww_op: znz_op ww) (n: nat) : - znz_op (word ww n) := - match n return znz_op (word ww n) with - O => ww_op - | S n1 => mk_zn2z_op (nmake_op ww ww_op n1) - end. - - (* Simplification by rewriting for nmake_op *) - Theorem nmake_op_S: forall ww (w_op: znz_op ww) x, - nmake_op _ w_op (S x) = mk_zn2z_op (nmake_op _ w_op x). - auto. - Qed. - - (* Eval and extend functions for each level *) - Let nmake_op0 := nmake_op _ w0_op. - Let eval0n n := znz_to_Z (nmake_op0 n). - Let extend0 := GenBase.extend (WW w_0). - Let nmake_op1 := nmake_op _ w1_op. - Let eval1n n := znz_to_Z (nmake_op1 n). - Let extend1 := GenBase.extend (WW (W0: w1)). - Let nmake_op2 := nmake_op _ w2_op. - Let eval2n n := znz_to_Z (nmake_op2 n). - Let extend2 := GenBase.extend (WW (W0: w2)). - Let nmake_op3 := nmake_op _ w3_op. - Let eval3n n := znz_to_Z (nmake_op3 n). - Let extend3 := GenBase.extend (WW (W0: w3)). - Let nmake_op4 := nmake_op _ w4_op. - Let eval4n n := znz_to_Z (nmake_op4 n). - Let extend4 := GenBase.extend (WW (W0: w4)). - Let nmake_op5 := nmake_op _ w5_op. - Let eval5n n := znz_to_Z (nmake_op5 n). - Let extend5 := GenBase.extend (WW (W0: w5)). - Let nmake_op6 := nmake_op _ w6_op. - Let eval6n n := znz_to_Z (nmake_op6 n). - Let extend6 := GenBase.extend (WW (W0: w6)). - - Theorem digits_gend:forall n ww (w_op: znz_op ww), - znz_digits (nmake_op _ w_op n) = - GenBase.gen_digits (znz_digits w_op) n. - Proof. intros n; elim n; auto; clear n. - intros n Hrec ww ww_op; simpl GenBase.gen_digits. - rewrite <- Hrec; auto. - Qed. - - Theorem nmake_gen: forall n ww (w_op: znz_op ww), - znz_to_Z (nmake_op _ w_op n) = - @GenBase.gen_to_Z _ (znz_digits w_op) (znz_to_Z w_op) n. - Proof. intros n; elim n; auto; clear n. - intros n Hrec ww ww_op; simpl GenBase.gen_to_Z; unfold zn2z_to_Z. - rewrite <- Hrec; auto. - unfold GenBase.gen_wB; rewrite <- digits_gend; auto. - Qed. - - Theorem digits_nmake:forall n ww (w_op: znz_op ww), - znz_digits (nmake_op _ w_op (S n)) = - xO (znz_digits (nmake_op _ w_op n)). - Proof. - auto. - Qed. - - Theorem znz_nmake_op: forall ww ww_op n xh xl, - znz_to_Z (nmake_op ww ww_op (S n)) (WW xh xl) = - znz_to_Z (nmake_op ww ww_op n) xh * - base (znz_digits (nmake_op ww ww_op n)) + - znz_to_Z (nmake_op ww ww_op n) xl. - Proof. - auto. - Qed. - - Theorem make_op_S: forall n, - make_op (S n) = mk_zn2z_op_karatsuba (make_op n). - intro n. - do 2 rewrite make_op_omake. - pattern n; apply lt_wf_ind; clear n. - intros n; case n; clear n. - intros _; unfold omake_op, make_op_aux, w8_op; apply refl_equal. - intros n; case n; clear n. - intros _; unfold omake_op, make_op_aux, w9_op; apply refl_equal. - intros n; case n; clear n. - intros _; unfold omake_op, make_op_aux, w9_op, w8_op; apply refl_equal. - intros n Hrec. - change (omake_op (S (S (S (S n))))) with - (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op (S n))))). - change (omake_op (S (S (S n)))) with - (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op n)))). - rewrite Hrec; auto with arith. - Qed. - - Let znz_to_Z_1: forall x y, - znz_to_Z w1_op (WW x y) = - znz_to_Z w0_op x * base (znz_digits w0_op) + znz_to_Z w0_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_2: forall x y, - znz_to_Z w2_op (WW x y) = - znz_to_Z w1_op x * base (znz_digits w1_op) + znz_to_Z w1_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_3: forall x y, - znz_to_Z w3_op (WW x y) = - znz_to_Z w2_op x * base (znz_digits w2_op) + znz_to_Z w2_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_4: forall x y, - znz_to_Z w4_op (WW x y) = - znz_to_Z w3_op x * base (znz_digits w3_op) + znz_to_Z w3_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_5: forall x y, - znz_to_Z w5_op (WW x y) = - znz_to_Z w4_op x * base (znz_digits w4_op) + znz_to_Z w4_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_6: forall x y, - znz_to_Z w6_op (WW x y) = - znz_to_Z w5_op x * base (znz_digits w5_op) + znz_to_Z w5_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_7: forall x y, - znz_to_Z w7_op (WW x y) = - znz_to_Z w6_op x * base (znz_digits w6_op) + znz_to_Z w6_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_8: forall x y, - znz_to_Z w8_op (WW x y) = - znz_to_Z w7_op x * base (znz_digits w7_op) + znz_to_Z w7_op y. - Proof. - auto. - Qed. - - Let znz_to_Z_n: forall n x y, - znz_to_Z (make_op (S n)) (WW x y) = - znz_to_Z (make_op n) x * base (znz_digits (make_op n)) + znz_to_Z (make_op n) y. - Proof. - intros n x y; rewrite make_op_S; auto. - Qed. - - Let w0_spec: znz_spec w0_op := W0.w_spec. - Let w1_spec: znz_spec w1_op := mk_znz2_spec w0_spec. - Let w2_spec: znz_spec w2_op := mk_znz2_spec w1_spec. - Let w3_spec: znz_spec w3_op := mk_znz2_spec w2_spec. - Let w4_spec : znz_spec w4_op := mk_znz2_karatsuba_spec w3_spec. - Let w5_spec : znz_spec w5_op := mk_znz2_karatsuba_spec w4_spec. - Let w6_spec : znz_spec w6_op := mk_znz2_karatsuba_spec w5_spec. - Let w7_spec : znz_spec w7_op := mk_znz2_karatsuba_spec w6_spec. - Let w8_spec : znz_spec w8_op := mk_znz2_karatsuba_spec w7_spec. - Let w9_spec : znz_spec w9_op := mk_znz2_karatsuba_spec w8_spec. - - Let wn_spec: forall n, znz_spec (make_op n). - intros n; elim n; clear n. - exact w7_spec. - intros n Hrec; rewrite make_op_S. - exact (mk_znz2_karatsuba_spec Hrec). - Qed. - - Definition w0_eq0 := w0_op.(znz_eq0). - Let spec_w0_eq0: forall x, if w0_eq0 x then [N0 x] = 0 else True. - intros x; unfold w0_eq0, to_Z; generalize (spec_eq0 w0_spec x); - case znz_eq0; auto. - Qed. - - Definition w1_eq0 := w1_op.(znz_eq0). - Let spec_w1_eq0: forall x, if w1_eq0 x then [N1 x] = 0 else True. - intros x; unfold w1_eq0, to_Z; generalize (spec_eq0 w1_spec x); - case znz_eq0; auto. - Qed. - - Definition w2_eq0 := w2_op.(znz_eq0). - Let spec_w2_eq0: forall x, if w2_eq0 x then [N2 x] = 0 else True. - intros x; unfold w2_eq0, to_Z; generalize (spec_eq0 w2_spec x); - case znz_eq0; auto. - Qed. - - Definition w3_eq0 := w3_op.(znz_eq0). - Let spec_w3_eq0: forall x, if w3_eq0 x then [N3 x] = 0 else True. - intros x; unfold w3_eq0, to_Z; generalize (spec_eq0 w3_spec x); - case znz_eq0; auto. - Qed. - - Definition w4_eq0 := w4_op.(znz_eq0). - Let spec_w4_eq0: forall x, if w4_eq0 x then [N4 x] = 0 else True. - intros x; unfold w4_eq0, to_Z; generalize (spec_eq0 w4_spec x); - case znz_eq0; auto. - Qed. - - Definition w5_eq0 := w5_op.(znz_eq0). - Let spec_w5_eq0: forall x, if w5_eq0 x then [N5 x] = 0 else True. - intros x; unfold w5_eq0, to_Z; generalize (spec_eq0 w5_spec x); - case znz_eq0; auto. - Qed. - - Definition w6_eq0 := w6_op.(znz_eq0). - Let spec_w6_eq0: forall x, if w6_eq0 x then [N6 x] = 0 else True. - intros x; unfold w6_eq0, to_Z; generalize (spec_eq0 w6_spec x); - case znz_eq0; auto. - Qed. - - - Theorem digits_w0: znz_digits w0_op = znz_digits (nmake_op _ w0_op 0). - auto. - Qed. - - Let spec_gen_eval0n: forall n, eval0n n = GenBase.gen_to_Z (znz_digits w0_op) (znz_to_Z w0_op) n. - intros n; exact (nmake_gen n w0 w0_op). - Qed. - - Theorem digits_w1: znz_digits w1_op = znz_digits (nmake_op _ w0_op 1). - rewrite digits_nmake; rewrite <- digits_w0; auto. - Qed. - - Let spec_gen_eval1n: forall n, eval1n n = GenBase.gen_to_Z (znz_digits w1_op) (znz_to_Z w1_op) n. - intros n; exact (nmake_gen n w1 w1_op). - Qed. - - Theorem digits_w2: znz_digits w2_op = znz_digits (nmake_op _ w0_op 2). - rewrite digits_nmake; rewrite <- digits_w1; auto. - Qed. - - Let spec_gen_eval2n: forall n, eval2n n = GenBase.gen_to_Z (znz_digits w2_op) (znz_to_Z w2_op) n. - intros n; exact (nmake_gen n w2 w2_op). - Qed. - - Theorem digits_w3: znz_digits w3_op = znz_digits (nmake_op _ w0_op 3). - rewrite digits_nmake; rewrite <- digits_w2; auto. - Qed. - - Let spec_gen_eval3n: forall n, eval3n n = GenBase.gen_to_Z (znz_digits w3_op) (znz_to_Z w3_op) n. - intros n; exact (nmake_gen n w3 w3_op). - Qed. - - Theorem digits_w4: znz_digits w4_op = znz_digits (nmake_op _ w0_op 4). - rewrite digits_nmake; rewrite <- digits_w3; auto. - Qed. - - Let spec_gen_eval4n: forall n, eval4n n = GenBase.gen_to_Z (znz_digits w4_op) (znz_to_Z w4_op) n. - intros n; exact (nmake_gen n w4 w4_op). - Qed. - - Theorem digits_w5: znz_digits w5_op = znz_digits (nmake_op _ w0_op 5). - rewrite digits_nmake; rewrite <- digits_w4; auto. - Qed. - - Let spec_gen_eval5n: forall n, eval5n n = GenBase.gen_to_Z (znz_digits w5_op) (znz_to_Z w5_op) n. - intros n; exact (nmake_gen n w5 w5_op). - Qed. - - Theorem digits_w6: znz_digits w6_op = znz_digits (nmake_op _ w0_op 6). - rewrite digits_nmake; rewrite <- digits_w5; auto. - Qed. - - Let spec_gen_eval6n: forall n, eval6n n = GenBase.gen_to_Z (znz_digits w6_op) (znz_to_Z w6_op) n. - intros n; exact (nmake_gen n w6 w6_op). - Qed. - - Theorem digits_w0n0: znz_digits w0_op = znz_digits (nmake_op _ w0_op 0). - auto. - Qed. - - Let spec_eval0n0: forall x, [N0 x] = eval0n 0 x. - intros x; rewrite spec_gen_eval0n; unfold GenBase.gen_to_Z, to_Z; auto. - Qed. - Let spec_extend0n1: forall x, [N0 x] = [N1 (extend0 0 x)]. - intros x; change (extend0 0 x) with (WW (znz_0 w0_op) x). - unfold to_Z; rewrite znz_to_Z_1. - rewrite (spec_0 w0_spec); auto. - Qed. - - Theorem digits_w0n1: znz_digits w1_op = znz_digits (nmake_op _ w0_op 1). - apply trans_equal with (xO (znz_digits w0_op)). - auto. - rewrite digits_nmake. - rewrite digits_w0n0. - auto. - Qed. - - Let spec_eval0n1: forall x, [N1 x] = eval0n 1 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_1. - rewrite digits_w0n0. - generalize (spec_eval0n0); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 0); auto. - Qed. - Let spec_extend0n2: forall x, [N0 x] = [N2 (extend0 1 x)]. - intros x; change (extend0 1 x) with (WW (znz_0 w1_op) (extend0 0 x)). - unfold to_Z; rewrite znz_to_Z_2. - rewrite (spec_0 w1_spec). - generalize (spec_extend0n1 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w0n2: znz_digits w2_op = znz_digits (nmake_op _ w0_op 2). - apply trans_equal with (xO (znz_digits w1_op)). - auto. - rewrite digits_nmake. - rewrite digits_w0n1. - auto. - Qed. - - Let spec_eval0n2: forall x, [N2 x] = eval0n 2 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_2. - rewrite digits_w0n1. - generalize (spec_eval0n1); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 1); auto. - Qed. - Let spec_extend0n3: forall x, [N0 x] = [N3 (extend0 2 x)]. - intros x; change (extend0 2 x) with (WW (znz_0 w2_op) (extend0 1 x)). - unfold to_Z; rewrite znz_to_Z_3. - rewrite (spec_0 w2_spec). - generalize (spec_extend0n2 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w0n3: znz_digits w3_op = znz_digits (nmake_op _ w0_op 3). - apply trans_equal with (xO (znz_digits w2_op)). - auto. - rewrite digits_nmake. - rewrite digits_w0n2. - auto. - Qed. - - Let spec_eval0n3: forall x, [N3 x] = eval0n 3 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_3. - rewrite digits_w0n2. - generalize (spec_eval0n2); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 2); auto. - Qed. - Let spec_extend0n4: forall x, [N0 x] = [N4 (extend0 3 x)]. - intros x; change (extend0 3 x) with (WW (znz_0 w3_op) (extend0 2 x)). - unfold to_Z; rewrite znz_to_Z_4. - rewrite (spec_0 w3_spec). - generalize (spec_extend0n3 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w0n4: znz_digits w4_op = znz_digits (nmake_op _ w0_op 4). - apply trans_equal with (xO (znz_digits w3_op)). - auto. - rewrite digits_nmake. - rewrite digits_w0n3. - auto. - Qed. - - Let spec_eval0n4: forall x, [N4 x] = eval0n 4 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_4. - rewrite digits_w0n3. - generalize (spec_eval0n3); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 3); auto. - Qed. - Let spec_extend0n5: forall x, [N0 x] = [N5 (extend0 4 x)]. - intros x; change (extend0 4 x) with (WW (znz_0 w4_op) (extend0 3 x)). - unfold to_Z; rewrite znz_to_Z_5. - rewrite (spec_0 w4_spec). - generalize (spec_extend0n4 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w0n5: znz_digits w5_op = znz_digits (nmake_op _ w0_op 5). - apply trans_equal with (xO (znz_digits w4_op)). - auto. - rewrite digits_nmake. - rewrite digits_w0n4. - auto. - Qed. - - Let spec_eval0n5: forall x, [N5 x] = eval0n 5 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_5. - rewrite digits_w0n4. - generalize (spec_eval0n4); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 4); auto. - Qed. - Let spec_extend0n6: forall x, [N0 x] = [N6 (extend0 5 x)]. - intros x; change (extend0 5 x) with (WW (znz_0 w5_op) (extend0 4 x)). - unfold to_Z; rewrite znz_to_Z_6. - rewrite (spec_0 w5_spec). - generalize (spec_extend0n5 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w0n6: znz_digits w6_op = znz_digits (nmake_op _ w0_op 6). - apply trans_equal with (xO (znz_digits w5_op)). - auto. - rewrite digits_nmake. - rewrite digits_w0n5. - auto. - Qed. - - Let spec_eval0n6: forall x, [N6 x] = eval0n 6 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_6. - rewrite digits_w0n5. - generalize (spec_eval0n5); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 5); auto. - Qed. - Theorem digits_w0n7: znz_digits w7_op = znz_digits (nmake_op _ w0_op 7). - apply trans_equal with (xO (znz_digits w6_op)). - auto. - rewrite digits_nmake. - rewrite digits_w0n6. - auto. - Qed. - - Let spec_eval0n7: forall x, [Nn 0 x] = eval0n 7 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_7. - rewrite digits_w0n6. - generalize (spec_eval0n6); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 6); auto. - Qed. - - Let spec_eval0n8: forall x, [Nn 1 x] = eval0n 8 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_8. - rewrite digits_w0n7. - generalize (spec_eval0n7); unfold to_Z; change (make_op 0) with (w7_op); intros HH; repeat rewrite HH. - unfold eval0n, nmake_op0. - rewrite (znz_nmake_op _ w0_op 7); auto. - Qed. - - Theorem digits_w1n0: znz_digits w1_op = znz_digits (nmake_op _ w1_op 0). - apply trans_equal with (xO (znz_digits w0_op)). - auto. - unfold nmake_op; auto. - Qed. - - Let spec_eval1n0: forall x, [N1 x] = eval1n 0 x. - intros x; rewrite spec_gen_eval1n; unfold GenBase.gen_to_Z, to_Z; auto. - Qed. - Let spec_extend1n2: forall x, [N1 x] = [N2 (extend1 0 x)]. - intros x; change (extend1 0 x) with (WW (znz_0 w1_op) x). - unfold to_Z; rewrite znz_to_Z_2. - rewrite (spec_0 w1_spec); auto. - Qed. - - Theorem digits_w1n1: znz_digits w2_op = znz_digits (nmake_op _ w1_op 1). - apply trans_equal with (xO (znz_digits w1_op)). - auto. - rewrite digits_nmake. - rewrite digits_w1n0. - auto. - Qed. - - Let spec_eval1n1: forall x, [N2 x] = eval1n 1 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_2. - rewrite digits_w1n0. - generalize (spec_eval1n0); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval1n, nmake_op1. - rewrite (znz_nmake_op _ w1_op 0); auto. - Qed. - Let spec_extend1n3: forall x, [N1 x] = [N3 (extend1 1 x)]. - intros x; change (extend1 1 x) with (WW (znz_0 w2_op) (extend1 0 x)). - unfold to_Z; rewrite znz_to_Z_3. - rewrite (spec_0 w2_spec). - generalize (spec_extend1n2 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w1n2: znz_digits w3_op = znz_digits (nmake_op _ w1_op 2). - apply trans_equal with (xO (znz_digits w2_op)). - auto. - rewrite digits_nmake. - rewrite digits_w1n1. - auto. - Qed. - - Let spec_eval1n2: forall x, [N3 x] = eval1n 2 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_3. - rewrite digits_w1n1. - generalize (spec_eval1n1); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval1n, nmake_op1. - rewrite (znz_nmake_op _ w1_op 1); auto. - Qed. - Let spec_extend1n4: forall x, [N1 x] = [N4 (extend1 2 x)]. - intros x; change (extend1 2 x) with (WW (znz_0 w3_op) (extend1 1 x)). - unfold to_Z; rewrite znz_to_Z_4. - rewrite (spec_0 w3_spec). - generalize (spec_extend1n3 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w1n3: znz_digits w4_op = znz_digits (nmake_op _ w1_op 3). - apply trans_equal with (xO (znz_digits w3_op)). - auto. - rewrite digits_nmake. - rewrite digits_w1n2. - auto. - Qed. - - Let spec_eval1n3: forall x, [N4 x] = eval1n 3 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_4. - rewrite digits_w1n2. - generalize (spec_eval1n2); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval1n, nmake_op1. - rewrite (znz_nmake_op _ w1_op 2); auto. - Qed. - Let spec_extend1n5: forall x, [N1 x] = [N5 (extend1 3 x)]. - intros x; change (extend1 3 x) with (WW (znz_0 w4_op) (extend1 2 x)). - unfold to_Z; rewrite znz_to_Z_5. - rewrite (spec_0 w4_spec). - generalize (spec_extend1n4 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w1n4: znz_digits w5_op = znz_digits (nmake_op _ w1_op 4). - apply trans_equal with (xO (znz_digits w4_op)). - auto. - rewrite digits_nmake. - rewrite digits_w1n3. - auto. - Qed. - - Let spec_eval1n4: forall x, [N5 x] = eval1n 4 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_5. - rewrite digits_w1n3. - generalize (spec_eval1n3); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval1n, nmake_op1. - rewrite (znz_nmake_op _ w1_op 3); auto. - Qed. - Let spec_extend1n6: forall x, [N1 x] = [N6 (extend1 4 x)]. - intros x; change (extend1 4 x) with (WW (znz_0 w5_op) (extend1 3 x)). - unfold to_Z; rewrite znz_to_Z_6. - rewrite (spec_0 w5_spec). - generalize (spec_extend1n5 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w1n5: znz_digits w6_op = znz_digits (nmake_op _ w1_op 5). - apply trans_equal with (xO (znz_digits w5_op)). - auto. - rewrite digits_nmake. - rewrite digits_w1n4. - auto. - Qed. - - Let spec_eval1n5: forall x, [N6 x] = eval1n 5 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_6. - rewrite digits_w1n4. - generalize (spec_eval1n4); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval1n, nmake_op1. - rewrite (znz_nmake_op _ w1_op 4); auto. - Qed. - Theorem digits_w1n6: znz_digits w7_op = znz_digits (nmake_op _ w1_op 6). - apply trans_equal with (xO (znz_digits w6_op)). - auto. - rewrite digits_nmake. - rewrite digits_w1n5. - auto. - Qed. - - Let spec_eval1n6: forall x, [Nn 0 x] = eval1n 6 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_7. - rewrite digits_w1n5. - generalize (spec_eval1n5); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval1n, nmake_op1. - rewrite (znz_nmake_op _ w1_op 5); auto. - Qed. - - Let spec_eval1n7: forall x, [Nn 1 x] = eval1n 7 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_8. - rewrite digits_w1n6. - generalize (spec_eval1n6); unfold to_Z; change (make_op 0) with (w7_op); intros HH; repeat rewrite HH. - unfold eval1n, nmake_op1. - rewrite (znz_nmake_op _ w1_op 6); auto. - Qed. - - Theorem digits_w2n0: znz_digits w2_op = znz_digits (nmake_op _ w2_op 0). - apply trans_equal with (xO (znz_digits w1_op)). - auto. - unfold nmake_op; auto. - Qed. - - Let spec_eval2n0: forall x, [N2 x] = eval2n 0 x. - intros x; rewrite spec_gen_eval2n; unfold GenBase.gen_to_Z, to_Z; auto. - Qed. - Let spec_extend2n3: forall x, [N2 x] = [N3 (extend2 0 x)]. - intros x; change (extend2 0 x) with (WW (znz_0 w2_op) x). - unfold to_Z; rewrite znz_to_Z_3. - rewrite (spec_0 w2_spec); auto. - Qed. - - Theorem digits_w2n1: znz_digits w3_op = znz_digits (nmake_op _ w2_op 1). - apply trans_equal with (xO (znz_digits w2_op)). - auto. - rewrite digits_nmake. - rewrite digits_w2n0. - auto. - Qed. - - Let spec_eval2n1: forall x, [N3 x] = eval2n 1 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_3. - rewrite digits_w2n0. - generalize (spec_eval2n0); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval2n, nmake_op2. - rewrite (znz_nmake_op _ w2_op 0); auto. - Qed. - Let spec_extend2n4: forall x, [N2 x] = [N4 (extend2 1 x)]. - intros x; change (extend2 1 x) with (WW (znz_0 w3_op) (extend2 0 x)). - unfold to_Z; rewrite znz_to_Z_4. - rewrite (spec_0 w3_spec). - generalize (spec_extend2n3 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w2n2: znz_digits w4_op = znz_digits (nmake_op _ w2_op 2). - apply trans_equal with (xO (znz_digits w3_op)). - auto. - rewrite digits_nmake. - rewrite digits_w2n1. - auto. - Qed. - - Let spec_eval2n2: forall x, [N4 x] = eval2n 2 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_4. - rewrite digits_w2n1. - generalize (spec_eval2n1); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval2n, nmake_op2. - rewrite (znz_nmake_op _ w2_op 1); auto. - Qed. - Let spec_extend2n5: forall x, [N2 x] = [N5 (extend2 2 x)]. - intros x; change (extend2 2 x) with (WW (znz_0 w4_op) (extend2 1 x)). - unfold to_Z; rewrite znz_to_Z_5. - rewrite (spec_0 w4_spec). - generalize (spec_extend2n4 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w2n3: znz_digits w5_op = znz_digits (nmake_op _ w2_op 3). - apply trans_equal with (xO (znz_digits w4_op)). - auto. - rewrite digits_nmake. - rewrite digits_w2n2. - auto. - Qed. - - Let spec_eval2n3: forall x, [N5 x] = eval2n 3 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_5. - rewrite digits_w2n2. - generalize (spec_eval2n2); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval2n, nmake_op2. - rewrite (znz_nmake_op _ w2_op 2); auto. - Qed. - Let spec_extend2n6: forall x, [N2 x] = [N6 (extend2 3 x)]. - intros x; change (extend2 3 x) with (WW (znz_0 w5_op) (extend2 2 x)). - unfold to_Z; rewrite znz_to_Z_6. - rewrite (spec_0 w5_spec). - generalize (spec_extend2n5 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w2n4: znz_digits w6_op = znz_digits (nmake_op _ w2_op 4). - apply trans_equal with (xO (znz_digits w5_op)). - auto. - rewrite digits_nmake. - rewrite digits_w2n3. - auto. - Qed. - - Let spec_eval2n4: forall x, [N6 x] = eval2n 4 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_6. - rewrite digits_w2n3. - generalize (spec_eval2n3); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval2n, nmake_op2. - rewrite (znz_nmake_op _ w2_op 3); auto. - Qed. - Theorem digits_w2n5: znz_digits w7_op = znz_digits (nmake_op _ w2_op 5). - apply trans_equal with (xO (znz_digits w6_op)). - auto. - rewrite digits_nmake. - rewrite digits_w2n4. - auto. - Qed. - - Let spec_eval2n5: forall x, [Nn 0 x] = eval2n 5 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_7. - rewrite digits_w2n4. - generalize (spec_eval2n4); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval2n, nmake_op2. - rewrite (znz_nmake_op _ w2_op 4); auto. - Qed. - - Let spec_eval2n6: forall x, [Nn 1 x] = eval2n 6 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_8. - rewrite digits_w2n5. - generalize (spec_eval2n5); unfold to_Z; change (make_op 0) with (w7_op); intros HH; repeat rewrite HH. - unfold eval2n, nmake_op2. - rewrite (znz_nmake_op _ w2_op 5); auto. - Qed. - - Theorem digits_w3n0: znz_digits w3_op = znz_digits (nmake_op _ w3_op 0). - apply trans_equal with (xO (znz_digits w2_op)). - auto. - unfold nmake_op; auto. - Qed. - - Let spec_eval3n0: forall x, [N3 x] = eval3n 0 x. - intros x; rewrite spec_gen_eval3n; unfold GenBase.gen_to_Z, to_Z; auto. - Qed. - Let spec_extend3n4: forall x, [N3 x] = [N4 (extend3 0 x)]. - intros x; change (extend3 0 x) with (WW (znz_0 w3_op) x). - unfold to_Z; rewrite znz_to_Z_4. - rewrite (spec_0 w3_spec); auto. - Qed. - - Theorem digits_w3n1: znz_digits w4_op = znz_digits (nmake_op _ w3_op 1). - apply trans_equal with (xO (znz_digits w3_op)). - auto. - rewrite digits_nmake. - rewrite digits_w3n0. - auto. - Qed. - - Let spec_eval3n1: forall x, [N4 x] = eval3n 1 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_4. - rewrite digits_w3n0. - generalize (spec_eval3n0); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval3n, nmake_op3. - rewrite (znz_nmake_op _ w3_op 0); auto. - Qed. - Let spec_extend3n5: forall x, [N3 x] = [N5 (extend3 1 x)]. - intros x; change (extend3 1 x) with (WW (znz_0 w4_op) (extend3 0 x)). - unfold to_Z; rewrite znz_to_Z_5. - rewrite (spec_0 w4_spec). - generalize (spec_extend3n4 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w3n2: znz_digits w5_op = znz_digits (nmake_op _ w3_op 2). - apply trans_equal with (xO (znz_digits w4_op)). - auto. - rewrite digits_nmake. - rewrite digits_w3n1. - auto. - Qed. - - Let spec_eval3n2: forall x, [N5 x] = eval3n 2 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_5. - rewrite digits_w3n1. - generalize (spec_eval3n1); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval3n, nmake_op3. - rewrite (znz_nmake_op _ w3_op 1); auto. - Qed. - Let spec_extend3n6: forall x, [N3 x] = [N6 (extend3 2 x)]. - intros x; change (extend3 2 x) with (WW (znz_0 w5_op) (extend3 1 x)). - unfold to_Z; rewrite znz_to_Z_6. - rewrite (spec_0 w5_spec). - generalize (spec_extend3n5 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w3n3: znz_digits w6_op = znz_digits (nmake_op _ w3_op 3). - apply trans_equal with (xO (znz_digits w5_op)). - auto. - rewrite digits_nmake. - rewrite digits_w3n2. - auto. - Qed. - - Let spec_eval3n3: forall x, [N6 x] = eval3n 3 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_6. - rewrite digits_w3n2. - generalize (spec_eval3n2); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval3n, nmake_op3. - rewrite (znz_nmake_op _ w3_op 2); auto. - Qed. - Theorem digits_w3n4: znz_digits w7_op = znz_digits (nmake_op _ w3_op 4). - apply trans_equal with (xO (znz_digits w6_op)). - auto. - rewrite digits_nmake. - rewrite digits_w3n3. - auto. - Qed. - - Let spec_eval3n4: forall x, [Nn 0 x] = eval3n 4 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_7. - rewrite digits_w3n3. - generalize (spec_eval3n3); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval3n, nmake_op3. - rewrite (znz_nmake_op _ w3_op 3); auto. - Qed. - - Let spec_eval3n5: forall x, [Nn 1 x] = eval3n 5 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_8. - rewrite digits_w3n4. - generalize (spec_eval3n4); unfold to_Z; change (make_op 0) with (w7_op); intros HH; repeat rewrite HH. - unfold eval3n, nmake_op3. - rewrite (znz_nmake_op _ w3_op 4); auto. - Qed. - - Theorem digits_w4n0: znz_digits w4_op = znz_digits (nmake_op _ w4_op 0). - apply trans_equal with (xO (znz_digits w3_op)). - auto. - unfold nmake_op; auto. - Qed. - - Let spec_eval4n0: forall x, [N4 x] = eval4n 0 x. - intros x; rewrite spec_gen_eval4n; unfold GenBase.gen_to_Z, to_Z; auto. - Qed. - Let spec_extend4n5: forall x, [N4 x] = [N5 (extend4 0 x)]. - intros x; change (extend4 0 x) with (WW (znz_0 w4_op) x). - unfold to_Z; rewrite znz_to_Z_5. - rewrite (spec_0 w4_spec); auto. - Qed. - - Theorem digits_w4n1: znz_digits w5_op = znz_digits (nmake_op _ w4_op 1). - apply trans_equal with (xO (znz_digits w4_op)). - auto. - rewrite digits_nmake. - rewrite digits_w4n0. - auto. - Qed. - - Let spec_eval4n1: forall x, [N5 x] = eval4n 1 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_5. - rewrite digits_w4n0. - generalize (spec_eval4n0); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval4n, nmake_op4. - rewrite (znz_nmake_op _ w4_op 0); auto. - Qed. - Let spec_extend4n6: forall x, [N4 x] = [N6 (extend4 1 x)]. - intros x; change (extend4 1 x) with (WW (znz_0 w5_op) (extend4 0 x)). - unfold to_Z; rewrite znz_to_Z_6. - rewrite (spec_0 w5_spec). - generalize (spec_extend4n5 x); unfold to_Z. - intros HH; rewrite <- HH; auto. - Qed. - - Theorem digits_w4n2: znz_digits w6_op = znz_digits (nmake_op _ w4_op 2). - apply trans_equal with (xO (znz_digits w5_op)). - auto. - rewrite digits_nmake. - rewrite digits_w4n1. - auto. - Qed. - - Let spec_eval4n2: forall x, [N6 x] = eval4n 2 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_6. - rewrite digits_w4n1. - generalize (spec_eval4n1); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval4n, nmake_op4. - rewrite (znz_nmake_op _ w4_op 1); auto. - Qed. - Theorem digits_w4n3: znz_digits w7_op = znz_digits (nmake_op _ w4_op 3). - apply trans_equal with (xO (znz_digits w6_op)). - auto. - rewrite digits_nmake. - rewrite digits_w4n2. - auto. - Qed. - - Let spec_eval4n3: forall x, [Nn 0 x] = eval4n 3 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_7. - rewrite digits_w4n2. - generalize (spec_eval4n2); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval4n, nmake_op4. - rewrite (znz_nmake_op _ w4_op 2); auto. - Qed. - - Let spec_eval4n4: forall x, [Nn 1 x] = eval4n 4 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_8. - rewrite digits_w4n3. - generalize (spec_eval4n3); unfold to_Z; change (make_op 0) with (w7_op); intros HH; repeat rewrite HH. - unfold eval4n, nmake_op4. - rewrite (znz_nmake_op _ w4_op 3); auto. - Qed. - - Theorem digits_w5n0: znz_digits w5_op = znz_digits (nmake_op _ w5_op 0). - apply trans_equal with (xO (znz_digits w4_op)). - auto. - unfold nmake_op; auto. - Qed. - - Let spec_eval5n0: forall x, [N5 x] = eval5n 0 x. - intros x; rewrite spec_gen_eval5n; unfold GenBase.gen_to_Z, to_Z; auto. - Qed. - Let spec_extend5n6: forall x, [N5 x] = [N6 (extend5 0 x)]. - intros x; change (extend5 0 x) with (WW (znz_0 w5_op) x). - unfold to_Z; rewrite znz_to_Z_6. - rewrite (spec_0 w5_spec); auto. - Qed. - - Theorem digits_w5n1: znz_digits w6_op = znz_digits (nmake_op _ w5_op 1). - apply trans_equal with (xO (znz_digits w5_op)). - auto. - rewrite digits_nmake. - rewrite digits_w5n0. - auto. - Qed. - - Let spec_eval5n1: forall x, [N6 x] = eval5n 1 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_6. - rewrite digits_w5n0. - generalize (spec_eval5n0); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval5n, nmake_op5. - rewrite (znz_nmake_op _ w5_op 0); auto. - Qed. - Theorem digits_w5n2: znz_digits w7_op = znz_digits (nmake_op _ w5_op 2). - apply trans_equal with (xO (znz_digits w6_op)). - auto. - rewrite digits_nmake. - rewrite digits_w5n1. - auto. - Qed. - - Let spec_eval5n2: forall x, [Nn 0 x] = eval5n 2 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_7. - rewrite digits_w5n1. - generalize (spec_eval5n1); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval5n, nmake_op5. - rewrite (znz_nmake_op _ w5_op 1); auto. - Qed. - - Let spec_eval5n3: forall x, [Nn 1 x] = eval5n 3 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_8. - rewrite digits_w5n2. - generalize (spec_eval5n2); unfold to_Z; change (make_op 0) with (w7_op); intros HH; repeat rewrite HH. - unfold eval5n, nmake_op5. - rewrite (znz_nmake_op _ w5_op 2); auto. - Qed. - - Theorem digits_w6n0: znz_digits w6_op = znz_digits (nmake_op _ w6_op 0). - apply trans_equal with (xO (znz_digits w5_op)). - auto. - unfold nmake_op; auto. - Qed. - - Let spec_eval6n0: forall x, [N6 x] = eval6n 0 x. - intros x; rewrite spec_gen_eval6n; unfold GenBase.gen_to_Z, to_Z; auto. - Qed. - Theorem digits_w6n1: znz_digits w7_op = znz_digits (nmake_op _ w6_op 1). - apply trans_equal with (xO (znz_digits w6_op)). - auto. - rewrite digits_nmake. - rewrite digits_w6n0. - auto. - Qed. - - Let spec_eval6n1: forall x, [Nn 0 x] = eval6n 1 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_7. - rewrite digits_w6n0. - generalize (spec_eval6n0); unfold to_Z; intros HH; repeat rewrite HH. - unfold eval6n, nmake_op6. - rewrite (znz_nmake_op _ w6_op 0); auto. - Qed. - - Let spec_eval6n2: forall x, [Nn 1 x] = eval6n 2 x. - intros x; case x. - auto. - intros xh xl; unfold to_Z; rewrite znz_to_Z_8. - rewrite digits_w6n1. - generalize (spec_eval6n1); unfold to_Z; change (make_op 0) with (w7_op); intros HH; repeat rewrite HH. - unfold eval6n, nmake_op6. - rewrite (znz_nmake_op _ w6_op 1); auto. - Qed. - - Let digits_w6n: forall n, - znz_digits (make_op n) = znz_digits (nmake_op _ w6_op (S n)). - intros n; elim n; clear n. - change (znz_digits (make_op 0)) with (xO (znz_digits w6_op)). - rewrite nmake_op_S; apply sym_equal; auto. - intros n Hrec. - replace (znz_digits (make_op (S n))) with (xO (znz_digits (make_op n))). - rewrite Hrec. - rewrite nmake_op_S; apply sym_equal; auto. - rewrite make_op_S; apply sym_equal; auto. - Qed. - - Let spec_eval6n: forall n x, [Nn n x] = eval6n (S n) x. - intros n; elim n; clear n. - exact spec_eval6n1. - intros n Hrec x; case x; clear x. - unfold to_Z, eval6n, nmake_op6. - rewrite make_op_S; rewrite nmake_op_S; auto. - intros xh xl. - unfold to_Z in Hrec |- *. - rewrite znz_to_Z_n. - rewrite digits_w6n. - repeat rewrite Hrec. - unfold eval6n, nmake_op6. - apply sym_equal; rewrite nmake_op_S; auto. - Qed. - - Let spec_extend6n: forall n x, [N6 x] = [Nn n (extend6 n x)]. - intros n; elim n; clear n. - intros x; change (extend6 0 x) with (WW (znz_0 w6_op) x). - unfold to_Z. - change (make_op 0) with w7_op. - rewrite znz_to_Z_7; rewrite (spec_0 w6_spec); auto. - intros n Hrec x. - change (extend6 (S n) x) with (WW W0 (extend6 n x)). - unfold to_Z in Hrec |- *; rewrite znz_to_Z_n; auto. - rewrite <- Hrec. - replace (znz_to_Z (make_op n) W0) with 0; auto. - case n; auto; intros; rewrite make_op_S; auto. - Qed. - - Theorem spec_pos: forall x, 0 <= [x]. - Proof. - intros x; case x; clear x. - intros x; case (spec_to_Z w0_spec x); auto. - intros x; case (spec_to_Z w1_spec x); auto. - intros x; case (spec_to_Z w2_spec x); auto. - intros x; case (spec_to_Z w3_spec x); auto. - intros x; case (spec_to_Z w4_spec x); auto. - intros x; case (spec_to_Z w5_spec x); auto. - intros x; case (spec_to_Z w6_spec x); auto. - intros n x; case (spec_to_Z (wn_spec n) x); auto. - Qed. - - Let spec_extendn_0: forall n wx, [Nn n (extend n _ wx)] = [Nn 0 wx]. - intros n; elim n; auto. - intros n1 Hrec wx; simpl extend; rewrite <- Hrec; auto. - unfold to_Z. - case n1; auto; intros n2; repeat rewrite make_op_S; auto. - Qed. - Hint Rewrite spec_extendn_0: extr. - - Let spec_extendn0_0: forall n wx, [Nn (S n) (WW W0 wx)] = [Nn n wx]. - Proof. - intros n x; unfold to_Z. - rewrite znz_to_Z_n. - rewrite <- (Zplus_0_l (znz_to_Z (make_op n) x)). - apply (f_equal2 Zplus); auto. - case n; auto. - intros n1; rewrite make_op_S; auto. - Qed. - Hint Rewrite spec_extendn_0: extr. - - Let spec_extend_tr: forall m n (w: word _ (S n)), - [Nn (m + n) (extend_tr w m)] = [Nn n w]. - Proof. - induction m; auto. - intros n x; simpl extend_tr. - simpl plus; rewrite spec_extendn0_0; auto. - Qed. - Hint Rewrite spec_extend_tr: extr. - - Let spec_cast_l: forall n m x1, - [Nn (Max.max n m) - (castm (diff_r n m) (extend_tr x1 (snd (diff n m))))] = - [Nn n x1]. - Proof. - intros n m x1; case (diff_r n m); simpl castm. - rewrite spec_extend_tr; auto. - Qed. - Hint Rewrite spec_cast_l: extr. - - Let spec_cast_r: forall n m x1, - [Nn (Max.max n m) - (castm (diff_l n m) (extend_tr x1 (fst (diff n m))))] = - [Nn m x1]. - Proof. - intros n m x1; case (diff_l n m); simpl castm. - rewrite spec_extend_tr; auto. - Qed. - Hint Rewrite spec_cast_r: extr. - - Section LevelAndIter. - - Variable res: Set. - Variable xxx: res. - Variable P: Z -> Z -> res -> Prop. - (* Abstraction function for each level *) - Variable f0: w0 -> w0 -> res. - Variable f0n: forall n, w0 -> word w0 (S n) -> res. - Variable fn0: forall n, word w0 (S n) -> w0 -> res. - Variable Pf0: forall x y, P [N0 x] [N0 y] (f0 x y). - Variable Pf0n: forall n x y, Z_of_nat n <= 6 -> P [N0 x] (eval0n (S n) y) (f0n n x y). - Variable Pfn0: forall n x y, Z_of_nat n <= 6 -> P (eval0n (S n) x) [N0 y] (fn0 n x y). - - Variable f1: w1 -> w1 -> res. - Variable f1n: forall n, w1 -> word w1 (S n) -> res. - Variable fn1: forall n, word w1 (S n) -> w1 -> res. - Variable Pf1: forall x y, P [N1 x] [N1 y] (f1 x y). - Variable Pf1n: forall n x y, Z_of_nat n <= 5 -> P [N1 x] (eval1n (S n) y) (f1n n x y). - Variable Pfn1: forall n x y, Z_of_nat n <= 5 -> P (eval1n (S n) x) [N1 y] (fn1 n x y). - - Variable f2: w2 -> w2 -> res. - Variable f2n: forall n, w2 -> word w2 (S n) -> res. - Variable fn2: forall n, word w2 (S n) -> w2 -> res. - Variable Pf2: forall x y, P [N2 x] [N2 y] (f2 x y). - Variable Pf2n: forall n x y, Z_of_nat n <= 4 -> P [N2 x] (eval2n (S n) y) (f2n n x y). - Variable Pfn2: forall n x y, Z_of_nat n <= 4 -> P (eval2n (S n) x) [N2 y] (fn2 n x y). - - Variable f3: w3 -> w3 -> res. - Variable f3n: forall n, w3 -> word w3 (S n) -> res. - Variable fn3: forall n, word w3 (S n) -> w3 -> res. - Variable Pf3: forall x y, P [N3 x] [N3 y] (f3 x y). - Variable Pf3n: forall n x y, Z_of_nat n <= 3 -> P [N3 x] (eval3n (S n) y) (f3n n x y). - Variable Pfn3: forall n x y, Z_of_nat n <= 3 -> P (eval3n (S n) x) [N3 y] (fn3 n x y). - - Variable f4: w4 -> w4 -> res. - Variable f4n: forall n, w4 -> word w4 (S n) -> res. - Variable fn4: forall n, word w4 (S n) -> w4 -> res. - Variable Pf4: forall x y, P [N4 x] [N4 y] (f4 x y). - Variable Pf4n: forall n x y, Z_of_nat n <= 2 -> P [N4 x] (eval4n (S n) y) (f4n n x y). - Variable Pfn4: forall n x y, Z_of_nat n <= 2 -> P (eval4n (S n) x) [N4 y] (fn4 n x y). - - Variable f5: w5 -> w5 -> res. - Variable f5n: forall n, w5 -> word w5 (S n) -> res. - Variable fn5: forall n, word w5 (S n) -> w5 -> res. - Variable Pf5: forall x y, P [N5 x] [N5 y] (f5 x y). - Variable Pf5n: forall n x y, Z_of_nat n <= 1 -> P [N5 x] (eval5n (S n) y) (f5n n x y). - Variable Pfn5: forall n x y, Z_of_nat n <= 1 -> P (eval5n (S n) x) [N5 y] (fn5 n x y). - - Variable f6: w6 -> w6 -> res. - Variable f6n: forall n, w6 -> word w6 (S n) -> res. - Variable fn6: forall n, word w6 (S n) -> w6 -> res. - Variable Pf6: forall x y, P [N6 x] [N6 y] (f6 x y). - Variable Pf6n: forall n x y, P [N6 x] (eval6n (S n) y) (f6n n x y). - Variable Pfn6: forall n x y, P (eval6n (S n) x) [N6 y] (fn6 n x y). - - Variable fnn: forall n, word w6 (S n) -> word w6 (S n) -> res. - Variable Pfnn: forall n x y, P [Nn n x] [Nn n y] (fnn n x y). - Variable fnm: forall n m, word w6 (S n) -> word w6 (S m) -> res. - Variable Pfnm: forall n m x y, P [Nn n x] [Nn m y] (fnm n m x y). - - (* Special zero functions *) - Variable f0t: t_ -> res. - Variable Pf0t: forall x, P 0 [x] (f0t x). - Variable ft0: t_ -> res. - Variable Pft0: forall x, P [x] 0 (ft0 x). - - (* We level the two arguments before applying *) - (* the functions at each leval *) - Definition same_level (x y: t_): res := - Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 - GenBase.extend GenBase.extend_aux - ] in - match x, y with - | N0 wx, N0 wy => f0 wx wy - | N0 wx, N1 wy => f1 (extend0 0 wx) wy - | N0 wx, N2 wy => f2 (extend0 1 wx) wy - | N0 wx, N3 wy => f3 (extend0 2 wx) wy - | N0 wx, N4 wy => f4 (extend0 3 wx) wy - | N0 wx, N5 wy => f5 (extend0 4 wx) wy - | N0 wx, N6 wy => f6 (extend0 5 wx) wy - | N0 wx, Nn m wy => fnn m (extend6 m (extend0 5 wx)) wy - | N1 wx, N0 wy => f1 wx (extend0 0 wy) - | N1 wx, N1 wy => f1 wx wy - | N1 wx, N2 wy => f2 (extend1 0 wx) wy - | N1 wx, N3 wy => f3 (extend1 1 wx) wy - | N1 wx, N4 wy => f4 (extend1 2 wx) wy - | N1 wx, N5 wy => f5 (extend1 3 wx) wy - | N1 wx, N6 wy => f6 (extend1 4 wx) wy - | N1 wx, Nn m wy => fnn m (extend6 m (extend1 4 wx)) wy - | N2 wx, N0 wy => f2 wx (extend0 1 wy) - | N2 wx, N1 wy => f2 wx (extend1 0 wy) - | N2 wx, N2 wy => f2 wx wy - | N2 wx, N3 wy => f3 (extend2 0 wx) wy - | N2 wx, N4 wy => f4 (extend2 1 wx) wy - | N2 wx, N5 wy => f5 (extend2 2 wx) wy - | N2 wx, N6 wy => f6 (extend2 3 wx) wy - | N2 wx, Nn m wy => fnn m (extend6 m (extend2 3 wx)) wy - | N3 wx, N0 wy => f3 wx (extend0 2 wy) - | N3 wx, N1 wy => f3 wx (extend1 1 wy) - | N3 wx, N2 wy => f3 wx (extend2 0 wy) - | N3 wx, N3 wy => f3 wx wy - | N3 wx, N4 wy => f4 (extend3 0 wx) wy - | N3 wx, N5 wy => f5 (extend3 1 wx) wy - | N3 wx, N6 wy => f6 (extend3 2 wx) wy - | N3 wx, Nn m wy => fnn m (extend6 m (extend3 2 wx)) wy - | N4 wx, N0 wy => f4 wx (extend0 3 wy) - | N4 wx, N1 wy => f4 wx (extend1 2 wy) - | N4 wx, N2 wy => f4 wx (extend2 1 wy) - | N4 wx, N3 wy => f4 wx (extend3 0 wy) - | N4 wx, N4 wy => f4 wx wy - | N4 wx, N5 wy => f5 (extend4 0 wx) wy - | N4 wx, N6 wy => f6 (extend4 1 wx) wy - | N4 wx, Nn m wy => fnn m (extend6 m (extend4 1 wx)) wy - | N5 wx, N0 wy => f5 wx (extend0 4 wy) - | N5 wx, N1 wy => f5 wx (extend1 3 wy) - | N5 wx, N2 wy => f5 wx (extend2 2 wy) - | N5 wx, N3 wy => f5 wx (extend3 1 wy) - | N5 wx, N4 wy => f5 wx (extend4 0 wy) - | N5 wx, N5 wy => f5 wx wy - | N5 wx, N6 wy => f6 (extend5 0 wx) wy - | N5 wx, Nn m wy => fnn m (extend6 m (extend5 0 wx)) wy - | N6 wx, N0 wy => f6 wx (extend0 5 wy) - | N6 wx, N1 wy => f6 wx (extend1 4 wy) - | N6 wx, N2 wy => f6 wx (extend2 3 wy) - | N6 wx, N3 wy => f6 wx (extend3 2 wy) - | N6 wx, N4 wy => f6 wx (extend4 1 wy) - | N6 wx, N5 wy => f6 wx (extend5 0 wy) - | N6 wx, N6 wy => f6 wx wy - | N6 wx, Nn m wy => fnn m (extend6 m wx) wy - | Nn n wx, N0 wy => fnn n wx (extend6 n (extend0 5 wy)) - | Nn n wx, N1 wy => fnn n wx (extend6 n (extend1 4 wy)) - | Nn n wx, N2 wy => fnn n wx (extend6 n (extend2 3 wy)) - | Nn n wx, N3 wy => fnn n wx (extend6 n (extend3 2 wy)) - | Nn n wx, N4 wy => fnn n wx (extend6 n (extend4 1 wy)) - | Nn n wx, N5 wy => fnn n wx (extend6 n (extend5 0 wy)) - | Nn n wx, N6 wy => fnn n wx (extend6 n wy) - | Nn n wx, Nn m wy => - let mn := Max.max n m in - let d := diff n m in - fnn mn - (castm (diff_r n m) (extend_tr wx (snd d))) - (castm (diff_l n m) (extend_tr wy (fst d))) - end. - - Lemma spec_same_level: forall x y, P [x] [y] (same_level x y). - Proof. - intros x; case x; clear x; unfold same_level. - intros x y; case y; clear y. - intros y; apply Pf0. - intros y; rewrite spec_extend0n1; apply Pf1. - intros y; rewrite spec_extend0n2; apply Pf2. - intros y; rewrite spec_extend0n3; apply Pf3. - intros y; rewrite spec_extend0n4; apply Pf4. - intros y; rewrite spec_extend0n5; apply Pf5. - intros y; rewrite spec_extend0n6; apply Pf6. - intros m y; rewrite spec_extend0n6; rewrite (spec_extend6n m); apply Pfnn. - intros x y; case y; clear y. - intros y; rewrite spec_extend0n1; apply Pf1. - intros y; apply Pf1. - intros y; rewrite spec_extend1n2; apply Pf2. - intros y; rewrite spec_extend1n3; apply Pf3. - intros y; rewrite spec_extend1n4; apply Pf4. - intros y; rewrite spec_extend1n5; apply Pf5. - intros y; rewrite spec_extend1n6; apply Pf6. - intros m y; rewrite spec_extend1n6; rewrite (spec_extend6n m); apply Pfnn. - intros x y; case y; clear y. - intros y; rewrite spec_extend0n2; apply Pf2. - intros y; rewrite spec_extend1n2; apply Pf2. - intros y; apply Pf2. - intros y; rewrite spec_extend2n3; apply Pf3. - intros y; rewrite spec_extend2n4; apply Pf4. - intros y; rewrite spec_extend2n5; apply Pf5. - intros y; rewrite spec_extend2n6; apply Pf6. - intros m y; rewrite spec_extend2n6; rewrite (spec_extend6n m); apply Pfnn. - intros x y; case y; clear y. - intros y; rewrite spec_extend0n3; apply Pf3. - intros y; rewrite spec_extend1n3; apply Pf3. - intros y; rewrite spec_extend2n3; apply Pf3. - intros y; apply Pf3. - intros y; rewrite spec_extend3n4; apply Pf4. - intros y; rewrite spec_extend3n5; apply Pf5. - intros y; rewrite spec_extend3n6; apply Pf6. - intros m y; rewrite spec_extend3n6; rewrite (spec_extend6n m); apply Pfnn. - intros x y; case y; clear y. - intros y; rewrite spec_extend0n4; apply Pf4. - intros y; rewrite spec_extend1n4; apply Pf4. - intros y; rewrite spec_extend2n4; apply Pf4. - intros y; rewrite spec_extend3n4; apply Pf4. - intros y; apply Pf4. - intros y; rewrite spec_extend4n5; apply Pf5. - intros y; rewrite spec_extend4n6; apply Pf6. - intros m y; rewrite spec_extend4n6; rewrite (spec_extend6n m); apply Pfnn. - intros x y; case y; clear y. - intros y; rewrite spec_extend0n5; apply Pf5. - intros y; rewrite spec_extend1n5; apply Pf5. - intros y; rewrite spec_extend2n5; apply Pf5. - intros y; rewrite spec_extend3n5; apply Pf5. - intros y; rewrite spec_extend4n5; apply Pf5. - intros y; apply Pf5. - intros y; rewrite spec_extend5n6; apply Pf6. - intros m y; rewrite spec_extend5n6; rewrite (spec_extend6n m); apply Pfnn. - intros x y; case y; clear y. - intros y; rewrite spec_extend0n6; apply Pf6. - intros y; rewrite spec_extend1n6; apply Pf6. - intros y; rewrite spec_extend2n6; apply Pf6. - intros y; rewrite spec_extend3n6; apply Pf6. - intros y; rewrite spec_extend4n6; apply Pf6. - intros y; rewrite spec_extend5n6; apply Pf6. - intros y; apply Pf6. - intros m y; rewrite (spec_extend6n m); apply Pfnn. - intros n x y; case y; clear y. - intros y; rewrite spec_extend0n6; rewrite (spec_extend6n n); apply Pfnn. - intros y; rewrite spec_extend1n6; rewrite (spec_extend6n n); apply Pfnn. - intros y; rewrite spec_extend2n6; rewrite (spec_extend6n n); apply Pfnn. - intros y; rewrite spec_extend3n6; rewrite (spec_extend6n n); apply Pfnn. - intros y; rewrite spec_extend4n6; rewrite (spec_extend6n n); apply Pfnn. - intros y; rewrite spec_extend5n6; rewrite (spec_extend6n n); apply Pfnn. - intros y; rewrite (spec_extend6n n); apply Pfnn. - intros m y; rewrite <- (spec_cast_l n m x); - rewrite <- (spec_cast_r n m y); apply Pfnn. - Qed. - - (* We level the two arguments before applying *) - (* the functions at each level (special zero case) *) - Definition same_level0 (x y: t_): res := - Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 - GenBase.extend GenBase.extend_aux - ] in - match x with - | N0 wx => - if w0_eq0 wx then f0t y else - match y with - | N0 wy => f0 wx wy - | N1 wy => f1 (extend0 0 wx) wy - | N2 wy => f2 (extend0 1 wx) wy - | N3 wy => f3 (extend0 2 wx) wy - | N4 wy => f4 (extend0 3 wx) wy - | N5 wy => f5 (extend0 4 wx) wy - | N6 wy => f6 (extend0 5 wx) wy - | Nn m wy => fnn m (extend6 m (extend0 5 wx)) wy - end - | N1 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f1 wx (extend0 0 wy) - | N1 wy => f1 wx wy - | N2 wy => f2 (extend1 0 wx) wy - | N3 wy => f3 (extend1 1 wx) wy - | N4 wy => f4 (extend1 2 wx) wy - | N5 wy => f5 (extend1 3 wx) wy - | N6 wy => f6 (extend1 4 wx) wy - | Nn m wy => fnn m (extend6 m (extend1 4 wx)) wy - end - | N2 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f2 wx (extend0 1 wy) - | N1 wy => - f2 wx (extend1 0 wy) - | N2 wy => f2 wx wy - | N3 wy => f3 (extend2 0 wx) wy - | N4 wy => f4 (extend2 1 wx) wy - | N5 wy => f5 (extend2 2 wx) wy - | N6 wy => f6 (extend2 3 wx) wy - | Nn m wy => fnn m (extend6 m (extend2 3 wx)) wy - end - | N3 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f3 wx (extend0 2 wy) - | N1 wy => - f3 wx (extend1 1 wy) - | N2 wy => - f3 wx (extend2 0 wy) - | N3 wy => f3 wx wy - | N4 wy => f4 (extend3 0 wx) wy - | N5 wy => f5 (extend3 1 wx) wy - | N6 wy => f6 (extend3 2 wx) wy - | Nn m wy => fnn m (extend6 m (extend3 2 wx)) wy - end - | N4 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f4 wx (extend0 3 wy) - | N1 wy => - f4 wx (extend1 2 wy) - | N2 wy => - f4 wx (extend2 1 wy) - | N3 wy => - f4 wx (extend3 0 wy) - | N4 wy => f4 wx wy - | N5 wy => f5 (extend4 0 wx) wy - | N6 wy => f6 (extend4 1 wx) wy - | Nn m wy => fnn m (extend6 m (extend4 1 wx)) wy - end - | N5 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f5 wx (extend0 4 wy) - | N1 wy => - f5 wx (extend1 3 wy) - | N2 wy => - f5 wx (extend2 2 wy) - | N3 wy => - f5 wx (extend3 1 wy) - | N4 wy => - f5 wx (extend4 0 wy) - | N5 wy => f5 wx wy - | N6 wy => f6 (extend5 0 wx) wy - | Nn m wy => fnn m (extend6 m (extend5 0 wx)) wy - end - | N6 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f6 wx (extend0 5 wy) - | N1 wy => - f6 wx (extend1 4 wy) - | N2 wy => - f6 wx (extend2 3 wy) - | N3 wy => - f6 wx (extend3 2 wy) - | N4 wy => - f6 wx (extend4 1 wy) - | N5 wy => - f6 wx (extend5 0 wy) - | N6 wy => f6 wx wy - | Nn m wy => fnn m (extend6 m wx) wy - end - | Nn n wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fnn n wx (extend6 n (extend0 5 wy)) - | N1 wy => - fnn n wx (extend6 n (extend1 4 wy)) - | N2 wy => - fnn n wx (extend6 n (extend2 3 wy)) - | N3 wy => - fnn n wx (extend6 n (extend3 2 wy)) - | N4 wy => - fnn n wx (extend6 n (extend4 1 wy)) - | N5 wy => - fnn n wx (extend6 n (extend5 0 wy)) - | N6 wy => - fnn n wx (extend6 n wy) - | Nn m wy => - let mn := Max.max n m in - let d := diff n m in - fnn mn - (castm (diff_r n m) (extend_tr wx (snd d))) - (castm (diff_l n m) (extend_tr wy (fst d))) - end - end. - - Lemma spec_same_level0: forall x y, P [x] [y] (same_level0 x y). - Proof. - intros x; case x; clear x; unfold same_level0. - intros x. - generalize (spec_w0_eq0 x); case w0_eq0; intros H. - intros y; rewrite H; apply Pf0t. - clear H. - intros y; case y; clear y. - intros y; apply Pf0. - intros y; rewrite spec_extend0n1; apply Pf1. - intros y; rewrite spec_extend0n2; apply Pf2. - intros y; rewrite spec_extend0n3; apply Pf3. - intros y; rewrite spec_extend0n4; apply Pf4. - intros y; rewrite spec_extend0n5; apply Pf5. - intros y; rewrite spec_extend0n6; apply Pf6. - intros m y; rewrite spec_extend0n6; rewrite (spec_extend6n m); apply Pfnn. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n1; apply Pf1. - intros y; apply Pf1. - intros y; rewrite spec_extend1n2; apply Pf2. - intros y; rewrite spec_extend1n3; apply Pf3. - intros y; rewrite spec_extend1n4; apply Pf4. - intros y; rewrite spec_extend1n5; apply Pf5. - intros y; rewrite spec_extend1n6; apply Pf6. - intros m y; rewrite spec_extend1n6; rewrite (spec_extend6n m); apply Pfnn. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n2; apply Pf2. - intros y. - rewrite spec_extend1n2; apply Pf2. - intros y; apply Pf2. - intros y; rewrite spec_extend2n3; apply Pf3. - intros y; rewrite spec_extend2n4; apply Pf4. - intros y; rewrite spec_extend2n5; apply Pf5. - intros y; rewrite spec_extend2n6; apply Pf6. - intros m y; rewrite spec_extend2n6; rewrite (spec_extend6n m); apply Pfnn. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n3; apply Pf3. - intros y. - rewrite spec_extend1n3; apply Pf3. - intros y. - rewrite spec_extend2n3; apply Pf3. - intros y; apply Pf3. - intros y; rewrite spec_extend3n4; apply Pf4. - intros y; rewrite spec_extend3n5; apply Pf5. - intros y; rewrite spec_extend3n6; apply Pf6. - intros m y; rewrite spec_extend3n6; rewrite (spec_extend6n m); apply Pfnn. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n4; apply Pf4. - intros y. - rewrite spec_extend1n4; apply Pf4. - intros y. - rewrite spec_extend2n4; apply Pf4. - intros y. - rewrite spec_extend3n4; apply Pf4. - intros y; apply Pf4. - intros y; rewrite spec_extend4n5; apply Pf5. - intros y; rewrite spec_extend4n6; apply Pf6. - intros m y; rewrite spec_extend4n6; rewrite (spec_extend6n m); apply Pfnn. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n5; apply Pf5. - intros y. - rewrite spec_extend1n5; apply Pf5. - intros y. - rewrite spec_extend2n5; apply Pf5. - intros y. - rewrite spec_extend3n5; apply Pf5. - intros y. - rewrite spec_extend4n5; apply Pf5. - intros y; apply Pf5. - intros y; rewrite spec_extend5n6; apply Pf6. - intros m y; rewrite spec_extend5n6; rewrite (spec_extend6n m); apply Pfnn. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n6; apply Pf6. - intros y. - rewrite spec_extend1n6; apply Pf6. - intros y. - rewrite spec_extend2n6; apply Pf6. - intros y. - rewrite spec_extend3n6; apply Pf6. - intros y. - rewrite spec_extend4n6; apply Pf6. - intros y. - rewrite spec_extend5n6; apply Pf6. - intros y; apply Pf6. - intros m y; rewrite (spec_extend6n m); apply Pfnn. - intros n x y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n6; rewrite (spec_extend6n n); apply Pfnn. - intros y. - rewrite spec_extend1n6; rewrite (spec_extend6n n); apply Pfnn. - intros y. - rewrite spec_extend2n6; rewrite (spec_extend6n n); apply Pfnn. - intros y. - rewrite spec_extend3n6; rewrite (spec_extend6n n); apply Pfnn. - intros y. - rewrite spec_extend4n6; rewrite (spec_extend6n n); apply Pfnn. - intros y. - rewrite spec_extend5n6; rewrite (spec_extend6n n); apply Pfnn. - intros y. - rewrite (spec_extend6n n); apply Pfnn. - intros m y; rewrite <- (spec_cast_l n m x); - rewrite <- (spec_cast_r n m y); apply Pfnn. - Qed. - - (* We iter the smaller argument with the bigger *) - Definition iter (x y: t_): res := - Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 - GenBase.extend GenBase.extend_aux - ] in - match x, y with - | N0 wx, N0 wy => f0 wx wy - | N0 wx, N1 wy => f0n 0 wx wy - | N0 wx, N2 wy => f0n 1 wx wy - | N0 wx, N3 wy => f0n 2 wx wy - | N0 wx, N4 wy => f0n 3 wx wy - | N0 wx, N5 wy => f0n 4 wx wy - | N0 wx, N6 wy => f0n 5 wx wy - | N0 wx, Nn m wy => f6n m (extend0 5 wx) wy - | N1 wx, N0 wy => fn0 0 wx wy - | N1 wx, N1 wy => f1 wx wy - | N1 wx, N2 wy => f1n 0 wx wy - | N1 wx, N3 wy => f1n 1 wx wy - | N1 wx, N4 wy => f1n 2 wx wy - | N1 wx, N5 wy => f1n 3 wx wy - | N1 wx, N6 wy => f1n 4 wx wy - | N1 wx, Nn m wy => f6n m (extend1 4 wx) wy - | N2 wx, N0 wy => fn0 1 wx wy - | N2 wx, N1 wy => fn1 0 wx wy - | N2 wx, N2 wy => f2 wx wy - | N2 wx, N3 wy => f2n 0 wx wy - | N2 wx, N4 wy => f2n 1 wx wy - | N2 wx, N5 wy => f2n 2 wx wy - | N2 wx, N6 wy => f2n 3 wx wy - | N2 wx, Nn m wy => f6n m (extend2 3 wx) wy - | N3 wx, N0 wy => fn0 2 wx wy - | N3 wx, N1 wy => fn1 1 wx wy - | N3 wx, N2 wy => fn2 0 wx wy - | N3 wx, N3 wy => f3 wx wy - | N3 wx, N4 wy => f3n 0 wx wy - | N3 wx, N5 wy => f3n 1 wx wy - | N3 wx, N6 wy => f3n 2 wx wy - | N3 wx, Nn m wy => f6n m (extend3 2 wx) wy - | N4 wx, N0 wy => fn0 3 wx wy - | N4 wx, N1 wy => fn1 2 wx wy - | N4 wx, N2 wy => fn2 1 wx wy - | N4 wx, N3 wy => fn3 0 wx wy - | N4 wx, N4 wy => f4 wx wy - | N4 wx, N5 wy => f4n 0 wx wy - | N4 wx, N6 wy => f4n 1 wx wy - | N4 wx, Nn m wy => f6n m (extend4 1 wx) wy - | N5 wx, N0 wy => fn0 4 wx wy - | N5 wx, N1 wy => fn1 3 wx wy - | N5 wx, N2 wy => fn2 2 wx wy - | N5 wx, N3 wy => fn3 1 wx wy - | N5 wx, N4 wy => fn4 0 wx wy - | N5 wx, N5 wy => f5 wx wy - | N5 wx, N6 wy => f5n 0 wx wy - | N5 wx, Nn m wy => f6n m (extend5 0 wx) wy - | N6 wx, N0 wy => fn0 5 wx wy - | N6 wx, N1 wy => fn1 4 wx wy - | N6 wx, N2 wy => fn2 3 wx wy - | N6 wx, N3 wy => fn3 2 wx wy - | N6 wx, N4 wy => fn4 1 wx wy - | N6 wx, N5 wy => fn5 0 wx wy - | N6 wx, N6 wy => f6 wx wy - | N6 wx, Nn m wy => f6n m wx wy - | Nn n wx, N0 wy => fn6 n wx (extend0 5 wy) - | Nn n wx, N1 wy => fn6 n wx (extend1 4 wy) - | Nn n wx, N2 wy => fn6 n wx (extend2 3 wy) - | Nn n wx, N3 wy => fn6 n wx (extend3 2 wy) - | Nn n wx, N4 wy => fn6 n wx (extend4 1 wy) - | Nn n wx, N5 wy => fn6 n wx (extend5 0 wy) - | Nn n wx, N6 wy => fn6 n wx wy - | Nn n wx, Nn m wy => fnm n m wx wy - end. - - Ltac zg_tac := try - (red; simpl Zcompare; auto; - let t := fresh "H" in (intros t; discriminate H)). - Lemma spec_iter: forall x y, P [x] [y] (iter x y). - Proof. - intros x; case x; clear x; unfold iter. - intros x y; case y; clear y. - intros y; apply Pf0. - intros y; rewrite spec_eval0n1; apply (Pf0n 0); zg_tac. - intros y; rewrite spec_eval0n2; apply (Pf0n 1); zg_tac. - intros y; rewrite spec_eval0n3; apply (Pf0n 2); zg_tac. - intros y; rewrite spec_eval0n4; apply (Pf0n 3); zg_tac. - intros y; rewrite spec_eval0n5; apply (Pf0n 4); zg_tac. - intros y; rewrite spec_eval0n6; apply (Pf0n 5); zg_tac. - intros m y; rewrite spec_extend0n6; rewrite spec_eval6n; apply Pf6n. - intros x y; case y; clear y. - intros y; rewrite spec_eval0n1; apply (Pfn0 0); zg_tac. - intros y; apply Pf1. - intros y; rewrite spec_eval1n1; apply (Pf1n 0); zg_tac. - intros y; rewrite spec_eval1n2; apply (Pf1n 1); zg_tac. - intros y; rewrite spec_eval1n3; apply (Pf1n 2); zg_tac. - intros y; rewrite spec_eval1n4; apply (Pf1n 3); zg_tac. - intros y; rewrite spec_eval1n5; apply (Pf1n 4); zg_tac. - intros m y; rewrite spec_extend1n6; rewrite spec_eval6n; apply Pf6n. - intros x y; case y; clear y. - intros y; rewrite spec_eval0n2; apply (Pfn0 1); zg_tac. - intros y; rewrite spec_eval1n1; apply (Pfn1 0); zg_tac. - intros y; apply Pf2. - intros y; rewrite spec_eval2n1; apply (Pf2n 0); zg_tac. - intros y; rewrite spec_eval2n2; apply (Pf2n 1); zg_tac. - intros y; rewrite spec_eval2n3; apply (Pf2n 2); zg_tac. - intros y; rewrite spec_eval2n4; apply (Pf2n 3); zg_tac. - intros m y; rewrite spec_extend2n6; rewrite spec_eval6n; apply Pf6n. - intros x y; case y; clear y. - intros y; rewrite spec_eval0n3; apply (Pfn0 2); zg_tac. - intros y; rewrite spec_eval1n2; apply (Pfn1 1); zg_tac. - intros y; rewrite spec_eval2n1; apply (Pfn2 0); zg_tac. - intros y; apply Pf3. - intros y; rewrite spec_eval3n1; apply (Pf3n 0); zg_tac. - intros y; rewrite spec_eval3n2; apply (Pf3n 1); zg_tac. - intros y; rewrite spec_eval3n3; apply (Pf3n 2); zg_tac. - intros m y; rewrite spec_extend3n6; rewrite spec_eval6n; apply Pf6n. - intros x y; case y; clear y. - intros y; rewrite spec_eval0n4; apply (Pfn0 3); zg_tac. - intros y; rewrite spec_eval1n3; apply (Pfn1 2); zg_tac. - intros y; rewrite spec_eval2n2; apply (Pfn2 1); zg_tac. - intros y; rewrite spec_eval3n1; apply (Pfn3 0); zg_tac. - intros y; apply Pf4. - intros y; rewrite spec_eval4n1; apply (Pf4n 0); zg_tac. - intros y; rewrite spec_eval4n2; apply (Pf4n 1); zg_tac. - intros m y; rewrite spec_extend4n6; rewrite spec_eval6n; apply Pf6n. - intros x y; case y; clear y. - intros y; rewrite spec_eval0n5; apply (Pfn0 4); zg_tac. - intros y; rewrite spec_eval1n4; apply (Pfn1 3); zg_tac. - intros y; rewrite spec_eval2n3; apply (Pfn2 2); zg_tac. - intros y; rewrite spec_eval3n2; apply (Pfn3 1); zg_tac. - intros y; rewrite spec_eval4n1; apply (Pfn4 0); zg_tac. - intros y; apply Pf5. - intros y; rewrite spec_eval5n1; apply (Pf5n 0); zg_tac. - intros m y; rewrite spec_extend5n6; rewrite spec_eval6n; apply Pf6n. - intros x y; case y; clear y. - intros y; rewrite spec_eval0n6; apply (Pfn0 5); zg_tac. - intros y; rewrite spec_eval1n5; apply (Pfn1 4); zg_tac. - intros y; rewrite spec_eval2n4; apply (Pfn2 3); zg_tac. - intros y; rewrite spec_eval3n3; apply (Pfn3 2); zg_tac. - intros y; rewrite spec_eval4n2; apply (Pfn4 1); zg_tac. - intros y; rewrite spec_eval5n1; apply (Pfn5 0); zg_tac. - intros y; apply Pf6. - intros m y; rewrite spec_eval6n; apply Pf6n. - intros n x y; case y; clear y. - intros y; rewrite spec_extend0n6; rewrite spec_eval6n; apply Pfn6. - intros y; rewrite spec_extend1n6; rewrite spec_eval6n; apply Pfn6. - intros y; rewrite spec_extend2n6; rewrite spec_eval6n; apply Pfn6. - intros y; rewrite spec_extend3n6; rewrite spec_eval6n; apply Pfn6. - intros y; rewrite spec_extend4n6; rewrite spec_eval6n; apply Pfn6. - intros y; rewrite spec_extend5n6; rewrite spec_eval6n; apply Pfn6. - intros y; rewrite spec_eval6n; apply Pfn6. - intros m y; apply Pfnm. - Qed. - - (* We iter the smaller argument with the bigger (zero case) *) - Definition iter0 (x y: t_): res := - Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 - GenBase.extend GenBase.extend_aux - ] in - match x with - | N0 wx => - if w0_eq0 wx then f0t y else - match y with - | N0 wy => f0 wx wy - | N1 wy => f0n 0 wx wy - | N2 wy => f0n 1 wx wy - | N3 wy => f0n 2 wx wy - | N4 wy => f0n 3 wx wy - | N5 wy => f0n 4 wx wy - | N6 wy => f0n 5 wx wy - | Nn m wy => f6n m (extend0 5 wx) wy - end - | N1 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 0 wx wy - | N1 wy => f1 wx wy - | N2 wy => f1n 0 wx wy - | N3 wy => f1n 1 wx wy - | N4 wy => f1n 2 wx wy - | N5 wy => f1n 3 wx wy - | N6 wy => f1n 4 wx wy - | Nn m wy => f6n m (extend1 4 wx) wy - end - | N2 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 1 wx wy - | N1 wy => - fn1 0 wx wy - | N2 wy => f2 wx wy - | N3 wy => f2n 0 wx wy - | N4 wy => f2n 1 wx wy - | N5 wy => f2n 2 wx wy - | N6 wy => f2n 3 wx wy - | Nn m wy => f6n m (extend2 3 wx) wy - end - | N3 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 2 wx wy - | N1 wy => - fn1 1 wx wy - | N2 wy => - fn2 0 wx wy - | N3 wy => f3 wx wy - | N4 wy => f3n 0 wx wy - | N5 wy => f3n 1 wx wy - | N6 wy => f3n 2 wx wy - | Nn m wy => f6n m (extend3 2 wx) wy - end - | N4 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 3 wx wy - | N1 wy => - fn1 2 wx wy - | N2 wy => - fn2 1 wx wy - | N3 wy => - fn3 0 wx wy - | N4 wy => f4 wx wy - | N5 wy => f4n 0 wx wy - | N6 wy => f4n 1 wx wy - | Nn m wy => f6n m (extend4 1 wx) wy - end - | N5 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 4 wx wy - | N1 wy => - fn1 3 wx wy - | N2 wy => - fn2 2 wx wy - | N3 wy => - fn3 1 wx wy - | N4 wy => - fn4 0 wx wy - | N5 wy => f5 wx wy - | N6 wy => f5n 0 wx wy - | Nn m wy => f6n m (extend5 0 wx) wy - end - | N6 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 5 wx wy - | N1 wy => - fn1 4 wx wy - | N2 wy => - fn2 3 wx wy - | N3 wy => - fn3 2 wx wy - | N4 wy => - fn4 1 wx wy - | N5 wy => - fn5 0 wx wy - | N6 wy => f6 wx wy - | Nn m wy => f6n m wx wy - end - | Nn n wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn6 n wx (extend0 5 wy) - | N1 wy => - fn6 n wx (extend1 4 wy) - | N2 wy => - fn6 n wx (extend2 3 wy) - | N3 wy => - fn6 n wx (extend3 2 wy) - | N4 wy => - fn6 n wx (extend4 1 wy) - | N5 wy => - fn6 n wx (extend5 0 wy) - | N6 wy => - fn6 n wx wy - | Nn m wy => fnm n m wx wy - end - end. - - Lemma spec_iter0: forall x y, P [x] [y] (iter0 x y). - Proof. - intros x; case x; clear x; unfold iter0. - intros x. - generalize (spec_w0_eq0 x); case w0_eq0; intros H. - intros y; rewrite H; apply Pf0t. - clear H. - intros y; case y; clear y. - intros y; apply Pf0. - intros y; rewrite spec_eval0n1; apply (Pf0n 0); zg_tac. - intros y; rewrite spec_eval0n2; apply (Pf0n 1); zg_tac. - intros y; rewrite spec_eval0n3; apply (Pf0n 2); zg_tac. - intros y; rewrite spec_eval0n4; apply (Pf0n 3); zg_tac. - intros y; rewrite spec_eval0n5; apply (Pf0n 4); zg_tac. - intros y; rewrite spec_eval0n6; apply (Pf0n 5); zg_tac. - intros m y; rewrite spec_extend0n6; rewrite spec_eval6n; apply Pf6n. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_eval0n1; apply (Pfn0 0); zg_tac. - intros y; apply Pf1. - intros y; rewrite spec_eval1n1; apply (Pf1n 0); zg_tac. - intros y; rewrite spec_eval1n2; apply (Pf1n 1); zg_tac. - intros y; rewrite spec_eval1n3; apply (Pf1n 2); zg_tac. - intros y; rewrite spec_eval1n4; apply (Pf1n 3); zg_tac. - intros y; rewrite spec_eval1n5; apply (Pf1n 4); zg_tac. - intros m y; rewrite spec_extend1n6; rewrite spec_eval6n; apply Pf6n. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_eval0n2; apply (Pfn0 1); zg_tac. - intros y. - rewrite spec_eval1n1; apply (Pfn1 0); zg_tac. - intros y; apply Pf2. - intros y; rewrite spec_eval2n1; apply (Pf2n 0); zg_tac. - intros y; rewrite spec_eval2n2; apply (Pf2n 1); zg_tac. - intros y; rewrite spec_eval2n3; apply (Pf2n 2); zg_tac. - intros y; rewrite spec_eval2n4; apply (Pf2n 3); zg_tac. - intros m y; rewrite spec_extend2n6; rewrite spec_eval6n; apply Pf6n. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_eval0n3; apply (Pfn0 2); zg_tac. - intros y. - rewrite spec_eval1n2; apply (Pfn1 1); zg_tac. - intros y. - rewrite spec_eval2n1; apply (Pfn2 0); zg_tac. - intros y; apply Pf3. - intros y; rewrite spec_eval3n1; apply (Pf3n 0); zg_tac. - intros y; rewrite spec_eval3n2; apply (Pf3n 1); zg_tac. - intros y; rewrite spec_eval3n3; apply (Pf3n 2); zg_tac. - intros m y; rewrite spec_extend3n6; rewrite spec_eval6n; apply Pf6n. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_eval0n4; apply (Pfn0 3); zg_tac. - intros y. - rewrite spec_eval1n3; apply (Pfn1 2); zg_tac. - intros y. - rewrite spec_eval2n2; apply (Pfn2 1); zg_tac. - intros y. - rewrite spec_eval3n1; apply (Pfn3 0); zg_tac. - intros y; apply Pf4. - intros y; rewrite spec_eval4n1; apply (Pf4n 0); zg_tac. - intros y; rewrite spec_eval4n2; apply (Pf4n 1); zg_tac. - intros m y; rewrite spec_extend4n6; rewrite spec_eval6n; apply Pf6n. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_eval0n5; apply (Pfn0 4); zg_tac. - intros y. - rewrite spec_eval1n4; apply (Pfn1 3); zg_tac. - intros y. - rewrite spec_eval2n3; apply (Pfn2 2); zg_tac. - intros y. - rewrite spec_eval3n2; apply (Pfn3 1); zg_tac. - intros y. - rewrite spec_eval4n1; apply (Pfn4 0); zg_tac. - intros y; apply Pf5. - intros y; rewrite spec_eval5n1; apply (Pf5n 0); zg_tac. - intros m y; rewrite spec_extend5n6; rewrite spec_eval6n; apply Pf6n. - intros x. - intros y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_eval0n6; apply (Pfn0 5); zg_tac. - intros y. - rewrite spec_eval1n5; apply (Pfn1 4); zg_tac. - intros y. - rewrite spec_eval2n4; apply (Pfn2 3); zg_tac. - intros y. - rewrite spec_eval3n3; apply (Pfn3 2); zg_tac. - intros y. - rewrite spec_eval4n2; apply (Pfn4 1); zg_tac. - intros y. - rewrite spec_eval5n1; apply (Pfn5 0); zg_tac. - intros y; apply Pf6. - intros m y; rewrite spec_eval6n; apply Pf6n. - intros n x y; case y; clear y. - intros y. - generalize (spec_w0_eq0 y); case w0_eq0; intros H. - rewrite H; apply Pft0. - clear H. - rewrite spec_extend0n6; rewrite spec_eval6n; apply Pfn6. - intros y. - rewrite spec_extend1n6; rewrite spec_eval6n; apply Pfn6. - intros y. - rewrite spec_extend2n6; rewrite spec_eval6n; apply Pfn6. - intros y. - rewrite spec_extend3n6; rewrite spec_eval6n; apply Pfn6. - intros y. - rewrite spec_extend4n6; rewrite spec_eval6n; apply Pfn6. - intros y. - rewrite spec_extend5n6; rewrite spec_eval6n; apply Pfn6. - intros y. - rewrite spec_eval6n; apply Pfn6. - intros m y; apply Pfnm. - Qed. - - End LevelAndIter. - - (***************************************************************) - (* *) - (* Reduction *) - (* *) - (***************************************************************) - - Definition reduce_0 (x:w) := N0 x. - Definition reduce_1 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w0_eq0 N0 N1. - Definition reduce_2 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w1_eq0 reduce_1 N2. - Definition reduce_3 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w2_eq0 reduce_2 N3. - Definition reduce_4 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w3_eq0 reduce_3 N4. - Definition reduce_5 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w4_eq0 reduce_4 N5. - Definition reduce_6 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w5_eq0 reduce_5 N6. - Definition reduce_7 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w6_eq0 reduce_6 (Nn 0). - Definition reduce_n n := - Eval lazy beta iota delta[reduce_n] in - reduce_n _ _ zero reduce_7 Nn n. - - Let spec_reduce_0: forall x, [reduce_0 x] = [N0 x]. - Proof. - intros x; unfold to_Z, reduce_0. - auto. - Qed. - - Let spec_reduce_1: forall x, [reduce_1 x] = [N1 x]. - Proof. - intros x; case x; unfold reduce_1. - exact (spec_0 w0_spec). - intros x1 y1. - generalize (spec_w0_eq0 x1); - case w0_eq0; intros H1; auto. - unfold to_Z; rewrite znz_to_Z_1. - unfold to_Z in H1; rewrite H1; auto. - Qed. - - Let spec_reduce_2: forall x, [reduce_2 x] = [N2 x]. - Proof. - intros x; case x; unfold reduce_2. - exact (spec_0 w0_spec). - intros x1 y1. - generalize (spec_w1_eq0 x1); - case w1_eq0; intros H1; auto. - rewrite spec_reduce_1. - unfold to_Z; rewrite znz_to_Z_2. - unfold to_Z in H1; rewrite H1; auto. - Qed. - - Let spec_reduce_3: forall x, [reduce_3 x] = [N3 x]. - Proof. - intros x; case x; unfold reduce_3. - exact (spec_0 w0_spec). - intros x1 y1. - generalize (spec_w2_eq0 x1); - case w2_eq0; intros H1; auto. - rewrite spec_reduce_2. - unfold to_Z; rewrite znz_to_Z_3. - unfold to_Z in H1; rewrite H1; auto. - Qed. - - Let spec_reduce_4: forall x, [reduce_4 x] = [N4 x]. - Proof. - intros x; case x; unfold reduce_4. - exact (spec_0 w0_spec). - intros x1 y1. - generalize (spec_w3_eq0 x1); - case w3_eq0; intros H1; auto. - rewrite spec_reduce_3. - unfold to_Z; rewrite znz_to_Z_4. - unfold to_Z in H1; rewrite H1; auto. - Qed. - - Let spec_reduce_5: forall x, [reduce_5 x] = [N5 x]. - Proof. - intros x; case x; unfold reduce_5. - exact (spec_0 w0_spec). - intros x1 y1. - generalize (spec_w4_eq0 x1); - case w4_eq0; intros H1; auto. - rewrite spec_reduce_4. - unfold to_Z; rewrite znz_to_Z_5. - unfold to_Z in H1; rewrite H1; auto. - Qed. - - Let spec_reduce_6: forall x, [reduce_6 x] = [N6 x]. - Proof. - intros x; case x; unfold reduce_6. - exact (spec_0 w0_spec). - intros x1 y1. - generalize (spec_w5_eq0 x1); - case w5_eq0; intros H1; auto. - rewrite spec_reduce_5. - unfold to_Z; rewrite znz_to_Z_6. - unfold to_Z in H1; rewrite H1; auto. - Qed. - - Let spec_reduce_7: forall x, [reduce_7 x] = [Nn 0 x]. - Proof. - intros x; case x; unfold reduce_7. - exact (spec_0 w0_spec). - intros x1 y1. - generalize (spec_w6_eq0 x1); - case w6_eq0; intros H1; auto. - rewrite spec_reduce_6. - unfold to_Z; rewrite znz_to_Z_7. - unfold to_Z in H1; rewrite H1; auto. - Qed. - - Let spec_reduce_n: forall n x, [reduce_n n x] = [Nn n x]. - Proof. - intros n; elim n; simpl reduce_n. - intros x; rewrite <- spec_reduce_7; auto. - intros n1 Hrec x; case x. - unfold to_Z; rewrite make_op_S; auto. - exact (spec_0 w0_spec). - intros x1 y1; case x1; auto. - rewrite Hrec. - rewrite spec_extendn0_0; auto. - Qed. - - (***************************************************************) - (* *) - (* Successor *) - (* *) - (***************************************************************) - - Definition w0_succ_c := w0_op.(znz_succ_c). - Definition w1_succ_c := w1_op.(znz_succ_c). - Definition w2_succ_c := w2_op.(znz_succ_c). - Definition w3_succ_c := w3_op.(znz_succ_c). - Definition w4_succ_c := w4_op.(znz_succ_c). - Definition w5_succ_c := w5_op.(znz_succ_c). - Definition w6_succ_c := w6_op.(znz_succ_c). - - Definition w0_succ := w0_op.(znz_succ). - Definition w1_succ := w1_op.(znz_succ). - Definition w2_succ := w2_op.(znz_succ). - Definition w3_succ := w3_op.(znz_succ). - Definition w4_succ := w4_op.(znz_succ). - Definition w5_succ := w5_op.(znz_succ). - Definition w6_succ := w6_op.(znz_succ). - - Definition succ x := - match x with - | N0 wx => - match w0_succ_c wx with - | C0 r => N0 r - | C1 r => N1 (WW one0 r) - end - | N1 wx => - match w1_succ_c wx with - | C0 r => N1 r - | C1 r => N2 (WW one1 r) - end - | N2 wx => - match w2_succ_c wx with - | C0 r => N2 r - | C1 r => N3 (WW one2 r) - end - | N3 wx => - match w3_succ_c wx with - | C0 r => N3 r - | C1 r => N4 (WW one3 r) - end - | N4 wx => - match w4_succ_c wx with - | C0 r => N4 r - | C1 r => N5 (WW one4 r) - end - | N5 wx => - match w5_succ_c wx with - | C0 r => N5 r - | C1 r => N6 (WW one5 r) - end - | N6 wx => - match w6_succ_c wx with - | C0 r => N6 r - | C1 r => Nn 0 (WW one6 r) - end - | Nn n wx => - let op := make_op n in - match op.(znz_succ_c) wx with - | C0 r => Nn n r - | C1 r => Nn (S n) (WW op.(znz_1) r) - end - end. - - Theorem spec_succ: forall n, [succ n] = [n] + 1. - Proof. - intros n; case n; unfold succ, to_Z. - intros n1; generalize (spec_succ_c w0_spec n1); - unfold succ, to_Z, w0_succ_c; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite znz_to_Z_1; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w0_spec)). - intros n1; generalize (spec_succ_c w1_spec n1); - unfold succ, to_Z, w1_succ_c; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite znz_to_Z_2; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w1_spec)). - intros n1; generalize (spec_succ_c w2_spec n1); - unfold succ, to_Z, w2_succ_c; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite znz_to_Z_3; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w2_spec)). - intros n1; generalize (spec_succ_c w3_spec n1); - unfold succ, to_Z, w3_succ_c; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite znz_to_Z_4; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w3_spec)). - intros n1; generalize (spec_succ_c w4_spec n1); - unfold succ, to_Z, w4_succ_c; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite znz_to_Z_5; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w4_spec)). - intros n1; generalize (spec_succ_c w5_spec n1); - unfold succ, to_Z, w5_succ_c; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite znz_to_Z_6; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w5_spec)). - intros n1; generalize (spec_succ_c w6_spec n1); - unfold succ, to_Z, w6_succ_c; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite znz_to_Z_7; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w6_spec)). - intros k n1; generalize (spec_succ_c (wn_spec k) n1). - unfold succ, to_Z; case znz_succ_c; auto. - intros ww H; rewrite <- H. - (rewrite (znz_to_Z_n k); unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 (wn_spec k))). - Qed. - - (***************************************************************) - (* *) - (* Adddition *) - (* *) - (***************************************************************) - - Definition w0_add_c := znz_add_c w0_op. - Definition w0_add x y := - match w0_add_c x y with - | C0 r => N0 r - | C1 r => N1 (WW one0 r) - end. - - Definition w1_add_c := znz_add_c w1_op. - Definition w1_add x y := - match w1_add_c x y with - | C0 r => N1 r - | C1 r => N2 (WW one1 r) - end. - - Definition w2_add_c := znz_add_c w2_op. - Definition w2_add x y := - match w2_add_c x y with - | C0 r => N2 r - | C1 r => N3 (WW one2 r) - end. - - Definition w3_add_c := znz_add_c w3_op. - Definition w3_add x y := - match w3_add_c x y with - | C0 r => N3 r - | C1 r => N4 (WW one3 r) - end. - - Definition w4_add_c := znz_add_c w4_op. - Definition w4_add x y := - match w4_add_c x y with - | C0 r => N4 r - | C1 r => N5 (WW one4 r) - end. - - Definition w5_add_c := znz_add_c w5_op. - Definition w5_add x y := - match w5_add_c x y with - | C0 r => N5 r - | C1 r => N6 (WW one5 r) - end. - - Definition w6_add_c := znz_add_c w6_op. - Definition w6_add x y := - match w6_add_c x y with - | C0 r => N6 r - | C1 r => Nn 0 (WW one6 r) - end. - - Definition addn n (x y : word w6 (S n)) := - let op := make_op n in - match op.(znz_add_c) x y with - | C0 r => Nn n r - | C1 r => Nn (S n) (WW op.(znz_1) r) end. - - Let spec_w0_add: forall x y, [w0_add x y] = [N0 x] + [N0 y]. - Proof. - intros n m; unfold to_Z, w0_add, w0_add_c. - generalize (spec_add_c w0_spec n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite znz_to_Z_1; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w0_spec). - Qed. - Hint Rewrite spec_w0_add: addr. - - Let spec_w1_add: forall x y, [w1_add x y] = [N1 x] + [N1 y]. - Proof. - intros n m; unfold to_Z, w1_add, w1_add_c. - generalize (spec_add_c w1_spec n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite znz_to_Z_2; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w1_spec). - Qed. - Hint Rewrite spec_w1_add: addr. - - Let spec_w2_add: forall x y, [w2_add x y] = [N2 x] + [N2 y]. - Proof. - intros n m; unfold to_Z, w2_add, w2_add_c. - generalize (spec_add_c w2_spec n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite znz_to_Z_3; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w2_spec). - Qed. - Hint Rewrite spec_w2_add: addr. - - Let spec_w3_add: forall x y, [w3_add x y] = [N3 x] + [N3 y]. - Proof. - intros n m; unfold to_Z, w3_add, w3_add_c. - generalize (spec_add_c w3_spec n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite znz_to_Z_4; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w3_spec). - Qed. - Hint Rewrite spec_w3_add: addr. - - Let spec_w4_add: forall x y, [w4_add x y] = [N4 x] + [N4 y]. - Proof. - intros n m; unfold to_Z, w4_add, w4_add_c. - generalize (spec_add_c w4_spec n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite znz_to_Z_5; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w4_spec). - Qed. - Hint Rewrite spec_w4_add: addr. - - Let spec_w5_add: forall x y, [w5_add x y] = [N5 x] + [N5 y]. - Proof. - intros n m; unfold to_Z, w5_add, w5_add_c. - generalize (spec_add_c w5_spec n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite znz_to_Z_6; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w5_spec). - Qed. - Hint Rewrite spec_w5_add: addr. - - Let spec_w6_add: forall x y, [w6_add x y] = [N6 x] + [N6 y]. - Proof. - intros n m; unfold to_Z, w6_add, w6_add_c. - generalize (spec_add_c w6_spec n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite znz_to_Z_7; unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 w6_spec). - Qed. - Hint Rewrite spec_w6_add: addr. - - Let spec_wn_add: forall n x y, [addn n x y] = [Nn n x] + [Nn n y]. - Proof. - intros k n m; unfold to_Z, addn. - generalize (spec_add_c (wn_spec k) n m); case znz_add_c; auto. - intros ww H; rewrite <- H. - rewrite (znz_to_Z_n k); unfold interp_carry; - apply f_equal2 with (f := Zplus); auto; - apply f_equal2 with (f := Zmult); auto; - exact (spec_1 (wn_spec k)). - Qed. - Hint Rewrite spec_wn_add: addr. - Definition add := Eval lazy beta delta [same_level] in - (same_level t_ w0_add w1_add w2_add w3_add w4_add w5_add w6_add addn). - - Theorem spec_add: forall x y, [add x y] = [x] + [y]. - Proof. - unfold add. - generalize (spec_same_level t_ (fun x y res => [res] = x + y)). - unfold same_level; intros HH; apply HH; clear HH. - exact spec_w0_add. - exact spec_w1_add. - exact spec_w2_add. - exact spec_w3_add. - exact spec_w4_add. - exact spec_w5_add. - exact spec_w6_add. - exact spec_wn_add. - Qed. - - (***************************************************************) - (* *) - (* Predecessor *) - (* *) - (***************************************************************) - - Definition w0_pred_c := w0_op.(znz_pred_c). - Definition w1_pred_c := w1_op.(znz_pred_c). - Definition w2_pred_c := w2_op.(znz_pred_c). - Definition w3_pred_c := w3_op.(znz_pred_c). - Definition w4_pred_c := w4_op.(znz_pred_c). - Definition w5_pred_c := w5_op.(znz_pred_c). - Definition w6_pred_c := w6_op.(znz_pred_c). - - Definition pred x := - match x with - | N0 wx => - match w0_pred_c wx with - | C0 r => reduce_0 r - | C1 r => zero - end - | N1 wx => - match w1_pred_c wx with - | C0 r => reduce_1 r - | C1 r => zero - end - | N2 wx => - match w2_pred_c wx with - | C0 r => reduce_2 r - | C1 r => zero - end - | N3 wx => - match w3_pred_c wx with - | C0 r => reduce_3 r - | C1 r => zero - end - | N4 wx => - match w4_pred_c wx with - | C0 r => reduce_4 r - | C1 r => zero - end - | N5 wx => - match w5_pred_c wx with - | C0 r => reduce_5 r - | C1 r => zero - end - | N6 wx => - match w6_pred_c wx with - | C0 r => reduce_6 r - | C1 r => zero - end - | Nn n wx => - let op := make_op n in - match op.(znz_pred_c) wx with - | C0 r => reduce_n n r - | C1 r => zero - end - end. - - Theorem spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1. - Proof. - intros x; case x; unfold pred. - intros x1 H1; unfold w0_pred_c; - generalize (spec_pred_c w0_spec x1); case znz_pred_c; intros y1. - rewrite spec_reduce_0; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z w0_spec x1); intros HH1 HH2. - case (spec_to_Z w0_spec y1); intros HH3 HH4 HH5. - assert (znz_to_Z w0_op x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - intros x1 H1; unfold w1_pred_c; - generalize (spec_pred_c w1_spec x1); case znz_pred_c; intros y1. - rewrite spec_reduce_1; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z w1_spec x1); intros HH1 HH2. - case (spec_to_Z w1_spec y1); intros HH3 HH4 HH5. - assert (znz_to_Z w1_op x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - intros x1 H1; unfold w2_pred_c; - generalize (spec_pred_c w2_spec x1); case znz_pred_c; intros y1. - rewrite spec_reduce_2; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z w2_spec x1); intros HH1 HH2. - case (spec_to_Z w2_spec y1); intros HH3 HH4 HH5. - assert (znz_to_Z w2_op x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - intros x1 H1; unfold w3_pred_c; - generalize (spec_pred_c w3_spec x1); case znz_pred_c; intros y1. - rewrite spec_reduce_3; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z w3_spec x1); intros HH1 HH2. - case (spec_to_Z w3_spec y1); intros HH3 HH4 HH5. - assert (znz_to_Z w3_op x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - intros x1 H1; unfold w4_pred_c; - generalize (spec_pred_c w4_spec x1); case znz_pred_c; intros y1. - rewrite spec_reduce_4; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z w4_spec x1); intros HH1 HH2. - case (spec_to_Z w4_spec y1); intros HH3 HH4 HH5. - assert (znz_to_Z w4_op x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - intros x1 H1; unfold w5_pred_c; - generalize (spec_pred_c w5_spec x1); case znz_pred_c; intros y1. - rewrite spec_reduce_5; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z w5_spec x1); intros HH1 HH2. - case (spec_to_Z w5_spec y1); intros HH3 HH4 HH5. - assert (znz_to_Z w5_op x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - intros x1 H1; unfold w6_pred_c; - generalize (spec_pred_c w6_spec x1); case znz_pred_c; intros y1. - rewrite spec_reduce_6; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z w6_spec x1); intros HH1 HH2. - case (spec_to_Z w6_spec y1); intros HH3 HH4 HH5. - assert (znz_to_Z w6_op x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - intros n x1 H1; - generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1. - rewrite spec_reduce_n; auto. - unfold interp_carry; unfold to_Z. - case (spec_to_Z (wn_spec n) x1); intros HH1 HH2. - case (spec_to_Z (wn_spec n) y1); intros HH3 HH4 HH5. - assert (znz_to_Z (make_op n) x1 - 1 < 0); auto with zarith. - unfold to_Z in H1; auto with zarith. - Qed. - - Let spec_pred0: forall x, [x] = 0 -> [pred x] = 0. - Proof. - intros x; case x; unfold pred. - intros x1 H1; unfold w0_pred_c; - generalize (spec_pred_c w0_spec x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z w0_spec y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - intros x1 H1; unfold w1_pred_c; - generalize (spec_pred_c w1_spec x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z w1_spec y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - intros x1 H1; unfold w2_pred_c; - generalize (spec_pred_c w2_spec x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z w2_spec y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - intros x1 H1; unfold w3_pred_c; - generalize (spec_pred_c w3_spec x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z w3_spec y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - intros x1 H1; unfold w4_pred_c; - generalize (spec_pred_c w4_spec x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z w4_spec y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - intros x1 H1; unfold w5_pred_c; - generalize (spec_pred_c w5_spec x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z w5_spec y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - intros x1 H1; unfold w6_pred_c; - generalize (spec_pred_c w6_spec x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z w6_spec y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - intros n x1 H1; - generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1. - unfold interp_carry; unfold to_Z. - unfold to_Z in H1; auto with zarith. - case (spec_to_Z (wn_spec n) y1); intros HH3 HH4; auto with zarith. - intros; exact (spec_0 w0_spec). - Qed. - - (***************************************************************) - (* *) - (* Subtraction *) - (* *) - (***************************************************************) - - Definition w0_sub_c := w0_op.(znz_sub_c). - Definition w1_sub_c := w1_op.(znz_sub_c). - Definition w2_sub_c := w2_op.(znz_sub_c). - Definition w3_sub_c := w3_op.(znz_sub_c). - Definition w4_sub_c := w4_op.(znz_sub_c). - Definition w5_sub_c := w5_op.(znz_sub_c). - Definition w6_sub_c := w6_op.(znz_sub_c). - - Definition w0_sub x y := - match w0_sub_c x y with - | C0 r => reduce_0 r - | C1 r => zero - end. - Definition w1_sub x y := - match w1_sub_c x y with - | C0 r => reduce_1 r - | C1 r => zero - end. - Definition w2_sub x y := - match w2_sub_c x y with - | C0 r => reduce_2 r - | C1 r => zero - end. - Definition w3_sub x y := - match w3_sub_c x y with - | C0 r => reduce_3 r - | C1 r => zero - end. - Definition w4_sub x y := - match w4_sub_c x y with - | C0 r => reduce_4 r - | C1 r => zero - end. - Definition w5_sub x y := - match w5_sub_c x y with - | C0 r => reduce_5 r - | C1 r => zero - end. - Definition w6_sub x y := - match w6_sub_c x y with - | C0 r => reduce_6 r - | C1 r => zero - end. - - Definition subn n (x y : word w6 (S n)) := - let op := make_op n in - match op.(znz_sub_c) x y with - | C0 r => Nn n r - | C1 r => N0 w_0 end. - - Let spec_w0_sub: forall x y, [N0 y] <= [N0 x] -> [w0_sub x y] = [N0 x] - [N0 y]. - Proof. - intros n m; unfold w0_sub, w0_sub_c. - generalize (spec_sub_c w0_spec n m); case znz_sub_c; - intros x; auto. - unfold interp_carry; unfold zero, w_0, to_Z. - rewrite (spec_0 w0_spec). - case (spec_to_Z w0_spec x); intros; auto with zarith. - Qed. - - Let spec_w1_sub: forall x y, [N1 y] <= [N1 x] -> [w1_sub x y] = [N1 x] - [N1 y]. - Proof. - intros n m; unfold w1_sub, w1_sub_c. - generalize (spec_sub_c w1_spec n m); case znz_sub_c; - intros x; try rewrite spec_reduce_1; auto. - unfold interp_carry; unfold zero, w_0, to_Z. - rewrite (spec_0 w0_spec). - case (spec_to_Z w1_spec x); intros; auto with zarith. - Qed. - - Let spec_w2_sub: forall x y, [N2 y] <= [N2 x] -> [w2_sub x y] = [N2 x] - [N2 y]. - Proof. - intros n m; unfold w2_sub, w2_sub_c. - generalize (spec_sub_c w2_spec n m); case znz_sub_c; - intros x; try rewrite spec_reduce_2; auto. - unfold interp_carry; unfold zero, w_0, to_Z. - rewrite (spec_0 w0_spec). - case (spec_to_Z w2_spec x); intros; auto with zarith. - Qed. - - Let spec_w3_sub: forall x y, [N3 y] <= [N3 x] -> [w3_sub x y] = [N3 x] - [N3 y]. - Proof. - intros n m; unfold w3_sub, w3_sub_c. - generalize (spec_sub_c w3_spec n m); case znz_sub_c; - intros x; try rewrite spec_reduce_3; auto. - unfold interp_carry; unfold zero, w_0, to_Z. - rewrite (spec_0 w0_spec). - case (spec_to_Z w3_spec x); intros; auto with zarith. - Qed. - - Let spec_w4_sub: forall x y, [N4 y] <= [N4 x] -> [w4_sub x y] = [N4 x] - [N4 y]. - Proof. - intros n m; unfold w4_sub, w4_sub_c. - generalize (spec_sub_c w4_spec n m); case znz_sub_c; - intros x; try rewrite spec_reduce_4; auto. - unfold interp_carry; unfold zero, w_0, to_Z. - rewrite (spec_0 w0_spec). - case (spec_to_Z w4_spec x); intros; auto with zarith. - Qed. - - Let spec_w5_sub: forall x y, [N5 y] <= [N5 x] -> [w5_sub x y] = [N5 x] - [N5 y]. - Proof. - intros n m; unfold w5_sub, w5_sub_c. - generalize (spec_sub_c w5_spec n m); case znz_sub_c; - intros x; try rewrite spec_reduce_5; auto. - unfold interp_carry; unfold zero, w_0, to_Z. - rewrite (spec_0 w0_spec). - case (spec_to_Z w5_spec x); intros; auto with zarith. - Qed. - - Let spec_w6_sub: forall x y, [N6 y] <= [N6 x] -> [w6_sub x y] = [N6 x] - [N6 y]. - Proof. - intros n m; unfold w6_sub, w6_sub_c. - generalize (spec_sub_c w6_spec n m); case znz_sub_c; - intros x; try rewrite spec_reduce_6; auto. - unfold interp_carry; unfold zero, w_0, to_Z. - rewrite (spec_0 w0_spec). - case (spec_to_Z w6_spec x); intros; auto with zarith. - Qed. - - Let spec_wn_sub: forall n x y, [Nn n y] <= [Nn n x] -> [subn n x y] = [Nn n x] - [Nn n y]. - Proof. - intros k n m; unfold subn. - generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; - intros x; auto. - unfold interp_carry, to_Z. - case (spec_to_Z (wn_spec k) x); intros; auto with zarith. - Qed. - - Definition sub := Eval lazy beta delta [same_level] in - (same_level t_ w0_sub w1_sub w2_sub w3_sub w4_sub w5_sub w6_sub subn). - - Theorem spec_sub: forall x y, [y] <= [x] -> [sub x y] = [x] - [y]. - Proof. - unfold sub. - generalize (spec_same_level t_ (fun x y res => y <= x -> [res] = x - y)). - unfold same_level; intros HH; apply HH; clear HH. - exact spec_w0_sub. - exact spec_w1_sub. - exact spec_w2_sub. - exact spec_w3_sub. - exact spec_w4_sub. - exact spec_w5_sub. - exact spec_w6_sub. - exact spec_wn_sub. - Qed. - - Let spec_w0_sub0: forall x y, [N0 x] < [N0 y] -> [w0_sub x y] = 0. - Proof. - intros n m; unfold w0_sub, w0_sub_c. - generalize (spec_sub_c w0_spec n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z w0_spec x); intros; auto with zarith. - intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto. - Qed. - - Let spec_w1_sub0: forall x y, [N1 x] < [N1 y] -> [w1_sub x y] = 0. - Proof. - intros n m; unfold w1_sub, w1_sub_c. - generalize (spec_sub_c w1_spec n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z w1_spec x); intros; auto with zarith. - intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto. - Qed. - - Let spec_w2_sub0: forall x y, [N2 x] < [N2 y] -> [w2_sub x y] = 0. - Proof. - intros n m; unfold w2_sub, w2_sub_c. - generalize (spec_sub_c w2_spec n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z w2_spec x); intros; auto with zarith. - intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto. - Qed. - - Let spec_w3_sub0: forall x y, [N3 x] < [N3 y] -> [w3_sub x y] = 0. - Proof. - intros n m; unfold w3_sub, w3_sub_c. - generalize (spec_sub_c w3_spec n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z w3_spec x); intros; auto with zarith. - intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto. - Qed. - - Let spec_w4_sub0: forall x y, [N4 x] < [N4 y] -> [w4_sub x y] = 0. - Proof. - intros n m; unfold w4_sub, w4_sub_c. - generalize (spec_sub_c w4_spec n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z w4_spec x); intros; auto with zarith. - intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto. - Qed. - - Let spec_w5_sub0: forall x y, [N5 x] < [N5 y] -> [w5_sub x y] = 0. - Proof. - intros n m; unfold w5_sub, w5_sub_c. - generalize (spec_sub_c w5_spec n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z w5_spec x); intros; auto with zarith. - intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto. - Qed. - - Let spec_w6_sub0: forall x y, [N6 x] < [N6 y] -> [w6_sub x y] = 0. - Proof. - intros n m; unfold w6_sub, w6_sub_c. - generalize (spec_sub_c w6_spec n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z w6_spec x); intros; auto with zarith. - intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto. - Qed. - - Let spec_wn_sub0: forall n x y, [Nn n x] < [Nn n y] -> [subn n x y] = 0. - Proof. - intros k n m; unfold subn. - generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; - intros x; unfold interp_carry. - unfold to_Z; case (spec_to_Z (wn_spec k) x); intros; auto with zarith. - intros; unfold to_Z, w_0; rewrite (spec_0 (w0_spec)); auto. - Qed. - - Theorem spec_sub0: forall x y, [x] < [y] -> [sub x y] = 0. - Proof. - unfold sub. - generalize (spec_same_level t_ (fun x y res => x < y -> [res] = 0)). - unfold same_level; intros HH; apply HH; clear HH. - exact spec_w0_sub0. - exact spec_w1_sub0. - exact spec_w2_sub0. - exact spec_w3_sub0. - exact spec_w4_sub0. - exact spec_w5_sub0. - exact spec_w6_sub0. - exact spec_wn_sub0. - Qed. - - (***************************************************************) - (* *) - (* Comparison *) - (* *) - (***************************************************************) - - Definition compare_0 := w0_op.(znz_compare). - Definition comparen_0 := - compare_mn_1 w0 w0 w_0 compare_0 (compare_0 w_0) compare_0. - Definition compare_1 := w1_op.(znz_compare). - Definition comparen_1 := - compare_mn_1 w1 w1 W0 compare_1 (compare_1 W0) compare_1. - Definition compare_2 := w2_op.(znz_compare). - Definition comparen_2 := - compare_mn_1 w2 w2 W0 compare_2 (compare_2 W0) compare_2. - Definition compare_3 := w3_op.(znz_compare). - Definition comparen_3 := - compare_mn_1 w3 w3 W0 compare_3 (compare_3 W0) compare_3. - Definition compare_4 := w4_op.(znz_compare). - Definition comparen_4 := - compare_mn_1 w4 w4 W0 compare_4 (compare_4 W0) compare_4. - Definition compare_5 := w5_op.(znz_compare). - Definition comparen_5 := - compare_mn_1 w5 w5 W0 compare_5 (compare_5 W0) compare_5. - Definition compare_6 := w6_op.(znz_compare). - Definition comparen_6 := - compare_mn_1 w6 w6 W0 compare_6 (compare_6 W0) compare_6. - - Definition comparenm n m wx wy := - let mn := Max.max n m in - let d := diff n m in - let op := make_op mn in - op.(znz_compare) - (castm (diff_r n m) (extend_tr wx (snd d))) - (castm (diff_l n m) (extend_tr wy (fst d))). - - Definition compare := Eval lazy beta delta [iter] in - (iter _ - compare_0 - (fun n x y => opp_compare (comparen_0 (S n) y x)) - (fun n => comparen_0 (S n)) - compare_1 - (fun n x y => opp_compare (comparen_1 (S n) y x)) - (fun n => comparen_1 (S n)) - compare_2 - (fun n x y => opp_compare (comparen_2 (S n) y x)) - (fun n => comparen_2 (S n)) - compare_3 - (fun n x y => opp_compare (comparen_3 (S n) y x)) - (fun n => comparen_3 (S n)) - compare_4 - (fun n x y => opp_compare (comparen_4 (S n) y x)) - (fun n => comparen_4 (S n)) - compare_5 - (fun n x y => opp_compare (comparen_5 (S n) y x)) - (fun n => comparen_5 (S n)) - compare_6 - (fun n x y => opp_compare (comparen_6 (S n) y x)) - (fun n => comparen_6 (S n)) - comparenm). - - Let spec_compare_0: forall x y, - match compare_0 x y with - Eq => [N0 x] = [N0 y] - | Lt => [N0 x] < [N0 y] - | Gt => [N0 x] > [N0 y] - end. - Proof. - unfold compare_0, to_Z; exact (spec_compare w0_spec). - Qed. - - Let spec_comparen_0: - forall (n : nat) (x : word w0 n) (y : w0), - match comparen_0 n x y with - | Eq => eval0n n x = [N0 y] - | Lt => eval0n n x < [N0 y] - | Gt => eval0n n x > [N0 y] - end. - intros n x y. - unfold comparen_0, to_Z; rewrite spec_gen_eval0n. - apply spec_compare_mn_1. - exact (spec_0 w0_spec). - intros x1; exact (spec_compare w0_spec w_0 x1). - exact (spec_to_Z w0_spec). - exact (spec_compare w0_spec). - exact (spec_compare w0_spec). - exact (spec_to_Z w0_spec). - Qed. - - Let spec_compare_1: forall x y, - match compare_1 x y with - Eq => [N1 x] = [N1 y] - | Lt => [N1 x] < [N1 y] - | Gt => [N1 x] > [N1 y] - end. - Proof. - unfold compare_1, to_Z; exact (spec_compare w1_spec). - Qed. - - Let spec_comparen_1: - forall (n : nat) (x : word w1 n) (y : w1), - match comparen_1 n x y with - | Eq => eval1n n x = [N1 y] - | Lt => eval1n n x < [N1 y] - | Gt => eval1n n x > [N1 y] - end. - intros n x y. - unfold comparen_1, to_Z; rewrite spec_gen_eval1n. - apply spec_compare_mn_1. - exact (spec_0 w1_spec). - intros x1; exact (spec_compare w1_spec W0 x1). - exact (spec_to_Z w1_spec). - exact (spec_compare w1_spec). - exact (spec_compare w1_spec). - exact (spec_to_Z w1_spec). - Qed. - - Let spec_compare_2: forall x y, - match compare_2 x y with - Eq => [N2 x] = [N2 y] - | Lt => [N2 x] < [N2 y] - | Gt => [N2 x] > [N2 y] - end. - Proof. - unfold compare_2, to_Z; exact (spec_compare w2_spec). - Qed. - - Let spec_comparen_2: - forall (n : nat) (x : word w2 n) (y : w2), - match comparen_2 n x y with - | Eq => eval2n n x = [N2 y] - | Lt => eval2n n x < [N2 y] - | Gt => eval2n n x > [N2 y] - end. - intros n x y. - unfold comparen_2, to_Z; rewrite spec_gen_eval2n. - apply spec_compare_mn_1. - exact (spec_0 w2_spec). - intros x1; exact (spec_compare w2_spec W0 x1). - exact (spec_to_Z w2_spec). - exact (spec_compare w2_spec). - exact (spec_compare w2_spec). - exact (spec_to_Z w2_spec). - Qed. - - Let spec_compare_3: forall x y, - match compare_3 x y with - Eq => [N3 x] = [N3 y] - | Lt => [N3 x] < [N3 y] - | Gt => [N3 x] > [N3 y] - end. - Proof. - unfold compare_3, to_Z; exact (spec_compare w3_spec). - Qed. - - Let spec_comparen_3: - forall (n : nat) (x : word w3 n) (y : w3), - match comparen_3 n x y with - | Eq => eval3n n x = [N3 y] - | Lt => eval3n n x < [N3 y] - | Gt => eval3n n x > [N3 y] - end. - intros n x y. - unfold comparen_3, to_Z; rewrite spec_gen_eval3n. - apply spec_compare_mn_1. - exact (spec_0 w3_spec). - intros x1; exact (spec_compare w3_spec W0 x1). - exact (spec_to_Z w3_spec). - exact (spec_compare w3_spec). - exact (spec_compare w3_spec). - exact (spec_to_Z w3_spec). - Qed. - - Let spec_compare_4: forall x y, - match compare_4 x y with - Eq => [N4 x] = [N4 y] - | Lt => [N4 x] < [N4 y] - | Gt => [N4 x] > [N4 y] - end. - Proof. - unfold compare_4, to_Z; exact (spec_compare w4_spec). - Qed. - - Let spec_comparen_4: - forall (n : nat) (x : word w4 n) (y : w4), - match comparen_4 n x y with - | Eq => eval4n n x = [N4 y] - | Lt => eval4n n x < [N4 y] - | Gt => eval4n n x > [N4 y] - end. - intros n x y. - unfold comparen_4, to_Z; rewrite spec_gen_eval4n. - apply spec_compare_mn_1. - exact (spec_0 w4_spec). - intros x1; exact (spec_compare w4_spec W0 x1). - exact (spec_to_Z w4_spec). - exact (spec_compare w4_spec). - exact (spec_compare w4_spec). - exact (spec_to_Z w4_spec). - Qed. - - Let spec_compare_5: forall x y, - match compare_5 x y with - Eq => [N5 x] = [N5 y] - | Lt => [N5 x] < [N5 y] - | Gt => [N5 x] > [N5 y] - end. - Proof. - unfold compare_5, to_Z; exact (spec_compare w5_spec). - Qed. - - Let spec_comparen_5: - forall (n : nat) (x : word w5 n) (y : w5), - match comparen_5 n x y with - | Eq => eval5n n x = [N5 y] - | Lt => eval5n n x < [N5 y] - | Gt => eval5n n x > [N5 y] - end. - intros n x y. - unfold comparen_5, to_Z; rewrite spec_gen_eval5n. - apply spec_compare_mn_1. - exact (spec_0 w5_spec). - intros x1; exact (spec_compare w5_spec W0 x1). - exact (spec_to_Z w5_spec). - exact (spec_compare w5_spec). - exact (spec_compare w5_spec). - exact (spec_to_Z w5_spec). - Qed. - - Let spec_compare_6: forall x y, - match compare_6 x y with - Eq => [N6 x] = [N6 y] - | Lt => [N6 x] < [N6 y] - | Gt => [N6 x] > [N6 y] - end. - Proof. - unfold compare_6, to_Z; exact (spec_compare w6_spec). - Qed. - - Let spec_comparen_6: - forall (n : nat) (x : word w6 n) (y : w6), - match comparen_6 n x y with - | Eq => eval6n n x = [N6 y] - | Lt => eval6n n x < [N6 y] - | Gt => eval6n n x > [N6 y] - end. - intros n x y. - unfold comparen_6, to_Z; rewrite spec_gen_eval6n. - apply spec_compare_mn_1. - exact (spec_0 w6_spec). - intros x1; exact (spec_compare w6_spec W0 x1). - exact (spec_to_Z w6_spec). - exact (spec_compare w6_spec). - exact (spec_compare w6_spec). - exact (spec_to_Z w6_spec). - Qed. - - Let spec_opp_compare: forall c (u v: Z), - match c with Eq => u = v | Lt => u < v | Gt => u > v end -> - match opp_compare c with Eq => v = u | Lt => v < u | Gt => v > u end. - Proof. - intros c u v; case c; unfold opp_compare; auto with zarith. - Qed. - - Theorem spec_compare: forall x y, - match compare x y with - Eq => [x] = [y] - | Lt => [x] < [y] - | Gt => [x] > [y] - end. - Proof. - refine (spec_iter _ (fun x y res => - match res with - Eq => x = y - | Lt => x < y - | Gt => x > y - end) - compare_0 - (fun n x y => opp_compare (comparen_0 (S n) y x)) - (fun n => comparen_0 (S n)) _ _ _ - compare_1 - (fun n x y => opp_compare (comparen_1 (S n) y x)) - (fun n => comparen_1 (S n)) _ _ _ - compare_2 - (fun n x y => opp_compare (comparen_2 (S n) y x)) - (fun n => comparen_2 (S n)) _ _ _ - compare_3 - (fun n x y => opp_compare (comparen_3 (S n) y x)) - (fun n => comparen_3 (S n)) _ _ _ - compare_4 - (fun n x y => opp_compare (comparen_4 (S n) y x)) - (fun n => comparen_4 (S n)) _ _ _ - compare_5 - (fun n x y => opp_compare (comparen_5 (S n) y x)) - (fun n => comparen_5 (S n)) _ _ _ - compare_6 - (fun n x y => opp_compare (comparen_6 (S n) y x)) - (fun n => comparen_6 (S n)) _ _ _ - comparenm _). - exact spec_compare_0. - intros n x y H;apply spec_opp_compare; apply spec_comparen_0. - intros n x y H; exact (spec_comparen_0 (S n) x y). - exact spec_compare_1. - intros n x y H;apply spec_opp_compare; apply spec_comparen_1. - intros n x y H; exact (spec_comparen_1 (S n) x y). - exact spec_compare_2. - intros n x y H;apply spec_opp_compare; apply spec_comparen_2. - intros n x y H; exact (spec_comparen_2 (S n) x y). - exact spec_compare_3. - intros n x y H;apply spec_opp_compare; apply spec_comparen_3. - intros n x y H; exact (spec_comparen_3 (S n) x y). - exact spec_compare_4. - intros n x y H;apply spec_opp_compare; apply spec_comparen_4. - intros n x y H; exact (spec_comparen_4 (S n) x y). - exact spec_compare_5. - intros n x y H;apply spec_opp_compare; apply spec_comparen_5. - intros n x y H; exact (spec_comparen_5 (S n) x y). - exact spec_compare_6. - intros n x y;apply spec_opp_compare; apply spec_comparen_6. - intros n; exact (spec_comparen_6 (S n)). - intros n m x y; unfold comparenm. - rewrite <- (spec_cast_l n m x); rewrite <- (spec_cast_r n m y). - unfold to_Z; apply (spec_compare (wn_spec (Max.max n m))). - Qed. - - Definition eq_bool x y := - match compare x y with - | Eq => true - | _ => false - end. - - Theorem spec_eq_bool: forall x y, - if eq_bool x y then [x] = [y] else [x] <> [y]. - Proof. - intros x y; unfold eq_bool. - generalize (spec_compare x y); case compare; auto with zarith. - Qed. - - (***************************************************************) - (* *) - (* Multiplication *) - (* *) - (***************************************************************) - - Definition w0_mul_c := w0_op.(znz_mul_c). - Definition w1_mul_c := w1_op.(znz_mul_c). - Definition w2_mul_c := w2_op.(znz_mul_c). - Definition w3_mul_c := w3_op.(znz_mul_c). - Definition w4_mul_c := w4_op.(znz_mul_c). - Definition w5_mul_c := w5_op.(znz_mul_c). - Definition w6_mul_c := w6_op.(znz_mul_c). - - Definition w0_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w0 w_0 w0_succ w0_add_c w0_mul_c. - Definition w1_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w1 W0 w1_succ w1_add_c w1_mul_c. - Definition w2_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w2 W0 w2_succ w2_add_c w2_mul_c. - Definition w3_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w3 W0 w3_succ w3_add_c w3_mul_c. - Definition w4_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w4 W0 w4_succ w4_add_c w4_mul_c. - Definition w5_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w5 W0 w5_succ w5_add_c w5_mul_c. - Definition w6_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w6 W0 w6_succ w6_add_c w6_mul_c. - - Definition w0_0W := w0_op.(znz_0W). - Definition w1_0W := w1_op.(znz_0W). - Definition w2_0W := w2_op.(znz_0W). - Definition w3_0W := w3_op.(znz_0W). - Definition w4_0W := w4_op.(znz_0W). - Definition w5_0W := w5_op.(znz_0W). - Definition w6_0W := w6_op.(znz_0W). - - Definition w0_mul_add_n1 := - @gen_mul_add_n1 w0 w_0 w0_op.(znz_WW) w0_0W w0_mul_add. - Definition w1_mul_add_n1 := - @gen_mul_add_n1 w1 W0 w1_op.(znz_WW) w1_0W w1_mul_add. - Definition w2_mul_add_n1 := - @gen_mul_add_n1 w2 W0 w2_op.(znz_WW) w2_0W w2_mul_add. - Definition w3_mul_add_n1 := - @gen_mul_add_n1 w3 W0 w3_op.(znz_WW) w3_0W w3_mul_add. - Definition w4_mul_add_n1 := - @gen_mul_add_n1 w4 W0 w4_op.(znz_WW) w4_0W w4_mul_add. - Definition w5_mul_add_n1 := - @gen_mul_add_n1 w5 W0 w5_op.(znz_WW) w5_0W w5_mul_add. - Definition w6_mul_add_n1 := - @gen_mul_add_n1 w6 W0 w6_op.(znz_WW) w6_0W w6_mul_add. - - Let to_Z0 n := - match n return word w0 (S n) -> t_ with - | 0%nat => fun x => N1 x - | 1%nat => fun x => N2 x - | 2%nat => fun x => N3 x - | 3%nat => fun x => N4 x - | 4%nat => fun x => N5 x - | 5%nat => fun x => N6 x - | 6%nat => fun x => Nn 0 x - | 7%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. - - Let to_Z1 n := - match n return word w1 (S n) -> t_ with - | 0%nat => fun x => N2 x - | 1%nat => fun x => N3 x - | 2%nat => fun x => N4 x - | 3%nat => fun x => N5 x - | 4%nat => fun x => N6 x - | 5%nat => fun x => Nn 0 x - | 6%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. - - Let to_Z2 n := - match n return word w2 (S n) -> t_ with - | 0%nat => fun x => N3 x - | 1%nat => fun x => N4 x - | 2%nat => fun x => N5 x - | 3%nat => fun x => N6 x - | 4%nat => fun x => Nn 0 x - | 5%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. - - Let to_Z3 n := - match n return word w3 (S n) -> t_ with - | 0%nat => fun x => N4 x - | 1%nat => fun x => N5 x - | 2%nat => fun x => N6 x - | 3%nat => fun x => Nn 0 x - | 4%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. - - Let to_Z4 n := - match n return word w4 (S n) -> t_ with - | 0%nat => fun x => N5 x - | 1%nat => fun x => N6 x - | 2%nat => fun x => Nn 0 x - | 3%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. - - Let to_Z5 n := - match n return word w5 (S n) -> t_ with - | 0%nat => fun x => N6 x - | 1%nat => fun x => Nn 0 x - | 2%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. - -Theorem to_Z0_spec: - forall n x, Z_of_nat n <= 7 -> [to_Z0 n x] = znz_to_Z (nmake_op _ w0_op (S n)) x. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n1; auto. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n2; auto. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n3; auto. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n4; auto. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n5; auto. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n6; auto. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n7; auto. - intros n; case n; clear n. - unfold to_Z0. - intros x H; rewrite spec_eval0n8; auto. - intros n x. - repeat rewrite inj_S; unfold Zsucc; auto with zarith. - Qed. - -Theorem to_Z1_spec: - forall n x, Z_of_nat n <= 6 -> [to_Z1 n x] = znz_to_Z (nmake_op _ w1_op (S n)) x. - intros n; case n; clear n. - unfold to_Z1. - intros x H; rewrite spec_eval1n1; auto. - intros n; case n; clear n. - unfold to_Z1. - intros x H; rewrite spec_eval1n2; auto. - intros n; case n; clear n. - unfold to_Z1. - intros x H; rewrite spec_eval1n3; auto. - intros n; case n; clear n. - unfold to_Z1. - intros x H; rewrite spec_eval1n4; auto. - intros n; case n; clear n. - unfold to_Z1. - intros x H; rewrite spec_eval1n5; auto. - intros n; case n; clear n. - unfold to_Z1. - intros x H; rewrite spec_eval1n6; auto. - intros n; case n; clear n. - unfold to_Z1. - intros x H; rewrite spec_eval1n7; auto. - intros n x. - repeat rewrite inj_S; unfold Zsucc; auto with zarith. - Qed. - -Theorem to_Z2_spec: - forall n x, Z_of_nat n <= 5 -> [to_Z2 n x] = znz_to_Z (nmake_op _ w2_op (S n)) x. - intros n; case n; clear n. - unfold to_Z2. - intros x H; rewrite spec_eval2n1; auto. - intros n; case n; clear n. - unfold to_Z2. - intros x H; rewrite spec_eval2n2; auto. - intros n; case n; clear n. - unfold to_Z2. - intros x H; rewrite spec_eval2n3; auto. - intros n; case n; clear n. - unfold to_Z2. - intros x H; rewrite spec_eval2n4; auto. - intros n; case n; clear n. - unfold to_Z2. - intros x H; rewrite spec_eval2n5; auto. - intros n; case n; clear n. - unfold to_Z2. - intros x H; rewrite spec_eval2n6; auto. - intros n x. - repeat rewrite inj_S; unfold Zsucc; auto with zarith. - Qed. - -Theorem to_Z3_spec: - forall n x, Z_of_nat n <= 4 -> [to_Z3 n x] = znz_to_Z (nmake_op _ w3_op (S n)) x. - intros n; case n; clear n. - unfold to_Z3. - intros x H; rewrite spec_eval3n1; auto. - intros n; case n; clear n. - unfold to_Z3. - intros x H; rewrite spec_eval3n2; auto. - intros n; case n; clear n. - unfold to_Z3. - intros x H; rewrite spec_eval3n3; auto. - intros n; case n; clear n. - unfold to_Z3. - intros x H; rewrite spec_eval3n4; auto. - intros n; case n; clear n. - unfold to_Z3. - intros x H; rewrite spec_eval3n5; auto. - intros n x. - repeat rewrite inj_S; unfold Zsucc; auto with zarith. - Qed. - -Theorem to_Z4_spec: - forall n x, Z_of_nat n <= 3 -> [to_Z4 n x] = znz_to_Z (nmake_op _ w4_op (S n)) x. - intros n; case n; clear n. - unfold to_Z4. - intros x H; rewrite spec_eval4n1; auto. - intros n; case n; clear n. - unfold to_Z4. - intros x H; rewrite spec_eval4n2; auto. - intros n; case n; clear n. - unfold to_Z4. - intros x H; rewrite spec_eval4n3; auto. - intros n; case n; clear n. - unfold to_Z4. - intros x H; rewrite spec_eval4n4; auto. - intros n x. - repeat rewrite inj_S; unfold Zsucc; auto with zarith. - Qed. - -Theorem to_Z5_spec: - forall n x, Z_of_nat n <= 2 -> [to_Z5 n x] = znz_to_Z (nmake_op _ w5_op (S n)) x. - intros n; case n; clear n. - unfold to_Z5. - intros x H; rewrite spec_eval5n1; auto. - intros n; case n; clear n. - unfold to_Z5. - intros x H; rewrite spec_eval5n2; auto. - intros n; case n; clear n. - unfold to_Z5. - intros x H; rewrite spec_eval5n3; auto. - intros n x. - repeat rewrite inj_S; unfold Zsucc; auto with zarith. - Qed. - - Definition w0_mul n x y := - let (w,r) := w0_mul_add_n1 (S n) x y w_0 in - if w0_eq0 w then to_Z0 n r - else to_Z0 (S n) (WW (extend0 n w) r). - - Definition w1_mul n x y := - let (w,r) := w1_mul_add_n1 (S n) x y W0 in - if w1_eq0 w then to_Z1 n r - else to_Z1 (S n) (WW (extend1 n w) r). - - Definition w2_mul n x y := - let (w,r) := w2_mul_add_n1 (S n) x y W0 in - if w2_eq0 w then to_Z2 n r - else to_Z2 (S n) (WW (extend2 n w) r). - - Definition w3_mul n x y := - let (w,r) := w3_mul_add_n1 (S n) x y W0 in - if w3_eq0 w then to_Z3 n r - else to_Z3 (S n) (WW (extend3 n w) r). - - Definition w4_mul n x y := - let (w,r) := w4_mul_add_n1 (S n) x y W0 in - if w4_eq0 w then to_Z4 n r - else to_Z4 (S n) (WW (extend4 n w) r). - - Definition w5_mul n x y := - let (w,r) := w5_mul_add_n1 (S n) x y W0 in - if w5_eq0 w then to_Z5 n r - else to_Z5 (S n) (WW (extend5 n w) r). - - Definition w6_mul n x y := - let (w,r) := w6_mul_add_n1 (S n) x y W0 in - if w6_eq0 w then Nn n r - else Nn (S n) (WW (extend6 n w) r). - - Definition mulnm n m x y := - let mn := Max.max n m in - let d := diff n m in - let op := make_op mn in - reduce_n (S mn) (op.(znz_mul_c) - (castm (diff_r n m) (extend_tr x (snd d))) - (castm (diff_l n m) (extend_tr y (fst d)))). - - Definition mul := Eval lazy beta delta [iter0] in - (iter0 t_ - (fun x y => reduce_1 (w0_mul_c x y)) - (fun n x y => w0_mul n y x) - w0_mul - (fun x y => reduce_2 (w1_mul_c x y)) - (fun n x y => w1_mul n y x) - w1_mul - (fun x y => reduce_3 (w2_mul_c x y)) - (fun n x y => w2_mul n y x) - w2_mul - (fun x y => reduce_4 (w3_mul_c x y)) - (fun n x y => w3_mul n y x) - w3_mul - (fun x y => reduce_5 (w4_mul_c x y)) - (fun n x y => w4_mul n y x) - w4_mul - (fun x y => reduce_6 (w5_mul_c x y)) - (fun n x y => w5_mul n y x) - w5_mul - (fun x y => reduce_7 (w6_mul_c x y)) - (fun n x y => w6_mul n y x) - w6_mul - mulnm - (fun _ => N0 w_0) - (fun _ => N0 w_0) - ). - - Let spec_w0_mul_add: forall x y z, - let (q,r) := w0_mul_add x y z in - znz_to_Z w0_op q * (base (znz_digits w0_op)) + znz_to_Z w0_op r = - znz_to_Z w0_op x * znz_to_Z w0_op y + znz_to_Z w0_op z := - (spec_mul_add w0_spec). - - Let spec_w1_mul_add: forall x y z, - let (q,r) := w1_mul_add x y z in - znz_to_Z w1_op q * (base (znz_digits w1_op)) + znz_to_Z w1_op r = - znz_to_Z w1_op x * znz_to_Z w1_op y + znz_to_Z w1_op z := - (spec_mul_add w1_spec). - - Let spec_w2_mul_add: forall x y z, - let (q,r) := w2_mul_add x y z in - znz_to_Z w2_op q * (base (znz_digits w2_op)) + znz_to_Z w2_op r = - znz_to_Z w2_op x * znz_to_Z w2_op y + znz_to_Z w2_op z := - (spec_mul_add w2_spec). - - Let spec_w3_mul_add: forall x y z, - let (q,r) := w3_mul_add x y z in - znz_to_Z w3_op q * (base (znz_digits w3_op)) + znz_to_Z w3_op r = - znz_to_Z w3_op x * znz_to_Z w3_op y + znz_to_Z w3_op z := - (spec_mul_add w3_spec). - - Let spec_w4_mul_add: forall x y z, - let (q,r) := w4_mul_add x y z in - znz_to_Z w4_op q * (base (znz_digits w4_op)) + znz_to_Z w4_op r = - znz_to_Z w4_op x * znz_to_Z w4_op y + znz_to_Z w4_op z := - (spec_mul_add w4_spec). - - Let spec_w5_mul_add: forall x y z, - let (q,r) := w5_mul_add x y z in - znz_to_Z w5_op q * (base (znz_digits w5_op)) + znz_to_Z w5_op r = - znz_to_Z w5_op x * znz_to_Z w5_op y + znz_to_Z w5_op z := - (spec_mul_add w5_spec). - - Let spec_w6_mul_add: forall x y z, - let (q,r) := w6_mul_add x y z in - znz_to_Z w6_op q * (base (znz_digits w6_op)) + znz_to_Z w6_op r = - znz_to_Z w6_op x * znz_to_Z w6_op y + znz_to_Z w6_op z := - (spec_mul_add w6_spec). - - Theorem spec_w0_mul_add_n1: forall n x y z, - let (q,r) := w0_mul_add_n1 n x y z in - znz_to_Z w0_op q * (base (znz_digits (nmake_op _ w0_op n))) + - znz_to_Z (nmake_op _ w0_op n) r = - znz_to_Z (nmake_op _ w0_op n) x * znz_to_Z w0_op y + - znz_to_Z w0_op z. - Proof. - intros n x y z; unfold w0_mul_add_n1. - rewrite nmake_gen. - rewrite digits_gend. - change (base (GenBase.gen_digits (znz_digits w0_op) n)) with - (GenBase.gen_wB (znz_digits w0_op) n). - apply spec_gen_mul_add_n1; auto. - exact (spec_0 w0_spec). - exact (spec_WW w0_spec). - exact (spec_0W w0_spec). - exact (spec_mul_add w0_spec). - Qed. - - Theorem spec_w1_mul_add_n1: forall n x y z, - let (q,r) := w1_mul_add_n1 n x y z in - znz_to_Z w1_op q * (base (znz_digits (nmake_op _ w1_op n))) + - znz_to_Z (nmake_op _ w1_op n) r = - znz_to_Z (nmake_op _ w1_op n) x * znz_to_Z w1_op y + - znz_to_Z w1_op z. - Proof. - intros n x y z; unfold w1_mul_add_n1. - rewrite nmake_gen. - rewrite digits_gend. - change (base (GenBase.gen_digits (znz_digits w1_op) n)) with - (GenBase.gen_wB (znz_digits w1_op) n). - apply spec_gen_mul_add_n1; auto. - exact (spec_WW w1_spec). - exact (spec_0W w1_spec). - exact (spec_mul_add w1_spec). - Qed. - - Theorem spec_w2_mul_add_n1: forall n x y z, - let (q,r) := w2_mul_add_n1 n x y z in - znz_to_Z w2_op q * (base (znz_digits (nmake_op _ w2_op n))) + - znz_to_Z (nmake_op _ w2_op n) r = - znz_to_Z (nmake_op _ w2_op n) x * znz_to_Z w2_op y + - znz_to_Z w2_op z. - Proof. - intros n x y z; unfold w2_mul_add_n1. - rewrite nmake_gen. - rewrite digits_gend. - change (base (GenBase.gen_digits (znz_digits w2_op) n)) with - (GenBase.gen_wB (znz_digits w2_op) n). - apply spec_gen_mul_add_n1; auto. - exact (spec_WW w2_spec). - exact (spec_0W w2_spec). - exact (spec_mul_add w2_spec). - Qed. - - Theorem spec_w3_mul_add_n1: forall n x y z, - let (q,r) := w3_mul_add_n1 n x y z in - znz_to_Z w3_op q * (base (znz_digits (nmake_op _ w3_op n))) + - znz_to_Z (nmake_op _ w3_op n) r = - znz_to_Z (nmake_op _ w3_op n) x * znz_to_Z w3_op y + - znz_to_Z w3_op z. - Proof. - intros n x y z; unfold w3_mul_add_n1. - rewrite nmake_gen. - rewrite digits_gend. - change (base (GenBase.gen_digits (znz_digits w3_op) n)) with - (GenBase.gen_wB (znz_digits w3_op) n). - apply spec_gen_mul_add_n1; auto. - exact (spec_WW w3_spec). - exact (spec_0W w3_spec). - exact (spec_mul_add w3_spec). - Qed. - - Theorem spec_w4_mul_add_n1: forall n x y z, - let (q,r) := w4_mul_add_n1 n x y z in - znz_to_Z w4_op q * (base (znz_digits (nmake_op _ w4_op n))) + - znz_to_Z (nmake_op _ w4_op n) r = - znz_to_Z (nmake_op _ w4_op n) x * znz_to_Z w4_op y + - znz_to_Z w4_op z. - Proof. - intros n x y z; unfold w4_mul_add_n1. - rewrite nmake_gen. - rewrite digits_gend. - change (base (GenBase.gen_digits (znz_digits w4_op) n)) with - (GenBase.gen_wB (znz_digits w4_op) n). - apply spec_gen_mul_add_n1; auto. - exact (spec_WW w4_spec). - exact (spec_0W w4_spec). - exact (spec_mul_add w4_spec). - Qed. - - Theorem spec_w5_mul_add_n1: forall n x y z, - let (q,r) := w5_mul_add_n1 n x y z in - znz_to_Z w5_op q * (base (znz_digits (nmake_op _ w5_op n))) + - znz_to_Z (nmake_op _ w5_op n) r = - znz_to_Z (nmake_op _ w5_op n) x * znz_to_Z w5_op y + - znz_to_Z w5_op z. - Proof. - intros n x y z; unfold w5_mul_add_n1. - rewrite nmake_gen. - rewrite digits_gend. - change (base (GenBase.gen_digits (znz_digits w5_op) n)) with - (GenBase.gen_wB (znz_digits w5_op) n). - apply spec_gen_mul_add_n1; auto. - exact (spec_WW w5_spec). - exact (spec_0W w5_spec). - exact (spec_mul_add w5_spec). - Qed. - - Theorem spec_w6_mul_add_n1: forall n x y z, - let (q,r) := w6_mul_add_n1 n x y z in - znz_to_Z w6_op q * (base (znz_digits (nmake_op _ w6_op n))) + - znz_to_Z (nmake_op _ w6_op n) r = - znz_to_Z (nmake_op _ w6_op n) x * znz_to_Z w6_op y + - znz_to_Z w6_op z. - Proof. - intros n x y z; unfold w6_mul_add_n1. - rewrite nmake_gen. - rewrite digits_gend. - change (base (GenBase.gen_digits (znz_digits w6_op) n)) with - (GenBase.gen_wB (znz_digits w6_op) n). - apply spec_gen_mul_add_n1; auto. - exact (spec_WW w6_spec). - exact (spec_0W w6_spec). - exact (spec_mul_add w6_spec). - Qed. - - Lemma nmake_op_WW: forall ww ww1 n x y, - znz_to_Z (nmake_op ww ww1 (S n)) (WW x y) = - znz_to_Z (nmake_op ww ww1 n) x * base (znz_digits (nmake_op ww ww1 n)) + - znz_to_Z (nmake_op ww ww1 n) y. - auto. - Qed. - - Lemma extend0n_spec: forall n x1, - znz_to_Z (nmake_op _ w0_op (S n)) (extend0 n x1) = - znz_to_Z w0_op x1. - Proof. - intros n1 x2; rewrite nmake_gen. - unfold extend0. - rewrite GenBase.spec_extend; auto. - intros l; simpl; unfold w_0; rewrite (spec_0 w0_spec); ring. - Qed. - - Lemma extend1n_spec: forall n x1, - znz_to_Z (nmake_op _ w1_op (S n)) (extend1 n x1) = - znz_to_Z w1_op x1. - Proof. - intros n1 x2; rewrite nmake_gen. - unfold extend1. - rewrite GenBase.spec_extend; auto. - Qed. - - Lemma extend2n_spec: forall n x1, - znz_to_Z (nmake_op _ w2_op (S n)) (extend2 n x1) = - znz_to_Z w2_op x1. - Proof. - intros n1 x2; rewrite nmake_gen. - unfold extend2. - rewrite GenBase.spec_extend; auto. - Qed. - - Lemma extend3n_spec: forall n x1, - znz_to_Z (nmake_op _ w3_op (S n)) (extend3 n x1) = - znz_to_Z w3_op x1. - Proof. - intros n1 x2; rewrite nmake_gen. - unfold extend3. - rewrite GenBase.spec_extend; auto. - Qed. - - Lemma extend4n_spec: forall n x1, - znz_to_Z (nmake_op _ w4_op (S n)) (extend4 n x1) = - znz_to_Z w4_op x1. - Proof. - intros n1 x2; rewrite nmake_gen. - unfold extend4. - rewrite GenBase.spec_extend; auto. - Qed. - - Lemma extend5n_spec: forall n x1, - znz_to_Z (nmake_op _ w5_op (S n)) (extend5 n x1) = - znz_to_Z w5_op x1. - Proof. - intros n1 x2; rewrite nmake_gen. - unfold extend5. - rewrite GenBase.spec_extend; auto. - Qed. - - Lemma extend6n_spec: forall n x1, - znz_to_Z (nmake_op _ w6_op (S n)) (extend6 n x1) = - znz_to_Z w6_op x1. - Proof. - intros n1 x2; rewrite nmake_gen. - unfold extend6. - rewrite GenBase.spec_extend; auto. - Qed. - - Lemma spec_muln: - forall n (x: word _ (S n)) y, - [Nn (S n) (znz_mul_c (make_op n) x y)] = [Nn n x] * [Nn n y]. - Proof. - intros n x y; unfold to_Z. - rewrite <- (spec_mul_c (wn_spec n)). - rewrite make_op_S. - case znz_mul_c; auto. - Qed. - Theorem spec_mul: forall x y, [mul x y] = [x] * [y]. - Proof. - assert(F0: - forall n x y, - Z_of_nat n <= 6 -> [w0_mul n x y] = eval0n (S n) x * [N0 y]). - intros n x y H; unfold w0_mul. - generalize (spec_w0_mul_add_n1 (S n) x y w_0). - case w0_mul_add_n1; intros x1 y1. - change (znz_to_Z (nmake_op _ w0_op (S n)) x) with (eval0n (S n) x). - change (znz_to_Z w0_op y) with ([N0 y]). - unfold w_0; rewrite (spec_0 w0_spec); rewrite Zplus_0_r. - intros H1; rewrite <- H1; clear H1. - generalize (spec_w0_eq0 x1); case w0_eq0; intros HH. - unfold to_Z in HH; rewrite HH. - rewrite to_Z0_spec; auto with zarith. - rewrite to_Z0_spec; try (rewrite inj_S; auto with zarith). - rewrite nmake_op_WW; rewrite extend0n_spec; auto. - assert(F1: - forall n x y, - Z_of_nat n <= 5 -> [w1_mul n x y] = eval1n (S n) x * [N1 y]). - intros n x y H; unfold w1_mul. - generalize (spec_w1_mul_add_n1 (S n) x y W0). - case w1_mul_add_n1; intros x1 y1. - change (znz_to_Z (nmake_op _ w1_op (S n)) x) with (eval1n (S n) x). - change (znz_to_Z w1_op y) with ([N1 y]). - change (znz_to_Z w1_op W0) with 0; rewrite Zplus_0_r. - intros H1; rewrite <- H1; clear H1. - generalize (spec_w1_eq0 x1); case w1_eq0; intros HH. - unfold to_Z in HH; rewrite HH. - rewrite to_Z1_spec; auto with zarith. - rewrite to_Z1_spec; try (rewrite inj_S; auto with zarith). - rewrite nmake_op_WW; rewrite extend1n_spec; auto. - assert(F2: - forall n x y, - Z_of_nat n <= 4 -> [w2_mul n x y] = eval2n (S n) x * [N2 y]). - intros n x y H; unfold w2_mul. - generalize (spec_w2_mul_add_n1 (S n) x y W0). - case w2_mul_add_n1; intros x1 y1. - change (znz_to_Z (nmake_op _ w2_op (S n)) x) with (eval2n (S n) x). - change (znz_to_Z w2_op y) with ([N2 y]). - change (znz_to_Z w2_op W0) with 0; rewrite Zplus_0_r. - intros H1; rewrite <- H1; clear H1. - generalize (spec_w2_eq0 x1); case w2_eq0; intros HH. - unfold to_Z in HH; rewrite HH. - rewrite to_Z2_spec; auto with zarith. - rewrite to_Z2_spec; try (rewrite inj_S; auto with zarith). - rewrite nmake_op_WW; rewrite extend2n_spec; auto. - assert(F3: - forall n x y, - Z_of_nat n <= 3 -> [w3_mul n x y] = eval3n (S n) x * [N3 y]). - intros n x y H; unfold w3_mul. - generalize (spec_w3_mul_add_n1 (S n) x y W0). - case w3_mul_add_n1; intros x1 y1. - change (znz_to_Z (nmake_op _ w3_op (S n)) x) with (eval3n (S n) x). - change (znz_to_Z w3_op y) with ([N3 y]). - change (znz_to_Z w3_op W0) with 0; rewrite Zplus_0_r. - intros H1; rewrite <- H1; clear H1. - generalize (spec_w3_eq0 x1); case w3_eq0; intros HH. - unfold to_Z in HH; rewrite HH. - rewrite to_Z3_spec; auto with zarith. - rewrite to_Z3_spec; try (rewrite inj_S; auto with zarith). - rewrite nmake_op_WW; rewrite extend3n_spec; auto. - assert(F4: - forall n x y, - Z_of_nat n <= 2 -> [w4_mul n x y] = eval4n (S n) x * [N4 y]). - intros n x y H; unfold w4_mul. - generalize (spec_w4_mul_add_n1 (S n) x y W0). - case w4_mul_add_n1; intros x1 y1. - change (znz_to_Z (nmake_op _ w4_op (S n)) x) with (eval4n (S n) x). - change (znz_to_Z w4_op y) with ([N4 y]). - change (znz_to_Z w4_op W0) with 0; rewrite Zplus_0_r. - intros H1; rewrite <- H1; clear H1. - generalize (spec_w4_eq0 x1); case w4_eq0; intros HH. - unfold to_Z in HH; rewrite HH. - rewrite to_Z4_spec; auto with zarith. - rewrite to_Z4_spec; try (rewrite inj_S; auto with zarith). - rewrite nmake_op_WW; rewrite extend4n_spec; auto. - assert(F5: - forall n x y, - Z_of_nat n <= 1 -> [w5_mul n x y] = eval5n (S n) x * [N5 y]). - intros n x y H; unfold w5_mul. - generalize (spec_w5_mul_add_n1 (S n) x y W0). - case w5_mul_add_n1; intros x1 y1. - change (znz_to_Z (nmake_op _ w5_op (S n)) x) with (eval5n (S n) x). - change (znz_to_Z w5_op y) with ([N5 y]). - change (znz_to_Z w5_op W0) with 0; rewrite Zplus_0_r. - intros H1; rewrite <- H1; clear H1. - generalize (spec_w5_eq0 x1); case w5_eq0; intros HH. - unfold to_Z in HH; rewrite HH. - rewrite to_Z5_spec; auto with zarith. - rewrite to_Z5_spec; try (rewrite inj_S; auto with zarith). - rewrite nmake_op_WW; rewrite extend5n_spec; auto. - assert(F6: - forall n x y, - [w6_mul n x y] = eval6n (S n) x * [N6 y]). - intros n x y; unfold w6_mul. - generalize (spec_w6_mul_add_n1 (S n) x y W0). - case w6_mul_add_n1; intros x1 y1. - change (znz_to_Z (nmake_op _ w6_op (S n)) x) with (eval6n (S n) x). - change (znz_to_Z w6_op y) with ([N6 y]). - change (znz_to_Z w6_op W0) with 0; rewrite Zplus_0_r. - intros H1; rewrite <- H1; clear H1. - generalize (spec_w6_eq0 x1); case w6_eq0; intros HH. - unfold to_Z in HH; rewrite HH. - rewrite spec_eval6n; unfold eval6n, nmake_op6; auto. - rewrite spec_eval6n; unfold eval6n, nmake_op6. - rewrite nmake_op_WW; rewrite extend6n_spec; auto. - refine (spec_iter0 t_ (fun x y res => [res] = x * y) - (fun x y => reduce_1 (w0_mul_c x y)) - (fun n x y => w0_mul n y x) - w0_mul _ _ _ - (fun x y => reduce_2 (w1_mul_c x y)) - (fun n x y => w1_mul n y x) - w1_mul _ _ _ - (fun x y => reduce_3 (w2_mul_c x y)) - (fun n x y => w2_mul n y x) - w2_mul _ _ _ - (fun x y => reduce_4 (w3_mul_c x y)) - (fun n x y => w3_mul n y x) - w3_mul _ _ _ - (fun x y => reduce_5 (w4_mul_c x y)) - (fun n x y => w4_mul n y x) - w4_mul _ _ _ - (fun x y => reduce_6 (w5_mul_c x y)) - (fun n x y => w5_mul n y x) - w5_mul _ _ _ - (fun x y => reduce_7 (w6_mul_c x y)) - (fun n x y => w6_mul n y x) - w6_mul _ _ _ - mulnm _ - (fun _ => N0 w_0) _ - (fun _ => N0 w_0) _ - ). - intros x y; rewrite spec_reduce_1. - unfold w0_mul_c, to_Z. - generalize (spec_mul_c w0_spec x y). - intros HH; rewrite <- HH; clear HH; auto. - intros n x y H; rewrite F0; auto with zarith. - intros n x y H; rewrite F0; auto with zarith. - intros x y; rewrite spec_reduce_2. - unfold w1_mul_c, to_Z. - generalize (spec_mul_c w1_spec x y). - intros HH; rewrite <- HH; clear HH; auto. - intros n x y H; rewrite F1; auto with zarith. - intros n x y H; rewrite F1; auto with zarith. - intros x y; rewrite spec_reduce_3. - unfold w2_mul_c, to_Z. - generalize (spec_mul_c w2_spec x y). - intros HH; rewrite <- HH; clear HH; auto. - intros n x y H; rewrite F2; auto with zarith. - intros n x y H; rewrite F2; auto with zarith. - intros x y; rewrite spec_reduce_4. - unfold w3_mul_c, to_Z. - generalize (spec_mul_c w3_spec x y). - intros HH; rewrite <- HH; clear HH; auto. - intros n x y H; rewrite F3; auto with zarith. - intros n x y H; rewrite F3; auto with zarith. - intros x y; rewrite spec_reduce_5. - unfold w4_mul_c, to_Z. - generalize (spec_mul_c w4_spec x y). - intros HH; rewrite <- HH; clear HH; auto. - intros n x y H; rewrite F4; auto with zarith. - intros n x y H; rewrite F4; auto with zarith. - intros x y; rewrite spec_reduce_6. - unfold w5_mul_c, to_Z. - generalize (spec_mul_c w5_spec x y). - intros HH; rewrite <- HH; clear HH; auto. - intros n x y H; rewrite F5; auto with zarith. - intros n x y H; rewrite F5; auto with zarith. - intros x y; rewrite spec_reduce_7. - unfold w6_mul_c, to_Z. - generalize (spec_mul_c w6_spec x y). - intros HH; rewrite <- HH; clear HH; auto. - intros n x y; rewrite F6; auto with zarith. - intros n x y; rewrite F6; auto with zarith. - intros n m x y; unfold mulnm. - rewrite spec_reduce_n. - rewrite <- (spec_cast_l n m x). - rewrite <- (spec_cast_r n m y). - rewrite spec_muln; rewrite spec_cast_l; rewrite spec_cast_r; auto. - intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring. - intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring. - Qed. - - (***************************************************************) - (* *) - (* Square *) - (* *) - (***************************************************************) - - Definition w0_square_c := w0_op.(znz_square_c). - Definition w1_square_c := w1_op.(znz_square_c). - Definition w2_square_c := w2_op.(znz_square_c). - Definition w3_square_c := w3_op.(znz_square_c). - Definition w4_square_c := w4_op.(znz_square_c). - Definition w5_square_c := w5_op.(znz_square_c). - Definition w6_square_c := w6_op.(znz_square_c). - - Definition square x := - match x with - | N0 wx => reduce_1 (w0_square_c wx) - | N1 wx => N2 (w1_square_c wx) - | N2 wx => N3 (w2_square_c wx) - | N3 wx => N4 (w3_square_c wx) - | N4 wx => N5 (w4_square_c wx) - | N5 wx => N6 (w5_square_c wx) - | N6 wx => Nn 0 (w6_square_c wx) - | Nn n wx => - let op := make_op n in - Nn (S n) (op.(znz_square_c) wx) - end. - - Theorem spec_square: forall x, [square x] = [x] * [x]. - Proof. - intros x; case x; unfold square; clear x. - intros x; rewrite spec_reduce_1; unfold to_Z. - exact (spec_square_c w0_spec x). - intros x; unfold to_Z. - exact (spec_square_c w1_spec x). - intros x; unfold to_Z. - exact (spec_square_c w2_spec x). - intros x; unfold to_Z. - exact (spec_square_c w3_spec x). - intros x; unfold to_Z. - exact (spec_square_c w4_spec x). - intros x; unfold to_Z. - exact (spec_square_c w5_spec x). - intros x; unfold to_Z. - exact (spec_square_c w6_spec x). - intros n x; unfold to_Z. - rewrite make_op_S. - exact (spec_square_c (wn_spec n) x). -Qed. - - (***************************************************************) - (* *) - (* Power *) - (* *) - (***************************************************************) - - Fixpoint power_pos (x:t) (p:positive) {struct p} : t := - match p with - | xH => x - | xO p => square (power_pos x p) - | xI p => mul (square (power_pos x p)) x - end. - - Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. - Proof. - intros x n; generalize x; elim n; clear n x; simpl power_pos. - intros; rewrite spec_mul; rewrite spec_square; rewrite H. - rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith. - rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. - rewrite Zpower_2; rewrite Zpower_1_r; auto. - intros; rewrite spec_square; rewrite H. - rewrite Zpos_xO; auto with zarith. - rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. - rewrite Zpower_2; auto. - intros; rewrite Zpower_1_r; auto. - Qed. - - - (***************************************************************) - (* *) - (* Square root *) - (* *) - (***************************************************************) - - Definition w0_sqrt := w0_op.(znz_sqrt). - Definition w1_sqrt := w1_op.(znz_sqrt). - Definition w2_sqrt := w2_op.(znz_sqrt). - Definition w3_sqrt := w3_op.(znz_sqrt). - Definition w4_sqrt := w4_op.(znz_sqrt). - Definition w5_sqrt := w5_op.(znz_sqrt). - Definition w6_sqrt := w6_op.(znz_sqrt). - - Definition sqrt x := - match x with - | N0 wx => reduce_0 (w0_sqrt wx) - | N1 wx => reduce_1 (w1_sqrt wx) - | N2 wx => reduce_2 (w2_sqrt wx) - | N3 wx => reduce_3 (w3_sqrt wx) - | N4 wx => reduce_4 (w4_sqrt wx) - | N5 wx => reduce_5 (w5_sqrt wx) - | N6 wx => reduce_6 (w6_sqrt wx) - | Nn n wx => - let op := make_op n in - reduce_n n (op.(znz_sqrt) wx) - end. - - Theorem spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2. - Proof. - intros x; unfold sqrt; case x; clear x. - intros x; rewrite spec_reduce_0; exact (spec_sqrt w0_spec x). - intros x; rewrite spec_reduce_1; exact (spec_sqrt w1_spec x). - intros x; rewrite spec_reduce_2; exact (spec_sqrt w2_spec x). - intros x; rewrite spec_reduce_3; exact (spec_sqrt w3_spec x). - intros x; rewrite spec_reduce_4; exact (spec_sqrt w4_spec x). - intros x; rewrite spec_reduce_5; exact (spec_sqrt w5_spec x). - intros x; rewrite spec_reduce_6; exact (spec_sqrt w6_spec x). - intros n x; rewrite spec_reduce_n; exact (spec_sqrt (wn_spec n) x). - Qed. - - (***************************************************************) - (* *) - (* Division *) - (* *) - (***************************************************************) - - Definition w0_div_gt := w0_op.(znz_div_gt). - Definition w1_div_gt := w1_op.(znz_div_gt). - Definition w2_div_gt := w2_op.(znz_div_gt). - Definition w3_div_gt := w3_op.(znz_div_gt). - Definition w4_div_gt := w4_op.(znz_div_gt). - Definition w5_div_gt := w5_op.(znz_div_gt). - Definition w6_div_gt := w6_op.(znz_div_gt). - - Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := - (spec_gen_divn1 - ww_op.(znz_zdigits) ww_op.(znz_0) - ww_op.(znz_WW) ww_op.(znz_head0) - ww_op.(znz_add_mul_div) ww_op.(znz_div21) - ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op) - (spec_to_Z ww_spec) - (spec_zdigits ww_spec) - (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec) - (spec_add_mul_div ww_spec) (spec_div21 ww_spec) - (ZnZ.spec_compare ww_spec) (ZnZ.spec_sub ww_spec)). - - Definition w0_divn1 n x y := - let (u, v) := - gen_divn1 w0_op.(znz_zdigits) w0_op.(znz_0) - w0_op.(znz_WW) w0_op.(znz_head0) - w0_op.(znz_add_mul_div) w0_op.(znz_div21) - w0_op.(znz_compare) w0_op.(znz_sub) (S n) x y in - (to_Z0 _ u, N0 v). - Definition w1_divn1 n x y := - let (u, v) := - gen_divn1 w1_op.(znz_zdigits) w1_op.(znz_0) - w1_op.(znz_WW) w1_op.(znz_head0) - w1_op.(znz_add_mul_div) w1_op.(znz_div21) - w1_op.(znz_compare) w1_op.(znz_sub) (S n) x y in - (to_Z1 _ u, N1 v). - Definition w2_divn1 n x y := - let (u, v) := - gen_divn1 w2_op.(znz_zdigits) w2_op.(znz_0) - w2_op.(znz_WW) w2_op.(znz_head0) - w2_op.(znz_add_mul_div) w2_op.(znz_div21) - w2_op.(znz_compare) w2_op.(znz_sub) (S n) x y in - (to_Z2 _ u, N2 v). - Definition w3_divn1 n x y := - let (u, v) := - gen_divn1 w3_op.(znz_zdigits) w3_op.(znz_0) - w3_op.(znz_WW) w3_op.(znz_head0) - w3_op.(znz_add_mul_div) w3_op.(znz_div21) - w3_op.(znz_compare) w3_op.(znz_sub) (S n) x y in - (to_Z3 _ u, N3 v). - Definition w4_divn1 n x y := - let (u, v) := - gen_divn1 w4_op.(znz_zdigits) w4_op.(znz_0) - w4_op.(znz_WW) w4_op.(znz_head0) - w4_op.(znz_add_mul_div) w4_op.(znz_div21) - w4_op.(znz_compare) w4_op.(znz_sub) (S n) x y in - (to_Z4 _ u, N4 v). - Definition w5_divn1 n x y := - let (u, v) := - gen_divn1 w5_op.(znz_zdigits) w5_op.(znz_0) - w5_op.(znz_WW) w5_op.(znz_head0) - w5_op.(znz_add_mul_div) w5_op.(znz_div21) - w5_op.(znz_compare) w5_op.(znz_sub) (S n) x y in - (to_Z5 _ u, N5 v). - Definition w6_divn1 n x y := - let (u, v) := - gen_divn1 w6_op.(znz_zdigits) w6_op.(znz_0) - w6_op.(znz_WW) w6_op.(znz_head0) - w6_op.(znz_add_mul_div) w6_op.(znz_div21) - w6_op.(znz_compare) w6_op.(znz_sub) (S n) x y in - (Nn _ u, N6 v). - - Lemma spec_get_end0: forall n x y, - eval0n n x <= [N0 y] -> - [N0 (GenBase.get_low w_0 n x)] = eval0n n x. - Proof. - intros n x y H. - rewrite spec_gen_eval0n; unfold to_Z. - apply GenBase.spec_get_low. - exact (spec_0 w0_spec). - exact (spec_to_Z w0_spec). - apply Zle_lt_trans with [N0 y]; auto. - rewrite <- spec_gen_eval0n; auto. - unfold to_Z; case (spec_to_Z w0_spec y); auto. - Qed. - - Lemma spec_get_end1: forall n x y, - eval1n n x <= [N1 y] -> - [N1 (GenBase.get_low W0 n x)] = eval1n n x. - Proof. - intros n x y H. - rewrite spec_gen_eval1n; unfold to_Z. - apply GenBase.spec_get_low. - exact (spec_0 w1_spec). - exact (spec_to_Z w1_spec). - apply Zle_lt_trans with [N1 y]; auto. - rewrite <- spec_gen_eval1n; auto. - unfold to_Z; case (spec_to_Z w1_spec y); auto. - Qed. - - Lemma spec_get_end2: forall n x y, - eval2n n x <= [N2 y] -> - [N2 (GenBase.get_low W0 n x)] = eval2n n x. - Proof. - intros n x y H. - rewrite spec_gen_eval2n; unfold to_Z. - apply GenBase.spec_get_low. - exact (spec_0 w2_spec). - exact (spec_to_Z w2_spec). - apply Zle_lt_trans with [N2 y]; auto. - rewrite <- spec_gen_eval2n; auto. - unfold to_Z; case (spec_to_Z w2_spec y); auto. - Qed. - - Lemma spec_get_end3: forall n x y, - eval3n n x <= [N3 y] -> - [N3 (GenBase.get_low W0 n x)] = eval3n n x. - Proof. - intros n x y H. - rewrite spec_gen_eval3n; unfold to_Z. - apply GenBase.spec_get_low. - exact (spec_0 w3_spec). - exact (spec_to_Z w3_spec). - apply Zle_lt_trans with [N3 y]; auto. - rewrite <- spec_gen_eval3n; auto. - unfold to_Z; case (spec_to_Z w3_spec y); auto. - Qed. - - Lemma spec_get_end4: forall n x y, - eval4n n x <= [N4 y] -> - [N4 (GenBase.get_low W0 n x)] = eval4n n x. - Proof. - intros n x y H. - rewrite spec_gen_eval4n; unfold to_Z. - apply GenBase.spec_get_low. - exact (spec_0 w4_spec). - exact (spec_to_Z w4_spec). - apply Zle_lt_trans with [N4 y]; auto. - rewrite <- spec_gen_eval4n; auto. - unfold to_Z; case (spec_to_Z w4_spec y); auto. - Qed. - - Lemma spec_get_end5: forall n x y, - eval5n n x <= [N5 y] -> - [N5 (GenBase.get_low W0 n x)] = eval5n n x. - Proof. - intros n x y H. - rewrite spec_gen_eval5n; unfold to_Z. - apply GenBase.spec_get_low. - exact (spec_0 w5_spec). - exact (spec_to_Z w5_spec). - apply Zle_lt_trans with [N5 y]; auto. - rewrite <- spec_gen_eval5n; auto. - unfold to_Z; case (spec_to_Z w5_spec y); auto. - Qed. - - Lemma spec_get_end6: forall n x y, - eval6n n x <= [N6 y] -> - [N6 (GenBase.get_low W0 n x)] = eval6n n x. - Proof. - intros n x y H. - rewrite spec_gen_eval6n; unfold to_Z. - apply GenBase.spec_get_low. - exact (spec_0 w6_spec). - exact (spec_to_Z w6_spec). - apply Zle_lt_trans with [N6 y]; auto. - rewrite <- spec_gen_eval6n; auto. - unfold to_Z; case (spec_to_Z w6_spec y); auto. - Qed. - - Let div_gt0 x y := let (u,v) := (w0_div_gt x y) in (reduce_0 u, reduce_0 v). - Let div_gt1 x y := let (u,v) := (w1_div_gt x y) in (reduce_1 u, reduce_1 v). - Let div_gt2 x y := let (u,v) := (w2_div_gt x y) in (reduce_2 u, reduce_2 v). - Let div_gt3 x y := let (u,v) := (w3_div_gt x y) in (reduce_3 u, reduce_3 v). - Let div_gt4 x y := let (u,v) := (w4_div_gt x y) in (reduce_4 u, reduce_4 v). - Let div_gt5 x y := let (u,v) := (w5_div_gt x y) in (reduce_5 u, reduce_5 v). - Let div_gt6 x y := let (u,v) := (w6_div_gt x y) in (reduce_6 u, reduce_6 v). - - Let div_gtnm n m wx wy := - let mn := Max.max n m in - let d := diff n m in - let op := make_op mn in - let (q, r):= op.(znz_div_gt) - (castm (diff_r n m) (extend_tr wx (snd d))) - (castm (diff_l n m) (extend_tr wy (fst d))) in - (reduce_n mn q, reduce_n mn r). - - Definition div_gt := Eval lazy beta delta [iter] in - (iter _ - div_gt0 - (fun n x y => div_gt0 x (GenBase.get_low w_0 (S n) y)) - w0_divn1 - div_gt1 - (fun n x y => div_gt1 x (GenBase.get_low W0 (S n) y)) - w1_divn1 - div_gt2 - (fun n x y => div_gt2 x (GenBase.get_low W0 (S n) y)) - w2_divn1 - div_gt3 - (fun n x y => div_gt3 x (GenBase.get_low W0 (S n) y)) - w3_divn1 - div_gt4 - (fun n x y => div_gt4 x (GenBase.get_low W0 (S n) y)) - w4_divn1 - div_gt5 - (fun n x y => div_gt5 x (GenBase.get_low W0 (S n) y)) - w5_divn1 - div_gt6 - (fun n x y => div_gt6 x (GenBase.get_low W0 (S n) y)) - w6_divn1 - div_gtnm). - - Theorem spec_div_gt: forall x y, - [x] > [y] -> 0 < [y] -> - let (q,r) := div_gt x y in - [q] = [x] / [y] /\ [r] = [x] mod [y]. - Proof. - assert (FO: - forall x y, [x] > [y] -> 0 < [y] -> - let (q,r) := div_gt x y in - [x] = [q] * [y] + [r] /\ 0 <= [r] < [y]). - refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y -> - let (q,r) := res in - x = [q] * y + [r] /\ 0 <= [r] < y) - div_gt0 - (fun n x y => div_gt0 x (GenBase.get_low w_0 (S n) y)) - w0_divn1 _ _ _ - div_gt1 - (fun n x y => div_gt1 x (GenBase.get_low W0 (S n) y)) - w1_divn1 _ _ _ - div_gt2 - (fun n x y => div_gt2 x (GenBase.get_low W0 (S n) y)) - w2_divn1 _ _ _ - div_gt3 - (fun n x y => div_gt3 x (GenBase.get_low W0 (S n) y)) - w3_divn1 _ _ _ - div_gt4 - (fun n x y => div_gt4 x (GenBase.get_low W0 (S n) y)) - w4_divn1 _ _ _ - div_gt5 - (fun n x y => div_gt5 x (GenBase.get_low W0 (S n) y)) - w5_divn1 _ _ _ - div_gt6 - (fun n x y => div_gt6 x (GenBase.get_low W0 (S n) y)) - w6_divn1 _ _ _ - div_gtnm _). - intros x y H1 H2; unfold div_gt0, w0_div_gt. - generalize (spec_div_gt w0_spec x y H1 H2); case znz_div_gt. - intros xx yy; repeat rewrite spec_reduce_0; auto. - intros n x y H1 H2 H3; unfold div_gt0, w0_div_gt. - generalize (spec_div_gt w0_spec x - (GenBase.get_low w_0 (S n) y)). - unfold w0;case znz_div_gt. - intros xx yy H4; repeat rewrite spec_reduce_0. - generalize (spec_get_end0 (S n) y x); unfold to_Z; intros H5. - unfold to_Z in H2; rewrite H5 in H4; auto with zarith. - intros n x y H1 H2 H3. - generalize - (spec_divn1 w0 w0_op w0_spec (S n) x y H3). - unfold w0_divn1;unfold w0; case gen_divn1. - intros xx yy H4. - rewrite to_Z0_spec; auto with zarith. - repeat rewrite <- spec_gen_eval0n in H4; auto. - intros x y H1 H2; unfold div_gt1, w1_div_gt. - generalize (spec_div_gt w1_spec x y H1 H2); case znz_div_gt. - intros xx yy; repeat rewrite spec_reduce_1; auto. - intros n x y H1 H2 H3; unfold div_gt1, w1_div_gt. - generalize (spec_div_gt w1_spec x - (GenBase.get_low W0 (S n) y)). - unfold w1;unfold w0;case znz_div_gt. - intros xx yy H4; repeat rewrite spec_reduce_1. - generalize (spec_get_end1 (S n) y x); unfold to_Z; intros H5. - unfold to_Z in H2; rewrite H5 in H4; auto with zarith. - intros n x y H1 H2 H3. - generalize - (spec_divn1 w1 w1_op w1_spec (S n) x y H3). - unfold w1_divn1;unfold w1;unfold w0; case gen_divn1. - intros xx yy H4. - rewrite to_Z1_spec; auto with zarith. - repeat rewrite <- spec_gen_eval1n in H4; auto. - intros x y H1 H2; unfold div_gt2, w2_div_gt. - generalize (spec_div_gt w2_spec x y H1 H2); case znz_div_gt. - intros xx yy; repeat rewrite spec_reduce_2; auto. - intros n x y H1 H2 H3; unfold div_gt2, w2_div_gt. - generalize (spec_div_gt w2_spec x - (GenBase.get_low W0 (S n) y)). - unfold w2;unfold w1;unfold w0;case znz_div_gt. - intros xx yy H4; repeat rewrite spec_reduce_2. - generalize (spec_get_end2 (S n) y x); unfold to_Z; intros H5. - unfold to_Z in H2; rewrite H5 in H4; auto with zarith. - intros n x y H1 H2 H3. - generalize - (spec_divn1 w2 w2_op w2_spec (S n) x y H3). - unfold w2_divn1;unfold w2;unfold w1;unfold w0; case gen_divn1. - intros xx yy H4. - rewrite to_Z2_spec; auto with zarith. - repeat rewrite <- spec_gen_eval2n in H4; auto. - intros x y H1 H2; unfold div_gt3, w3_div_gt. - generalize (spec_div_gt w3_spec x y H1 H2); case znz_div_gt. - intros xx yy; repeat rewrite spec_reduce_3; auto. - intros n x y H1 H2 H3; unfold div_gt3, w3_div_gt. - generalize (spec_div_gt w3_spec x - (GenBase.get_low W0 (S n) y)). - unfold w3;unfold w2;unfold w1;unfold w0;case znz_div_gt. - intros xx yy H4; repeat rewrite spec_reduce_3. - generalize (spec_get_end3 (S n) y x); unfold to_Z; intros H5. - unfold to_Z in H2; rewrite H5 in H4; auto with zarith. - intros n x y H1 H2 H3. - generalize - (spec_divn1 w3 w3_op w3_spec (S n) x y H3). - unfold w3_divn1;unfold w3;unfold w2;unfold w1;unfold w0; case gen_divn1. - intros xx yy H4. - rewrite to_Z3_spec; auto with zarith. - repeat rewrite <- spec_gen_eval3n in H4; auto. - intros x y H1 H2; unfold div_gt4, w4_div_gt. - generalize (spec_div_gt w4_spec x y H1 H2); case znz_div_gt. - intros xx yy; repeat rewrite spec_reduce_4; auto. - intros n x y H1 H2 H3; unfold div_gt4, w4_div_gt. - generalize (spec_div_gt w4_spec x - (GenBase.get_low W0 (S n) y)). - unfold w4;unfold w3;unfold w2;unfold w1;unfold w0;case znz_div_gt. - intros xx yy H4; repeat rewrite spec_reduce_4. - generalize (spec_get_end4 (S n) y x); unfold to_Z; intros H5. - unfold to_Z in H2; rewrite H5 in H4; auto with zarith. - intros n x y H1 H2 H3. - generalize - (spec_divn1 w4 w4_op w4_spec (S n) x y H3). - unfold w4_divn1;unfold w4;unfold w3;unfold w2;unfold w1;unfold w0; case gen_divn1. - intros xx yy H4. - rewrite to_Z4_spec; auto with zarith. - repeat rewrite <- spec_gen_eval4n in H4; auto. - intros x y H1 H2; unfold div_gt5, w5_div_gt. - generalize (spec_div_gt w5_spec x y H1 H2); case znz_div_gt. - intros xx yy; repeat rewrite spec_reduce_5; auto. - intros n x y H1 H2 H3; unfold div_gt5, w5_div_gt. - generalize (spec_div_gt w5_spec x - (GenBase.get_low W0 (S n) y)). - unfold w5;unfold w4;unfold w3;unfold w2;unfold w1;unfold w0;case znz_div_gt. - intros xx yy H4; repeat rewrite spec_reduce_5. - generalize (spec_get_end5 (S n) y x); unfold to_Z; intros H5. - unfold to_Z in H2; rewrite H5 in H4; auto with zarith. - intros n x y H1 H2 H3. - generalize - (spec_divn1 w5 w5_op w5_spec (S n) x y H3). - unfold w5_divn1;unfold w5;unfold w4;unfold w3;unfold w2;unfold w1;unfold w0; case gen_divn1. - intros xx yy H4. - rewrite to_Z5_spec; auto with zarith. - repeat rewrite <- spec_gen_eval5n in H4; auto. - intros x y H1 H2; unfold div_gt6, w6_div_gt. - generalize (spec_div_gt w6_spec x y H1 H2); case znz_div_gt. - intros xx yy; repeat rewrite spec_reduce_6; auto. - intros n x y H2 H3; unfold div_gt6, w6_div_gt. - generalize (spec_div_gt w6_spec x - (GenBase.get_low W0 (S n) y)). - unfold w6;unfold w5;unfold w4;unfold w3;unfold w2;unfold w1;unfold w0;case znz_div_gt. - intros xx yy H4; repeat rewrite spec_reduce_6. - generalize (spec_get_end6 (S n) y x); unfold to_Z; intros H5. - unfold to_Z in H2; rewrite H5 in H4; auto with zarith. - intros n x y H2 H3. - generalize - (spec_divn1 w6 w6_op w6_spec (S n) x y H3). - unfold w6_divn1;unfold w6;unfold w5;unfold w4;unfold w3;unfold w2;unfold w1;unfold w0; case gen_divn1. - intros xx yy H4. - repeat rewrite <- spec_gen_eval6n in H4; auto. - rewrite spec_eval6n; auto. - intros n m x y H1 H2; unfold div_gtnm. - generalize (spec_div_gt (wn_spec (Max.max n m)) - (castm (diff_r n m) - (extend_tr x (snd (diff n m)))) - (castm (diff_l n m) - (extend_tr y (fst (diff n m))))). - case znz_div_gt. - intros xx yy HH. - repeat rewrite spec_reduce_n. - rewrite <- (spec_cast_l n m x). - rewrite <- (spec_cast_r n m y). - unfold to_Z; apply HH. - rewrite <- (spec_cast_l n m x) in H1; auto. - rewrite <- (spec_cast_r n m y) in H1; auto. - rewrite <- (spec_cast_r n m y) in H2; auto. - intros x y H1 H2; generalize (FO x y H1 H2); case div_gt. - intros q r (H3, H4); split. - apply (Zdiv_unique [x] [y] [q] [r]); auto. - rewrite Zmult_comm; auto. - apply (Zmod_unique [x] [y] [q] [r]); auto. - rewrite Zmult_comm; auto. - Qed. - - Definition div_eucl x y := - match compare x y with - | Eq => (one, zero) - | Lt => (zero, x) - | Gt => div_gt x y - end. - - Theorem spec_div_eucl: forall x y, - 0 < [y] -> - let (q,r) := div_eucl x y in - ([q], [r]) = Zdiv_eucl [x] [y]. - Proof. - assert (F0: [zero] = 0). - exact (spec_0 w0_spec). - assert (F1: [one] = 1). - exact (spec_1 w0_spec). - intros x y H; generalize (spec_compare x y); - unfold div_eucl; case compare; try rewrite F0; - try rewrite F1; intros; auto with zarith. - rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H)) - (Z_mod_same [y] (Zlt_gt _ _ H)); - unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. - assert (F2: 0 <= [x] < [y]). - generalize (spec_pos x); auto. - generalize (Zdiv_small _ _ F2) - (Zmod_small _ _ F2); - unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. - generalize (spec_div_gt _ _ H0 H); auto. - unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt. - intros a b c d (H1, H2); subst; auto. - Qed. - - Definition div x y := fst (div_eucl x y). - - Theorem spec_div: - forall x y, 0 < [y] -> [div x y] = [x] / [y]. - Proof. - intros x y H1; unfold div; generalize (spec_div_eucl x y H1); - case div_eucl; simpl fst. - intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; - injection H; auto. - Qed. - - (***************************************************************) - (* *) - (* Modulo *) - (* *) - (***************************************************************) - - Definition w0_mod_gt := w0_op.(znz_mod_gt). - Definition w1_mod_gt := w1_op.(znz_mod_gt). - Definition w2_mod_gt := w2_op.(znz_mod_gt). - Definition w3_mod_gt := w3_op.(znz_mod_gt). - Definition w4_mod_gt := w4_op.(znz_mod_gt). - Definition w5_mod_gt := w5_op.(znz_mod_gt). - Definition w6_mod_gt := w6_op.(znz_mod_gt). - - Definition w0_modn1 := - gen_modn1 w0_op.(znz_zdigits) w0_op.(znz_0) - w0_op.(znz_head0) w0_op.(znz_add_mul_div) w0_op.(znz_div21) - w0_op.(znz_compare) w0_op.(znz_sub). - Definition w1_modn1 := - gen_modn1 w1_op.(znz_zdigits) w1_op.(znz_0) - w1_op.(znz_head0) w1_op.(znz_add_mul_div) w1_op.(znz_div21) - w1_op.(znz_compare) w1_op.(znz_sub). - Definition w2_modn1 := - gen_modn1 w2_op.(znz_zdigits) w2_op.(znz_0) - w2_op.(znz_head0) w2_op.(znz_add_mul_div) w2_op.(znz_div21) - w2_op.(znz_compare) w2_op.(znz_sub). - Definition w3_modn1 := - gen_modn1 w3_op.(znz_zdigits) w3_op.(znz_0) - w3_op.(znz_head0) w3_op.(znz_add_mul_div) w3_op.(znz_div21) - w3_op.(znz_compare) w3_op.(znz_sub). - Definition w4_modn1 := - gen_modn1 w4_op.(znz_zdigits) w4_op.(znz_0) - w4_op.(znz_head0) w4_op.(znz_add_mul_div) w4_op.(znz_div21) - w4_op.(znz_compare) w4_op.(znz_sub). - Definition w5_modn1 := - gen_modn1 w5_op.(znz_zdigits) w5_op.(znz_0) - w5_op.(znz_head0) w5_op.(znz_add_mul_div) w5_op.(znz_div21) - w5_op.(znz_compare) w5_op.(znz_sub). - Definition w6_modn1 := - gen_modn1 w6_op.(znz_zdigits) w6_op.(znz_0) - w6_op.(znz_head0) w6_op.(znz_add_mul_div) w6_op.(znz_div21) - w6_op.(znz_compare) w6_op.(znz_sub). - - Let mod_gtnm n m wx wy := - let mn := Max.max n m in - let d := diff n m in - let op := make_op mn in - reduce_n mn (op.(znz_mod_gt) - (castm (diff_r n m) (extend_tr wx (snd d))) - (castm (diff_l n m) (extend_tr wy (fst d)))). - - Definition mod_gt := Eval lazy beta delta[iter] in - (iter _ - (fun x y => reduce_0 (w0_mod_gt x y)) - (fun n x y => reduce_0 (w0_mod_gt x (GenBase.get_low w_0 (S n) y))) - (fun n x y => reduce_0 (w0_modn1 (S n) x y)) - (fun x y => reduce_1 (w1_mod_gt x y)) - (fun n x y => reduce_1 (w1_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_1 (w1_modn1 (S n) x y)) - (fun x y => reduce_2 (w2_mod_gt x y)) - (fun n x y => reduce_2 (w2_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_2 (w2_modn1 (S n) x y)) - (fun x y => reduce_3 (w3_mod_gt x y)) - (fun n x y => reduce_3 (w3_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_3 (w3_modn1 (S n) x y)) - (fun x y => reduce_4 (w4_mod_gt x y)) - (fun n x y => reduce_4 (w4_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_4 (w4_modn1 (S n) x y)) - (fun x y => reduce_5 (w5_mod_gt x y)) - (fun n x y => reduce_5 (w5_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_5 (w5_modn1 (S n) x y)) - (fun x y => reduce_6 (w6_mod_gt x y)) - (fun n x y => reduce_6 (w6_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_6 (w6_modn1 (S n) x y)) - mod_gtnm). - - Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := - (spec_gen_modn1 - ww_op.(znz_zdigits) ww_op.(znz_0) - ww_op.(znz_WW) ww_op.(znz_head0) - ww_op.(znz_add_mul_div) ww_op.(znz_div21) - ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op) - (spec_to_Z ww_spec) - (spec_zdigits ww_spec) - (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec) - (spec_add_mul_div ww_spec) (spec_div21 ww_spec) - (ZnZ.spec_compare ww_spec) (ZnZ.spec_sub ww_spec)). - - Theorem spec_mod_gt: - forall x y, [x] > [y] -> 0 < [y] -> [mod_gt x y] = [x] mod [y]. - Proof. - refine (spec_iter _ (fun x y res => x > y -> 0 < y -> - [res] = x mod y) - (fun x y => reduce_0 (w0_mod_gt x y)) - (fun n x y => reduce_0 (w0_mod_gt x (GenBase.get_low w_0 (S n) y))) - (fun n x y => reduce_0 (w0_modn1 (S n) x y)) _ _ _ - (fun x y => reduce_1 (w1_mod_gt x y)) - (fun n x y => reduce_1 (w1_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_1 (w1_modn1 (S n) x y)) _ _ _ - (fun x y => reduce_2 (w2_mod_gt x y)) - (fun n x y => reduce_2 (w2_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_2 (w2_modn1 (S n) x y)) _ _ _ - (fun x y => reduce_3 (w3_mod_gt x y)) - (fun n x y => reduce_3 (w3_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_3 (w3_modn1 (S n) x y)) _ _ _ - (fun x y => reduce_4 (w4_mod_gt x y)) - (fun n x y => reduce_4 (w4_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_4 (w4_modn1 (S n) x y)) _ _ _ - (fun x y => reduce_5 (w5_mod_gt x y)) - (fun n x y => reduce_5 (w5_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_5 (w5_modn1 (S n) x y)) _ _ _ - (fun x y => reduce_6 (w6_mod_gt x y)) - (fun n x y => reduce_6 (w6_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_6 (w6_modn1 (S n) x y)) _ _ _ - mod_gtnm _). - intros x y H1 H2; rewrite spec_reduce_0. - exact (spec_mod_gt w0_spec x y H1 H2). - intros n x y H1 H2 H3; rewrite spec_reduce_0. - unfold w0_mod_gt. - rewrite <- (spec_get_end0 (S n) y x); auto with zarith. - unfold to_Z; apply (spec_mod_gt w0_spec); auto. - rewrite <- (spec_get_end0 (S n) y x) in H2; auto with zarith. - rewrite <- (spec_get_end0 (S n) y x) in H3; auto with zarith. - intros n x y H1 H2 H3; rewrite spec_reduce_0. - unfold w0_modn1, to_Z; rewrite spec_gen_eval0n. - apply (spec_modn1 _ _ w0_spec); auto. - intros x y H1 H2; rewrite spec_reduce_1. - exact (spec_mod_gt w1_spec x y H1 H2). - intros n x y H1 H2 H3; rewrite spec_reduce_1. - unfold w1_mod_gt. - rewrite <- (spec_get_end1 (S n) y x); auto with zarith. - unfold to_Z; apply (spec_mod_gt w1_spec); auto. - rewrite <- (spec_get_end1 (S n) y x) in H2; auto with zarith. - rewrite <- (spec_get_end1 (S n) y x) in H3; auto with zarith. - intros n x y H1 H2 H3; rewrite spec_reduce_1. - unfold w1_modn1, to_Z; rewrite spec_gen_eval1n. - apply (spec_modn1 _ _ w1_spec); auto. - intros x y H1 H2; rewrite spec_reduce_2. - exact (spec_mod_gt w2_spec x y H1 H2). - intros n x y H1 H2 H3; rewrite spec_reduce_2. - unfold w2_mod_gt. - rewrite <- (spec_get_end2 (S n) y x); auto with zarith. - unfold to_Z; apply (spec_mod_gt w2_spec); auto. - rewrite <- (spec_get_end2 (S n) y x) in H2; auto with zarith. - rewrite <- (spec_get_end2 (S n) y x) in H3; auto with zarith. - intros n x y H1 H2 H3; rewrite spec_reduce_2. - unfold w2_modn1, to_Z; rewrite spec_gen_eval2n. - apply (spec_modn1 _ _ w2_spec); auto. - intros x y H1 H2; rewrite spec_reduce_3. - exact (spec_mod_gt w3_spec x y H1 H2). - intros n x y H1 H2 H3; rewrite spec_reduce_3. - unfold w3_mod_gt. - rewrite <- (spec_get_end3 (S n) y x); auto with zarith. - unfold to_Z; apply (spec_mod_gt w3_spec); auto. - rewrite <- (spec_get_end3 (S n) y x) in H2; auto with zarith. - rewrite <- (spec_get_end3 (S n) y x) in H3; auto with zarith. - intros n x y H1 H2 H3; rewrite spec_reduce_3. - unfold w3_modn1, to_Z; rewrite spec_gen_eval3n. - apply (spec_modn1 _ _ w3_spec); auto. - intros x y H1 H2; rewrite spec_reduce_4. - exact (spec_mod_gt w4_spec x y H1 H2). - intros n x y H1 H2 H3; rewrite spec_reduce_4. - unfold w4_mod_gt. - rewrite <- (spec_get_end4 (S n) y x); auto with zarith. - unfold to_Z; apply (spec_mod_gt w4_spec); auto. - rewrite <- (spec_get_end4 (S n) y x) in H2; auto with zarith. - rewrite <- (spec_get_end4 (S n) y x) in H3; auto with zarith. - intros n x y H1 H2 H3; rewrite spec_reduce_4. - unfold w4_modn1, to_Z; rewrite spec_gen_eval4n. - apply (spec_modn1 _ _ w4_spec); auto. - intros x y H1 H2; rewrite spec_reduce_5. - exact (spec_mod_gt w5_spec x y H1 H2). - intros n x y H1 H2 H3; rewrite spec_reduce_5. - unfold w5_mod_gt. - rewrite <- (spec_get_end5 (S n) y x); auto with zarith. - unfold to_Z; apply (spec_mod_gt w5_spec); auto. - rewrite <- (spec_get_end5 (S n) y x) in H2; auto with zarith. - rewrite <- (spec_get_end5 (S n) y x) in H3; auto with zarith. - intros n x y H1 H2 H3; rewrite spec_reduce_5. - unfold w5_modn1, to_Z; rewrite spec_gen_eval5n. - apply (spec_modn1 _ _ w5_spec); auto. - intros x y H1 H2; rewrite spec_reduce_6. - exact (spec_mod_gt w6_spec x y H1 H2). - intros n x y H2 H3; rewrite spec_reduce_6. - unfold w6_mod_gt. - rewrite <- (spec_get_end6 (S n) y x); auto with zarith. - unfold to_Z; apply (spec_mod_gt w6_spec); auto. - rewrite <- (spec_get_end6 (S n) y x) in H2; auto with zarith. - rewrite <- (spec_get_end6 (S n) y x) in H3; auto with zarith. - intros n x y H2 H3; rewrite spec_reduce_6. - unfold w6_modn1, to_Z; rewrite spec_gen_eval6n. - apply (spec_modn1 _ _ w6_spec); auto. - intros n m x y H1 H2; unfold mod_gtnm. - repeat rewrite spec_reduce_n. - rewrite <- (spec_cast_l n m x). - rewrite <- (spec_cast_r n m y). - unfold to_Z; apply (spec_mod_gt (wn_spec (Max.max n m))). - rewrite <- (spec_cast_l n m x) in H1; auto. - rewrite <- (spec_cast_r n m y) in H1; auto. - rewrite <- (spec_cast_r n m y) in H2; auto. - Qed. - - Definition modulo x y := - match compare x y with - | Eq => zero - | Lt => x - | Gt => mod_gt x y - end. - - Theorem spec_modulo: - forall x y, 0 < [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 H; generalize (spec_compare x y); - unfold modulo; case compare; try rewrite F0; - try rewrite F1; intros; try split; auto with zarith. - rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith. - apply sym_equal; apply Zmod_small; auto with zarith. - generalize (spec_pos x); auto with zarith. - apply spec_mod_gt; auto. - Qed. - - (***************************************************************) - (* *) - (* Gcd *) - (* *) - (***************************************************************) - - Definition digits x := - match x with - | N0 _ => w0_op.(znz_digits) - | N1 _ => w1_op.(znz_digits) - | N2 _ => w2_op.(znz_digits) - | N3 _ => w3_op.(znz_digits) - | N4 _ => w4_op.(znz_digits) - | N5 _ => w5_op.(znz_digits) - | N6 _ => w6_op.(znz_digits) - | Nn n _ => (make_op n).(znz_digits) - end. - - Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x). - Proof. - intros x; case x; clear x. - intros x; unfold to_Z, digits; - generalize (spec_to_Z w0_spec x); unfold base; intros H; exact H. - intros x; unfold to_Z, digits; - generalize (spec_to_Z w1_spec x); unfold base; intros H; exact H. - intros x; unfold to_Z, digits; - generalize (spec_to_Z w2_spec x); unfold base; intros H; exact H. - intros x; unfold to_Z, digits; - generalize (spec_to_Z w3_spec x); unfold base; intros H; exact H. - intros x; unfold to_Z, digits; - generalize (spec_to_Z w4_spec x); unfold base; intros H; exact H. - intros x; unfold to_Z, digits; - generalize (spec_to_Z w5_spec x); unfold base; intros H; exact H. - intros x; unfold to_Z, digits; - generalize (spec_to_Z w6_spec x); unfold base; intros H; exact H. - intros n x; unfold to_Z, digits; - generalize (spec_to_Z (wn_spec n) x); unfold base; intros H; exact H. - Qed. - - Definition gcd_gt_body a b cont := - match compare b zero with - | Gt => - let r := mod_gt a b in - match compare r zero with - | Gt => cont r (mod_gt b r) - | _ => b - end - | _ => a - end. - - Theorem Zspec_gcd_gt_body: forall a b cont p, - [a] > [b] -> [a] < 2 ^ p -> - (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] -> - Zis_gcd [a1] [b1] [cont a1 b1]) -> - Zis_gcd [a] [b] [gcd_gt_body a b cont]. - Proof. - assert (F1: [zero] = 0). - unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto. - intros a b cont p H2 H3 H4; unfold gcd_gt_body. - generalize (spec_compare b zero); case compare; try rewrite F1. - intros HH; rewrite HH; apply Zis_gcd_0. - intros HH; absurd (0 <= [b]); auto with zarith. - case (spec_digits b); auto with zarith. - intros H5; generalize (spec_compare (mod_gt a b) zero); - case compare; try rewrite F1. - intros H6; rewrite <- (Zmult_1_r [b]). - rewrite (Z_div_mod_eq [a] [b]); auto with zarith. - rewrite <- spec_mod_gt; auto with zarith. - rewrite H6; rewrite Zplus_0_r. - apply Zis_gcd_mult; apply Zis_gcd_1. - intros; apply False_ind. - case (spec_digits (mod_gt a b)); auto with zarith. - intros H6; apply GenDiv.Zis_gcd_mod; auto with zarith. - apply GenDiv.Zis_gcd_mod; auto with zarith. - rewrite <- spec_mod_gt; auto with zarith. - assert (F2: [b] > [mod_gt a b]). - case (Z_mod_lt [a] [b]); auto with zarith. - repeat rewrite <- spec_mod_gt; auto with zarith. - assert (F3: [mod_gt a b] > [mod_gt b (mod_gt a b)]). - case (Z_mod_lt [b] [mod_gt a b]); auto with zarith. - rewrite <- spec_mod_gt; auto with zarith. - repeat rewrite <- spec_mod_gt; auto with zarith. - apply H4; auto with zarith. - apply Zmult_lt_reg_r with 2; auto with zarith. - apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith. - apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith. - apply Zplus_le_compat_r. - pattern [b] at 1; rewrite <- (Zmult_1_l [b]). - apply Zmult_le_compat_r; auto with zarith. - case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith. - intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2; - try rewrite <- HH in H2; auto with zarith. - case (Z_mod_lt [a] [b]); auto with zarith. - rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith. - rewrite <- Z_div_mod_eq; auto with zarith. - pattern 2 at 2; rewrite <- (Zpower_1_r 2). - rewrite <- Zpower_exp; auto with zarith. - ring_simplify (p - 1 + 1); auto. - case (Zle_lt_or_eq 0 p); auto with zarith. - generalize H3; case p; simpl Zpower; auto with zarith. - intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith. - Qed. - - Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t := - gcd_gt_body a b - (fun a b => - match p with - | xH => cont a b - | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b - | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b - end). - - Theorem Zspec_gcd_gt_aux: forall p n a b cont, - [a] > [b] -> [a] < 2 ^ (Zpos p + n) -> - (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] -> - Zis_gcd [a1] [b1] [cont a1 b1]) -> - Zis_gcd [a] [b] [gcd_gt_aux p cont a b]. - intros p; elim p; clear p. - intros p Hrec n a b cont H2 H3 H4. - unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto. - intros a1 b1 H6 H7. - apply Hrec with (Zpos p + n); auto. - replace (Zpos p + (Zpos p + n)) with - (Zpos (xI p) + n - 1); auto. - rewrite Zpos_xI; ring. - intros a2 b2 H9 H10. - apply Hrec with n; auto. - intros p Hrec n a b cont H2 H3 H4. - unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto. - intros a1 b1 H6 H7. - apply Hrec with (Zpos p + n - 1); auto. - replace (Zpos p + (Zpos p + n - 1)) with - (Zpos (xO p) + n - 1); auto. - rewrite Zpos_xO; ring. - intros a2 b2 H9 H10. - apply Hrec with (n - 1); auto. - replace (Zpos p + (n - 1)) with - (Zpos p + n - 1); auto with zarith. - intros a3 b3 H12 H13; apply H4; auto with zarith. - apply Zlt_le_trans with (1 := H12). - case (Zle_or_lt 1 n); intros HH. - apply Zpower_le_monotone; auto with zarith. - apply Zle_trans with 0; auto with zarith. - assert (HH1: n - 1 < 0); auto with zarith. - generalize HH1; case (n - 1); auto with zarith. - intros p1 HH2; discriminate. - intros n a b cont H H2 H3. - simpl gcd_gt_aux. - apply Zspec_gcd_gt_body with (n + 1); auto with zarith. - rewrite Zplus_comm; auto. - intros a1 b1 H5 H6; apply H3; auto. - replace n with (n + 1 - 1); auto; try ring. - Qed. - - Definition gcd_cont a b := - match compare one b with - | Eq => one - | _ => a - end. - - Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b. - - Theorem spec_gcd_gt: forall a b, - [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]. - Proof. - intros a b H2. - case (spec_digits (gcd_gt a b)); intros H3 H4. - case (spec_digits a); intros H5 H6. - apply sym_equal; apply Zis_gcd_gcd; auto with zarith. - unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith. - intros a1 a2; rewrite Zpower_0_r. - case (spec_digits a2); intros H7 H8; - intros; apply False_ind; auto with zarith. - Qed. - - Definition gcd a b := - match compare a b with - | Eq => a - | Lt => gcd_gt b a - | Gt => gcd_gt a b - end. - - Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]. - Proof. - intros a b. - case (spec_digits a); intros H1 H2. - case (spec_digits b); intros H3 H4. - unfold gcd; generalize (spec_compare a b); case compare. - intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto. - apply Zis_gcd_refl. - intros; apply trans_equal with (Zgcd [b] [a]). - apply spec_gcd_gt; auto with zarith. - apply Zis_gcd_gcd; auto with zarith. - apply Zgcd_is_pos. - apply Zis_gcd_sym; apply Zgcd_is_gcd. - intros; apply spec_gcd_gt; auto. - Qed. - - (***************************************************************) - (* *) - (* Conversion *) - (* *) - (***************************************************************) - - Definition pheight p := - Peano.pred (nat_of_P (get_height w0_op.(znz_digits) (plength p))). - - Theorem pheight_correct: forall p, - Zpos p < 2 ^ (Zpos (znz_digits w0_op) * 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_op) (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_monotone; auto with zarith. - Qed. - - Definition of_pos x := - let h := pheight x in - match h with - | 0%nat => reduce_0 (snd (w0_op.(znz_of_pos) x)) - | 1%nat => reduce_1 (snd (w1_op.(znz_of_pos) x)) - | 2%nat => reduce_2 (snd (w2_op.(znz_of_pos) x)) - | 3%nat => reduce_3 (snd (w3_op.(znz_of_pos) x)) - | 4%nat => reduce_4 (snd (w4_op.(znz_of_pos) x)) - | 5%nat => reduce_5 (snd (w5_op.(znz_of_pos) x)) - | 6%nat => reduce_6 (snd (w6_op.(znz_of_pos) x)) - | _ => - let n := minus h 7 in - reduce_n n (snd ((make_op n).(znz_of_pos) x)) - end. - - Theorem spec_of_pos: forall x, - [of_pos x] = Zpos x. - Proof. - assert (F := spec_more_than_1_digit w0_spec). - intros x; unfold of_pos; case_eq (pheight x). - intros H1; rewrite spec_reduce_0; unfold to_Z. - apply (znz_of_pos_correct w0_spec). - apply Zlt_le_trans with (1 := pheight_correct x). - rewrite H1; simpl Z_of_nat; change (2^0) with (1). - unfold base. - apply Zpower_le_monotone; split; auto with zarith. - intros n; case n; clear n. - intros H1; rewrite spec_reduce_1; unfold to_Z. - apply (znz_of_pos_correct w1_spec). - apply Zlt_le_trans with (1 := pheight_correct x). - rewrite H1; simpl Z_of_nat; change (2^1) with (2). - unfold base. - apply Zpower_le_monotone; split; auto with zarith. - apply Zeq_le; apply Zmult_comm. - intros n; case n; clear n. - intros H1; rewrite spec_reduce_2; unfold to_Z. - apply (znz_of_pos_correct w2_spec). - apply Zlt_le_trans with (1 := pheight_correct x). - rewrite H1; simpl Z_of_nat; change (2^2) with (2 * 2). - unfold base. - apply Zpower_le_monotone; split; auto with zarith. - apply Zeq_le; apply Zmult_comm. - intros n; case n; clear n. - intros H1; rewrite spec_reduce_3; unfold to_Z. - apply (znz_of_pos_correct w3_spec). - apply Zlt_le_trans with (1 := pheight_correct x). - rewrite H1; simpl Z_of_nat; change (2^3) with (2 * 2 * 2). - unfold base. - apply Zpower_le_monotone; split; auto with zarith. - apply Zeq_le; apply Zmult_comm. - intros n; case n; clear n. - intros H1; rewrite spec_reduce_4; unfold to_Z. - apply (znz_of_pos_correct w4_spec). - apply Zlt_le_trans with (1 := pheight_correct x). - rewrite H1; simpl Z_of_nat; change (2^4) with (2 * 2 * 2 * 2). - unfold base. - apply Zpower_le_monotone; split; auto with zarith. - apply Zeq_le; apply Zmult_comm. - intros n; case n; clear n. - intros H1; rewrite spec_reduce_5; unfold to_Z. - apply (znz_of_pos_correct w5_spec). - apply Zlt_le_trans with (1 := pheight_correct x). - rewrite H1; simpl Z_of_nat; change (2^5) with (2 * 2 * 2 * 2 * 2). - unfold base. - apply Zpower_le_monotone; split; auto with zarith. - apply Zeq_le; apply Zmult_comm. - intros n; case n; clear n. - intros H1; rewrite spec_reduce_6; unfold to_Z. - apply (znz_of_pos_correct w6_spec). - apply Zlt_le_trans with (1 := pheight_correct x). - rewrite H1; simpl Z_of_nat; change (2^6) with (2 * 2 * 2 * 2 * 2 * 2). - unfold base. - apply Zpower_le_monotone; split; auto with zarith. - apply Zeq_le; apply Zmult_comm. - intros n. - intros H1; rewrite spec_reduce_n; unfold to_Z. - simpl minus; rewrite <- minus_n_O. - apply (znz_of_pos_correct (wn_spec n)). - apply Zlt_le_trans with (1 := pheight_correct x). - unfold base. - apply Zpower_le_monotone; auto with zarith. - split; auto with zarith. - rewrite H1. - elim n; clear n H1. - simpl Z_of_nat; change (2^7) with (2 * 2 * 2 * 2 * 2 * 2 * 2). - rewrite Zmult_comm; repeat rewrite <- Zmult_assoc. - repeat rewrite <- Zpos_xO. - refine (Zle_refl _). - intros n Hrec. - rewrite make_op_S. - change (@znz_digits (word _ (S (S n))) (mk_zn2z_op_karatsuba (make_op n))) with - (xO (znz_digits (make_op n))). - rewrite (fun x y => (Zpos_xO (@znz_digits x y))). - rewrite inj_S; unfold Zsucc. - rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r. - assert (tmp: forall x y z, x * (y * z) = y * (x * z)); - [intros; ring | rewrite tmp; clear tmp]. - apply Zmult_le_compat_l; auto with zarith. - Qed. - - Definition of_N x := - match x with - | BinNat.N0 => zero - | Npos p => of_pos p - end. - - Theorem spec_of_N: forall x, - [of_N x] = Z_of_N x. - Proof. - intros x; case x. - simpl of_N. - unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto. - intros p; exact (spec_of_pos p). - Qed. - - (***************************************************************) - (* *) - (* Shift *) - (* *) - (***************************************************************) - - Definition head0 w := match w with - | N0 w=> reduce_0 (w0_op.(znz_head0) w) - | N1 w=> reduce_1 (w1_op.(znz_head0) w) - | N2 w=> reduce_2 (w2_op.(znz_head0) w) - | N3 w=> reduce_3 (w3_op.(znz_head0) w) - | N4 w=> reduce_4 (w4_op.(znz_head0) w) - | N5 w=> reduce_5 (w5_op.(znz_head0) w) - | N6 w=> reduce_6 (w6_op.(znz_head0) w) - | Nn n w=> reduce_n n ((make_op n).(znz_head0) w) - end. - - Theorem spec_head00: forall x, [x] = 0 ->[head0 x] = Zpos (digits x). - Proof. - intros x; case x; unfold head0; clear x. - intros x; rewrite spec_reduce_0; exact (spec_head00 w0_spec x). - intros x; rewrite spec_reduce_1; exact (spec_head00 w1_spec x). - intros x; rewrite spec_reduce_2; exact (spec_head00 w2_spec x). - intros x; rewrite spec_reduce_3; exact (spec_head00 w3_spec x). - intros x; rewrite spec_reduce_4; exact (spec_head00 w4_spec x). - intros x; rewrite spec_reduce_5; exact (spec_head00 w5_spec x). - intros x; rewrite spec_reduce_6; exact (spec_head00 w6_spec x). - intros n x; rewrite spec_reduce_n; exact (spec_head00 (wn_spec n) x). - Qed. - - Theorem spec_head0: forall x, 0 < [x] -> - 2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x). - Proof. - assert (F0: forall x, (x - 1) + 1 = x). - intros; ring. - intros x; case x; unfold digits, head0; clear x. - intros x Hx; rewrite spec_reduce_0. - assert (F1:= spec_more_than_1_digit w0_spec). - generalize (spec_head0 w0_spec x Hx). - unfold base. - pattern (Zpos (znz_digits w0_op)) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - intros x Hx; rewrite spec_reduce_1. - assert (F1:= spec_more_than_1_digit w1_spec). - generalize (spec_head0 w1_spec x Hx). - unfold base. - pattern (Zpos (znz_digits w1_op)) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - intros x Hx; rewrite spec_reduce_2. - assert (F1:= spec_more_than_1_digit w2_spec). - generalize (spec_head0 w2_spec x Hx). - unfold base. - pattern (Zpos (znz_digits w2_op)) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - intros x Hx; rewrite spec_reduce_3. - assert (F1:= spec_more_than_1_digit w3_spec). - generalize (spec_head0 w3_spec x Hx). - unfold base. - pattern (Zpos (znz_digits w3_op)) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - intros x Hx; rewrite spec_reduce_4. - assert (F1:= spec_more_than_1_digit w4_spec). - generalize (spec_head0 w4_spec x Hx). - unfold base. - pattern (Zpos (znz_digits w4_op)) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - intros x Hx; rewrite spec_reduce_5. - assert (F1:= spec_more_than_1_digit w5_spec). - generalize (spec_head0 w5_spec x Hx). - unfold base. - pattern (Zpos (znz_digits w5_op)) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - intros x Hx; rewrite spec_reduce_6. - assert (F1:= spec_more_than_1_digit w6_spec). - generalize (spec_head0 w6_spec x Hx). - unfold base. - pattern (Zpos (znz_digits w6_op)) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - intros n x Hx; rewrite spec_reduce_n. - assert (F1:= spec_more_than_1_digit (wn_spec n)). - generalize (spec_head0 (wn_spec n) x Hx). - unfold base. - pattern (Zpos (znz_digits (make_op n))) at 1; - rewrite <- (fun x => (F0 (Zpos x))). - rewrite Zpower_exp; auto with zarith. - rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith. - Qed. - - Definition tail0 w := match w with - | N0 w=> reduce_0 (w0_op.(znz_tail0) w) - | N1 w=> reduce_1 (w1_op.(znz_tail0) w) - | N2 w=> reduce_2 (w2_op.(znz_tail0) w) - | N3 w=> reduce_3 (w3_op.(znz_tail0) w) - | N4 w=> reduce_4 (w4_op.(znz_tail0) w) - | N5 w=> reduce_5 (w5_op.(znz_tail0) w) - | N6 w=> reduce_6 (w6_op.(znz_tail0) w) - | Nn n w=> reduce_n n ((make_op n).(znz_tail0) w) - end. - - Theorem spec_tail00: forall x, [x] = 0 ->[tail0 x] = Zpos (digits x). - Proof. - intros x; case x; unfold tail0; clear x. - intros x; rewrite spec_reduce_0; exact (spec_tail00 w0_spec x). - intros x; rewrite spec_reduce_1; exact (spec_tail00 w1_spec x). - intros x; rewrite spec_reduce_2; exact (spec_tail00 w2_spec x). - intros x; rewrite spec_reduce_3; exact (spec_tail00 w3_spec x). - intros x; rewrite spec_reduce_4; exact (spec_tail00 w4_spec x). - intros x; rewrite spec_reduce_5; exact (spec_tail00 w5_spec x). - intros x; rewrite spec_reduce_6; exact (spec_tail00 w6_spec x). - intros n x; rewrite spec_reduce_n; exact (spec_tail00 (wn_spec n) x). - Qed. - - Theorem spec_tail0: forall x, - 0 < [x] -> exists y, 0 <= y /\ [x] = (2 * y + 1) * 2 ^ [tail0 x]. - Proof. - intros x; case x; clear x; unfold tail0. - intros x Hx; rewrite spec_reduce_0; exact (spec_tail0 w0_spec x Hx). - intros x Hx; rewrite spec_reduce_1; exact (spec_tail0 w1_spec x Hx). - intros x Hx; rewrite spec_reduce_2; exact (spec_tail0 w2_spec x Hx). - intros x Hx; rewrite spec_reduce_3; exact (spec_tail0 w3_spec x Hx). - intros x Hx; rewrite spec_reduce_4; exact (spec_tail0 w4_spec x Hx). - intros x Hx; rewrite spec_reduce_5; exact (spec_tail0 w5_spec x Hx). - intros x Hx; rewrite spec_reduce_6; exact (spec_tail0 w6_spec x Hx). - intros n x Hx; rewrite spec_reduce_n; exact (spec_tail0 (wn_spec n) x Hx). - Qed. - - Definition Ndigits x := - match x with - | N0 _ => N0 w0_op.(znz_zdigits) - | N1 _ => reduce_1 w1_op.(znz_zdigits) - | N2 _ => reduce_2 w2_op.(znz_zdigits) - | N3 _ => reduce_3 w3_op.(znz_zdigits) - | N4 _ => reduce_4 w4_op.(znz_zdigits) - | N5 _ => reduce_5 w5_op.(znz_zdigits) - | N6 _ => reduce_6 w6_op.(znz_zdigits) - | Nn n _ => reduce_n n (make_op n).(znz_zdigits) - end. - - Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x). - Proof. - intros x; case x; clear x; unfold Ndigits, digits. - intros _; try rewrite spec_reduce_0; exact (spec_zdigits w0_spec). - intros _; try rewrite spec_reduce_1; exact (spec_zdigits w1_spec). - intros _; try rewrite spec_reduce_2; exact (spec_zdigits w2_spec). - intros _; try rewrite spec_reduce_3; exact (spec_zdigits w3_spec). - intros _; try rewrite spec_reduce_4; exact (spec_zdigits w4_spec). - intros _; try rewrite spec_reduce_5; exact (spec_zdigits w5_spec). - intros _; try rewrite spec_reduce_6; exact (spec_zdigits w6_spec). - intros n _; try rewrite spec_reduce_n; exact (spec_zdigits (wn_spec n)). - Qed. - - Definition shiftr0 n x := w0_op.(znz_add_mul_div) (w0_op.(znz_sub) w0_op.(znz_zdigits) n) w0_op.(znz_0) x. - Definition shiftr1 n x := w1_op.(znz_add_mul_div) (w1_op.(znz_sub) w1_op.(znz_zdigits) n) w1_op.(znz_0) x. - Definition shiftr2 n x := w2_op.(znz_add_mul_div) (w2_op.(znz_sub) w2_op.(znz_zdigits) n) w2_op.(znz_0) x. - Definition shiftr3 n x := w3_op.(znz_add_mul_div) (w3_op.(znz_sub) w3_op.(znz_zdigits) n) w3_op.(znz_0) x. - Definition shiftr4 n x := w4_op.(znz_add_mul_div) (w4_op.(znz_sub) w4_op.(znz_zdigits) n) w4_op.(znz_0) x. - Definition shiftr5 n x := w5_op.(znz_add_mul_div) (w5_op.(znz_sub) w5_op.(znz_zdigits) n) w5_op.(znz_0) x. - Definition shiftr6 n x := w6_op.(znz_add_mul_div) (w6_op.(znz_sub) w6_op.(znz_zdigits) n) w6_op.(znz_0) x. - Definition shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x. - - Definition shiftr := Eval lazy beta delta [same_level] in - same_level _ (fun n x => N0 (shiftr0 n x)) - (fun n x => reduce_1 (shiftr1 n x)) - (fun n x => reduce_2 (shiftr2 n x)) - (fun n x => reduce_3 (shiftr3 n x)) - (fun n x => reduce_4 (shiftr4 n x)) - (fun n x => reduce_5 (shiftr5 n x)) - (fun n x => reduce_6 (shiftr6 n x)) - (fun n p x => reduce_n n (shiftrn n p x)). - - Theorem spec_shiftr: forall n x, - [n] <= [Ndigits x] -> [shiftr n x] = [x] / 2 ^ [n]. - Proof. - assert (F0: forall x y, x - (x - y) = y). - intros; ring. - assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z). - 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_monotone; auto with zarith. - rewrite Zpower_0_r; ring. - assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x). - intros xx y HH HH1. - split; auto with zarith. - apply Zle_lt_trans with xx; auto with zarith. - apply Zpower2_lt_lin; auto with zarith. - assert (F4: forall ww ww1 ww2 - (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2) - xx yy xx1 yy1, - znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_zdigits ww1_op) -> - znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) -> - znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op -> - znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx -> - znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy -> - znz_to_Z ww_op - (znz_add_mul_div ww_op (znz_sub ww_op (znz_zdigits ww_op) yy1) - (znz_0 ww_op) xx1) = znz_to_Z ww1_op xx / 2 ^ znz_to_Z ww2_op yy). - intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy. - case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2. - case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4. - rewrite <- Hx. - rewrite <- Hy. - generalize (spec_add_mul_div Hw - (znz_0 ww_op) xx1 - (znz_sub ww_op (znz_zdigits ww_op) - yy1) - ). - rewrite (spec_0 Hw). - rewrite Zmult_0_l; rewrite Zplus_0_l. - rewrite (ZnZ.spec_sub Hw). - rewrite Zmod_small; auto with zarith. - rewrite (spec_zdigits Hw). - rewrite F0. - rewrite Zmod_small; auto with zarith. - unfold base; rewrite (spec_zdigits Hw) in Hl1 |- *; - auto with zarith. - assert (F5: forall n m, (n <= m)%nat -> - Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m))). - intros n m HH; elim HH; clear m HH; auto with zarith. - intros m HH Hrec; apply Zle_trans with (1 := Hrec). - rewrite make_op_S. - match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end. - rewrite Zpos_xO. - assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith. - assert (F6: forall n, Zpos (znz_digits w6_op) <= Zpos (znz_digits (make_op n))). - intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0))). - change (znz_digits (make_op 0)) with (xO (znz_digits w6_op)). - rewrite Zpos_xO. - assert (0 <= Zpos (znz_digits w6_op)); auto with zarith. - apply F5; auto with arith. - intros x; case x; clear x; unfold shiftr, same_level. - intros x y; case y; clear y. - intros y; unfold shiftr0, Ndigits. - repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w0_spec)(4:=w0_spec)(5:=w0_spec); auto with zarith. - intros y; unfold shiftr1, Ndigits. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w1_spec)(4:=w1_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n1 x)). - intros y; unfold shiftr2, Ndigits. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w2_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n2 x)). - intros y; unfold shiftr3, Ndigits. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n3 x)). - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n4 x)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n5 x)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n6 x)). - intros m y; unfold shiftrn, Ndigits. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w0_spec); auto with zarith. - change ([Nn m (extend6 m (extend0 5 x))] = [N0 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend0n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftr1, Ndigits. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w1_spec)(4:=w0_spec)(5:=w1_spec); auto with zarith. - rewrite (spec_zdigits w1_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w1_op) with (xO (znz_digits w0_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n1 y)). - intros y; unfold shiftr1, Ndigits. - repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w1_spec)(4:=w1_spec)(5:=w1_spec); auto with zarith. - intros y; unfold shiftr2, Ndigits. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w2_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n2 x)). - intros y; unfold shiftr3, Ndigits. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n3 x)). - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n4 x)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n5 x)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n6 x)). - intros m y; unfold shiftrn, Ndigits. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w1_spec); auto with zarith. - change ([Nn m (extend6 m (extend1 4 x))] = [N1 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend1n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftr2, Ndigits. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w0_spec)(5:=w2_spec); auto with zarith. - rewrite (spec_zdigits w2_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w2_op) with (xO (xO (znz_digits w0_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n2 y)). - intros y; unfold shiftr2, Ndigits. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w1_spec)(5:=w2_spec); auto with zarith. - rewrite (spec_zdigits w2_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w2_op) with (xO (znz_digits w1_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n2 y)). - intros y; unfold shiftr2, Ndigits. - repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w2_spec)(5:=w2_spec); auto with zarith. - intros y; unfold shiftr3, Ndigits. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n3 x)). - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n4 x)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n5 x)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n6 x)). - intros m y; unfold shiftrn, Ndigits. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w2_spec); auto with zarith. - change ([Nn m (extend6 m (extend2 3 x))] = [N2 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend2n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftr3, Ndigits. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w0_spec)(5:=w3_spec); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w3_op) with (xO (xO (xO (znz_digits w0_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n3 y)). - intros y; unfold shiftr3, Ndigits. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w1_spec)(5:=w3_spec); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w3_op) with (xO (xO (znz_digits w1_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n3 y)). - intros y; unfold shiftr3, Ndigits. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w2_spec)(5:=w3_spec); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w3_op) with (xO (znz_digits w2_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n3 y)). - intros y; unfold shiftr3, Ndigits. - repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w3_spec); auto with zarith. - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w3_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend3n4 x)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w3_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend3n5 x)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w3_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend3n6 x)). - intros m y; unfold shiftrn, Ndigits. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w3_spec); auto with zarith. - change ([Nn m (extend6 m (extend3 2 x))] = [N3 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend3n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w0_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w4_op) with (xO (xO (xO (xO (znz_digits w0_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n4 y)). - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w1_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w4_op) with (xO (xO (xO (znz_digits w1_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n4 y)). - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w2_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w4_op) with (xO (xO (znz_digits w2_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n4 y)). - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w3_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w3_spec). - change (znz_digits w4_op) with (xO (znz_digits w3_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w3_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend3n4 y)). - intros y; unfold shiftr4, Ndigits. - repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w4_spec); auto with zarith. - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w4_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend4n5 x)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w4_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend4n6 x)). - intros m y; unfold shiftrn, Ndigits. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w4_spec); auto with zarith. - change ([Nn m (extend6 m (extend4 1 x))] = [N4 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend4n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w0_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w5_op) with (xO (xO (xO (xO (xO (znz_digits w0_op)))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n5 y)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w1_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w5_op) with (xO (xO (xO (xO (znz_digits w1_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n5 y)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w2_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w5_op) with (xO (xO (xO (znz_digits w2_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n5 y)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w3_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w3_spec). - change (znz_digits w5_op) with (xO (xO (znz_digits w3_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w3_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend3n5 y)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w4_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w4_spec). - change (znz_digits w5_op) with (xO (znz_digits w4_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w4_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend4n5 y)). - intros y; unfold shiftr5, Ndigits. - repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w5_spec); auto with zarith. - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w5_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend5n6 x)). - intros m y; unfold shiftrn, Ndigits. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w5_spec); auto with zarith. - change ([Nn m (extend6 m (extend5 0 x))] = [N5 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend5n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w0_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO (xO (znz_digits w0_op))))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n6 y)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w1_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO (znz_digits w1_op)))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n6 y)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w2_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w6_op) with (xO (xO (xO (xO (znz_digits w2_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n6 y)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w3_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w3_spec). - change (znz_digits w6_op) with (xO (xO (xO (znz_digits w3_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w3_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend3n6 y)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w4_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w4_spec). - change (znz_digits w6_op) with (xO (xO (znz_digits w4_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w4_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend4n6 y)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w5_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w5_spec). - change (znz_digits w6_op) with (xO (znz_digits w5_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w5_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend5n6 y)). - intros y; unfold shiftr6, Ndigits. - repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w6_spec); auto with zarith. - intros m y; unfold shiftrn, Ndigits. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w6_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend6n m x)). - intros n x y; case y; clear y; - intros y; unfold shiftrn, Ndigits; try rewrite spec_reduce_n. - try rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w0_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w0_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO (xO(znz_digits w0_op))))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w0_op)); auto with zarith. - change ([Nn n (extend6 n (extend0 5 y))] = [N0 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend0n6; auto). - try rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w1_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w1_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO(znz_digits w1_op)))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w1_op)); auto with zarith. - change ([Nn n (extend6 n (extend1 4 y))] = [N1 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend1n6; auto). - try rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w2_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w2_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO (xO(znz_digits w2_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w2_op)); auto with zarith. - change ([Nn n (extend6 n (extend2 3 y))] = [N2 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend2n6; auto). - try rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w3_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO(znz_digits w3_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w3_op)); auto with zarith. - change ([Nn n (extend6 n (extend3 2 y))] = [N3 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend3n6; auto). - try rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w4_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO(znz_digits w4_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w4_op)); auto with zarith. - change ([Nn n (extend6 n (extend4 1 y))] = [N4 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend4n6; auto). - try rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w5_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO(znz_digits w5_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w5_op)); auto with zarith. - change ([Nn n (extend6 n (extend5 0 y))] = [N5 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend5n6; auto). - try rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w6_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (znz_digits w6_op). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w6_op)); auto with zarith. - change ([Nn n (extend6 n y)] = [N6 y]). - rewrite <- (spec_extend6n n); auto. - generalize y; clear y; intros m y. - rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits (wn_spec m)). - rewrite (spec_zdigits (wn_spec (Max.max n m))). - apply F5; auto with arith. - exact (spec_cast_r n m y). - exact (spec_cast_l n m x). - Qed. - - Definition safe_shiftr n x := - match compare n (Ndigits x) with - | Lt => shiftr n x - | _ => N0 w_0 - end. - - Theorem spec_safe_shiftr: forall n x, - [safe_shiftr n x] = [x] / 2 ^ [n]. - Proof. - intros n x; unfold safe_shiftr; - generalize (spec_compare 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_shiftr; auto with zarith. - apply trans_equal with (1 := spec_0 w0_spec). - apply sym_equal; apply Zdiv_small. - rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2. - split; auto. - apply Zlt_le_trans with (1 := H2). - apply Zpower_le_monotone; auto with zarith. - Qed. - - - Definition shiftl0 n x := w0_op.(znz_add_mul_div) n x w0_op.(znz_0). - Definition shiftl1 n x := w1_op.(znz_add_mul_div) n x w1_op.(znz_0). - Definition shiftl2 n x := w2_op.(znz_add_mul_div) n x w2_op.(znz_0). - Definition shiftl3 n x := w3_op.(znz_add_mul_div) n x w3_op.(znz_0). - Definition shiftl4 n x := w4_op.(znz_add_mul_div) n x w4_op.(znz_0). - Definition shiftl5 n x := w5_op.(znz_add_mul_div) n x w5_op.(znz_0). - Definition shiftl6 n x := w6_op.(znz_add_mul_div) n x w6_op.(znz_0). - Definition shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0). - Definition shiftl := Eval lazy beta delta [same_level] in - same_level _ (fun n x => N0 (shiftl0 n x)) - (fun n x => reduce_1 (shiftl1 n x)) - (fun n x => reduce_2 (shiftl2 n x)) - (fun n x => reduce_3 (shiftl3 n x)) - (fun n x => reduce_4 (shiftl4 n x)) - (fun n x => reduce_5 (shiftl5 n x)) - (fun n x => reduce_6 (shiftl6 n x)) - (fun n p x => reduce_n n (shiftln n p x)). - - - Theorem spec_shiftl: forall n x, - [n] <= [head0 x] -> [shiftl n x] = [x] * 2 ^ [n]. - Proof. - assert (F0: forall x y, x - (x - y) = y). - intros; ring. - assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z). - 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_monotone; auto with zarith. - rewrite Zpower_0_r; ring. - assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x). - intros xx y HH HH1. - split; auto with zarith. - apply Zle_lt_trans with xx; auto with zarith. - apply Zpower2_lt_lin; auto with zarith. - assert (F4: forall ww ww1 ww2 - (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2) - xx yy xx1 yy1, - znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_head0 ww1_op xx) -> - znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) -> - znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op -> - znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx -> - znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy -> - znz_to_Z ww_op - (znz_add_mul_div ww_op yy1 - xx1 (znz_0 ww_op)) = znz_to_Z ww1_op xx * 2 ^ znz_to_Z ww2_op yy). - intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy. - case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2. - case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4. - rewrite <- Hx. - rewrite <- Hy. - generalize (spec_add_mul_div Hw xx1 (znz_0 ww_op) yy1). - rewrite (spec_0 Hw). - assert (F1: znz_to_Z ww1_op (znz_head0 ww1_op xx) <= Zpos (znz_digits ww1_op)). - case (Zle_lt_or_eq _ _ HH1); intros HH5. - apply Zlt_le_weak. - case (ZnZ.spec_head0 Hw1 xx). - rewrite <- Hx; auto. - intros _ Hu; unfold base in Hu. - case (Zle_or_lt (Zpos (znz_digits ww1_op)) - (znz_to_Z ww1_op (znz_head0 ww1_op xx))); auto; intros H1. - absurd (2 ^ (Zpos (znz_digits ww1_op)) <= 2 ^ (znz_to_Z ww1_op (znz_head0 ww1_op xx))). - apply Zlt_not_le. - case (spec_to_Z Hw1 xx); intros HHx3 HHx4. - rewrite <- (Zmult_1_r (2 ^ znz_to_Z ww1_op (znz_head0 ww1_op xx))). - apply Zle_lt_trans with (2 := Hu). - apply Zmult_le_compat_l; auto with zarith. - apply Zpower_le_monotone; auto with zarith. - rewrite (ZnZ.spec_head00 Hw1 xx); auto with zarith. - rewrite Zdiv_0_l; auto with zarith. - rewrite Zplus_0_r. - case (Zle_lt_or_eq _ _ HH1); intros HH5. - rewrite Zmod_small; auto with zarith. - intros HH; apply HH. - rewrite Hy; apply Zle_trans with (1:= Hl). - rewrite <- (spec_zdigits Hw). - apply Zle_trans with (2 := Hl1); auto. - rewrite (spec_zdigits Hw1); auto with zarith. - split; auto with zarith . - apply Zlt_le_trans with (base (znz_digits ww1_op)). - rewrite Hx. - case (ZnZ.spec_head0 Hw1 xx); auto. - rewrite <- Hx; auto. - intros _ Hu; rewrite Zmult_comm in Hu. - apply Zle_lt_trans with (2 := Hu). - apply Zmult_le_compat_l; auto with zarith. - apply Zpower_le_monotone; auto with zarith. - unfold base; apply Zpower_le_monotone; auto with zarith. - split; auto with zarith. - rewrite <- (spec_zdigits Hw); auto with zarith. - rewrite <- (spec_zdigits Hw1); auto with zarith. - rewrite <- HH5. - rewrite Zmult_0_l. - rewrite Zmod_small; auto with zarith. - intros HH; apply HH. - rewrite Hy; apply Zle_trans with (1 := Hl). - rewrite (ZnZ.spec_head00 Hw1 xx); auto with zarith. - rewrite <- (spec_zdigits Hw); auto with zarith. - rewrite <- (spec_zdigits Hw1); auto with zarith. - assert (F5: forall n m, (n <= m)%nat -> - Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m))). - intros n m HH; elim HH; clear m HH; auto with zarith. - intros m HH Hrec; apply Zle_trans with (1 := Hrec). - rewrite make_op_S. - match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end. - rewrite Zpos_xO. - assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith. - assert (F6: forall n, Zpos (znz_digits w6_op) <= Zpos (znz_digits (make_op n))). - intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0))). - change (znz_digits (make_op 0)) with (xO (znz_digits w6_op)). - rewrite Zpos_xO. - assert (0 <= Zpos (znz_digits w6_op)); auto with zarith. - apply F5; auto with arith. - intros x; case x; clear x; unfold shiftl, same_level. - intros x y; case y; clear y. - intros y; unfold shiftl0, head0. - repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w0_spec)(4:=w0_spec)(5:=w0_spec); auto with zarith. - intros y; unfold shiftl1, head0. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w1_spec)(4:=w1_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n1 x)). - intros y; unfold shiftl2, head0. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w2_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n2 x)). - intros y; unfold shiftl3, head0. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n3 x)). - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n4 x)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n5 x)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_0; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w0_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend0n6 x)). - intros m y; unfold shiftln, head0. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w0_spec); auto with zarith. - change ([Nn m (extend6 m (extend0 5 x))] = [N0 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend0n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftl1, head0. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w1_spec)(4:=w0_spec)(5:=w1_spec); auto with zarith. - rewrite (spec_zdigits w1_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w1_op) with (xO (znz_digits w0_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n1 y)). - intros y; unfold shiftl1, head0. - repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w1_spec)(4:=w1_spec)(5:=w1_spec); auto with zarith. - intros y; unfold shiftl2, head0. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w2_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n2 x)). - intros y; unfold shiftl3, head0. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n3 x)). - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n4 x)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n5 x)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_1; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w1_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend1n6 x)). - intros m y; unfold shiftln, head0. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w1_spec); auto with zarith. - change ([Nn m (extend6 m (extend1 4 x))] = [N1 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend1n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftl2, head0. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w0_spec)(5:=w2_spec); auto with zarith. - rewrite (spec_zdigits w2_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w2_op) with (xO (xO (znz_digits w0_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n2 y)). - intros y; unfold shiftl2, head0. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w1_spec)(5:=w2_spec); auto with zarith. - rewrite (spec_zdigits w2_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w2_op) with (xO (znz_digits w1_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n2 y)). - intros y; unfold shiftl2, head0. - repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w2_spec)(4:=w2_spec)(5:=w2_spec); auto with zarith. - intros y; unfold shiftl3, head0. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n3 x)). - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n4 x)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n5 x)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_2; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w2_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend2n6 x)). - intros m y; unfold shiftln, head0. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w2_spec); auto with zarith. - change ([Nn m (extend6 m (extend2 3 x))] = [N2 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend2n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftl3, head0. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w0_spec)(5:=w3_spec); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w3_op) with (xO (xO (xO (znz_digits w0_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n3 y)). - intros y; unfold shiftl3, head0. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w1_spec)(5:=w3_spec); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w3_op) with (xO (xO (znz_digits w1_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n3 y)). - intros y; unfold shiftl3, head0. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w2_spec)(5:=w3_spec); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w3_op) with (xO (znz_digits w2_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n3 y)). - intros y; unfold shiftl3, head0. - repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w3_spec)(4:=w3_spec)(5:=w3_spec); auto with zarith. - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w3_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend3n4 x)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w3_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend3n5 x)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_3; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w3_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend3n6 x)). - intros m y; unfold shiftln, head0. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w3_spec); auto with zarith. - change ([Nn m (extend6 m (extend3 2 x))] = [N3 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend3n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w0_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w4_op) with (xO (xO (xO (xO (znz_digits w0_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n4 y)). - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w1_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w4_op) with (xO (xO (xO (znz_digits w1_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n4 y)). - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w2_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w4_op) with (xO (xO (znz_digits w2_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n4 y)). - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w3_spec)(5:=w4_spec); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits w3_spec). - change (znz_digits w4_op) with (xO (znz_digits w3_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w3_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend3n4 y)). - intros y; unfold shiftl4, head0. - repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w4_spec)(4:=w4_spec)(5:=w4_spec); auto with zarith. - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w4_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend4n5 x)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_4; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w4_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend4n6 x)). - intros m y; unfold shiftln, head0. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w4_spec); auto with zarith. - change ([Nn m (extend6 m (extend4 1 x))] = [N4 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend4n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w0_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w5_op) with (xO (xO (xO (xO (xO (znz_digits w0_op)))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n5 y)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w1_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w5_op) with (xO (xO (xO (xO (znz_digits w1_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n5 y)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w2_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w5_op) with (xO (xO (xO (znz_digits w2_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n5 y)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w3_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w3_spec). - change (znz_digits w5_op) with (xO (xO (znz_digits w3_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w3_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend3n5 y)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w4_spec)(5:=w5_spec); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits w4_spec). - change (znz_digits w5_op) with (xO (znz_digits w4_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w4_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend4n5 y)). - intros y; unfold shiftl5, head0. - repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w5_spec)(4:=w5_spec)(5:=w5_spec); auto with zarith. - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_5; repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w5_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend5n6 x)). - intros m y; unfold shiftln, head0. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w5_spec); auto with zarith. - change ([Nn m (extend6 m (extend5 0 x))] = [N5 x]). - rewrite <- (spec_extend6n m); rewrite <- spec_extend5n6; auto. - intros x y; case y; clear y. - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w0_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w0_spec). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO (xO (znz_digits w0_op))))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w0_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend0n6 y)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w1_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w1_spec). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO (znz_digits w1_op)))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w1_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend1n6 y)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w2_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w2_spec). - change (znz_digits w6_op) with (xO (xO (xO (xO (znz_digits w2_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w2_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend2n6 y)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w3_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w3_spec). - change (znz_digits w6_op) with (xO (xO (xO (znz_digits w3_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w3_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend3n6 y)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w4_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w4_spec). - change (znz_digits w6_op) with (xO (xO (znz_digits w4_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w4_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend4n6 y)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_6; repeat rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w5_spec)(5:=w6_spec); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits w5_spec). - change (znz_digits w6_op) with (xO (znz_digits w5_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (0 <= Zpos (znz_digits w5_op)); auto with zarith. - try (apply sym_equal; exact (spec_extend5n6 y)). - intros y; unfold shiftl6, head0. - repeat rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=w6_spec)(4:=w6_spec)(5:=w6_spec); auto with zarith. - intros m y; unfold shiftln, head0. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w6_spec); auto with zarith. - try (apply sym_equal; exact (spec_extend6n m x)). - intros n x y; case y; clear y; - intros y; unfold shiftln, head0; try rewrite spec_reduce_n. - try rewrite spec_reduce_0; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w0_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w0_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO (xO(znz_digits w0_op))))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w0_op)); auto with zarith. - change ([Nn n (extend6 n (extend0 5 y))] = [N0 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend0n6; auto). - try rewrite spec_reduce_1; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w1_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w1_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO (xO (xO(znz_digits w1_op)))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w1_op)); auto with zarith. - change ([Nn n (extend6 n (extend1 4 y))] = [N1 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend1n6; auto). - try rewrite spec_reduce_2; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w2_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w2_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO (xO(znz_digits w2_op))))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w2_op)); auto with zarith. - change ([Nn n (extend6 n (extend2 3 y))] = [N2 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend2n6; auto). - try rewrite spec_reduce_3; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w3_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w3_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO (xO(znz_digits w3_op)))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w3_op)); auto with zarith. - change ([Nn n (extend6 n (extend3 2 y))] = [N3 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend3n6; auto). - try rewrite spec_reduce_4; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w4_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w4_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO (xO(znz_digits w4_op))). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w4_op)); auto with zarith. - change ([Nn n (extend6 n (extend4 1 y))] = [N4 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend4n6; auto). - try rewrite spec_reduce_5; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w5_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w5_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (xO(znz_digits w5_op)). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w5_op)); auto with zarith. - change ([Nn n (extend6 n (extend5 0 y))] = [N5 y]). - rewrite <- (spec_extend6n n); auto. - try (rewrite <- spec_extend5n6; auto). - try rewrite spec_reduce_6; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec n))(4:=w6_spec)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits w6_spec). - rewrite (spec_zdigits (wn_spec n)). - apply Zle_trans with (2 := F6 n). - change (znz_digits w6_op) with (znz_digits w6_op). - repeat rewrite (fun x => Zpos_xO (xO x)). - repeat rewrite (fun x y => Zpos_xO (@znz_digits x y)). - assert (H: 0 <= Zpos (znz_digits w6_op)); auto with zarith. - change ([Nn n (extend6 n y)] = [N6 y]). - rewrite <- (spec_extend6n n); auto. - generalize y; clear y; intros m y. - repeat rewrite spec_reduce_n; unfold to_Z; intros H1. - apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith. - rewrite (spec_zdigits (wn_spec m)). - rewrite (spec_zdigits (wn_spec (Max.max n m))). - apply F5; auto with arith. - exact (spec_cast_r n m y). - exact (spec_cast_l n m x). - Qed. - - Definition double_size w := match w with - | N0 x => N1 (WW (znz_0 w0_op) x) - | N1 x => N2 (WW (znz_0 w1_op) x) - | N2 x => N3 (WW (znz_0 w2_op) x) - | N3 x => N4 (WW (znz_0 w3_op) x) - | N4 x => N5 (WW (znz_0 w4_op) x) - | N5 x => N6 (WW (znz_0 w5_op) x) - | N6 x => Nn 0 (WW (znz_0 w6_op) x) - | Nn n x => Nn (S n) (WW (znz_0 (make_op n)) x) - end. - - 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; case x; unfold double_size; clear x. - intros x; unfold to_Z, make_op; - rewrite znz_to_Z_1; rewrite (spec_0 w0_spec); auto with zarith. - intros x; unfold to_Z, make_op; - rewrite znz_to_Z_2; rewrite (spec_0 w1_spec); auto with zarith. - intros x; unfold to_Z, make_op; - rewrite znz_to_Z_3; rewrite (spec_0 w2_spec); auto with zarith. - intros x; unfold to_Z, make_op; - rewrite znz_to_Z_4; rewrite (spec_0 w3_spec); auto with zarith. - intros x; unfold to_Z, make_op; - rewrite znz_to_Z_5; rewrite (spec_0 w4_spec); auto with zarith. - intros x; unfold to_Z, make_op; - rewrite znz_to_Z_6; rewrite (spec_0 w5_spec); auto with zarith. - intros x; unfold to_Z, make_op; - rewrite znz_to_Z_7; rewrite (spec_0 w6_spec); auto with zarith. - intros n x; unfold to_Z; - generalize (znz_to_Z_n n); simpl word. - intros HH; rewrite HH; clear HH. - generalize (spec_0 (wn_spec n)); simpl word. - intros HH; rewrite HH; clear HH; 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_monotone; auto; auto with zarith. - generalize (spec_pos (head0 (double_size x))); 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_monotone; auto with zarith. - split; 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_monotone; 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_monotone; auto with zarith. - split; 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. - - Definition safe_shiftl_aux_body cont n x := - match compare n (head0 x) with - Gt => cont n (double_size x) - | _ => shiftl n x - end. - - Theorem spec_safe_shift_aux_body: forall n p x cont, - 2^ Zpos p <= [head0 x] -> - (forall x, 2 ^ (Zpos p + 1) <= [head0 x]-> - [cont n x] = [x] * 2 ^ [n]) -> - [safe_shiftl_aux_body cont n x] = [x] * 2 ^ [n]. - Proof. - intros n p x cont H1 H2; unfold safe_shiftl_aux_body. - generalize (spec_compare n (head0 x)); case compare; intros H. - apply spec_shiftl; auto with zarith. - apply spec_shiftl; auto with zarith. - rewrite H2. - rewrite spec_double_size; auto. - rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith. - apply Zle_trans with (2 := spec_double_size_head0 x). - rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith. - Qed. - - Fixpoint safe_shiftl_aux p cont n x {struct p} := - safe_shiftl_aux_body - (fun n x => match p with - | xH => cont n x - | xO p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x - | xI p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x - end) n x. - - Theorem spec_safe_shift_aux: forall p q n x cont, - 2 ^ (Zpos q) <= [head0 x] -> - (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] -> - [cont n x] = [x] * 2 ^ [n]) -> - [safe_shiftl_aux p cont n x] = [x] * 2 ^ [n]. - Proof. - intros p; elim p; unfold safe_shiftl_aux; fold safe_shiftl_aux; clear p. - intros p Hrec q n x cont H1 H2. - apply spec_safe_shift_aux_body with (q); auto. - intros x1 H3; apply Hrec with (q + 1)%positive; auto. - intros x2 H4; apply Hrec with (p + q + 1)%positive; auto. - rewrite <- Pplus_assoc. - rewrite Zpos_plus_distr; auto. - intros x3 H5; apply H2. - rewrite Zpos_xI. - replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1)); - auto. - repeat rewrite Zpos_plus_distr; ring. - intros p Hrec q n x cont H1 H2. - apply spec_safe_shift_aux_body with (q); auto. - intros x1 H3; apply Hrec with (q); auto. - apply Zle_trans with (2 := H3); auto with zarith. - apply Zpower_le_monotone; auto with zarith. - intros x2 H4; apply Hrec with (p + q)%positive; auto. - intros x3 H5; apply H2. - rewrite (Zpos_xO p). - replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q)); - auto. - repeat rewrite Zpos_plus_distr; ring. - intros q n x cont H1 H2. - apply spec_safe_shift_aux_body with (q); auto. - rewrite Zplus_comm; auto. - Qed. - - Definition safe_shiftl n x := - safe_shiftl_aux_body - (safe_shiftl_aux_body - (safe_shiftl_aux (digits n) shiftl)) n x. - - Theorem spec_safe_shift: forall n x, - [safe_shiftl n x] = [x] * 2 ^ [n]. - Proof. - intros n x; unfold safe_shiftl, safe_shiftl_aux_body. - generalize (spec_compare n (head0 x)); case compare; intros H. - apply spec_shiftl; auto with zarith. - apply spec_shiftl; auto with zarith. - rewrite <- (spec_double_size x). - generalize (spec_compare n (head0 (double_size x))); case compare; intros H1. - apply spec_shiftl; auto with zarith. - apply spec_shiftl; auto with zarith. - rewrite <- (spec_double_size (double_size x)). - apply spec_safe_shift_aux with 1%positive. - apply Zle_trans with (2 := spec_double_size_head0 (double_size x)). - replace (2 ^ 1) with (2 * 1). - apply Zmult_le_compat_l; auto with zarith. - generalize (spec_double_size_head0_pos x); auto with zarith. - rewrite Zpower_1_r; ring. - intros x1 H2; apply spec_shiftl. - apply Zle_trans with (2 := H2). - apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith. - case (spec_digits n); auto with zarith. - apply Zpower_le_monotone; auto with zarith. - Qed. - - Definition is_even x := - match x with - | N0 wx => w0_op.(znz_is_even) wx - | N1 wx => w1_op.(znz_is_even) wx - | N2 wx => w2_op.(znz_is_even) wx - | N3 wx => w3_op.(znz_is_even) wx - | N4 wx => w4_op.(znz_is_even) wx - | N5 wx => w5_op.(znz_is_even) wx - | N6 wx => w6_op.(znz_is_even) wx - | Nn n wx => (make_op n).(znz_is_even) wx - end. - - Theorem spec_is_even: forall x, - if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1. - Proof. - intros x; case x; unfold is_even, to_Z; clear x. - intros x; exact (spec_is_even w0_spec x). - intros x; exact (spec_is_even w1_spec x). - intros x; exact (spec_is_even w2_spec x). - intros x; exact (spec_is_even w3_spec x). - intros x; exact (spec_is_even w4_spec x). - intros x; exact (spec_is_even w5_spec x). - intros x; exact (spec_is_even w6_spec x). - intros n x; exact (spec_is_even (wn_spec n) x). - Qed. - - Theorem spec_0: [zero] = 0. - Proof. - exact (spec_0 w0_spec). - Qed. - - Theorem spec_1: [one] = 1. - Proof. - exact (spec_1 w0_spec). - Qed. - -End Make. diff --git a/theories/Ints/num/Nbasic.v b/theories/Ints/num/Nbasic.v deleted file mode 100644 index 1398e8f559..0000000000 --- a/theories/Ints/num/Nbasic.v +++ /dev/null @@ -1,510 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import Max. -Require Import GenBase. -Require Import ZnZ. -Require Import Zn2Z. - -(* To compute the necessary height *) - -Fixpoint plength (p: positive) : positive := - match p with - xH => xH - | xO p1 => Psucc (plength p1) - | xI p1 => Psucc (plength p1) - end. - -Theorem plength_correct: forall p, (Zpos p < 2 ^ Zpos (plength p))%Z. -assert (F: (forall p, 2 ^ (Zpos (Psucc p)) = 2 * 2 ^ Zpos p)%Z). -intros p; replace (Zpos (Psucc p)) with (1 + Zpos p)%Z. -rewrite Zpower_exp; auto with zarith. -rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith. -intros p; elim p; simpl plength; auto. -intros p1 Hp1; rewrite F; repeat rewrite Zpos_xI. -assert (tmp: (forall p, 2 * p = p + p)%Z); - try repeat rewrite tmp; auto with zarith. -intros p1 Hp1; rewrite F; rewrite (Zpos_xO p1). -assert (tmp: (forall p, 2 * p = p + p)%Z); - try repeat rewrite tmp; auto with zarith. -rewrite Zpower_1_r; auto with zarith. -Qed. - -Theorem plength_pred_correct: forall p, (Zpos p <= 2 ^ Zpos (plength (Ppred p)))%Z. -intros p; case (Psucc_pred p); intros H1. -subst; simpl plength. -rewrite Zpower_1_r; auto with zarith. -pattern p at 1; rewrite <- H1. -rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith. -generalize (plength_correct (Ppred p)); auto with zarith. -Qed. - -Definition Pdiv p q := - match Zdiv (Zpos p) (Zpos q) with - Zpos q1 => match (Zpos p) - (Zpos q) * (Zpos q1) with - Z0 => q1 - | _ => (Psucc q1) - end - | _ => xH - end. - -Theorem Pdiv_le: forall p q, - Zpos p <= Zpos q * Zpos (Pdiv p q). -intros p q. -unfold Pdiv. -assert (H1: Zpos q > 0); auto with zarith. -assert (H1b: Zpos p >= 0); auto with zarith. -generalize (Z_div_ge0 (Zpos p) (Zpos q) H1 H1b). -generalize (Z_div_mod_eq (Zpos p) (Zpos q) H1); case Zdiv. - intros HH _; rewrite HH; rewrite Zmult_0_r; rewrite Zmult_1_r; simpl. -case (Z_mod_lt (Zpos p) (Zpos q) H1); auto with zarith. -intros q1 H2. -replace (Zpos p - Zpos q * Zpos q1) with (Zpos p mod Zpos q). - 2: pattern (Zpos p) at 2; rewrite H2; auto with zarith. -generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2; - case Zmod. - intros HH _; rewrite HH; auto with zarith. - intros r1 HH (_,HH1); rewrite HH; rewrite Zpos_succ_morphism. - unfold Zsucc; rewrite Zmult_plus_distr_r; auto with zarith. - intros r1 _ (HH,_); case HH; auto. -intros q1 HH; rewrite HH. -unfold Zge; simpl Zcompare; intros HH1; case HH1; auto. -Qed. - -Definition is_one p := match p with xH => true | _ => false end. - -Theorem is_one_one: forall p, is_one p = true -> p = xH. -intros p; case p; auto; intros p1 H1; discriminate H1. -Qed. - -Definition get_height digits p := - let r := Pdiv p digits in - if is_one r then xH else Psucc (plength (Ppred r)). - -Theorem get_height_correct: - forall digits N, - Zpos N <= Zpos digits * (2 ^ (Zpos (get_height digits N) -1)). -intros digits N. -unfold get_height. -assert (H1 := Pdiv_le N digits). -case_eq (is_one (Pdiv N digits)); intros H2. -rewrite (is_one_one _ H2) in H1. -rewrite Zmult_1_r in H1. -change (2^(1-1))%Z with 1; rewrite Zmult_1_r; auto. -clear H2. -apply Zle_trans with (1 := H1). -apply Zmult_le_compat_l; auto with zarith. -rewrite Zpos_succ_morphism; unfold Zsucc. -rewrite Zplus_comm; rewrite Zminus_plus. -apply plength_pred_correct. -Qed. - -Definition zn2z_word_comm : forall w n, zn2z (word w n) = word (zn2z w) n. - fix zn2z_word_comm 2. - intros w n; case n. - reflexivity. - intros n0;simpl. - case (zn2z_word_comm w n0). - reflexivity. -Defined. - -Fixpoint extend (n:nat) {struct n} : forall w:Set, zn2z w -> word w (S n) := - match n return forall w:Set, zn2z w -> word w (S n) with - | O => fun w x => x - | S m => - let aux := extend m in - fun w x => WW W0 (aux w x) - end. - -Section ExtendMax. - -Open Scope nat_scope. - -Fixpoint plusnS (n m: nat) {struct n} : (n + S m = S (n + m))%nat := - match n return (n + S m = S (n + m))%nat with - | 0 => refl_equal (S m) - | S n1 => - let v := S (S n1 + m) in - eq_ind_r (fun n => S n = v) (refl_equal v) (plusnS n1 m) - end. - -Fixpoint plusn0 n : n + 0 = n := - match n return (n + 0 = n) with - | 0 => refl_equal 0 - | S n1 => - let v := S n1 in - eq_ind_r (fun n : nat => S n = v) (refl_equal v) (plusn0 n1) - end. - - Fixpoint diff (m n: nat) {struct m}: nat * nat := - match m, n with - O, n => (O, n) - | m, O => (m, O) - | S m1, S n1 => diff m1 n1 - end. - -Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n := - match m return fst (diff m n) + n = max m n with - | 0 => - match n return (n = max 0 n) with - | 0 => refl_equal _ - | S n0 => refl_equal _ - end - | S m1 => - match n return (fst (diff (S m1) n) + n = max (S m1) n) - with - | 0 => plusn0 _ - | S n1 => - let v := fst (diff m1 n1) + n1 in - let v1 := fst (diff m1 n1) + S n1 in - eq_ind v (fun n => v1 = S n) - (eq_ind v1 (fun n => v1 = n) (refl_equal v1) (S v) (plusnS _ _)) - _ (diff_l _ _) - end - end. - -Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n := - match m return (snd (diff m n) + m = max m n) with - | 0 => - match n return (snd (diff 0 n) + 0 = max 0 n) with - | 0 => refl_equal _ - | S _ => plusn0 _ - end - | S m => - match n return (snd (diff (S m) n) + S m = max (S m) n) with - | 0 => refl_equal (snd (diff (S m) 0) + S m) - | S n1 => - let v := S (max m n1) in - eq_ind_r (fun n => n = v) - (eq_ind_r (fun n => S n = v) - (refl_equal v) (diff_r _ _)) (plusnS _ _) - end - end. - - Variable w: Set. - - Definition castm (m n: nat) (H: m = n) (x: word w (S m)): - (word w (S n)) := - match H in (_ = y) return (word w (S y)) with - | refl_equal => x - end. - -Variable m: nat. -Variable v: (word w (S m)). - -Fixpoint extend_tr (n : nat) {struct n}: (word w (S (n + m))) := - match n return (word w (S (n + m))) with - | O => v - | S n1 => WW W0 (extend_tr n1) - end. - -End ExtendMax. - -Implicit Arguments extend_tr[w m]. -Implicit Arguments castm[w m n]. - - - -Section Reduce. - - Variable w : Set. - Variable nT : Set. - Variable N0 : nT. - Variable eq0 : w -> bool. - Variable reduce_n : w -> nT. - Variable zn2z_to_Nt : zn2z w -> nT. - - Definition reduce_n1 (x:zn2z w) := - match x with - | W0 => N0 - | WW xh xl => - if eq0 xh then reduce_n xl - else zn2z_to_Nt x - end. - -End Reduce. - -Section ReduceRec. - - Variable w : Set. - Variable nT : Set. - Variable N0 : nT. - Variable reduce_1n : zn2z w -> nT. - Variable c : forall n, word w (S n) -> nT. - - Fixpoint reduce_n (n:nat) : word w (S n) -> nT := - match n return word w (S n) -> nT with - | O => reduce_1n - | S m => fun x => - match x with - | W0 => N0 - | WW xh xl => - match xh with - | W0 => @reduce_n m xl - | _ => @c (S m) x - end - end - end. - -End ReduceRec. - -Definition opp_compare cmp := - match cmp with - | Lt => Gt - | Eq => Eq - | Gt => Lt - end. - -Section CompareRec. - - Variable wm w : Set. - Variable w_0 : w. - Variable compare : w -> w -> comparison. - Variable compare0_m : wm -> comparison. - Variable compare_m : wm -> w -> comparison. - - Fixpoint compare0_mn (n:nat) : word wm n -> comparison := - match n return word wm n -> comparison with - | O => compare0_m - | S m => fun x => - match x with - | W0 => Eq - | WW xh xl => - match compare0_mn m xh with - | Eq => compare0_mn m xl - | r => Lt - end - end - end. - - Variable wm_base: positive. - Variable wm_to_Z: wm -> Z. - 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. - Variable wm_to_Z_pos: forall x, 0 <= wm_to_Z x < base wm_base. - - Let gen_to_Z := gen_to_Z wm_base wm_to_Z. - Let gen_wB := gen_wB wm_base. - - Lemma base_xO: forall n, base (xO n) = (base n)^2. - Proof. - intros n1; unfold base. - rewrite (Zpos_xO n1); rewrite Zmult_comm; rewrite Zpower_mult; auto with zarith. - Qed. - - Let gen_to_Z_pos: forall n x, 0 <= gen_to_Z n x < gen_wB n := - (spec_gen_to_Z wm_base wm_to_Z wm_to_Z_pos). - - - Lemma spec_compare0_mn: forall n x, - match compare0_mn n x with - Eq => 0 = gen_to_Z n x - | Lt => 0 < gen_to_Z n x - | Gt => 0 > gen_to_Z n x - end. - Proof. - intros n; elim n; clear n; auto. - intros x; generalize (spec_compare0_m x); rewrite w_to_Z_0; auto. - intros n Hrec x; case x; unfold compare0_mn; fold compare0_mn; auto. - intros xh xl. - generalize (Hrec xh); case compare0_mn; auto. - generalize (Hrec xl); case compare0_mn; auto. - simpl gen_to_Z; intros H1 H2; rewrite H1; rewrite <- H2; auto. - simpl gen_to_Z; intros H1 H2; rewrite <- H2; auto. - case (gen_to_Z_pos n xl); auto with zarith. - intros H1; simpl gen_to_Z. - set (u := GenBase.gen_wB wm_base n). - case (gen_to_Z_pos n xl); intros H2 H3. - assert (0 < u); auto with zarith. - unfold u, GenBase.gen_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 (gen_to_Z_pos n xh); auto with zarith. - Qed. - - Fixpoint compare_mn_1 (n:nat) : word wm n -> w -> comparison := - match n return word wm n -> w -> comparison with - | O => compare_m - | S m => fun x y => - match x with - | W0 => compare w_0 y - | WW xh xl => - match compare0_mn m xh with - | Eq => compare_mn_1 m xl y - | r => Gt - end - end - 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. - 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. - Variable wm_base_lt: forall x, - 0 <= w_to_Z x < base (wm_base). - - Let gen_wB_lt: forall n x, - 0 <= w_to_Z x < (gen_wB n). - Proof. - intros n x; elim n; simpl; auto; clear n. - intros n (H0, H); split; auto. - apply Zlt_le_trans with (1:= H). - unfold gen_wB, GenBase.gen_wB; simpl. - rewrite base_xO. - set (u := base (gen_digits wm_base n)). - assert (0 < u). - unfold u, base; auto with zarith. - replace (u^2) with (u * u); simpl; auto with zarith. - apply Zle_trans with (1 * u); auto with zarith. - unfold Zpower_pos; simpl; ring. - Qed. - - - Lemma spec_compare_mn_1: forall n x y, - match compare_mn_1 n x y with - Eq => gen_to_Z n x = w_to_Z y - | Lt => gen_to_Z n x < w_to_Z y - | Gt => gen_to_Z n x > w_to_Z y - end. - 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. - rewrite <- H1b; rewrite Zmult_0_l; rewrite Zplus_0_l; auto. - apply Hrec. - apply Zlt_gt. - case (gen_wB_lt n y); intros _ H0. - apply Zlt_le_trans with (1:= H0). - fold gen_wB. - case (gen_to_Z_pos n xl); intros H1 H2. - apply Zle_trans with (gen_to_Z n xh * gen_wB n); auto with zarith. - apply Zle_trans with (1 * gen_wB n); auto with zarith. - case (gen_to_Z_pos n xh); auto with zarith. - Qed. - -End CompareRec. - - -Section AddS. - - Variable w wm: Set. - Variable incr : wm -> carry wm. - Variable addr : w -> wm -> carry wm. - Variable injr : w -> zn2z wm. - - Variable w_0 u: w. - Fixpoint injs (n:nat): word w (S n) := - match n return (word w (S n)) with - O => WW w_0 u - | S n1 => (WW W0 (injs n1)) - end. - - Definition adds x y := - match y with - W0 => C0 (injr x) - | WW hy ly => match addr x ly with - C0 z => C0 (WW hy z) - | C1 z => match incr hy with - C0 z1 => C0 (WW z1 z) - | C1 z1 => C1 (WW z1 z) - end - end - end. - -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. - - Theorem length_pos_lt: forall x y, - (length_pos x < length_pos y)%nat -> Zpos x < Zpos y. - Proof. - intros x; elim x; clear x; [intros x1 Hrec | intros x1 Hrec | idtac]; - intros y; case y; clear y; intros y1 H || intros H; simpl length_pos; - try (rewrite (Zpos_xI x1) || rewrite (Zpos_xO x1)); - try (rewrite (Zpos_xI y1) || rewrite (Zpos_xO y1)); - try (inversion H; fail); - try (assert (Zpos x1 < Zpos y1); [apply Hrec; apply lt_S_n | idtac]; auto with zarith); - assert (0 < Zpos y1); auto with zarith; red; auto. - Qed. - - Theorem cancel_app: forall A B (f g: A -> B) x, f = g -> f x = g x. - Proof. - intros A B f g x H; rewrite H; auto. - Qed. - - - Section SimplOp. - - Variable w: Set. - - Theorem digits_zop: forall w (x: znz_op w), - znz_digits (mk_zn2z_op x) = xO (znz_digits x). - 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). - intros ww x; auto. - Qed. - - Theorem make_zop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op x) = - fun z => match z with - W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) - + znz_to_Z x xl - end. - intros ww x; auto. - Qed. - - Theorem make_kzop: forall w (x: znz_op w), - znz_to_Z (mk_zn2z_op_karatsuba x) = - fun z => match z with - W0 => 0 - | WW xh xl => znz_to_Z x xh * base (znz_digits x) - + znz_to_Z x xl - end. - intros ww x; auto. - Qed. - - End SimplOp. diff --git a/theories/Ints/num/Q0Make.v b/theories/Ints/num/Q0Make.v deleted file mode 100644 index d5809ea591..0000000000 --- a/theories/Ints/num/Q0Make.v +++ /dev/null @@ -1,1349 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import Zaux. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Q0. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/y. The pairs (x,0) and (0,y) are all - interpreted as 0. *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => if BigN.eq_bool y BigN.zero then 0%Q - else BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_of_pos; intros HH; discriminate HH. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => - if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero - else BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - | Qq nx dx, Qz zy => - if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy - else BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - | Qq nx dx, Qq ny dy => - match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with - | true, true => Eq - | true, false => BigZ.compare BigZ.zero ny - | false, true => BigZ.compare nx BigZ.zero - | false, false => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end - end. - - Theorem spec_compare: forall q1 q2, - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero z2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zcompare_refl; auto. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero x2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare; - auto; rewrite BigZ.spec_0. - intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - repeat rewrite Z2P_correct. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * BigZ.Pos y2) - (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - Qed. - - Theorem spec_comparec: forall q1 q2, - compare q1 q2 = ([[q1]] ?= [[q2]]). - unfold Qccompare, to_Qc. - intros q1 q2; rewrite spec_compare; simpl; auto. - apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -(* Je pense que cette fonction normalise bien ... *) - Definition norm n d: t := - let gcd := BigN.gcd (BigZ.to_N n) d in - match BigN.compare BigN.one gcd with - | Lt => - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - match BigN.compare d BigN.one with - | Gt => Qq n d - | Eq => Qz n - | Lt => zero - end - | Eq => Qq n d - | Gt => zero (* gcd = 0 => both numbers are 0 *) - end. - - - - Theorem spec_norm: forall n q, - ([norm n q] == [Qq n q])%Q. - intros p q; unfold norm. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H2 HH. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl; - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - auto with zarith. - generalize H2; rewrite H3; - rewrite Zdiv_0_l; auto with zarith. - generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3. - rewrite spec_to_N. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl. - case H3. - generalize H1 H2 H3 HH; clear H1 H2 H3 HH. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 HH. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith. - case (Zle_lt_or_eq _ _ HH); auto with zarith. - intros HH1; rewrite <- HH1; ring. - generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith. - simpl. - assert (FF := BigN.spec_pos q). - rewrite Z2P_correct; auto with zarith. - rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith. - simpl; rewrite BigZ.spec_div; simpl. - rewrite BigN.spec_gcd; auto with zarith. - generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4 HH FF. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q))); - rewrite BigN.spec_gcd; auto with zarith. - intros; apply False_ind; auto with zarith. - intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2; simpl. - rewrite spec_to_N. - rewrite FF2; ring. - Qed. - - - Definition add (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end - end. - - Theorem spec_add x y: - ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r; red; simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - rewrite Zmult_1_r; rewrite Pmult_1_r. - apply Qeq_refl. - assert (F1:= BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - case HH2; auto. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH2; auto. - case HH1; auto. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH; auto. - rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r. - apply Qeq_refl. - simpl. - generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros HH2. - (case (Zmult_integral _ _ HH2); intros HH3); - [case HH| case HH1]; auto. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - red; simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: - [[add x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end - end. - - - Theorem spec_add_norm x y: - ([add_norm x y] == [x] + [y])%Q. - intros x y; rewrite <- spec_add; auto. - case x; case y; clear x y; unfold add_norm, add. - intros; apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - simpl. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - apply Qeq_refl. - intros p1 p2 n. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - Qed. - - Theorem spec_add_normc x y: - [[add_norm x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub x y := add x (opp y). - - - Theorem spec_sub x y: - ([sub x y] == [x] - [y])%Q. - intros x y; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - intros x y; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm x y: - ([sub_norm x y] == [x] - [y])%Q. - intros x y; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_sub_normc x y: - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - - Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - red; simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - red; simpl; ring. - case (Zmult_integral _ _ HH1); intros HH. - case HH2; auto. - case HH3; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - case HH1; rewrite HH2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - case HH1; rewrite HH3; ring. - rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - - Theorem spec_mulc x y: - [[mul x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => - if BigZ.eq_bool zx BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zx) dy in - match BigN.compare gcd BigN.one with - Gt => - let zx := BigZ.div zx (BigZ.Pos gcd) in - let d := BigN.div dy gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny) - else Qq (BigZ.mul zx ny) d - | _ => Qq (BigZ.mul zx ny) dy - end - | Qq nx dx, Qz zy => - if BigZ.eq_bool zy BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zy) dx in - match BigN.compare gcd BigN.one with - Gt => - let zy := BigZ.div zy (BigZ.Pos gcd) in - let d := BigN.div dx gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx) - else Qq (BigZ.mul zy nx) d - | _ => Qq (BigZ.mul zy nx) dx - end - | Qq nx dx, Qq ny dy => - let (nx, dy) := - let gcd := BigN.gcd (BigZ.to_N nx) dy in - match BigN.compare gcd BigN.one with - Gt => (BigZ.div nx (BigZ.Pos gcd), BigN.div dy gcd) - | _ => (nx, dy) - end in - let (ny, dx) := - let gcd := BigN.gcd (BigZ.to_N ny) dx in - match BigN.compare gcd BigN.one with - Gt => (BigZ.div ny (BigZ.Pos gcd), BigN.div dx gcd) - | _ => (ny, dx) - end in - let d := (BigN.mul dx dy) in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul ny nx) - else Qq (BigZ.mul ny nx) d - end. - - Theorem spec_mul_norm x y: - ([mul_norm x y] == [x] * [y])%Q. - intros x y; rewrite <- spec_mul; auto. - unfold mul_norm, mul; case x; case y; clear x y. - intros; apply Qeq_refl. - intros p1 n p2. - set (a := BigN.to_Z (BigZ.to_N p2)). - set (b := BigN.to_Z n). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - case BigN.eq_bool; try apply Qeq_refl. - rewrite BigZ.spec_mul; rewrite H. - red; simpl; ring. - assert (F: (0 < a)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; - fold a b; intros H1. - apply Qeq_refl. - apply Qeq_refl. - assert (F0 : (0 < (Zgcd a b))%Z). - apply Zlt_trans with 1%Z. - red; auto. - apply Zgt_lt; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; - fold a b; intros H2. - assert (F1: b = Zgcd a b). - pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); - auto with zarith. - rewrite H2; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - assert (F2: (0 < b)%Z). - rewrite F1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H3. - rewrite H3 in F2; discriminate F2. - rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite BigZ.spec_mul. - red; simpl; rewrite Z2P_correct; auto. - rewrite Zmult_1_r; rewrite spec_to_N; fold a b. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; fold a b; auto; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - apply Qeq_refl. - case H4; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H3; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto. - rewrite BigZ.spec_mul; rewrite BigZ.spec_div; simpl; - rewrite BigN.spec_gcd; fold a b; auto with zarith. - assert (F1: (0 < b)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos n)); fold b; auto with zarith. - red; simpl. - rewrite BigZ.spec_mul. - repeat rewrite Z2P_correct; auto. - rewrite spec_to_N; fold a. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - ring. - apply Zgcd_div_pos; auto. - intros p1 p2 n. - set (a := BigN.to_Z (BigZ.to_N p1)). - set (b := BigN.to_Z n). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - case BigN.eq_bool; try apply Qeq_refl. - rewrite BigZ.spec_mul; rewrite H. - red; simpl; ring. - assert (F: (0 < a)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; - fold a b; intros H1. - repeat rewrite BigZ.spec_mul; rewrite Zmult_comm. - apply Qeq_refl. - repeat rewrite BigZ.spec_mul; rewrite Zmult_comm. - apply Qeq_refl. - assert (F0 : (0 < (Zgcd a b))%Z). - apply Zlt_trans with 1%Z. - red; auto. - apply Zgt_lt; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; - fold a b; intros H2. - assert (F1: b = Zgcd a b). - pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); - auto with zarith. - rewrite H2; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - assert (F2: (0 < b)%Z). - rewrite F1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H3. - rewrite H3 in F2; discriminate F2. - rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite BigZ.spec_mul. - red; simpl; rewrite Z2P_correct; auto. - rewrite Zmult_1_r; rewrite spec_to_N; fold a b. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; fold a b; auto; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - apply Qeq_refl. - case H4; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H3; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto. - rewrite BigZ.spec_mul; rewrite BigZ.spec_div; simpl; - rewrite BigN.spec_gcd; fold a b; auto with zarith. - assert (F1: (0 < b)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos n)); fold b; auto with zarith. - red; simpl. - rewrite BigZ.spec_mul. - repeat rewrite Z2P_correct; auto. - rewrite spec_to_N; fold a. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - ring. - apply Zgcd_div_pos; auto. - set (f := fun p t => - match (BigN.gcd (BigZ.to_N p) t ?= BigN.one)%bigN with - | Eq => (p, t) - | Lt => (p, t) - | Gt => - ((p / BigZ.Pos (BigN.gcd (BigZ.to_N p) t))%bigZ, - (t / BigN.gcd (BigZ.to_N p) t)%bigN) - end). - assert (F: forall p t, - let (n, d) := f p t in [Qq p t] == [Qq n d]). - intros p t1; unfold f. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - apply Qeq_refl. - set (a := BigN.to_Z (BigZ.to_N p)). - set (b := BigN.to_Z t1). - fold a b in H1. - assert (F0 : (0 < (Zgcd a b))%Z). - apply Zlt_trans with 1%Z. - red; auto. - apply Zgt_lt; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros HH2. - simpl; ring. - case HH2. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; auto. - rewrite HH1; rewrite Zdiv_0_l; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; auto; - intros HH2. - case HH1. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite HH2; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; fold a b; auto with zarith. - assert (F1: (0 < b)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos t1)); fold b; auto with zarith. - intros HH; case HH1; auto. - repeat rewrite Z2P_correct; auto. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto. - apply Zgcd_div_pos; auto. - intros HH; rewrite HH in F0; discriminate F0. - intros p1 n1 p2 n2. - change ([let (nx , dy) := f p2 n1 in - let (ny, dx) := f p1 n2 in - if BigN.eq_bool (dx * dy)%bigN BigN.one - then Qz (ny * nx) - else Qq (ny * nx) (dx * dy)] == [Qq (p2 * p1) (n2 * n1)]). - generalize (F p2 n1) (F p1 n2). - case f; case f. - intros u1 u2 v1 v2 Hu1 Hv1. - apply Qeq_trans with [mul (Qq p2 n1) (Qq p1 n2)]. - rewrite spec_mul; rewrite Hu1; rewrite Hv1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_mul; intros HH1. - assert (F1: BigN.to_Z u2 = 1%Z). - case (Zmult_1_inversion_l _ _ HH1); auto. - generalize (BigN.spec_pos u2); auto with zarith. - assert (F2: BigN.to_Z v2 = 1%Z). - rewrite Zmult_comm in HH1. - case (Zmult_1_inversion_l _ _ HH1); auto. - generalize (BigN.spec_pos v2); auto with zarith. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1 in F2; discriminate F2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2. - rewrite H2 in F1; discriminate F1. - simpl; rewrite BigZ.spec_mul. - rewrite F1; rewrite F2; simpl; ring. - rewrite Qmult_comm; rewrite <- spec_mul. - apply Qeq_refl. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - rewrite Zmult_comm; intros H1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; intros H2; auto. - case H2; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; intros H2; auto. - case H1; auto. - Qed. - - Theorem spec_mul_normc x y: - [[mul_norm x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - -Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => Qq BigZ.one n - | Qz (BigZ.Neg n) => Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n - end. - - Theorem spec_inv x: - ([inv x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - Qed. - - Theorem spec_invc x: - [[inv x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -Definition inv_norm (x: t): t := - match x with - | Qz (BigZ.Pos n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.one n - | _ => x - end - | Qz (BigZ.Neg n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.minus_one n - | _ => x - end - | Qq (BigZ.Pos n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Pos d) n - | Eq => Qz (BigZ.Pos d) - | Lt => Qz (BigZ.zero) - end - | Qq (BigZ.Neg n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Neg d) n - | Eq => Qz (BigZ.Neg d) - | Lt => Qz (BigZ.zero) - end - end. - - Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, Qinv. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - Qed. - - Theorem spec_inv_normc x: - [[inv_norm x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv_norm; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: ([div x y] == [x] / [y])%Q. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - Theorem spec_square x: ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - simpl Qpower. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H1; rewrite H; auto. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H; case (Zmult_integral _ _ H1); auto. - simpl. - rewrite BigZ.spec_square. - rewrite Zpos_mult_morphism. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p) - end. - - Theorem spec_power_pos x p: ([power_pos x p] == [x] ^ Zpos p)%Q. - Proof. - intros [x | nx dx] p; unfold power_pos. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_power_pos; intros H1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - elim p; simpl. - intros; red; simpl; auto. - intros p1 Hp1; rewrite <- Hp1; red; simpl; auto. - apply Qeq_refl. - case H2; generalize H1. - elim p; simpl. - intros p1 Hrec. - change (xI p1) with (1 + (xO p1))%positive. - rewrite Zpower_pos_is_exp; rewrite Zpower_pos_1_r. - intros HH; case (Zmult_integral _ _ HH); auto. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - intros p1 Hrec. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - rewrite Zpower_pos_1_r; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - case H1; rewrite H2; auto. - simpl; rewrite Zpower_pos_0_l; auto. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z dx))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - Qed. - - Theorem spec_power_posc x p: - [[power_pos x p]] = [[x]] ^ nat_of_P p. - intros x p; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos; auto. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; case x; simpl; clear x Hrec. - intros x; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - unfold Qpower_positive. - assert (tmp: forall p, pow_pos Qmult 0%Q p = 0%Q). - intros p1; elim p1; simpl; auto; clear p1. - intros p1 Hp1; rewrite Hp1; auto. - intros p1 Hp1; rewrite Hp1; auto. - repeat rewrite tmp; intros; red; simpl; auto. - intros H1. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -End Q0. diff --git a/theories/Ints/num/QMake_base.v b/theories/Ints/num/QMake_base.v deleted file mode 100644 index 0cd2d2122f..0000000000 --- a/theories/Ints/num/QMake_base.v +++ /dev/null @@ -1,38 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(* $Id:$ *) - -(** * An implementation of rational numbers based on big integers *) - -(** -- Authors: Benjamin Grégoire, Laurent Théry -- Institution: INRIA -- Date: 2007 -*) - -Require Export BigN. -Require Export BigZ. - -(* Basic type for Q: a Z or a pair of a Z and an N *) - -Inductive q_type : Set := - | Qz : BigZ.t -> q_type - | Qq : BigZ.t -> BigN.t -> q_type. - -Definition print_type x := - match x with - | Qz _ => Z - | _ => (Z*Z)%type - end. - -Definition print x := - match x return print_type x with - | Qz zx => BigZ.to_Z zx - | Qq nx dx => (BigZ.to_Z nx, BigN.to_Z dx) - end. diff --git a/theories/Ints/num/QbiMake.v b/theories/Ints/num/QbiMake.v deleted file mode 100644 index a98fda9d7f..0000000000 --- a/theories/Ints/num/QbiMake.v +++ /dev/null @@ -1,1058 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import Zaux. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Qbi. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/y. The pairs (x,0) and (0,y) are all - interpreted as 0. *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => if BigN.eq_bool y BigN.zero then 0%Q - else BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_of_pos; intros HH; discriminate HH. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => - if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero - else - match BigZ.cmp_sign zx ny with - | Lt => Lt - | Gt => Gt - | Eq => BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - end - | Qq nx dx, Qz zy => - if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy - else - match BigZ.cmp_sign nx zy with - | Lt => Lt - | Gt => Gt - | Eq => BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - end - | Qq nx dx, Qq ny dy => - match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with - | true, true => Eq - | true, false => BigZ.compare BigZ.zero ny - | false, true => BigZ.compare nx BigZ.zero - | false, false => - match BigZ.cmp_sign nx ny with - | Lt => Lt - | Gt => Gt - | Eq => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end - end - end. - - Theorem spec_compare: forall q1 q2, - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto. - set (a := BigZ.to_Z z1); set (b := BigZ.to_Z x2); - set (c := BigN.to_Z y2); fold c in HH. - assert (F: (0 < c)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y2)); fold c; auto. - intros H1; case HH; rewrite <- H1; auto. - rewrite Z2P_correct; auto with zarith. - generalize (BigZ.spec_cmp_sign z1 x2); case BigZ.cmp_sign; fold a b c. - intros _; generalize (BigZ.spec_compare (z1 * BigZ.Pos y2)%bigZ x2); - case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c; auto. - intros H1; rewrite H1; rewrite Zcompare_refl; auto. - intros (H1, H2); apply sym_equal; change (a * c < b)%Z. - apply Zlt_le_trans with (2 := H2). - change 0%Z with (0 * c)%Z. - apply Zmult_lt_compat_r; auto with zarith. - intros (H1, H2); apply sym_equal; change (a * c > b)%Z. - apply Zlt_gt. - apply Zlt_le_trans with (1 := H2). - change 0%Z with (0 * c)%Z. - apply Zmult_le_compat_r; auto with zarith. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero z2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto. - set (a := BigZ.to_Z z2); set (b := BigZ.to_Z x1); - set (c := BigN.to_Z y1); fold c in HH. - assert (F: (0 < c)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y1)); fold c; auto. - intros H1; case HH; rewrite <- H1; auto. - rewrite Zmult_1_r; rewrite Z2P_correct; auto with zarith. - generalize (BigZ.spec_cmp_sign x1 z2); case BigZ.cmp_sign; fold a b c. - intros _; generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1)%bigZ); - case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c; auto. - intros H1; rewrite H1; rewrite Zcompare_refl; auto. - intros (H1, H2); apply sym_equal; change (b < a * c)%Z. - apply Zlt_le_trans with (1 := H1). - change 0%Z with (0 * c)%Z. - apply Zmult_le_compat_r; auto with zarith. - intros (H1, H2); apply sym_equal; change (b > a * c)%Z. - apply Zlt_gt. - apply Zlt_le_trans with (2 := H1). - change 0%Z with (0 * c)%Z. - apply Zmult_lt_compat_r; auto with zarith. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zcompare_refl; auto. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero x2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare; - auto; rewrite BigZ.spec_0. - intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - set (a := BigZ.to_Z x1); set (b := BigZ.to_Z x2); - set (c1 := BigN.to_Z y1); set (c2 := BigN.to_Z y2). - fold c1 in HH; fold c2 in HH1. - assert (F1: (0 < c1)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y1)); fold c1; auto. - intros H1; case HH; rewrite <- H1; auto. - assert (F2: (0 < c2)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y2)); fold c2; auto. - intros H1; case HH1; rewrite <- H1; auto. - repeat rewrite Z2P_correct; auto. - generalize (BigZ.spec_cmp_sign x1 x2); case BigZ.cmp_sign. - intros _; generalize (BigZ.spec_compare (x1 * BigZ.Pos y2)%bigZ - (x2 * BigZ.Pos y1)%bigZ); - case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c1 c2; auto. - rewrite BigZ.spec_mul; simpl; fold a b c1; intros HH2; rewrite HH2; - rewrite Zcompare_refl; auto. - rewrite BigZ.spec_mul; simpl; auto. - rewrite BigZ.spec_mul; simpl; auto. - fold a b; intros (H1, H2); apply sym_equal; change (a * c2 < b * c1)%Z. - apply Zlt_le_trans with 0%Z. - change 0%Z with (0 * c2)%Z. - apply Zmult_lt_compat_r; auto with zarith. - apply Zmult_le_0_compat; auto with zarith. - fold a b; intros (H1, H2); apply sym_equal; change (a * c2 > b * c1)%Z. - apply Zlt_gt; apply Zlt_le_trans with 0%Z. - change 0%Z with (0 * c1)%Z. - apply Zmult_lt_compat_r; auto with zarith. - apply Zmult_le_0_compat; auto with zarith. - Qed. - - - Definition do_norm_n n := - match n with - | BigN.N0 _ => false - | BigN.N1 _ => false - | BigN.N2 _ => false - | BigN.N3 _ => false - | BigN.N4 _ => false - | BigN.N5 _ => false - | BigN.N6 _ => false - | _ => true - end. - - Definition do_norm_z z := - match z with - | BigZ.Pos n => do_norm_n n - | BigZ.Neg n => do_norm_n n - end. - -(* Je pense que cette fonction normalise bien ... *) - Definition norm n d: t := - if andb (do_norm_z n) (do_norm_n d) then - let gcd := BigN.gcd (BigZ.to_N n) d in - match BigN.compare BigN.one gcd with - | Lt => - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - match BigN.compare d BigN.one with - | Gt => Qq n d - | Eq => Qz n - | Lt => zero - end - | Eq => Qq n d - | Gt => zero (* gcd = 0 => both numbers are 0 *) - end - else Qq n d. - - Theorem spec_norm: forall n q, - ([norm n q] == [Qq n q])%Q. - intros p q; unfold norm. - case do_norm_z; simpl andb. - 2: apply Qeq_refl. - case do_norm_n. - 2: apply Qeq_refl. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H2 HH. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl; - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - auto with zarith. - generalize H2; rewrite H3; - rewrite Zdiv_0_l; auto with zarith. - generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3. - rewrite spec_to_N. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl. - case H3. - generalize H1 H2 H3 HH; clear H1 H2 H3 HH. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 HH. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith. - case (Zle_lt_or_eq _ _ HH); auto with zarith. - intros HH1; rewrite <- HH1; ring. - generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith. - simpl. - assert (FF := BigN.spec_pos q). - rewrite Z2P_correct; auto with zarith. - rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith. - simpl; rewrite BigZ.spec_div; simpl. - rewrite BigN.spec_gcd; auto with zarith. - generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4 HH FF. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q))); - rewrite BigN.spec_gcd; auto with zarith. - intros; apply False_ind; auto with zarith. - intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2; simpl. - rewrite spec_to_N. - rewrite FF2; ring. - Qed. - - Definition add (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - if BigN.eq_bool dx dy then - let n := BigZ.add nx ny in - Qq n dx - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end - end. - - - - Theorem spec_add x y: - ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r; red; simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - rewrite Zmult_1_r; rewrite Pmult_1_r. - apply Qeq_refl. - assert (F1:= BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - case HH2; auto. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH2; auto. - case HH1; auto. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH; auto. - rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r. - apply Qeq_refl. - simpl. - generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros HH2. - (case (Zmult_integral _ _ HH2); intros HH3); - [case HH| case HH1]; auto. - generalize (BigN.spec_eq_bool dx dy); - case BigN.eq_bool; intros HH3. - rewrite <- HH3. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - red; simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH4. - case HH; auto. - simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - ring. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - red; simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros H3; simpl. - absurd (0 < 0)%Z; auto with zarith. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - repeat rewrite Z2P_correct; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: - [[add x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - if BigN.eq_bool dx dy then - let n := BigZ.add nx ny in - norm n dx - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end - end. - - Theorem spec_add_norm x y: - ([add_norm x y] == [x] + [y])%Q. - intros x y; rewrite <- spec_add; auto. - case x; case y; clear x y; unfold add_norm, add. - intros; apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - simpl. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - apply Qeq_refl. - intros p1 p2 n. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; intros HH3; - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - Qed. - - Theorem spec_add_normc x y: - [[add_norm x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub x y := add x (opp y). - - Theorem spec_sub x y: - ([sub x y] == [x] - [y])%Q. - intros x y; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - intros x y; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm x y: - ([sub_norm x y] == [x] - [y])%Q. - intros x y; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_sub_normc x y: - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - red; simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - red; simpl; ring. - case (Zmult_integral _ _ HH1); intros HH. - case HH2; auto. - case HH3; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - case HH1; rewrite HH2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - case HH1; rewrite HH3; ring. - rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - - Theorem spec_mulc x y: - [[mul x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => mul (Qz ny) (norm zx dy) - | Qq nx dx, Qz zy => mul (Qz nx) (norm zy dx) - | Qq nx dx, Qq ny dy => mul (norm nx dy) (norm ny dx) - end. - - Theorem spec_mul_norm x y: - ([mul_norm x y] == [x] * [y])%Q. - intros x y; rewrite <- spec_mul; auto. - unfold mul_norm; case x; case y; clear x y. - intros; apply Qeq_refl. - intros p1 n p2. - repeat rewrite spec_mul. - match goal with |- ?Z == _ => - match Z with context id [norm ?X ?Y] => - let y := context id [Qq X Y] in - apply Qeq_trans with y; [repeat apply Qmult_comp; - repeat apply Qplus_comp; repeat apply Qeq_refl; - apply spec_norm | idtac] - end - end. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH; simpl; ring. - intros p1 p2 n. - repeat rewrite spec_mul. - match goal with |- ?Z == _ => - match Z with context id [norm ?X ?Y] => - let y := context id [Qq X Y] in - apply Qeq_trans with y; [repeat apply Qmult_comp; - repeat apply Qplus_comp; repeat apply Qeq_refl; - apply spec_norm | idtac] - end - end. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Pmult_1_r; auto. - intros p1 n1 p2 n2. - repeat rewrite spec_mul. - repeat match goal with |- ?Z == _ => - match Z with context id [norm ?X ?Y] => - let y := context id [Qq X Y] in - apply Qeq_trans with y; [repeat apply Qmult_comp; - repeat apply Qplus_comp; repeat apply Qeq_refl; - apply spec_norm | idtac] - end - end. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; try ring. - repeat rewrite Zpos_mult_morphism; ring. - Qed. - - Theorem spec_mul_normc x y: - [[mul_norm x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => Qq BigZ.one n - | Qz (BigZ.Neg n) => Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n - end. - - - Theorem spec_inv x: - ([inv x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - Qed. - - Theorem spec_invc x: - [[inv x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv_norm (x: t): t := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one n - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg d) n - end. - - Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q. - intros x; rewrite <- spec_inv; generalize x; clear x. - intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, inv; - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; try apply Qeq_refl; - red; simpl; - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; auto; - case H2; auto. - Qed. - - Theorem spec_inv_normc x: - [[inv_norm x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv_norm; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: ([div x y] == [x] / [y])%Q. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - - Theorem spec_square x: ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - simpl Qpower. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H1; rewrite H; auto. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H; case (Zmult_integral _ _ H1); auto. - simpl. - rewrite BigZ.spec_square. - rewrite Zpos_mult_morphism. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p) - end. - - Theorem spec_power_pos x p: ([power_pos x p] == [x] ^ Zpos p)%Q. - Proof. - intros [x | nx dx] p; unfold power_pos. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_power_pos; intros H1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - elim p; simpl. - intros; red; simpl; auto. - intros p1 Hp1; rewrite <- Hp1; red; simpl; auto. - apply Qeq_refl. - case H2; generalize H1. - elim p; simpl. - intros p1 Hrec. - change (xI p1) with (1 + (xO p1))%positive. - rewrite Zpower_pos_is_exp; rewrite Zpower_pos_1_r. - intros HH; case (Zmult_integral _ _ HH); auto. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - intros p1 Hrec. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - rewrite Zpower_pos_1_r; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - case H1; rewrite H2; auto. - simpl; rewrite Zpower_pos_0_l; auto. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z dx))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - Qed. - - Theorem spec_power_posc x p: - [[power_pos x p]] = [[x]] ^ nat_of_P p. - intros x p; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos; auto. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; case x; simpl; clear x Hrec. - intros x; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - unfold Qpower_positive. - assert (tmp: forall p, pow_pos Qmult 0%Q p = 0%Q). - intros p1; elim p1; simpl; auto; clear p1. - intros p1 Hp1; rewrite Hp1; auto. - intros p1 Hp1; rewrite Hp1; auto. - repeat rewrite tmp; intros; red; simpl; auto. - intros H1. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -End Qbi. diff --git a/theories/Ints/num/QifMake.v b/theories/Ints/num/QifMake.v deleted file mode 100644 index 83c182ee08..0000000000 --- a/theories/Ints/num/QifMake.v +++ /dev/null @@ -1,971 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import Zaux. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Qif. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/y. The pairs (x,0) and (0,y) are all - interpreted as 0. *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => if BigN.eq_bool y BigN.zero then 0%Q - else BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_of_pos; intros HH; discriminate HH. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => - if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero - else BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - | Qq nx dx, Qz zy => - if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy - else BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - | Qq nx dx, Qq ny dy => - match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with - | true, true => Eq - | true, false => BigZ.compare BigZ.zero ny - | false, true => BigZ.compare nx BigZ.zero - | false, false => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end - end. - - Theorem spec_compare: forall q1 q2, - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero z2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zcompare_refl; auto. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero x2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare; - auto; rewrite BigZ.spec_0. - intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - repeat rewrite Z2P_correct. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * BigZ.Pos y2) - (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - Qed. - - Definition do_norm_n n := - match n with - | BigN.N0 _ => false - | BigN.N1 _ => false - | BigN.N2 _ => false - | BigN.N3 _ => false - | BigN.N4 _ => false - | BigN.N5 _ => false - | BigN.N6 _ => false - | _ => true - end. - - Definition do_norm_z z := - match z with - | BigZ.Pos n => do_norm_n n - | BigZ.Neg n => do_norm_n n - end. - -(* Je pense que cette fonction normalise bien ... *) - Definition norm n d: t := - if andb (do_norm_z n) (do_norm_n d) then - let gcd := BigN.gcd (BigZ.to_N n) d in - match BigN.compare BigN.one gcd with - | Lt => - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - match BigN.compare d BigN.one with - | Gt => Qq n d - | Eq => Qz n - | Lt => zero - end - | Eq => Qq n d - | Gt => zero (* gcd = 0 => both numbers are 0 *) - end - else Qq n d. - - Theorem spec_norm: forall n q, - ([norm n q] == [Qq n q])%Q. - intros p q; unfold norm. - case do_norm_z; simpl andb. - 2: apply Qeq_refl. - case do_norm_n. - 2: apply Qeq_refl. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H2 HH. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl; - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - auto with zarith. - generalize H2; rewrite H3; - rewrite Zdiv_0_l; auto with zarith. - generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3. - rewrite spec_to_N. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl. - case H3. - generalize H1 H2 H3 HH; clear H1 H2 H3 HH. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 HH. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith. - case (Zle_lt_or_eq _ _ HH); auto with zarith. - intros HH1; rewrite <- HH1; ring. - generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith. - simpl. - assert (FF := BigN.spec_pos q). - rewrite Z2P_correct; auto with zarith. - rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith. - simpl; rewrite BigZ.spec_div; simpl. - rewrite BigN.spec_gcd; auto with zarith. - generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4 HH FF. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q))); - rewrite BigN.spec_gcd; auto with zarith. - intros; apply False_ind; auto with zarith. - intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2; simpl. - rewrite spec_to_N. - rewrite FF2; ring. - Qed. - - - Definition add (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end - end. - - - Theorem spec_add x y: - ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r; red; simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - rewrite Zmult_1_r; rewrite Pmult_1_r. - apply Qeq_refl. - assert (F1:= BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - case HH2; auto. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH2; auto. - case HH1; auto. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH; auto. - rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r. - apply Qeq_refl. - simpl. - generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros HH2. - (case (Zmult_integral _ _ HH2); intros HH3); - [case HH| case HH1]; auto. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - red; simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: - [[add x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end - end. - - Theorem spec_add_norm x y: - ([add_norm x y] == [x] + [y])%Q. - intros x y; rewrite <- spec_add; auto. - case x; case y; clear x y; unfold add_norm, add. - intros; apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - simpl. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - apply Qeq_refl. - intros p1 p2 n. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - Qed. - - Theorem spec_add_normc x y: - [[add_norm x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub x y := add x (opp y). - - - Theorem spec_sub x y: - ([sub x y] == [x] - [y])%Q. - intros x y; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - intros x y; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm x y: - ([sub_norm x y] == [x] - [y])%Q. - intros x y; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_sub_normc x y: - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - - Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - red; simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - red; simpl; ring. - case (Zmult_integral _ _ HH1); intros HH. - case HH2; auto. - case HH3; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - case HH1; rewrite HH2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - case HH1; rewrite HH3; ring. - rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - - Theorem spec_mulc x y: - [[mul x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => norm (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => norm (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => norm (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem spec_mul_norm x y: - ([mul_norm x y] == [x] * [y])%Q. - intros x y; rewrite <- spec_mul; auto. - unfold mul_norm, mul; case x; case y; clear x y. - intros; apply Qeq_refl. - intros p1 n p2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - intros p1 p2 n. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - intros p1 n1 p2 n2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - Qed. - - Theorem spec_mul_normc x y: - [[mul_norm x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => Qq BigZ.one n - | Qz (BigZ.Neg n) => Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n - end. - - Theorem spec_inv x: - ([inv x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - Qed. - - Theorem spec_invc x: - [[inv x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -Definition inv_norm (x: t): t := - match x with - | Qz (BigZ.Pos n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.one n - | _ => x - end - | Qz (BigZ.Neg n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.minus_one n - | _ => x - end - | Qq (BigZ.Pos n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Pos d) n - | Eq => Qz (BigZ.Pos d) - | Lt => Qz (BigZ.zero) - end - | Qq (BigZ.Neg n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Neg d) n - | Eq => Qz (BigZ.Neg d) - | Lt => Qz (BigZ.zero) - end - end. - - Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, Qinv. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - Qed. - - Theorem spec_inv_normc x: - [[inv_norm x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv_norm; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: ([div x y] == [x] / [y])%Q. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - Theorem spec_square x: ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - simpl Qpower. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H1; rewrite H; auto. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H; case (Zmult_integral _ _ H1); auto. - simpl. - rewrite BigZ.spec_square. - rewrite Zpos_mult_morphism. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -End Qif. diff --git a/theories/Ints/num/QpMake.v b/theories/Ints/num/QpMake.v deleted file mode 100644 index a28434baf2..0000000000 --- a/theories/Ints/num/QpMake.v +++ /dev/null @@ -1,888 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import Zaux. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Qp. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/(y+1). *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition d_to_Z d := BigZ.Pos (BigN.succ d). - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.pred (BigN.of_N (Npos y))) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => BigZ.to_Z x # Z2P (BigN.to_Z (BigN.succ y)) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - rewrite BigZ.spec_of_Z; auto. - rewrite BigN.spec_succ; simpl. simpl. - rewrite BigN.spec_pred; rewrite (BigN.spec_of_pos). - replace (Zpos y - 1 + 1)%Z with (Zpos y); auto; ring. - red; auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - rewrite BigZ.spec_opp; auto. - Qed. - - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => BigZ.compare (BigZ.mul zx (d_to_Z dy)) ny - | Qq nx dy, Qz zy => BigZ.compare nx (BigZ.mul zy (d_to_Z dy)) - | Qq nx dx, Qq ny dy => - BigZ.compare (BigZ.mul nx (d_to_Z dy)) (BigZ.mul ny (d_to_Z dx)) - end. - - Theorem spec_compare: forall q1 q2, - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; unfold Qcompare; simpl. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - rewrite BigN.spec_succ. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * d_to_Z y2) x2)%bigZ; case BigZ.compare; - intros H; rewrite <- H. - rewrite BigZ.spec_mul; unfold d_to_Z; simpl. - rewrite BigN.spec_succ. - rewrite Zcompare_refl; auto. - rewrite BigZ.spec_mul; unfold d_to_Z; simpl. - rewrite BigN.spec_succ; auto. - rewrite BigZ.spec_mul; unfold d_to_Z; simpl. - rewrite BigN.spec_succ; auto. - rewrite Zmult_1_r. - rewrite BigN.spec_succ. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - generalize (BigZ.spec_compare x1 (z2 * d_to_Z y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; unfold d_to_Z; simpl; - rewrite BigN.spec_succ; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - repeat rewrite BigN.spec_succ; auto. - repeat rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * d_to_Z y2) - (x2 * d_to_Z y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; unfold d_to_Z; simpl; - repeat rewrite BigN.spec_succ; intros H; auto. - rewrite H; auto. - rewrite Zcompare_refl; auto. - Qed. - - - Theorem spec_comparec: forall q1 q2, - compare q1 q2 = ([[q1]] ?= [[q2]]). - unfold Qccompare, to_Qc. - intros q1 q2; rewrite spec_compare; simpl. - apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -(* Inv d > 0, Pour la forme normal unique on veut d > 1 *) - Definition norm n d: t := - if BigZ.eq_bool n BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N n) d in - if BigN.eq_bool gcd BigN.one then Qq n (BigN.pred d) - else - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz n - else Qq n (BigN.pred d). - - Theorem spec_norm: forall n q, - ((0 < BigN.to_Z q)%Z -> [norm n q] == [Qq n (BigN.pred q)])%Q. - intros p q; unfold norm; intros Hq. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto; rewrite BigZ.spec_0; intros H1. - red; simpl; rewrite H1; ring. - case (Zle_lt_or_eq _ _ Hp); clear Hp; intros Hp. - case (Zle_lt_or_eq _ _ - (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p)) (BigN.to_Z q))); intros H4. - 2: generalize Hq; rewrite (Zgcd_inv_0_r _ _ (sym_equal H4)); auto with zarith. - 2: red; simpl; auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1; intros H2. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Zmult_1_r. - rewrite BigN.succ_pred; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; intros; rewrite Zgcd_div_swap; auto. - rewrite H; ring. - intros H3. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.succ_pred; auto with zarith. - assert (F: (0 < BigN.to_Z (q / BigN.gcd (BigZ.to_N p) q)%bigN)%Z). - rewrite BigN.spec_div; auto with zarith. - rewrite BigN.spec_gcd. - apply Zgcd_div_pos; auto. - rewrite BigN.spec_gcd; auto. - rewrite BigN.succ_pred; auto with zarith. - rewrite Z2P_correct; auto. - rewrite Z2P_correct; auto. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite spec_to_N; apply Zgcd_div_swap; auto. - case H1; rewrite spec_to_N; rewrite <- Hp; ring. - Qed. - - Theorem spec_normc: forall n q, - (0 < BigN.to_Z q)%Z -> [[norm n q]] = [[Qq n (BigN.pred q)]]. - intros n q H; unfold to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_norm; auto. - Qed. - - Definition add (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.add (BigZ.mul zx (d_to_Z dy)) ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.add nx (BigZ.mul zy (d_to_Z dx))) dx - | Qq nx dx, Qq ny dy => - let dx' := BigN.succ dx in - let dy' := BigN.succ dy in - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy')) (BigZ.mul ny (BigZ.Pos dx')) in - let d := BigN.pred (BigN.mul dx' dy') in - Qq n d - end. - - Theorem spec_d_to_Z: forall dy, - (BigZ.to_Z (d_to_Z dy) = BigN.to_Z dy + 1)%Z. - intros dy; unfold d_to_Z; simpl. - rewrite BigN.spec_succ; auto. - Qed. - - Theorem spec_succ_pos: forall p, - (0 < BigN.to_Z (BigN.succ p))%Z. - intros p; rewrite BigN.spec_succ; - generalize (BigN.spec_pos p); auto with zarith. - Qed. - - Theorem spec_add x y: ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r. - simpl; rewrite Z2P_correct; rewrite BigN.spec_succ; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul. - rewrite spec_d_to_Z; apply Qeq_refl. - assert (F1:= BigN.spec_pos dx). - rewrite Zmult_1_r; rewrite Pmult_1_r. - simpl; rewrite Z2P_correct; rewrite BigN.spec_succ; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul. - rewrite spec_d_to_Z; apply Qeq_refl. - repeat rewrite BigN.spec_succ. - assert (Fx: (0 < BigN.to_Z dx + 1)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy + 1)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - repeat rewrite BigN.spec_pred. - rewrite BigZ.spec_add; repeat rewrite BigN.spec_mul; - repeat rewrite BigN.spec_succ. - assert (tmp: forall x, (x-1+1 = x)%Z); [intros; ring | rewrite tmp; clear tmp]. - repeat rewrite Z2P_correct; auto. - repeat rewrite BigZ.spec_mul; simpl. - repeat rewrite BigN.spec_succ. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto; apply Qeq_refl. - rewrite BigN.spec_mul; repeat rewrite BigN.spec_succ; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: [[add x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => - let d := BigN.succ dy in - norm (BigZ.add (BigZ.mul zx (BigZ.Pos d)) ny) d - | Qq nx dx, Qz zy => - let d := BigN.succ dx in - norm (BigZ.add (BigZ.mul zy (BigZ.Pos d)) nx) d - | Qq nx dx, Qq ny dy => - let dx' := BigN.succ dx in - let dy' := BigN.succ dy in - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy')) (BigZ.mul ny (BigZ.Pos dx')) in - let d := BigN.mul dx' dy' in - norm n d - end. - - Theorem spec_add_norm x y: ([add_norm x y] == [x] + [y])%Q. - intros x y; rewrite <- spec_add. - unfold add_norm, add; case x; case y. - intros; apply Qeq_refl. - intros p1 n p2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end. - rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - rewrite BigN.succ_pred; try apply Qeq_refl; apply spec_succ_pos. - intros p1 n p2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end. - rewrite BigN.spec_succ; generalize (BigN.spec_pos p2); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - rewrite Zplus_comm. - rewrite BigN.succ_pred; try apply Qeq_refl; apply spec_succ_pos. - intros p1 q1 p2 q2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat; apply spec_succ_pos. - Qed. - - Theorem spec_add_normc x y: [[add_norm x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub (x y: t): t := add x (opp y). - - Theorem spec_sub x y: ([sub x y] == [x] - [y])%Q. - intros x y; unfold sub; rewrite spec_add. - rewrite spec_opp; ring. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - intros x y; unfold sub; rewrite spec_addc. - rewrite spec_oppc; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm x y: ([sub_norm x y] == [x] - [y])%Q. - intros x y; unfold sub_norm; rewrite spec_add_norm. - rewrite spec_opp; ring. - Qed. - - Theorem spec_sub_normc x y: [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc. - rewrite spec_oppc; ring. - Qed. - - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => - Qq (BigZ.mul nx ny) (BigN.pred (BigN.mul (BigN.succ dx) (BigN.succ dy))) - end. - - Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - apply Qeq_refl; auto. - rewrite BigZ.spec_mul; apply Qeq_refl. - rewrite BigZ.spec_mul; rewrite Pmult_1_r; auto. - apply Qeq_refl; auto. - assert (F1:= spec_succ_pos dx). - assert (F2:= spec_succ_pos dy). - rewrite BigN.succ_pred; rewrite BigN.spec_mul. - rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto; apply Qeq_refl. - apply Zmult_lt_0_compat; apply spec_succ_pos. - Qed. - - Theorem spec_mulc x y: [[mul x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => - if BigZ.eq_bool zx BigZ.zero then zero - else - let d := BigN.succ dy in - let gcd := BigN.gcd (BigZ.to_N zx) d in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zx ny) dy - else - let zx := BigZ.div zx (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny) - else Qq (BigZ.mul zx ny) (BigN.pred d) - | Qq nx dx, Qz zy => - if BigZ.eq_bool zy BigZ.zero then zero - else - let d := BigN.succ dx in - let gcd := BigN.gcd (BigZ.to_N zy) d in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zy nx) dx - else - let zy := BigZ.div zy (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx) - else Qq (BigZ.mul zy nx) (BigN.pred d) - | Qq nx dx, Qq ny dy => - norm (BigZ.mul nx ny) (BigN.mul (BigN.succ dx) (BigN.succ dy)) - end. - - Theorem spec_mul_norm x y: ([mul_norm x y] == [x] * [y])%Q. - intros x y; rewrite <- spec_mul. - unfold mul_norm, mul; case x; case y. - intros; apply Qeq_refl. - intros p1 n p2. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; auto. - assert (F: (0 < BigN.to_Z (BigZ.to_N p2))%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < BigN.to_Z (BigN.succ n))%Z). - rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith. - assert (F2: (0 < Zgcd (BigN.to_Z (BigZ.to_N p2)) (BigN.to_Z (BigN.succ n)))%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p2)) - (BigN.to_Z (BigN.succ n)))); intros H3; auto. - generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - intros; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p2). - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.succ n / - BigN.gcd (BigZ.to_N p2) - (BigN.succ n)))%bigN); intros F3. - rewrite BigN.succ_pred; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - apply False_ind; generalize F1. - rewrite (Zdivide_Zdiv_eq - (Zgcd (BigN.to_Z (BigZ.to_N p2)) (BigN.to_Z (BigN.succ n))) - (BigN.to_Z (BigN.succ n))); auto. - generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros HH; rewrite <- HH; auto with zarith. - assert (FF:= Zgcd_is_gcd (BigN.to_Z (BigZ.to_N p2)) - (BigN.to_Z (BigN.succ n))); inversion FF; auto. - intros p1 p2 n. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; simpl; ring. - assert (F: (0 < BigN.to_Z (BigZ.to_N p1))%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < BigN.to_Z (BigN.succ n))%Z). - rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith. - assert (F2: (0 < Zgcd (BigN.to_Z (BigZ.to_N p1)) (BigN.to_Z (BigN.succ n)))%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p1)) - (BigN.to_Z (BigN.succ n)))); intros H3; auto. - generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - intros; repeat rewrite BigZ.spec_mul; rewrite Zmult_comm; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p1). - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.succ n / - BigN.gcd (BigZ.to_N p1) - (BigN.succ n)))%bigN); intros F3. - rewrite BigN.succ_pred; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - apply False_ind; generalize F1. - rewrite (Zdivide_Zdiv_eq - (Zgcd (BigN.to_Z (BigZ.to_N p1)) (BigN.to_Z (BigN.succ n))) - (BigN.to_Z (BigN.succ n))); auto. - generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros HH; rewrite <- HH; auto with zarith. - assert (FF:= Zgcd_is_gcd (BigN.to_Z (BigZ.to_N p1)) - (BigN.to_Z (BigN.succ n))); inversion FF; auto. - intros p1 n1 p2 n2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat; rewrite BigN.spec_succ; - generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith. - Qed. - - Theorem spec_mul_normc x y: [[mul_norm x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one (BigN.pred n) - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one (BigN.pred n) - | Qq (BigZ.Pos n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos (BigN.succ d)) (BigN.pred n) - | Qq (BigZ.Neg n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg (BigN.succ d)) (BigN.pred n) - end. - - Theorem spec_inv x: ([inv x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - unfold to_Q; rewrite BigZ.spec_1. - rewrite BigN.succ_pred; auto. - red; unfold Qinv; simpl. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - red; unfold Qinv; simpl. - rewrite BigN.succ_pred; auto. - generalize F; case BigN.to_Z; simpl; auto with zarith. - intros p Hp; discriminate Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite BigN.succ_pred; auto. - rewrite BigN.spec_succ; rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite BigN.succ_pred; auto. - rewrite BigN.spec_succ; rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - simpl; intros. - match goal with |- (?X = Zneg ?Y)%Z => - replace (Zneg Y) with (Zopp (Zpos Y)); - try rewrite Z2P_correct; auto with zarith - end. - rewrite Zpos_mult_morphism; - rewrite Z2P_correct; auto with zarith; try ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_invc x: [[inv x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -Definition inv_norm x := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then x else Qq BigZ.one (BigN.pred n) - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then x else Qq BigZ.minus_one (BigN.pred n) - | Qq (BigZ.Pos n) d => let d := BigN.succ d in - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then Qz (BigZ.Pos d) - else Qq (BigZ.Pos d) (BigN.pred n) - | Qq (BigZ.Neg n) d => let d := BigN.succ d in - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then Qz (BigZ.Neg d) - else Qq (BigZ.Neg d) (BigN.pred n) - end. - - Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q. - intros x; rewrite <- spec_inv. - (case x; clear x); [intros [x | x] | intros nx dx]; - unfold inv_norm, inv. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred; auto. - rewrite Z2P_correct; try rewrite H1; auto with zarith. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred; auto. - rewrite Z2P_correct; try rewrite H1; auto with zarith. - apply Qeq_refl. - case nx; clear nx; intros nx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred; try rewrite H1; auto with zarith. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred; try rewrite H1; auto with zarith. - apply Qeq_refl. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: ([div x y] == [x] / [y])%Q. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.pred (BigN.square (BigN.succ dx))) - end. - - Theorem spec_square x: ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - assert (F: (0 < BigN.to_Z (BigN.succ dx))%Z). - rewrite BigN.spec_succ; - case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith. - assert (F1 : (0 < BigN.to_Z (BigN.square (BigN.succ dx)))%Z). - rewrite BigN.spec_square; apply Zmult_lt_0_compat; - auto with zarith. - rewrite BigN.succ_pred; auto. - rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - repeat rewrite BigN.spec_succ; auto with zarith. - rewrite BigN.spec_square; auto with zarith. - repeat rewrite BigN.spec_succ; auto with zarith. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.pred (BigN.power_pos (BigN.succ dx) p)) - end. - - - Theorem spec_power_pos x p: ([power_pos x p] == [x] ^ Zpos p)%Q. - Proof. - intros [x | nx dx] p; unfold power_pos. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - assert (F1: (0 < BigN.to_Z (BigN.succ dx))%Z). - rewrite BigN.spec_succ; - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z (BigN.succ dx) ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - rewrite BigN.succ_pred; rewrite BigN.spec_power_pos; auto. - rewrite Z2P_correct; auto. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z (BigN.succ dx)))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - Qed. - - Theorem spec_power_posc x p: [[power_pos x p]] = [[x]] ^ nat_of_P p. - intros x p; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; case x; simpl; clear x Hrec. - intros x; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - assert (F1: (0 < BigN.to_Z (BigN.succ dx))%Z). - rewrite BigN.spec_succ; generalize (BigN.spec_pos dx); - auto with zarith. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -End Qp. diff --git a/theories/Ints/num/QvMake.v b/theories/Ints/num/QvMake.v deleted file mode 100644 index 85655dafcd..0000000000 --- a/theories/Ints/num/QvMake.v +++ /dev/null @@ -1,1143 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import Zaux. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Qv. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/y. All functions maintain the invariant - that y is never zero. *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition wf x := - match x with - | Qz _ => True - | Qq n d => if BigN.eq_bool d BigN.zero then False else True - end. - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem wf_opp: forall x, wf x -> wf (opp x). - intros [zx | nx dx]; unfold opp, wf; auto. - Qed. - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - (* Les fonctions doivent assurer que si leur arguments sont valides alors - le resultat est correct et valide (si c'est un Q) - *) - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - | Qq nx dx, Qz zy => BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - | Qq nx dx, Qq ny dy => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end. - - Theorem spec_compare: forall q1 q2, wf q1 -> wf q2 -> - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden, wf. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH2 _ _. - repeat rewrite Z2P_correct. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * BigZ.Pos y2) - (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - Qed. - - Theorem spec_comparec: forall q1 q2, wf q1 -> wf q2 -> - compare q1 q2 = ([[q1]] ?= [[q2]]). - unfold Qccompare, to_Qc. - intros q1 q2 Hq1 Hq2; rewrite spec_compare; simpl; auto. - apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition norm n d: t := - if BigZ.eq_bool n BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N n) d in - if BigN.eq_bool gcd BigN.one then Qq n d - else - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz n - else Qq n d. - - Theorem wf_norm: forall n q, - (BigN.to_Z q <> 0)%Z -> wf (norm n q). - intros p q; unfold norm, wf; intros Hq. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto; rewrite BigZ.spec_0; intros H1. - simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - set (a := BigN.to_Z (BigZ.to_N p)). - set (b := (BigN.to_Z q)). - assert (F: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto. - intros HH1; case Hq; apply (Zgcd_inv_0_r _ _ (sym_equal HH1)). - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto; fold a; fold b. - intros H; case Hq; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H; auto with zarith. - assert (F1:= Zgcd_is_gcd a b); inversion F1; auto. - Qed. - - Theorem spec_norm: forall n q, - ((0 < BigN.to_Z q)%Z -> [norm n q] == [Qq n q])%Q. - intros p q; unfold norm; intros Hq. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto; rewrite BigZ.spec_0; intros H1. - red; simpl; rewrite H1; ring. - case (Zle_lt_or_eq _ _ Hp); clear Hp; intros Hp. - case (Zle_lt_or_eq _ _ - (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p)) (BigN.to_Z q))); intros H4. - 2: generalize Hq; rewrite (Zgcd_inv_0_r _ _ (sym_equal H4)); auto with zarith. - 2: red; simpl; auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1; intros H2. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Zmult_1_r. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; intros; rewrite Zgcd_div_swap; auto. - rewrite H; ring. - intros H3. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - assert (F: (0 < BigN.to_Z (q / BigN.gcd (BigZ.to_N p) q)%bigN)%Z). - rewrite BigN.spec_div; auto with zarith. - rewrite BigN.spec_gcd. - apply Zgcd_div_pos; auto. - rewrite BigN.spec_gcd; auto. - rewrite Z2P_correct; auto. - rewrite Z2P_correct; auto. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite spec_to_N; apply Zgcd_div_swap; auto. - case H1; rewrite spec_to_N; rewrite <- Hp; ring. - Qed. - - Theorem spec_normc: forall n q, - (0 < BigN.to_Z q)%Z -> [[norm n q]] = [[Qq n q]]. - intros n q H; unfold to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_norm; auto. - Qed. - - Definition add (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq nx dx, Qq ny dy => - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end. - - Theorem wf_add: forall x y, wf x -> wf y -> wf (add x y). - intros [zx | nx dx] [zy | ny dy]; unfold add, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - intros H1 H2 H3. - case (Zmult_integral _ _ H1); auto with zarith. - Qed. - - Theorem spec_add x y: wf x -> wf y -> - ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul. - simpl; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - assert (F1:= BigN.spec_pos dx). - rewrite Zmult_1_r; rewrite Pmult_1_r. - simpl; rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl. - apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH2 _ _. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - rewrite BigZ.spec_add; repeat rewrite BigN.spec_mul. - red; simpl. - rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - repeat rewrite BigZ.spec_mul; simpl; auto. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: wf x -> wf y -> - [[add x y]] = [[x]] + [[y]]. - intros x y H1 H2; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => - norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - | Qq nx dx, Qz zy => - norm (BigZ.add (BigZ.mul zy (BigZ.Pos dx)) nx) dx - | Qq nx dx, Qq ny dy => - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end. - - Theorem wf_add_norm: forall x y, wf x -> wf y -> wf (add_norm x y). - intros [zx | nx dx] [zy | ny dy]; unfold add_norm; auto. - intros HH1 HH2; apply wf_norm. - generalize HH2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros HH1 HH2; apply wf_norm. - generalize HH1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros HH1 HH2; apply wf_norm. - rewrite BigN.spec_mul; intros HH3. - case (Zmult_integral _ _ HH3). - generalize HH1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - generalize HH2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - Qed. - - Theorem spec_add_norm x y: wf x -> wf y -> - ([add_norm x y] == [x] + [y])%Q. - intros x y H1 H2; rewrite <- spec_add; auto. - generalize H1 H2; unfold add_norm, add, wf; case x; case y; clear H1 H2. - intros; apply Qeq_refl. - intros p1 n p2 _. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - generalize (BigN.spec_pos n); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool p2 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - generalize (BigN.spec_pos p2); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - rewrite Zplus_comm. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1 _. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH2 _. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat. - generalize (BigN.spec_pos q2); auto with zarith. - generalize (BigN.spec_pos q1); auto with zarith. - Qed. - - Theorem spec_add_normc x y: wf x -> wf y -> - [[add_norm x y]] = [[x]] + [[y]]. - intros x y Hx Hy; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub x y := add x (opp y). - - Theorem wf_sub x y: wf x -> wf y -> wf (sub x y). - intros x y Hx Hy; unfold sub; apply wf_add; auto. - apply wf_opp; auto. - Qed. - - Theorem spec_sub x y: wf x -> wf y -> - ([sub x y] == [x] - [y])%Q. - intros x y Hx Hy; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - apply wf_opp; auto. - Qed. - - Theorem spec_subc x y: wf x -> wf y -> - [[sub x y]] = [[x]] - [[y]]. - intros x y Hx Hy; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - apply wf_opp; auto. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem wf_sub_norm x y: wf x -> wf y -> wf (sub_norm x y). - intros x y Hx Hy; unfold sub_norm; apply wf_add_norm; auto. - apply wf_opp; auto. - Qed. - - Theorem spec_sub_norm x y: wf x -> wf y -> - ([sub_norm x y] == [x] - [y])%Q. - intros x y Hx Hy; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - apply wf_opp; auto. - Qed. - - Theorem spec_sub_normc x y: wf x -> wf y -> - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y Hx Hy; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - apply wf_opp; auto. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => - Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem wf_mul: forall x y, wf x -> wf y -> wf (mul x y). - intros [zx | nx dx] [zy | ny dy]; unfold mul, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - intros H1 H2 H3. - case (Zmult_integral _ _ H1); auto with zarith. - Qed. - - Theorem spec_mul x y: wf x -> wf y -> ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH1 _ _. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1 _ _. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ HH; case HH. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ _ _ HH; case HH. - rewrite BigN.spec_0; intros H1 H2 _ _. - rewrite BigZ.spec_mul; rewrite BigN.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - - Theorem spec_mulc x y: wf x -> wf y -> - [[mul x y]] = [[x]] * [[y]]. - intros x y Hx Hy; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => - if BigZ.eq_bool zx BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zx) dy in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zx ny) dy - else - let zx := BigZ.div zx (BigZ.Pos gcd) in - let d := BigN.div dy gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny) - else Qq (BigZ.mul zx ny) d - | Qq nx dx, Qz zy => - if BigZ.eq_bool zy BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zy) dx in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zy nx) dx - else - let zy := BigZ.div zy (BigZ.Pos gcd) in - let d := BigN.div dx gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx) - else Qq (BigZ.mul zy nx) d - | Qq nx dx, Qq ny dy => norm (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem wf_mul_norm: forall x y, wf x -> wf y -> wf (mul_norm x y). - intros [zx | nx dx] [zy | ny dy]; unfold mul_norm; auto. - intros HH1 HH2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_1; rewrite BigZ.spec_0. - intros H1 H2; unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0. - set (a := BigN.to_Z (BigZ.to_N zx)). - set (b := (BigN.to_Z dy)). - assert (F: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto. - intros HH3; case H2; rewrite spec_to_N; fold a. - rewrite (Zgcd_inv_0_l _ _ (sym_equal HH3)); try ring. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto. - intros H. - generalize HH2; simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0; intros HH; case HH; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H; auto with zarith. - assert (F1:= Zgcd_is_gcd a b); inversion F1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_1; rewrite BigN.spec_gcd. - intros HH1 H1 H2. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto. - rewrite BigN.spec_1; rewrite BigN.spec_gcd. - intros HH1 H1 H2. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto. - rewrite BigZ.spec_0. - intros HH2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - set (a := BigN.to_Z (BigZ.to_N zy)). - set (b := (BigN.to_Z dx)). - assert (F: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto. - intros HH3; case HH2; rewrite spec_to_N; fold a. - rewrite (Zgcd_inv_0_l _ _ (sym_equal HH3)); try ring. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto. - intros H; unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto. - intros HH; generalize H1; simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0. - intros HH3; case HH3; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite HH; auto with zarith. - assert (F1:= Zgcd_is_gcd a b); inversion F1; auto. - intros HH1 HH2; apply wf_norm. - rewrite BigN.spec_mul; intros HH3. - case (Zmult_integral _ _ HH3). - generalize HH1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - generalize HH2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - Qed. - - Theorem spec_mul_norm x y: wf x -> wf y -> - ([mul_norm x y] == [x] * [y])%Q. - intros x y Hx Hy; rewrite <- spec_mul; auto. - unfold mul_norm, mul; generalize Hx Hy; case x; case y; clear Hx Hy. - intros; apply Qeq_refl. - intros p1 n p2 Hx Hy. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; auto. - assert (F: (0 < BigN.to_Z (BigZ.to_N p2))%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < BigN.to_Z n)%Z). - generalize Hy; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ HH; case HH. - rewrite BigN.spec_0; generalize (BigN.spec_pos n); auto with zarith. - set (a := BigN.to_Z (BigZ.to_N p2)). - set (b := BigN.to_Z n). - assert (F2: (0 < Zgcd a b )%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); intros H3; auto. - generalize F; fold a; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; try rewrite BigN.spec_gcd; - fold a b; intros H1. - intros; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith; fold a b; intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; fold a; fold b. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - intros H2; red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p2); fold a b. - rewrite Z2P_correct; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (n / - BigN.gcd (BigZ.to_N p2) - n))%bigN); - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - intros H3. - apply False_ind; generalize F1. - generalize Hy; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - intros HH; case HH; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite <- H3; ring. - assert (FF:= Zgcd_is_gcd a b); inversion FF; auto. - intros p1 p2 n Hx Hy. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; simpl; ring. - set (a := BigN.to_Z (BigZ.to_N p1)). - set (b := BigN.to_Z n). - assert (F: (0 < a)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < b)%Z). - generalize Hx; unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - generalize (BigN.spec_pos n); fold b; auto with zarith. - assert (F2: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); intros H3; auto. - generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; fold a b; intros H1. - intros; repeat rewrite BigZ.spec_mul; rewrite Zmult_comm; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - fold a b; intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; fold a b. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p1); fold a b. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (n / BigN.gcd (BigZ.to_N p1) n))%bigN); intros F3. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - apply False_ind; generalize F1. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; - auto with zarith. - intros HH; rewrite <- HH; auto with zarith. - assert (FF:= Zgcd_is_gcd a b); inversion FF; auto. - intros p1 n1 p2 n2 Hn1 Hn2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat. - generalize Hn1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith. - generalize Hn2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith. - Qed. - - Theorem spec_mul_normc x y: wf x -> wf y -> - [[mul_norm x y]] = [[x]] * [[y]]. - intros x y Hx Hy; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one n - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg d) n - end. - - - Theorem wf_inv: forall x, wf x -> wf (inv x). - intros [ zx | nx dx]; unfold inv, wf; auto. - case zx; clear zx. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - case nx; clear nx. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; simpl; auto. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; simpl; auto. - Qed. - - Theorem spec_inv x: wf x -> - ([inv x] == /[x])%Q. - intros [ [x | x] _ | [nx | nx] dx]; unfold inv. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - unfold to_Q; rewrite BigZ.spec_1. - red; unfold Qinv; simpl. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - red; unfold Qinv; simpl. - generalize F; case BigN.to_Z; simpl; auto with zarith. - intros p Hp; discriminate Hp. - simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - intros HH; case HH. - intros _. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - intros HH; case HH. - intros _. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - simpl; intros. - match goal with |- (?X = Zneg ?Y)%Z => - replace (Zneg Y) with (Zopp (Zpos Y)); - try rewrite Z2P_correct; auto with zarith - end. - rewrite Zpos_mult_morphism; - rewrite Z2P_correct; auto with zarith; try ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_invc x: wf x -> - [[inv x]] = /[[x]]. - intros x Hx; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem wf_div x y: wf x -> wf y -> wf (div x y). - intros x y Hx Hy; unfold div; apply wf_mul; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_div x y: wf x -> wf y -> - ([div x y] == [x] / [y])%Q. - intros x y Hx Hy; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_divc x y: wf x -> wf y -> - [[div x y]] = [[x]] / [[y]]. - intros x y Hx Hy; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - apply wf_inv; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem wf_div_norm x y: wf x -> wf y -> wf (div_norm x y). - intros x y Hx Hy; unfold div_norm; apply wf_mul_norm; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_div_norm x y: wf x -> wf y -> - ([div_norm x y] == [x] / [y])%Q. - intros x y Hx Hy; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_div_normc x y: wf x -> wf y -> - [[div_norm x y]] = [[x]] / [[y]]. - intros x y Hx Hy; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - apply wf_inv; auto. - Qed. - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - Theorem wf_square: forall x, wf x -> wf (square x). - intros [ zx | nx dx]; unfold square, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_square; intros H1 H2; case H2. - case (Zmult_integral _ _ H1); auto. - Qed. - - Theorem spec_square x: wf x -> ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - intros _. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - unfold wf. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - assert (F: (0 < BigN.to_Z dx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith. - assert (F1 : (0 < BigN.to_Z (BigN.square dx))%Z). - rewrite BigN.spec_square; apply Zmult_lt_0_compat; - auto with zarith. - rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_square; auto with zarith. - Qed. - - Theorem spec_squarec x: wf x -> [[square x]] = [[x]]^2. - intros x Hx; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p) - end. - - Theorem wf_power_pos: forall x p, wf x -> wf (power_pos x p). - intros [ zx | nx dx] p; unfold power_pos, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_power_pos; simpl. - intros H1 H2 _. - case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith. - intros H3; generalize (Zpower_pos_pos _ p H3); auto with zarith. - Qed. - - Theorem spec_power_pos x p: wf x -> ([power_pos x p] == [x] ^ Zpos p)%Q. - Proof. - intros [x | nx dx] p; unfold power_pos. - intros _; unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - rewrite Z2P_correct; rewrite BigN.spec_power_pos; auto. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z dx))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - Qed. - - Theorem spec_power_posc x p: wf x -> - [[power_pos x p]] = [[x]] ^ nat_of_P p. - intros x p Hx; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos; auto. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; generalize Hx; case x; simpl; clear x Hx Hrec. - intros x _; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -End Qv. - diff --git a/theories/Ints/num/ZMake.v b/theories/Ints/num/ZMake.v deleted file mode 100644 index 75fc19584d..0000000000 --- a/theories/Ints/num/ZMake.v +++ /dev/null @@ -1,558 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -Require Import ZArith. -Require Import Zaux. - -Open Scope Z_scope. - -Module Type NType. - - Parameter t : Set. - - Parameter zero : t. - Parameter one : t. - - Parameter of_N : N -> t. - Parameter to_Z : t -> Z. - Parameter spec_pos: forall x, 0 <= to_Z x. - Parameter spec_0: to_Z zero = 0. - Parameter spec_1: to_Z one = 1. - Parameter spec_of_N: forall x, to_Z (of_N x) = Z_of_N x. - - Parameter compare : t -> t -> comparison. - - Parameter spec_compare: forall x y, - match compare x y with - Eq => to_Z x = to_Z y - | Lt => to_Z x < to_Z y - | Gt => to_Z x > to_Z y - end. - - Parameter eq_bool : t -> t -> bool. - - Parameter spec_eq_bool: forall x y, - if eq_bool x y then to_Z x = to_Z y else to_Z x <> to_Z y. - - Parameter succ : t -> t. - - Parameter spec_succ: forall n, to_Z (succ n) = to_Z n + 1. - - Parameter add : t -> t -> t. - - Parameter spec_add: forall x y, to_Z (add x y) = to_Z x + to_Z y. - - Parameter pred : t -> t. - - Parameter spec_pred: forall x, 0 < to_Z x -> to_Z (pred x) = to_Z x - 1. - - Parameter sub : t -> t -> t. - - Parameter spec_sub: forall x y, to_Z y <= to_Z x -> - to_Z (sub x y) = to_Z x - to_Z y. - - Parameter mul : t -> t -> t. - - Parameter spec_mul: forall x y, to_Z (mul x y) = to_Z x * to_Z y. - - Parameter square : t -> t. - - Parameter spec_square: forall x, to_Z (square x) = to_Z x * to_Z x. - - Parameter power_pos : t -> positive -> t. - - Parameter spec_power_pos: forall x n, to_Z (power_pos x n) = to_Z x ^ Zpos n. - - Parameter sqrt : t -> t. - - Parameter spec_sqrt: forall x, to_Z (sqrt x) ^ 2 <= to_Z x < (to_Z (sqrt x) + 1) ^ 2. - - Parameter div_eucl : t -> t -> t * t. - - Parameter spec_div_eucl: forall x y, - 0 < to_Z y -> - let (q,r) := div_eucl x y in (to_Z q, to_Z r) = (Zdiv_eucl (to_Z x) (to_Z y)). - - Parameter div : t -> t -> t. - - Parameter spec_div: forall x y, - 0 < to_Z y -> to_Z (div x y) = to_Z x / to_Z y. - - Parameter modulo : t -> t -> t. - - Parameter spec_modulo: - forall x y, 0 < to_Z y -> to_Z (modulo x y) = to_Z x mod to_Z y. - - Parameter gcd : t -> t -> t. - - Parameter spec_gcd: forall a b, to_Z (gcd a b) = Zgcd (to_Z a) (to_Z b). - - -End NType. - -Module Make (N:NType). - - Inductive t_ : Set := - | Pos : N.t -> t_ - | Neg : N.t -> t_. - - Definition t := t_. - - Definition zero := Pos N.zero. - Definition one := Pos N.one. - Definition minus_one := Neg N.one. - - Definition of_Z x := - match x with - | Zpos x => Pos (N.of_N (Npos x)) - | Z0 => zero - | Zneg x => Neg (N.of_N (Npos x)) - end. - - Definition to_Z x := - match x with - | Pos nx => N.to_Z nx - | Neg nx => Zopp (N.to_Z nx) - end. - - Theorem spec_of_Z: forall x, to_Z (of_Z x) = x. - intros x; case x; unfold to_Z, of_Z, zero. - exact N.spec_0. - intros; rewrite N.spec_of_N; auto. - intros; rewrite N.spec_of_N; auto. - Qed. - - - Theorem spec_0: to_Z zero = 0. - exact N.spec_0. - Qed. - - Theorem spec_1: to_Z one = 1. - exact N.spec_1. - Qed. - - Theorem spec_m1: to_Z minus_one = -1. - simpl; rewrite N.spec_1; auto. - Qed. - - Definition compare x y := - match x, y with - | Pos nx, Pos ny => N.compare nx ny - | Pos nx, Neg ny => - match N.compare nx N.zero with - | Gt => Gt - | _ => N.compare ny N.zero - end - | Neg nx, Pos ny => - match N.compare N.zero nx with - | Lt => Lt - | _ => N.compare N.zero ny - end - | Neg nx, Neg ny => N.compare ny nx - end. - - - Theorem spec_compare: forall x y, - match compare x y with - Eq => to_Z x = to_Z y - | Lt => to_Z x < to_Z y - | Gt => to_Z x > to_Z y - end. - unfold compare, to_Z; intros x y; case x; case y; clear x y; - intros x y; auto; generalize (N.spec_pos x) (N.spec_pos y). - generalize (N.spec_compare y x); case N.compare; auto with zarith. - generalize (N.spec_compare y N.zero); case N.compare; - try rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare x N.zero); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare x N.zero); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare N.zero y); case N.compare; - try rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; auto with zarith. - generalize (N.spec_compare x y); case N.compare; auto with zarith. - Qed. - - Definition eq_bool x y := - match compare x y with - | Eq => true - | _ => false - end. - - Theorem spec_eq_bool: forall x y, - if eq_bool x y then to_Z x = to_Z y else to_Z x <> to_Z y. - intros x y; unfold eq_bool; - generalize (spec_compare x y); case compare; auto with zarith. - Qed. - - Definition cmp_sign x y := - match x, y with - | Pos nx, Neg ny => - if N.eq_bool ny N.zero then Eq else Gt - | Neg nx, Pos ny => - if N.eq_bool nx N.zero then Eq else Lt - | _, _ => Eq - end. - - Theorem spec_cmp_sign: forall x y, - match cmp_sign x y with - | Gt => 0 <= to_Z x /\ to_Z y < 0 - | Lt => to_Z x < 0 /\ 0 <= to_Z y - | Eq => True - end. - Proof. - intros [x | x] [y | y]; unfold cmp_sign; auto. - generalize (N.spec_eq_bool y N.zero); case N.eq_bool; auto. - rewrite N.spec_0; unfold to_Z. - generalize (N.spec_pos x) (N.spec_pos y); auto with zarith. - generalize (N.spec_eq_bool x N.zero); case N.eq_bool; auto. - rewrite N.spec_0; unfold to_Z. - generalize (N.spec_pos x) (N.spec_pos y); auto with zarith. - Qed. - - Definition to_N x := - match x with - | Pos nx => nx - | Neg nx => nx - end. - - Definition abs x := Pos (to_N x). - - Theorem spec_abs: forall x, to_Z (abs x) = Zabs (to_Z x). - intros x; case x; clear x; intros x; assert (F:=N.spec_pos x). - simpl; rewrite Zabs_eq; auto. - simpl; rewrite Zabs_non_eq; simpl; auto with zarith. - Qed. - - Definition opp x := - match x with - | Pos nx => Neg nx - | Neg nx => Pos nx - end. - - Theorem spec_opp: forall x, to_Z (opp x) = - to_Z x. - intros x; case x; simpl; auto with zarith. - Qed. - - Definition succ x := - match x with - | Pos n => Pos (N.succ n) - | Neg n => - match N.compare N.zero n with - | Lt => Neg (N.pred n) - | _ => one - end - end. - - Theorem spec_succ: forall n, to_Z (succ n) = to_Z n + 1. - intros x; case x; clear x; intros x. - exact (N.spec_succ x). - simpl; generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; simpl. - intros HH; rewrite <- HH; rewrite N.spec_1; ring. - intros HH; rewrite N.spec_pred; auto with zarith. - generalize (N.spec_pos x); auto with zarith. - Qed. - - Definition add x y := - match x, y with - | Pos nx, Pos ny => Pos (N.add nx ny) - | Pos nx, Neg ny => - match N.compare nx ny with - | Gt => Pos (N.sub nx ny) - | Eq => zero - | Lt => Neg (N.sub ny nx) - end - | Neg nx, Pos ny => - match N.compare nx ny with - | Gt => Neg (N.sub nx ny) - | Eq => zero - | Lt => Pos (N.sub ny nx) - end - | Neg nx, Neg ny => Neg (N.add nx ny) - end. - - Theorem spec_add: forall x y, to_Z (add x y) = to_Z x + to_Z y. - unfold add, to_Z; intros [x | x] [y | y]. - exact (N.spec_add x y). - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_add; try ring; auto with zarith. - Qed. - - Definition pred x := - match x with - | Pos nx => - match N.compare N.zero nx with - | Lt => Pos (N.pred nx) - | _ => minus_one - end - | Neg nx => Neg (N.succ nx) - end. - - Theorem spec_pred: forall x, to_Z (pred x) = to_Z x - 1. - unfold pred, to_Z, minus_one; intros [x | x]. - generalize (N.spec_compare N.zero x); case N.compare; - rewrite N.spec_0; try rewrite N.spec_1; auto with zarith. - intros H; exact (N.spec_pred _ H). - generalize (N.spec_pos x); auto with zarith. - rewrite N.spec_succ; ring. - Qed. - - Definition sub x y := - match x, y with - | Pos nx, Pos ny => - match N.compare nx ny with - | Gt => Pos (N.sub nx ny) - | Eq => zero - | Lt => Neg (N.sub ny nx) - end - | Pos nx, Neg ny => Pos (N.add nx ny) - | Neg nx, Pos ny => Neg (N.add nx ny) - | Neg nx, Neg ny => - match N.compare nx ny with - | Gt => Neg (N.sub nx ny) - | Eq => zero - | Lt => Pos (N.sub ny nx) - end - end. - - Theorem spec_sub: forall x y, to_Z (sub x y) = to_Z x - to_Z y. - unfold sub, to_Z; intros [x | x] [y | y]. - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - rewrite N.spec_add; ring. - rewrite N.spec_add; ring. - unfold zero; generalize (N.spec_compare x y); case N.compare. - rewrite N.spec_0; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - intros; rewrite N.spec_sub; try ring; auto with zarith. - Qed. - - Definition mul x y := - match x, y with - | Pos nx, Pos ny => Pos (N.mul nx ny) - | Pos nx, Neg ny => Neg (N.mul nx ny) - | Neg nx, Pos ny => Neg (N.mul nx ny) - | Neg nx, Neg ny => Pos (N.mul nx ny) - end. - - - Theorem spec_mul: forall x y, to_Z (mul x y) = to_Z x * to_Z y. - unfold mul, to_Z; intros [x | x] [y | y]; rewrite N.spec_mul; ring. - Qed. - - Definition square x := - match x with - | Pos nx => Pos (N.square nx) - | Neg nx => Pos (N.square nx) - end. - - Theorem spec_square: forall x, to_Z (square x) = to_Z x * to_Z x. - unfold square, to_Z; intros [x | x]; rewrite N.spec_square; ring. - Qed. - - Definition power_pos x p := - match x with - | Pos nx => Pos (N.power_pos nx p) - | Neg nx => - match p with - | xH => x - | xO _ => Pos (N.power_pos nx p) - | xI _ => Neg (N.power_pos nx p) - end - end. - - Theorem spec_power_pos: forall x n, to_Z (power_pos x n) = to_Z x ^ Zpos n. - assert (F0: forall x, (-x)^2 = x^2). - intros x; rewrite Zpower_2; ring. - unfold power_pos, to_Z; intros [x | x] [p | p |]; - try rewrite N.spec_power_pos; try ring. - assert (F: 0 <= 2 * Zpos p). - assert (0 <= Zpos p); auto with zarith. - rewrite Zpos_xI; repeat rewrite Zpower_exp; auto with zarith. - repeat rewrite Zpower_mult; auto with zarith. - rewrite F0; ring. - assert (F: 0 <= 2 * Zpos p). - assert (0 <= Zpos p); auto with zarith. - rewrite Zpos_xO; repeat rewrite Zpower_exp; auto with zarith. - repeat rewrite Zpower_mult; auto with zarith. - rewrite F0; ring. - Qed. - - Definition sqrt x := - match x with - | Pos nx => Pos (N.sqrt nx) - | Neg nx => Neg N.zero - end. - - - Theorem spec_sqrt: forall x, 0 <= to_Z x -> - to_Z (sqrt x) ^ 2 <= to_Z x < (to_Z (sqrt x) + 1) ^ 2. - unfold to_Z, sqrt; intros [x | x] H. - exact (N.spec_sqrt x). - replace (N.to_Z x) with 0. - rewrite N.spec_0; simpl Zpower; unfold Zpower_pos, iter_pos; - auto with zarith. - generalize (N.spec_pos x); auto with zarith. - Qed. - - Definition div_eucl x y := - match x, y with - | Pos nx, Pos ny => - let (q, r) := N.div_eucl nx ny in - (Pos q, Pos r) - | Pos nx, Neg ny => - let (q, r) := N.div_eucl nx ny in - match N.compare N.zero r with - | Eq => (Neg q, zero) - | _ => (Neg (N.succ q), Neg (N.sub ny r)) - end - | Neg nx, Pos ny => - let (q, r) := N.div_eucl nx ny in - match N.compare N.zero r with - | Eq => (Neg q, zero) - | _ => (Neg (N.succ q), Pos (N.sub ny r)) - end - | Neg nx, Neg ny => - let (q, r) := N.div_eucl nx ny in - (Pos q, Neg r) - end. - - - Theorem spec_div_eucl: forall x y, - to_Z y <> 0 -> - let (q,r) := div_eucl x y in - (to_Z q, to_Z r) = Zdiv_eucl (to_Z x) (to_Z y). - unfold div_eucl, to_Z; intros [x | x] [y | y] H. - assert (H1: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y H1); case N.div_eucl; auto. - assert (HH: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y HH); case N.div_eucl; auto. - intros q r; generalize (N.spec_pos x) HH; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); - try (intros; apply False_ind; auto with zarith; fail). - intros p He1 He2 _ _ H1; injection H1; intros H2 H3. - generalize (N.spec_compare N.zero r); case N.compare; - unfold zero; rewrite N.spec_0; try rewrite H3; auto. - rewrite H2; intros; apply False_ind; auto with zarith. - rewrite H2; intros; apply False_ind; auto with zarith. - intros p _ _ _ H1; discriminate H1. - intros p He p1 He1 H1 _. - generalize (N.spec_compare N.zero r); case N.compare. - change (- Zpos p) with (Zneg p). - unfold zero; lazy zeta. - rewrite N.spec_0; intros H2; rewrite <- H2. - intros H3; rewrite <- H3; auto. - rewrite N.spec_0; intros H2. - change (- Zpos p) with (Zneg p); lazy iota beta. - intros H3; rewrite <- H3; auto. - rewrite N.spec_succ; rewrite N.spec_sub. - generalize H2; case (N.to_Z r). - intros; apply False_ind; auto with zarith. - intros p2 _; rewrite He; auto with zarith. - change (Zneg p) with (- (Zpos p)); apply f_equal2 with (f := @pair Z Z); ring. - intros p2 H4; discriminate H4. - assert (N.to_Z r = (Zpos p1 mod (Zpos p))). - unfold Zmod, Zdiv_eucl; rewrite <- H3; auto. - case (Z_mod_lt (Zpos p1) (Zpos p)); auto with zarith. - rewrite N.spec_0; intros H2; generalize (N.spec_pos r); - intros; apply False_ind; auto with zarith. - assert (HH: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y HH); case N.div_eucl; auto. - intros q r; generalize (N.spec_pos x) HH; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); - try (intros; apply False_ind; auto with zarith; fail). - intros p He1 He2 _ _ H1; injection H1; intros H2 H3. - generalize (N.spec_compare N.zero r); case N.compare; - unfold zero; rewrite N.spec_0; try rewrite H3; auto. - rewrite H2; intros; apply False_ind; auto with zarith. - rewrite H2; intros; apply False_ind; auto with zarith. - intros p _ _ _ H1; discriminate H1. - intros p He p1 He1 H1 _. - generalize (N.spec_compare N.zero r); case N.compare. - change (- Zpos p1) with (Zneg p1). - unfold zero; lazy zeta. - rewrite N.spec_0; intros H2; rewrite <- H2. - intros H3; rewrite <- H3; auto. - rewrite N.spec_0; intros H2. - change (- Zpos p1) with (Zneg p1); lazy iota beta. - intros H3; rewrite <- H3; auto. - rewrite N.spec_succ; rewrite N.spec_sub. - generalize H2; case (N.to_Z r). - intros; apply False_ind; auto with zarith. - intros p2 _; rewrite He; auto with zarith. - intros p2 H4; discriminate H4. - assert (N.to_Z r = (Zpos p1 mod (Zpos p))). - unfold Zmod, Zdiv_eucl; rewrite <- H3; auto. - case (Z_mod_lt (Zpos p1) (Zpos p)); auto with zarith. - rewrite N.spec_0; generalize (N.spec_pos r); intros; apply False_ind; auto with zarith. - assert (H1: 0 < N.to_Z y). - generalize (N.spec_pos y); auto with zarith. - generalize (N.spec_div_eucl x y H1); case N.div_eucl; auto. - intros q r; generalize (N.spec_pos x) H1; unfold Zdiv_eucl; - case_eq (N.to_Z x); case_eq (N.to_Z y); - try (intros; apply False_ind; auto with zarith; fail). - change (-0) with 0; lazy iota beta; auto. - intros p _ _ _ _ H2; injection H2. - intros H3 H4; rewrite H3; rewrite H4; auto. - intros p _ _ _ H2; discriminate H2. - intros p He p1 He1 _ _ H2. - change (- Zpos p1) with (Zneg p1); lazy iota beta. - change (- Zpos p) with (Zneg p); lazy iota beta. - rewrite <- H2; auto. - Qed. - - Definition div x y := fst (div_eucl x y). - - Definition spec_div: forall x y, - to_Z y <> 0 -> to_Z (div x y) = to_Z x / to_Z y. - intros x y H1; generalize (spec_div_eucl x y H1); unfold div, Zdiv. - case div_eucl; case Zdiv_eucl; simpl; auto. - intros q r q11 r1 H; injection H; auto. - Qed. - - Definition modulo x y := snd (div_eucl x y). - - Theorem spec_modulo: - forall x y, to_Z y <> 0 -> to_Z (modulo x y) = to_Z x mod to_Z y. - intros x y H1; generalize (spec_div_eucl x y H1); unfold modulo, Zmod. - case div_eucl; case Zdiv_eucl; simpl; auto. - intros q r q11 r1 H; injection H; auto. - Qed. - - Definition gcd x y := - match x, y with - | Pos nx, Pos ny => Pos (N.gcd nx ny) - | Pos nx, Neg ny => Pos (N.gcd nx ny) - | Neg nx, Pos ny => Pos (N.gcd nx ny) - | Neg nx, Neg ny => Pos (N.gcd nx ny) - end. - - Theorem spec_gcd: forall a b, to_Z (gcd a b) = Zgcd (to_Z a) (to_Z b). - unfold gcd, Zgcd, to_Z; intros [x | x] [y | y]; rewrite N.spec_gcd; unfold Zgcd; - auto; case N.to_Z; simpl; auto with zarith; - try rewrite Zabs_Zopp; auto; - case N.to_Z; simpl; auto with zarith. - Qed. - -End Make. diff --git a/theories/Ints/num/Zn2Z.v b/theories/Ints/num/Zn2Z.v deleted file mode 100644 index 48cf268409..0000000000 --- a/theories/Ints/num/Zn2Z.v +++ /dev/null @@ -1,917 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Zaux. -Require Import Basic_type. -Require Import GenBase. -Require Import GenAdd. -Require Import GenSub. -Require Import GenMul. -Require Import GenSqrt. -Require Import GenLift. -Require Import GenDivn1. -Require Import GenDiv. -Require Import ZnZ. - -Open Local Scope Z_scope. - - -Section Zn2Z. - - Variable w : Set. - 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 w_0 := w_op.(znz_0). - Let w_1 := w_op.(znz_1). - Let w_Bm1 := w_op.(znz_Bm1). - - Let w_WW := w_op.(znz_WW). - Let w_W0 := w_op.(znz_W0). - Let w_0W := w_op.(znz_0W). - - 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). - - 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_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_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). - - Let _zn2z := zn2z w. - - Let wB := base w_digits. - - Let w_Bm2 := w_pred w_Bm1. - - Let ww_1 := ww_1 w_0 w_1. - Let ww_Bm1 := ww_Bm1 w_Bm1. - - Let w_add2 a b := match w_add_c a b with C0 p => WW w_0 p | C1 p => WW w_1 p end. - - Let _ww_digits := xO w_digits. - - Let _ww_zdigits := w_add2 w_zdigits w_zdigits. - - Let to_Z := zn2z_to_Z wB w_to_Z. - - Let ww_of_pos p := - match w_of_pos p with - | (N0, l) => (N0, WW w_0 l) - | (Npos ph,l) => - let (n,h) := w_of_pos ph in (n, w_WW h l) - end. - - - Let head0 := - Eval lazy beta delta [ww_head0] in - ww_head0 w_0 w_0W w_compare w_head0 w_add2 w_zdigits _ww_zdigits. - - Let tail0 := - Eval lazy beta delta [ww_tail0] in - 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). - - (* ** Comparison ** *) - Let compare := - Eval lazy beta delta[ww_compare] in ww_compare w_0 w_compare. - - Let eq0 (x:zn2z w) := - match x with - | W0 => true - | _ => false - end. - - (* ** Opposites ** *) - Let opp_c := - Eval lazy beta delta [ww_opp_c] in ww_opp_c w_0 w_opp_c w_opp_carry. - - Let opp := - Eval lazy beta delta [ww_opp] in ww_opp w_0 w_opp_c w_opp_carry w_opp. - - Let opp_carry := - Eval lazy beta delta [ww_opp_carry] in ww_opp_carry w_WW ww_Bm1 w_opp_carry. - - (* ** Additions ** *) - - Let succ_c := - Eval lazy beta delta [ww_succ_c] in ww_succ_c w_0 ww_1 w_succ_c. - - Let add_c := - Eval lazy beta delta [ww_add_c] in ww_add_c w_WW w_add_c w_add_carry_c. - - Let add_carry_c := - Eval lazy beta iota delta [ww_add_carry_c ww_succ_c] in - ww_add_carry_c w_0 w_WW ww_1 w_succ_c w_add_c w_add_carry_c. - - Let succ := - Eval lazy beta delta [ww_succ] in ww_succ w_W0 ww_1 w_succ_c w_succ. - - Let add := - Eval lazy beta delta [ww_add] in ww_add w_add_c w_add w_add_carry. - - Let add_carry := - Eval lazy beta iota delta [ww_add_carry ww_succ] in - ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ w_add w_add_carry. - - (* ** Subtractions ** *) - - Let pred_c := - Eval lazy beta delta [ww_pred_c] in ww_pred_c w_Bm1 w_WW ww_Bm1 w_pred_c. - - Let sub_c := - Eval lazy beta iota delta [ww_sub_c ww_opp_c] in - ww_sub_c w_0 w_WW w_opp_c w_opp_carry w_sub_c w_sub_carry_c. - - Let sub_carry_c := - Eval lazy beta iota delta [ww_sub_carry_c ww_pred_c ww_opp_carry] in - ww_sub_carry_c w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c w_sub_c w_sub_carry_c. - - Let pred := - Eval lazy beta delta [ww_pred] in ww_pred w_Bm1 w_WW ww_Bm1 w_pred_c w_pred. - - Let sub := - Eval lazy beta iota delta [ww_sub ww_opp] in - ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry. - - Let sub_carry := - Eval lazy beta iota delta [ww_sub_carry ww_pred ww_opp_carry] in - ww_sub_carry w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c w_sub_carry_c w_pred - w_sub w_sub_carry. - - - (* ** Multiplication ** *) - - Let mul_c := - Eval lazy beta iota delta [ww_mul_c gen_mul_c] in - ww_mul_c w_0 w_1 w_WW w_W0 w_mul_c add_c add add_carry. - - Let karatsuba_c := - Eval lazy beta iota delta [ww_karatsuba_c gen_mul_c kara_prod] in - ww_karatsuba_c w_0 w_1 w_WW w_W0 w_compare w_add w_sub w_mul_c - add_c add add_carry sub_c sub. - - Let mul := - Eval lazy beta delta [ww_mul] in - ww_mul w_W0 w_add w_mul_c w_mul add. - - Let square_c := - Eval lazy beta delta [ww_square_c] in - ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add add_carry. - - (* Division operation *) - - Let div32 := - Eval lazy beta iota delta [w_div32] in - w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c - w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c. - - Let div21 := - 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 add_mul_div := - Eval lazy beta delta [ww_add_mul_div] in - ww_add_mul_div w_0 w_WW w_W0 w_0W compare w_add_mul_div sub w_zdigits low. - - Let div_gt := - Eval lazy beta delta [ww_div_gt] in - ww_div_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp - w_opp_carry w_sub_c w_sub w_sub_carry - w_div_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits. - - Let div := - Eval lazy beta delta [ww_div] in ww_div ww_1 compare div_gt. - - Let mod_gt := - Eval lazy beta delta [ww_mod_gt] in - ww_mod_gt w_0 w_WW w_0W w_compare w_eq0 w_opp_c w_opp w_opp_carry w_sub_c w_sub w_sub_carry - w_mod_gt w_add_mul_div w_head0 w_div21 div32 _ww_zdigits add_mul_div w_zdigits. - - Let mod_ := - Eval lazy beta delta [ww_mod] in ww_mod compare mod_gt. - - Let pos_mod := - Eval lazy beta delta [ww_pos_mod] in - ww_pos_mod w_0 w_zdigits w_WW w_pos_mod compare w_0W low sub _ww_zdigits. - - Let is_even := - Eval lazy beta delta [ww_is_even] in ww_is_even w_is_even. - - Let sqrt2 := - Eval lazy beta delta [ww_sqrt2] in - ww_sqrt2 w_is_even w_compare w_0 w_1 w_Bm1 w_0W w_sub w_square_c - w_div21 w_add_mul_div w_zdigits w_add_c w_sqrt2 w_pred pred_c - pred add_c add sub_c add_mul_div. - - Let sqrt := - Eval lazy beta delta [ww_sqrt] in - ww_sqrt w_is_even w_0 w_sub w_add_mul_div w_zdigits - _ww_zdigits w_sqrt2 pred add_mul_div head0 compare low. - - Let gcd_gt_fix := - Eval cbv beta delta [ww_gcd_gt_aux ww_gcd_gt_body] in - ww_gcd_gt_aux w_0 w_WW w_0W w_compare w_opp_c w_opp w_opp_carry - w_sub_c w_sub w_sub_carry w_gcd_gt - w_add_mul_div w_head0 w_div21 div32 _ww_zdigits add_mul_div - w_zdigits. - - Let gcd_cont := - Eval lazy beta delta [gcd_cont] in gcd_cont ww_1 w_1 w_compare. - - Let gcd_gt := - Eval lazy beta delta [ww_gcd_gt] in - ww_gcd_gt w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont. - - Let gcd := - Eval lazy beta delta [ww_gcd] in - ww_gcd compare w_0 w_eq0 w_gcd_gt _ww_digits gcd_gt_fix gcd_cont. - - (* ** Record of operators on 2 words *) - - Definition mk_zn2z_op := - mk_znz_op _ww_digits _ww_zdigits - to_Z ww_of_pos head0 tail0 - W0 ww_1 ww_Bm1 - ww_WW ww_W0 ww_0W - compare eq0 - opp_c opp opp_carry - succ_c add_c add_carry_c - succ add add_carry - pred_c sub_c sub_carry_c - pred sub sub_carry - mul_c mul square_c - div21 div_gt div - mod_gt mod_ - gcd_gt gcd - add_mul_div - pos_mod - is_even - sqrt2 - sqrt. - - Definition mk_zn2z_op_karatsuba := - mk_znz_op _ww_digits _ww_zdigits - to_Z ww_of_pos head0 tail0 - W0 ww_1 ww_Bm1 - ww_WW ww_W0 ww_0W - compare eq0 - opp_c opp opp_carry - succ_c add_c add_carry_c - succ add add_carry - pred_c sub_c sub_carry_c - pred sub sub_carry - karatsuba_c mul square_c - div21 div_gt div - mod_gt mod_ - gcd_gt gcd - add_mul_div - pos_mod - is_even - sqrt2 - sqrt. - - (* Proof *) - Variable op_spec : znz_spec w_op. - - 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_WW op_spec) - (spec_0W op_spec) - (spec_W0 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). - - Let wwB := base _ww_digits. - - Notation "[| x |]" := (to_Z x) (at level 0, x at level 99). - - Notation "[+| c |]" := - (interp_carry 1 wwB to_Z c) (at level 0, x at level 99). - - Notation "[-| c |]" := - (interp_carry (-1) wwB to_Z c) (at level 0, x at level 99). - - Notation "[[ x ]]" := (zn2z_to_Z wwB to_Z x) (at level 0, x at level 99). - - Let spec_ww_to_Z : forall x, 0 <= [| x |] < wwB. - Proof. refine (spec_ww_to_Z w_digits w_to_Z _);auto. Qed. - - Let spec_ww_of_pos : forall p, - 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, w_WW, to_Z. - rewrite (spec_WW op_spec). replace wwB with (wB*wB). - unfold wB,w_digits;clear H;destruct n;ring. - symmetry. rewrite <- Zpower_2; exact (wwB_wBwB w_digits). - Qed. - - Let spec_ww_0 : [|W0|] = 0. - Proof. reflexivity. Qed. - - Let spec_ww_1 : [|ww_1|] = 1. - Proof. refine (spec_ww_1 w_0 w_1 w_digits w_to_Z _ _);auto. Qed. - - Let spec_ww_Bm1 : [|ww_Bm1|] = wwB - 1. - Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed. - - Let spec_ww_WW : forall h l, [[ww_WW h l]] = [|h|] * wwB + [|l|]. - Proof. - intros h l. replace wwB with (wB*wB). destruct h;simpl. - destruct l;simpl;ring. ring. - symmetry. rewrite <- Zpower_2; exact (wwB_wBwB w_digits). - Qed. - - Let spec_ww_0W : forall l, [[ww_0W l]] = [|l|]. - Proof. - intros l. replace wwB with (wB*wB). - destruct l;simpl;ring. - symmetry. ring_simplify; exact (wwB_wBwB w_digits). - Qed. - - Let spec_ww_W0 : forall h, [[ww_W0 h]] = [|h|]*wwB. - Proof. - intros h. replace wwB with (wB*wB). - destruct h;simpl;ring. - symmetry. ring_simplify; exact (wwB_wBwB w_digits). - Qed. - - Let spec_ww_compare : - forall x y, - match compare x y with - | Eq => [|x|] = [|y|] - | Lt => [|x|] < [|y|] - | Gt => [|x|] > [|y|] - end. - Proof. - refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto. - exact (spec_compare op_spec). - Qed. - - Let spec_ww_eq0 : forall x, eq0 x = true -> [|x|] = 0. - Proof. destruct x;simpl;intros;trivial;discriminate. Qed. - - Let spec_ww_opp_c : forall x, [-|opp_c x|] = -[|x|]. - Proof. - refine(spec_ww_opp_c w_0 w_0 W0 w_opp_c w_opp_carry w_digits w_to_Z _ _ _ _); - auto. - Qed. - - Let spec_ww_opp : forall x, [|opp x|] = (-[|x|]) mod wwB. - Proof. - refine(spec_ww_opp w_0 w_0 W0 w_opp_c w_opp_carry w_opp - w_digits w_to_Z _ _ _ _ _); - auto. - Qed. - - Let spec_ww_opp_carry : forall x, [|opp_carry x|] = wwB - [|x|] - 1. - Proof. - refine (spec_ww_opp_carry w_WW ww_Bm1 w_opp_carry w_digits w_to_Z _ _ _); - auto. exact (spec_WW op_spec). - Qed. - - Let spec_ww_succ_c : forall x, [+|succ_c x|] = [|x|] + 1. - Proof. - refine (spec_ww_succ_c w_0 w_0 ww_1 w_succ_c w_digits w_to_Z _ _ _ _);auto. - Qed. - - Let spec_ww_add_c : forall x y, [+|add_c x y|] = [|x|] + [|y|]. - Proof. - refine (spec_ww_add_c w_WW w_add_c w_add_carry_c w_digits w_to_Z _ _ _);auto. - exact (spec_WW op_spec). - Qed. - - Let spec_ww_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|]+[|y|]+1. - Proof. - refine (spec_ww_add_carry_c w_0 w_0 w_WW ww_1 w_succ_c w_add_c w_add_carry_c - w_digits w_to_Z _ _ _ _ _ _ _);auto. exact (spec_WW op_spec). - Qed. - - Let spec_ww_succ : forall x, [|succ x|] = ([|x|] + 1) mod wwB. - Proof. - refine (spec_ww_succ w_W0 ww_1 w_succ_c w_succ w_digits w_to_Z _ _ _ _ _); - auto. exact (spec_W0 op_spec). - Qed. - - Let spec_ww_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wwB. - Proof. - refine (spec_ww_add w_add_c w_add w_add_carry w_digits w_to_Z _ _ _ _);auto. - Qed. - - Let spec_ww_add_carry : forall x y, [|add_carry x y|]=([|x|]+[|y|]+1)mod wwB. - Proof. - refine (spec_ww_add_carry w_W0 ww_1 w_succ_c w_add_carry_c w_succ - w_add w_add_carry w_digits w_to_Z _ _ _ _ _ _ _ _);auto. - exact (spec_W0 op_spec). - Qed. - - Let spec_ww_pred_c : forall x, [-|pred_c x|] = [|x|] - 1. - Proof. - refine (spec_ww_pred_c w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_digits w_to_Z - _ _ _ _ _);auto. exact (spec_WW op_spec). - Qed. - - Let spec_ww_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|]. - Proof. - refine (spec_ww_sub_c w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c - w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _);auto. exact (spec_WW op_spec). - Qed. - - Let spec_ww_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|]-[|y|]-1. - Proof. - refine (spec_ww_sub_carry_c w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c - w_sub_c w_sub_carry_c w_digits w_to_Z _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - Qed. - - Let spec_ww_pred : forall x, [|pred x|] = ([|x|] - 1) mod wwB. - Proof. - refine (spec_ww_pred w_0 w_Bm1 w_WW ww_Bm1 w_pred_c w_pred w_digits w_to_Z - _ _ _ _ _ _);auto. exact (spec_WW op_spec). - Qed. - - Let spec_ww_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wwB. - Proof. - refine (spec_ww_sub w_0 w_0 w_WW W0 w_opp_c w_opp_carry w_sub_c w_opp - w_sub w_sub_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - Qed. - - Let spec_ww_sub_carry : forall x y, [|sub_carry x y|]=([|x|]-[|y|]-1) mod wwB. - Proof. - refine (spec_ww_sub_carry w_0 w_Bm1 w_WW ww_Bm1 w_opp_carry w_pred_c - w_sub_carry_c w_pred w_sub w_sub_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _ _); - auto. exact (spec_WW op_spec). - Qed. - - Let spec_ww_mul_c : forall x y, [[mul_c x y ]] = [|x|] * [|y|]. - Proof. - refine (spec_ww_mul_c w_0 w_1 w_WW w_W0 w_mul_c add_c add add_carry w_digits - w_to_Z _ _ _ _ _ _ _ _ _);auto. exact (spec_WW op_spec). - exact (spec_W0 op_spec). exact (spec_mul_c op_spec). - Qed. - - Let spec_ww_karatsuba_c : forall x y, [[karatsuba_c x y ]] = [|x|] * [|y|]. - Proof. - refine (spec_ww_karatsuba_c _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ - _ _ _ _ _ _ _ _ _ _ _ _); auto. - unfold w_digits; apply spec_more_than_1_digit; auto. - exact (spec_WW op_spec). - exact (spec_W0 op_spec). - exact (spec_compare op_spec). - exact (spec_mul_c op_spec). - Qed. - - Let spec_ww_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wwB. - Proof. - refine (spec_ww_mul w_W0 w_add w_mul_c w_mul add w_digits w_to_Z _ _ _ _ _); - auto. exact (spec_W0 op_spec). exact (spec_mul_c op_spec). - Qed. - - Let spec_ww_square_c : forall x, [[square_c x]] = [|x|] * [|x|]. - Proof. - refine (spec_ww_square_c w_0 w_1 w_WW w_W0 w_mul_c w_square_c add_c add - add_carry w_digits w_to_Z _ _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). exact (spec_W0 op_spec). - exact (spec_mul_c op_spec). exact (spec_square_c op_spec). - Qed. - - Let spec_w_div32 : forall a1 a2 a3 b1 b2, - wB / 2 <= (w_to_Z b1) -> - [|WW a1 a2|] < [|WW b1 b2|] -> - let (q, r) := div32 a1 a2 a3 b1 b2 in - (w_to_Z a1) * wwB + (w_to_Z a2) * wB + (w_to_Z a3) = - (w_to_Z q) * ((w_to_Z b1)*wB + (w_to_Z b2)) + [|r|] /\ - 0 <= [|r|] < (w_to_Z b1)*wB + w_to_Z b2. - Proof. - refine (spec_w_div32 w_0 w_Bm1 w_Bm2 w_WW w_compare w_add_c w_add_carry_c - w_add w_add_carry w_pred w_sub w_mul_c w_div21 sub_c w_digits w_to_Z - _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);auto. - unfold w_Bm2, w_to_Z, w_pred, w_Bm1. - rewrite (spec_pred op_spec);rewrite (spec_Bm1 op_spec). - unfold w_digits;rewrite Zmod_small. ring. - assert (H:= wB_pos(znz_digits w_op)). omega. - exact (spec_WW op_spec). exact (spec_compare op_spec). - exact (spec_mul_c op_spec). exact (spec_div21 op_spec). - Qed. - - Let spec_ww_div21 : forall a1 a2 b, - wwB/2 <= [|b|] -> - [|a1|] < [|b|] -> - let (q,r) := div21 a1 a2 b in - [|a1|] *wwB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]. - Proof. - refine (spec_ww_div21 w_0 w_0W div32 ww_1 compare sub w_digits w_to_Z - _ _ _ _ _ _ _);auto. exact (spec_0W op_spec). - Qed. - - 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 w0 Hw0; simpl; unfold w_to_Z; rewrite Hw0. - unfold w_0; rewrite 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. - 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. - intros xh xl; simpl. - rewrite Zplus_comm; rewrite Z_mod_plus; auto with zarith. - rewrite Zmod_small; auto with zarith. - unfold wB, base; auto with zarith. - Qed. - - Let spec_ww_digits: - [|_ww_zdigits|] = Zpos (xO w_digits). - Proof. - unfold w_to_Z, _ww_zdigits. - rewrite spec_add2. - unfold w_to_Z, w_zdigits, w_digits. - rewrite spec_zdigits; auto. - rewrite Zpos_xO; auto with zarith. - Qed. - - - Let spec_ww_head00 : forall x, [|x|] = 0 -> [|head0 x|] = Zpos _ww_digits. - Proof. - 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). - Qed. - - Let spec_ww_head0 : forall x, 0 < [|x|] -> - wwB/ 2 <= 2 ^ [|head0 x|] * [|x|] < wwB. - Proof. - refine (spec_ww_head0 w_0 w_0W w_compare w_head0 - w_add2 w_zdigits _ww_zdigits - w_to_Z _ _ _ _ _ _ _);auto. - exact (spec_0W op_spec). - exact (spec_compare op_spec). - exact (spec_zdigits op_spec). - Qed. - - Let spec_ww_tail00 : forall x, [|x|] = 0 -> [|tail0 x|] = Zpos _ww_digits. - Proof. - 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) _ _ _ _); auto. - exact (spec_compare op_spec). - exact (spec_tail00 op_spec). - exact (spec_zdigits op_spec). - Qed. - - - Let spec_ww_tail0 : forall x, 0 < [|x|] -> - exists y, 0 <= y /\ [|x|] = (2 * y + 1) * 2 ^ [|tail0 x|]. - Proof. - refine (spec_ww_tail0 (w_digits := w_digits) w_0 w_0W w_compare w_tail0 - w_add2 w_zdigits _ww_zdigits w_to_Z _ _ _ _ _ _ _);auto. - exact (spec_0W op_spec). - exact (spec_compare op_spec). - exact (spec_zdigits op_spec). - Qed. - - Lemma spec_ww_add_mul_div : forall x y p, - [|p|] <= Zpos _ww_digits -> - [| add_mul_div p x y |] = - ([|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 - sub w_digits w_zdigits low w_to_Z - _ _ _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - exact (spec_W0 op_spec). - exact (spec_0W op_spec). - exact (spec_zdigits op_spec). - Qed. - - Let spec_ww_div_gt : forall a b, - [|a|] > [|b|] -> 0 < [|b|] -> - let (q,r) := div_gt a b in - [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. - Proof. -refine -(@spec_ww_div_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 - 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 (spec_WW op_spec). - exact (spec_0W op_spec). - 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 spec_w_div32. - exact (spec_zdigits op_spec). - exact spec_ww_digits. - exact spec_ww_1. - exact spec_ww_add_mul_div. - Qed. - - Let spec_ww_div : forall a b, 0 < [|b|] -> - let (q,r) := div a b in - [|a|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]. - Proof. - refine (spec_ww_div w_digits ww_1 compare div_gt w_to_Z _ _ _ _);auto. - Qed. - - Let spec_ww_mod_gt : forall a b, - [|a|] > [|b|] -> 0 < [|b|] -> - [|mod_gt a b|] = [|a|] mod [|b|]. - Proof. - refine (@spec_ww_mod_gt w w_digits w_0 w_WW w_0W w_compare w_eq0 - 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 - _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - exact (spec_0W op_spec). - exact (spec_compare op_spec). - exact (spec_div_gt op_spec). - exact (spec_div21 op_spec). - exact (spec_zdigits op_spec). - exact spec_ww_add_mul_div. - Qed. - - Let spec_ww_mod : forall a b, 0 < [|b|] -> [|mod_ a b|] = [|a|] mod [|b|]. - Proof. - refine (spec_ww_mod w_digits W0 compare mod_gt w_to_Z _ _ _);auto. - Qed. - - 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 _ - w_0 w_0 w_eq0 w_gcd_gt _ww_digits - _ gcd_gt_fix _ _ _ _ gcd_cont _);auto. - refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp - w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0 - w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z - _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - exact (spec_0W op_spec). - exact (spec_compare op_spec). - exact (spec_div21 op_spec). - exact (spec_zdigits op_spec). - exact spec_ww_add_mul_div. - refine (@spec_gcd_cont w 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 - _ww_digits _ gcd_gt_fix _ _ _ _ gcd_cont _);auto. - refine (@spec_ww_gcd_gt_aux w w_digits w_0 w_WW w_0W w_compare w_opp_c w_opp - w_opp_carry w_sub_c w_sub w_sub_carry w_gcd_gt w_add_mul_div w_head0 - w_div21 div32 _ww_zdigits ww_1 add_mul_div w_zdigits w_to_Z - _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - exact (spec_0W op_spec). - exact (spec_compare op_spec). - exact (spec_div21 op_spec). - exact (spec_zdigits op_spec). - exact spec_ww_add_mul_div. - refine (@spec_gcd_cont w 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, - match is_even x with - true => [|x|] mod 2 = 0 - | 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). - Qed. - - Let spec_ww_sqrt2 : forall x y, - wwB/ 4 <= [|x|] -> - let (s,r) := sqrt2 x y in - [[WW x y]] = [|s|] ^ 2 + [+|r|] /\ - [+|r|] <= 2 * [|s|]. - Proof. - intros x y H. - refine (@spec_ww_sqrt2 w 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 - _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); auto. - exact (spec_zdigits op_spec). - exact (spec_more_than_1_digit op_spec). - exact (spec_0W op_spec). - exact (spec_is_even op_spec). - exact (spec_compare op_spec). - exact (spec_square_c op_spec). - exact (spec_div21 op_spec). - exact (spec_ww_add_mul_div). - exact (spec_sqrt2 op_spec). - 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 - w_sub w_add_mul_div w_digits w_zdigits _ww_zdigits - w_sqrt2 pred add_mul_div head0 compare - _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _); auto. - 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). - Qed. - - Lemma mk_znz2_spec : znz_spec mk_zn2z_op. - Proof. - apply mk_znz_spec;auto. - exact spec_ww_add_mul_div. - - refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW - w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z - _ _ _ _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - exact (spec_pos_mod op_spec). - exact (spec_0W op_spec). - exact (spec_zdigits op_spec). - unfold w_to_Z, w_zdigits. - rewrite (spec_zdigits op_spec). - rewrite <- Zpos_xO; exact spec_ww_digits. - Qed. - - Lemma mk_znz2_karatsuba_spec : znz_spec mk_zn2z_op_karatsuba. - Proof. - apply mk_znz_spec;auto. - exact spec_ww_add_mul_div. - refine (@spec_ww_pos_mod w w_0 w_digits w_zdigits w_WW - w_pos_mod compare w_0W low sub _ww_zdigits w_to_Z - _ _ _ _ _ _ _ _ _ _ _ _);auto. - exact (spec_WW op_spec). - exact (spec_pos_mod op_spec). - exact (spec_0W op_spec). - exact (spec_zdigits op_spec). - unfold w_to_Z, w_zdigits. - rewrite (spec_zdigits op_spec). - rewrite <- Zpos_xO; exact spec_ww_digits. - Qed. -End Zn2Z. - -Section MulAdd. - - Variable w: Set. - Variable op: znz_op w. - Variable sop: znz_spec op. - - Definition mul_add:= w_mul_add (znz_0 op) (znz_succ op) (znz_add_c op) (znz_mul_c op). - - Notation "[| x |]" := (znz_to_Z op 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). - - - Lemma spec_mul_add: forall x y z, - let (zh, zl) := mul_add x y z in - [||WW zh zl||] = [|x|] * [|y|] + [|z|]. - 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). - Qed. - -End MulAdd. - - - - diff --git a/theories/Ints/num/ZnZ.v b/theories/Ints/num/ZnZ.v deleted file mode 100644 index d5b798a18c..0000000000 --- a/theories/Ints/num/ZnZ.v +++ /dev/null @@ -1,323 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(* Benjamin Gregoire, INRIA Laurent Thery, INRIA *) -(************************************************************************) - -(* $Id:$ *) - -(** * Signature and specification of a bounded integer structure *) - -(** -- Authors: Benjamin Grégoire, Laurent Théry -- Institution: INRIA -- Date: 2007 -*) - -Set Implicit Arguments. - -Require Import ZArith. -Require Import Znumtheory. -Require Import Basic_type. -Require Import GenBase. - -Open Local Scope Z_scope. - -Section ZnZ_Op. - - Variable znz : Set. - - Record znz_op : Set := mk_znz_op { - - (* Conversion functions with Z *) - 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; - - (* Basic constructors *) - znz_0 : znz; - znz_1 : znz; - znz_Bm1 : znz; - znz_WW : znz -> znz -> zn2z znz; - znz_W0 : znz -> zn2z znz; - znz_0W : znz -> zn2z znz; - - (* Comparison *) - znz_compare : znz -> znz -> comparison; - znz_eq0 : znz -> 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; - - (* Special divisions operations *) - 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; - - (* square root *) - znz_is_even : znz -> bool; - znz_sqrt2 : znz -> znz -> znz * carry znz; - znz_sqrt : znz -> znz }. - -End ZnZ_Op. - -Section Spec. - Variable w : Set. - 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 wWW := w_op.(znz_WW). - Let w0W := w_op.(znz_0W). - Let wW0 := w_op.(znz_W0). - - 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). - - 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_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_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. - - Notation "[+| c |]" := - (interp_carry 1 wB w_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). - - Notation "[|| x ||]" := - (zn2z_to_Z wB w_to_Z x) (at level 0, x at level 99). - - Notation "[! n | x !]" := (gen_to_Z w_digits w_to_Z n x) - (at level 0, x at level 99). - - Record znz_spec : Set := mk_znz_spec { - - (* 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; - - (* Basic constructors *) - spec_0 : [|w0|] = 0; - spec_1 : [|w1|] = 1; - spec_Bm1 : [|wBm1|] = wB - 1; - spec_WW : forall h l, [||wWW h l||] = [|h|] * wB + [|l|]; - spec_0W : forall l, [||w0W l||] = [|l|]; - spec_W0 : forall h, [||wW0 h||] = [|h|]*wB; - - (* 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; - (* 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_add_carry : - forall x y, [|w_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_sub_carry : - forall x y, [|w_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|]; - - (* Special divisions operations *) - spec_div21 : forall a1 a2 b, - wB/2 <= [|b|] -> - [|a1|] < [|b|] -> - let (q,r) := w_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 - [|a|] = [|q|] * [|b|] + [|r|] /\ - 0 <= [|r|] < [|b|]; - spec_div : forall a b, 0 < [|b|] -> - let (q,r) := w_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_gcd_gt : forall a b, [|a|] > [|b|] -> - Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]; - spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|w_gcd a b|]; - - - (* shift operations *) - spec_head00: forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits; - spec_head0 : forall x, 0 < [|x|] -> - wB/ 2 <= 2 ^ ([|w_head0 x|]) * [|x|] < wB; - spec_tail00: forall x, [|x|] = 0 -> [|w_tail0 x|] = Zpos w_digits; - spec_tail0 : forall x, 0 < [|x|] -> - exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|w_tail0 x|]) ; - spec_add_mul_div : forall x y p, - [|p|] <= Zpos w_digits -> - [| w_add_mul_div p x y |] = - ([|x|] * (2 ^ [|p|]) + - [|y|] / (2 ^ ((Zpos w_digits) - [|p|]))) mod wB; - spec_pos_mod : forall w p, - [|w_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; - spec_sqrt2 : forall x y, - wB/ 4 <= [|x|] -> - let (s,r) := w_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 - }. - -End Spec. - - -Section znz_of_pos. - - Variable w : Set. - Variable w_op : znz_op w. - Variable op_spec : znz_spec w_op. - - Notation "[| x |]" := (znz_to_Z w_op x) (at level 0, x at level 99). - - Definition znz_of_Z (w:Set) (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. - intros p Hp. - generalize (spec_of_pos op_spec p). - case (znz_of_pos w_op 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. - case p1; simpl; intros; red; simpl; intros; discriminate. - unfold base; auto with zarith. - case (spec_to_Z op_spec 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. - intros p; case p; simpl; try rewrite spec_0; auto. - intros; rewrite znz_of_pos_correct; auto with zarith. - intros p1 (H1, _); contradict H1; apply Zlt_not_le; red; simpl; auto. - Qed. -End znz_of_pos. diff --git a/theories/Ints/num/genN.ml b/theories/Ints/num/genN.ml deleted file mode 100644 index 8bf583ab6b..0000000000 --- a/theories/Ints/num/genN.ml +++ /dev/null @@ -1,3407 +0,0 @@ -open Format - -let size = 6 -let sizeaux = 1 -let gen_proof = true - -let t = "t" -let c = "N" -let pz n = if n == 0 then "w_0" else "W0" -let rec gen2 n = if n == 0 then "1" else if n == 1 then "2" - else "2 * " ^ (gen2 (n - 1)) -let rec genxO n s = - if n == 0 then s else " (xO" ^ (genxO (n - 1) s) ^ ")" - - -(******* Start Printing ********) -let basename = "N" - - -let print_header fmt l = - let l = "ZAux"::"ZArith"::"Basic_type"::"ZnZ"::"Zn2Z"::"Nbasic"::"GenMul":: - "GenDivn1"::"Wf_nat"::"MemoFn"::l in - List.iter (fun s -> fprintf fmt "Require Import %s.\n" s) l; - fprintf fmt "\n" - -let start_file post l = - let outname = basename^post^".v" in - let fd = - try - Unix.openfile outname [Unix.O_WRONLY;Unix.O_CREAT;Unix.O_TRUNC] 0o640 - with _ -> - print_string ("can not open file "^outname^"\n"); - exit 1 in - let out = Unix.out_channel_of_descr fd in - set_binary_mode_out out false; - let fmt = formatter_of_out_channel out in - print_header fmt l; - fmt - - - -(****** Print types *******) - -let print_Make () = - let fmt = start_file "Make" [] in - - fprintf fmt "(***************************************************************)\n"; - fprintf fmt "(* *)\n"; - fprintf fmt "(* File automatically generated DO NOT EDIT *)\n"; - fprintf fmt "(* Constructors: %i Generated Proofs: %b %s %s *)\n" size gen_proof (if size < 10 then " " else "") (if gen_proof then " " else ""); - fprintf fmt "(* *)\n"; - fprintf fmt "(* To change this file, edit in genN.ml the two lines *)\n"; - fprintf fmt "(* let size = %i%s *)\n" size (if size < 10 then " " else ""); - fprintf fmt "(* let gen_proof = %s *)\n" (if gen_proof then "true " else "false"); - fprintf fmt "(* Recompile the file *)\n"; - fprintf fmt "(* camlopt -o genN unix.cmxa genN.ml *)\n"; - fprintf fmt "(* Regenerate NMake.v *)\n"; - fprintf fmt "(* ./genN *)\n"; - fprintf fmt "(***************************************************************)\n\n"; - - - fprintf fmt "Module Type W0Type.\n"; - fprintf fmt " Parameter w : Set.\n"; - fprintf fmt " Parameter w_op : znz_op w.\n"; - fprintf fmt " Parameter w_spec : znz_spec w_op.\n"; - fprintf fmt "End W0Type.\n"; - fprintf fmt "\n"; - - fprintf fmt "Module Make (W0:W0Type).\n"; - fprintf fmt " Import W0.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition w0 := W0.w.\n"; - for i = 1 to size do - fprintf fmt " Definition w%i := zn2z w%i.\n" i (i-1) - done; - fprintf fmt "\n"; - - fprintf fmt " Definition w0_op := W0.w_op.\n"; - for i = 1 to 3 do - fprintf fmt " Definition w%i_op := mk_zn2z_op w%i_op.\n" i (i-1) - done; - for i = 4 to size + 3 do - fprintf fmt " Definition w%i_op := mk_zn2z_op_karatsuba w%i_op.\n" i (i-1) - done; - fprintf fmt "\n"; - - fprintf fmt " Section Make_op.\n"; - fprintf fmt " Variable mk : forall w', znz_op w' -> znz_op (zn2z w').\n"; - fprintf fmt "\n"; - fprintf fmt - " Fixpoint make_op_aux (n:nat) : znz_op (word w%i (S n)):=\n" size; - fprintf fmt " match n return znz_op (word w%i (S n)) with\n" size; - fprintf fmt " | O => w%i_op\n" (size+1); - fprintf fmt " | S n1 =>\n"; - fprintf fmt " match n1 return znz_op (word w%i (S (S n1))) with\n" size; - fprintf fmt " | O => w%i_op\n" (size+2); - fprintf fmt " | S n2 =>\n"; - fprintf fmt " match n2 return znz_op (word w%i (S (S (S n2)))) with\n" - size; - fprintf fmt " | O => w%i_op\n" (size+3); - fprintf fmt " | S n3 => mk _ (mk _ (mk _ (make_op_aux n3)))\n"; - fprintf fmt " end\n"; - fprintf fmt " end\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - fprintf fmt " End Make_op.\n"; - fprintf fmt "\n"; - fprintf fmt " Definition omake_op := make_op_aux mk_zn2z_op_karatsuba.\n"; - fprintf fmt "\n"; - fprintf fmt "\n"; - fprintf fmt " Definition make_op_list := dmemo_list _ omake_op.\n"; - fprintf fmt "\n"; - fprintf fmt " Definition make_op n := dmemo_get _ omake_op n make_op_list.\n"; - fprintf fmt "\n"; - fprintf fmt " Lemma make_op_omake: forall n, make_op n = omake_op n.\n"; - fprintf fmt " intros n; unfold make_op, make_op_list.\n"; - fprintf fmt " refine (dmemo_get_correct _ _ _).\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Inductive %s_ : Set :=\n" t; - for i = 0 to size do - fprintf fmt " | %s%i : w%i -> %s_\n" c i i t - done; - fprintf fmt " | %sn : forall n, word w%i (S n) -> %s_.\n" c size t; - fprintf fmt "\n"; - fprintf fmt " Definition %s := %s_.\n" t t; - fprintf fmt "\n"; - - fprintf fmt " Definition w_0 := w0_op.(znz_0).\n"; - fprintf fmt "\n"; - - for i = 0 to size do - fprintf fmt " Definition one%i := w%i_op.(znz_1).\n" i i - done; - fprintf fmt "\n"; - - - fprintf fmt " Definition zero := %s0 w_0.\n" c; - fprintf fmt " Definition one := %s0 one0.\n" c; - fprintf fmt "\n"; - - fprintf fmt " Definition to_Z x :=\n"; - fprintf fmt " match x with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wx => w%i_op.(znz_to_Z) wx\n" c i i - done; - fprintf fmt " | %sn n wx => (make_op n).(znz_to_Z) wx\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Open Scope Z_scope.\n"; - fprintf fmt " Notation \"[ x ]\" := (to_Z x).\n"; - fprintf fmt " \n"; - - - - - if gen_proof then - begin - fprintf fmt " (* Regular make op (no karatsuba) *)\n"; - fprintf fmt " Fixpoint nmake_op (ww:Set) (ww_op: znz_op ww) (n: nat) : \n"; - fprintf fmt " znz_op (word ww n) :=\n"; - fprintf fmt " match n return znz_op (word ww n) with \n"; - fprintf fmt " O => ww_op\n"; - fprintf fmt " | S n1 => mk_zn2z_op (nmake_op ww ww_op n1) \n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - fprintf fmt " (* Simplification by rewriting for nmake_op *)\n"; - fprintf fmt " Theorem nmake_op_S: forall ww (w_op: znz_op ww) x, \n"; - fprintf fmt " nmake_op _ w_op (S x) = mk_zn2z_op (nmake_op _ w_op x).\n"; - fprintf fmt " auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - - fprintf fmt " (* Eval and extend functions for each level *)\n"; - for i = 0 to size do - if gen_proof then - fprintf fmt " Let nmake_op%i := nmake_op _ w%i_op.\n" i i; - if gen_proof then - fprintf fmt " Let eval%in n := znz_to_Z (nmake_op%i n).\n" i i; - if i == 0 then - fprintf fmt " Let extend%i := GenBase.extend (WW w_0).\n" i - else - fprintf fmt " Let extend%i := GenBase.extend (WW (W0: w%i)).\n" i i; - done; - fprintf fmt "\n"; - - - if gen_proof then - begin - fprintf fmt " Theorem digits_gend:forall n ww (w_op: znz_op ww), \n"; - fprintf fmt " znz_digits (nmake_op _ w_op n) = \n"; - fprintf fmt " GenBase.gen_digits (znz_digits w_op) n.\n"; - fprintf fmt " Proof."; - fprintf fmt " intros n; elim n; auto; clear n.\n"; - fprintf fmt " intros n Hrec ww ww_op; simpl GenBase.gen_digits.\n"; - fprintf fmt " rewrite <- Hrec; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - fprintf fmt " Theorem nmake_gen: forall n ww (w_op: znz_op ww), \n"; - fprintf fmt " znz_to_Z (nmake_op _ w_op n) =\n"; - fprintf fmt " %sGenBase.gen_to_Z _ (znz_digits w_op) (znz_to_Z w_op) n.\n" "@"; - fprintf fmt " Proof."; - fprintf fmt " intros n; elim n; auto; clear n.\n"; - fprintf fmt " intros n Hrec ww ww_op; simpl GenBase.gen_to_Z; unfold zn2z_to_Z.\n"; - fprintf fmt " rewrite <- Hrec; auto.\n"; - fprintf fmt " unfold GenBase.gen_wB; rewrite <- digits_gend; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem digits_nmake:forall n ww (w_op: znz_op ww), \n"; - fprintf fmt " znz_digits (nmake_op _ w_op (S n)) = \n"; - fprintf fmt " xO (znz_digits (nmake_op _ w_op n)).\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem znz_nmake_op: forall ww ww_op n xh xl,\n"; - fprintf fmt " znz_to_Z (nmake_op ww ww_op (S n)) (WW xh xl) =\n"; - fprintf fmt " znz_to_Z (nmake_op ww ww_op n) xh *\n"; - fprintf fmt " base (znz_digits (nmake_op ww ww_op n)) +\n"; - fprintf fmt " znz_to_Z (nmake_op ww ww_op n) xl.\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem make_op_S: forall n,\n"; - fprintf fmt " make_op (S n) = mk_zn2z_op_karatsuba (make_op n).\n"; - fprintf fmt " intro n.\n"; - fprintf fmt " do 2 rewrite make_op_omake.\n"; - fprintf fmt " pattern n; apply lt_wf_ind; clear n.\n"; - fprintf fmt " intros n; case n; clear n.\n"; - fprintf fmt " intros _; unfold omake_op, make_op_aux, w%i_op; apply refl_equal.\n" (size + 2); - fprintf fmt " intros n; case n; clear n.\n"; - fprintf fmt " intros _; unfold omake_op, make_op_aux, w%i_op; apply refl_equal.\n" (size + 3); - fprintf fmt " intros n; case n; clear n.\n"; - fprintf fmt " intros _; unfold omake_op, make_op_aux, w%i_op, w%i_op; apply refl_equal.\n" (size + 3) (size + 2); - fprintf fmt " intros n Hrec.\n"; - fprintf fmt " change (omake_op (S (S (S (S n))))) with\n"; - fprintf fmt " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op (S n))))).\n"; - fprintf fmt " change (omake_op (S (S (S n)))) with\n"; - fprintf fmt " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op n)))).\n"; - fprintf fmt " rewrite Hrec; auto with arith.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " \n"; - - - for i = 1 to size + 2 do - fprintf fmt " Let znz_to_Z_%i: forall x y,\n" i; - fprintf fmt " znz_to_Z w%i_op (WW x y) = \n" i; - fprintf fmt " znz_to_Z w%i_op x * base (znz_digits w%i_op) + znz_to_Z w%i_op y.\n" (i-1) (i-1) (i-1); - fprintf fmt " Proof.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " Qed. \n"; - fprintf fmt "\n"; - done; - - fprintf fmt " Let znz_to_Z_n: forall n x y,\n"; - fprintf fmt " znz_to_Z (make_op (S n)) (WW x y) = \n"; - fprintf fmt " znz_to_Z (make_op n) x * base (znz_digits (make_op n)) + znz_to_Z (make_op n) y.\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n x y; rewrite make_op_S; auto.\n"; - fprintf fmt " Qed. \n"; - fprintf fmt "\n"; - end; - - if gen_proof then - begin - fprintf fmt " Let w0_spec: znz_spec w0_op := W0.w_spec.\n"; - for i = 1 to 3 do - fprintf fmt " Let w%i_spec: znz_spec w%i_op := mk_znz2_spec w%i_spec.\n" i i (i-1) - done; - for i = 4 to size + 3 do - fprintf fmt " Let w%i_spec : znz_spec w%i_op := mk_znz2_karatsuba_spec w%i_spec.\n" i i (i-1) - done; - fprintf fmt "\n"; - - fprintf fmt " Let wn_spec: forall n, znz_spec (make_op n).\n"; - fprintf fmt " intros n; elim n; clear n.\n"; - fprintf fmt " exact w%i_spec.\n" (size + 1); - fprintf fmt " intros n Hrec; rewrite make_op_S.\n"; - fprintf fmt " exact (mk_znz2_karatsuba_spec Hrec).\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " \n"; - end; - - for i = 0 to size do - fprintf fmt " Definition w%i_eq0 := w%i_op.(znz_eq0).\n" i i; - fprintf fmt " Let spec_w%i_eq0: forall x, if w%i_eq0 x then [%s%i x] = 0 else True.\n" i i c i; - if gen_proof then - begin - fprintf fmt " intros x; unfold w%i_eq0, to_Z; generalize (spec_eq0 w%i_spec x);\n" i i; - fprintf fmt " case znz_eq0; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - done; - fprintf fmt "\n"; - - - if gen_proof then - begin - for i = 0 to size do - fprintf fmt " Theorem digits_w%i: znz_digits w%i_op = znz_digits (nmake_op _ w0_op %i).\n" i i i; - if i == 0 then - fprintf fmt " auto.\n" - else - fprintf fmt " rewrite digits_nmake; rewrite <- digits_w%i; auto.\n" (i - 1); - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Let spec_gen_eval%in: forall n, eval%in n = GenBase.gen_to_Z (znz_digits w%i_op) (znz_to_Z w%i_op) n.\n" i i i i; - if gen_proof then - begin - fprintf fmt " intros n; exact (nmake_gen n w%i w%i_op).\n" i i; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - done; - - for i = 0 to size do - for j = 0 to (size - i) do - fprintf fmt " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i).\n" i j (i + j) i j; - if j == 0 then - if i == 0 then - fprintf fmt " auto.\n" - else - begin - fprintf fmt " apply trans_equal with (xO (znz_digits w%i_op)).\n" (i + j -1); - fprintf fmt " auto.\n"; - fprintf fmt " unfold nmake_op; auto.\n"; - end - else - begin - fprintf fmt " apply trans_equal with (xO (znz_digits w%i_op)).\n" (i + j -1); - fprintf fmt " auto.\n"; - fprintf fmt " rewrite digits_nmake.\n"; - fprintf fmt " rewrite digits_w%in%i.\n" i (j - 1); - fprintf fmt " auto.\n"; - end; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - fprintf fmt " Let spec_eval%in%i: forall x, [%s%i x] = eval%in %i x.\n" i j c (i + j) i j; - if gen_proof then - begin - if j == 0 then - fprintf fmt " intros x; rewrite spec_gen_eval%in; unfold GenBase.gen_to_Z, to_Z; auto.\n" i - else - begin - fprintf fmt " intros x; case x.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i.\n" (i + j); - fprintf fmt " rewrite digits_w%in%i.\n" i (j - 1); - fprintf fmt " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH.\n" i (j - 1); - fprintf fmt " unfold eval%in, nmake_op%i.\n" i i; - fprintf fmt " rewrite (znz_nmake_op _ w%i_op %i); auto.\n" i (j - 1); - - end; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - if i + j <> size then - begin - fprintf fmt " Let spec_extend%in%i: forall x, [%s%i x] = [%s%i (extend%i %i x)].\n" i (i + j + 1) c i c (i + j + 1) i j; - if j == 0 then - begin - fprintf fmt " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x).\n" i (i + j); - fprintf fmt " unfold to_Z; rewrite znz_to_Z_%i.\n" (i + j + 1); - fprintf fmt " rewrite (spec_0 w%i_spec); auto.\n" (i + j); - - end - else - begin - fprintf fmt " intros x; change (extend%i %i x) with (WW (znz_0 w%i_op) (extend%i %i x)).\n" i j (i + j) i (j - 1); - fprintf fmt " unfold to_Z; rewrite znz_to_Z_%i.\n" (i + j + 1); - fprintf fmt " rewrite (spec_0 w%i_spec).\n" (i + j); - fprintf fmt " generalize (spec_extend%in%i x); unfold to_Z.\n" i (i + j); - fprintf fmt " intros HH; rewrite <- HH; auto.\n"; - - end; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - done; - - fprintf fmt " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i).\n" i (size - i + 1) (size + 1) i (size - i + 1); - fprintf fmt " apply trans_equal with (xO (znz_digits w%i_op)).\n" size; - fprintf fmt " auto.\n"; - fprintf fmt " rewrite digits_nmake.\n"; - fprintf fmt " rewrite digits_w%in%i.\n" i (size - i); - fprintf fmt " auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Let spec_eval%in%i: forall x, [%sn 0 x] = eval%in %i x.\n" i (size - i + 1) c i (size - i + 1); - fprintf fmt " intros x; case x.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i.\n" (size + 1); - fprintf fmt " rewrite digits_w%in%i.\n" i (size - i); - fprintf fmt " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH.\n" i (size - i); - fprintf fmt " unfold eval%in, nmake_op%i.\n" i i; - fprintf fmt " rewrite (znz_nmake_op _ w%i_op %i); auto.\n" i (size - i); - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Let spec_eval%in%i: forall x, [%sn 1 x] = eval%in %i x.\n" i (size - i + 2) c i (size - i + 2); - fprintf fmt " intros x; case x.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i.\n" (size + 2); - fprintf fmt " rewrite digits_w%in%i.\n" i (size + 1 - i); - fprintf fmt " generalize (spec_eval%in%i); unfold to_Z; change (make_op 0) with (w%i_op); intros HH; repeat rewrite HH.\n" i (size + 1 - i) (size + 1); - fprintf fmt " unfold eval%in, nmake_op%i.\n" i i; - fprintf fmt " rewrite (znz_nmake_op _ w%i_op %i); auto.\n" i (size + 1 - i); - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - done; - - fprintf fmt " Let digits_w%in: forall n,\n" size; - fprintf fmt " znz_digits (make_op n) = znz_digits (nmake_op _ w%i_op (S n)).\n" size; - fprintf fmt " intros n; elim n; clear n.\n"; - fprintf fmt " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op)).\n" size; - fprintf fmt " rewrite nmake_op_S; apply sym_equal; auto.\n"; - fprintf fmt " intros n Hrec.\n"; - fprintf fmt " replace (znz_digits (make_op (S n))) with (xO (znz_digits (make_op n))).\n"; - fprintf fmt " rewrite Hrec.\n"; - fprintf fmt " rewrite nmake_op_S; apply sym_equal; auto.\n"; - fprintf fmt " rewrite make_op_S; apply sym_equal; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Let spec_eval%in: forall n x, [%sn n x] = eval%in (S n) x.\n" size c size; - fprintf fmt " intros n; elim n; clear n.\n"; - fprintf fmt " exact spec_eval%in1.\n" size; - fprintf fmt " intros n Hrec x; case x; clear x.\n"; - fprintf fmt " unfold to_Z, eval%in, nmake_op%i.\n" size size; - fprintf fmt " rewrite make_op_S; rewrite nmake_op_S; auto.\n"; - fprintf fmt " intros xh xl.\n"; - fprintf fmt " unfold to_Z in Hrec |- *.\n"; - fprintf fmt " rewrite znz_to_Z_n.\n"; - fprintf fmt " rewrite digits_w%in.\n" size; - fprintf fmt " repeat rewrite Hrec.\n"; - fprintf fmt " unfold eval%in, nmake_op%i.\n" size size; - fprintf fmt " apply sym_equal; rewrite nmake_op_S; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Let spec_extend%in: forall n x, [%s%i x] = [%sn n (extend%i n x)].\n" size c size c size ; - fprintf fmt " intros n; elim n; clear n.\n"; - fprintf fmt " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x).\n" size size; - fprintf fmt " unfold to_Z.\n"; - fprintf fmt " change (make_op 0) with w%i_op.\n" (size + 1); - fprintf fmt " rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto.\n" (size + 1) size; - fprintf fmt " intros n Hrec x.\n"; - fprintf fmt " change (extend%i (S n) x) with (WW W0 (extend%i n x)).\n" size size; - fprintf fmt " unfold to_Z in Hrec |- *; rewrite znz_to_Z_n; auto.\n"; - fprintf fmt " rewrite <- Hrec.\n"; - fprintf fmt " replace (znz_to_Z (make_op n) W0) with 0; auto.\n"; - fprintf fmt " case n; auto; intros; rewrite make_op_S; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - - - fprintf fmt " Theorem spec_pos: forall x, 0 <= [x].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x; case (spec_to_Z w%i_spec x); auto.\n" i; - done; - fprintf fmt " intros n x; case (spec_to_Z (wn_spec n) x); auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - if gen_proof then - begin - fprintf fmt " Let spec_extendn_0: forall n wx, [%sn n (extend n _ wx)] = [%sn 0 wx].\n" c c; - fprintf fmt " intros n; elim n; auto.\n"; - fprintf fmt " intros n1 Hrec wx; simpl extend; rewrite <- Hrec; auto.\n"; - fprintf fmt " unfold to_Z.\n"; - fprintf fmt " case n1; auto; intros n2; repeat rewrite make_op_S; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " Hint Rewrite spec_extendn_0: extr.\n"; - fprintf fmt "\n"; - fprintf fmt " Let spec_extendn0_0: forall n wx, [%sn (S n) (WW W0 wx)] = [%sn n wx].\n" c c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n x; unfold to_Z.\n"; - fprintf fmt " rewrite znz_to_Z_n.\n"; - fprintf fmt " rewrite <- (Zplus_0_l (znz_to_Z (make_op n) x)).\n"; - fprintf fmt " apply (f_equal2 Zplus); auto.\n"; - fprintf fmt " case n; auto.\n"; - fprintf fmt " intros n1; rewrite make_op_S; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " Hint Rewrite spec_extendn_0: extr.\n"; - fprintf fmt "\n"; - fprintf fmt " Let spec_extend_tr: forall m n (w: word _ (S n)),\n"; - fprintf fmt " [%sn (m + n) (extend_tr w m)] = [%sn n w].\n" c c; - fprintf fmt " Proof.\n"; - fprintf fmt " induction m; auto.\n"; - fprintf fmt " intros n x; simpl extend_tr.\n"; - fprintf fmt " simpl plus; rewrite spec_extendn0_0; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " Hint Rewrite spec_extend_tr: extr.\n"; - fprintf fmt "\n"; - fprintf fmt " Let spec_cast_l: forall n m x1,\n"; - fprintf fmt " [%sn (Max.max n m)\n" c; - fprintf fmt " (castm (diff_r n m) (extend_tr x1 (snd (diff n m))))] =\n"; - fprintf fmt " [%sn n x1].\n" c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n m x1; case (diff_r n m); simpl castm.\n"; - fprintf fmt " rewrite spec_extend_tr; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " Hint Rewrite spec_cast_l: extr.\n"; - fprintf fmt "\n"; - fprintf fmt " Let spec_cast_r: forall n m x1,\n"; - fprintf fmt " [%sn (Max.max n m)\n" c; - fprintf fmt " (castm (diff_l n m) (extend_tr x1 (fst (diff n m))))] =\n"; - fprintf fmt " [%sn m x1].\n" c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n m x1; case (diff_l n m); simpl castm.\n"; - fprintf fmt " rewrite spec_extend_tr; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " Hint Rewrite spec_cast_r: extr.\n"; - fprintf fmt "\n"; - end; - - - fprintf fmt " Section LevelAndIter.\n"; - fprintf fmt "\n"; - fprintf fmt " Variable res: Set.\n"; - fprintf fmt " Variable xxx: res.\n"; - fprintf fmt " Variable P: Z -> Z -> res -> Prop.\n"; - fprintf fmt " (* Abstraction function for each level *)\n"; - for i = 0 to size do - fprintf fmt " Variable f%i: w%i -> w%i -> res.\n" i i i; - fprintf fmt " Variable f%in: forall n, w%i -> word w%i (S n) -> res.\n" i i i; - fprintf fmt " Variable fn%i: forall n, word w%i (S n) -> w%i -> res.\n" i i i; - if gen_proof then - begin - fprintf fmt " Variable Pf%i: forall x y, P [%s%i x] [%s%i y] (f%i x y).\n" i c i c i i; - if i == size then - begin - fprintf fmt " Variable Pf%in: forall n x y, P [%s%i x] (eval%in (S n) y) (f%in n x y).\n" i c i i i; - fprintf fmt " Variable Pfn%i: forall n x y, P (eval%in (S n) x) [%s%i y] (fn%i n x y).\n" i i c i i; - end - else - begin - - fprintf fmt " 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).\n" i (size - i) c i i i; - fprintf fmt " 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).\n" i (size - i) i c i i; - end; - end; - fprintf fmt "\n"; - done; - fprintf fmt " Variable fnn: forall n, word w%i (S n) -> word w%i (S n) -> res.\n" size size; - if gen_proof then - fprintf fmt " Variable Pfnn: forall n x y, P [%sn n x] [%sn n y] (fnn n x y).\n" c c; - fprintf fmt " Variable fnm: forall n m, word w%i (S n) -> word w%i (S m) -> res.\n" size size; - if gen_proof then - fprintf fmt " Variable Pfnm: forall n m x y, P [%sn n x] [%sn m y] (fnm n m x y).\n" c c; - fprintf fmt "\n"; - fprintf fmt " (* Special zero functions *)\n"; - fprintf fmt " Variable f0t: t_ -> res.\n"; - if gen_proof then - fprintf fmt " Variable Pf0t: forall x, P 0 [x] (f0t x).\n"; - fprintf fmt " Variable ft0: t_ -> res.\n"; - if gen_proof then - fprintf fmt " Variable Pft0: forall x, P [x] 0 (ft0 x).\n"; - fprintf fmt "\n"; - - - fprintf fmt " (* We level the two arguments before applying *)\n"; - fprintf fmt " (* the functions at each leval *)\n"; - fprintf fmt " Definition same_level (x y: t_): res :=\n"; - fprintf fmt " Eval lazy zeta beta iota delta ["; - for i = 0 to size do - fprintf fmt "extend%i " i; - done; - fprintf fmt "\n"; - fprintf fmt " GenBase.extend GenBase.extend_aux\n"; - fprintf fmt " ] in\n"; - fprintf fmt " match x, y with\n"; - for i = 0 to size do - for j = 0 to i - 1 do - fprintf fmt " | %s%i wx, %s%i wy => f%i wx (extend%i %i wy)\n" c i c j i j (i - j -1); - done; - fprintf fmt " | %s%i wx, %s%i wy => f%i wx wy\n" c i c i i; - for j = i + 1 to size do - fprintf fmt " | %s%i wx, %s%i wy => f%i (extend%i %i wx) wy\n" c i c j j i (j - i - 1); - done; - if i == size then - fprintf fmt " | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy\n" c size c size - else - fprintf fmt " | %s%i wx, %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy\n" c i c size i (size - i - 1); - done; - for i = 0 to size do - if i == size then - fprintf fmt " | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)\n" c c size size - else - fprintf fmt " | %sn n wx, %s%i wy => fnn n wx (extend%i n (extend%i %i wy))\n" c c i size i (size - i - 1); - done; - fprintf fmt " | %sn n wx, Nn m wy =>\n" c; - fprintf fmt " let mn := Max.max n m in\n"; - fprintf fmt " let d := diff n m in\n"; - fprintf fmt " fnn mn\n"; - fprintf fmt " (castm (diff_r n m) (extend_tr wx (snd d)))\n"; - fprintf fmt " (castm (diff_l n m) (extend_tr wy (fst d)))\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - if gen_proof then - begin - fprintf fmt " Lemma spec_same_level: forall x y, P [x] [y] (same_level x y).\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x; unfold same_level.\n"; - for i = 0 to size do - fprintf fmt " intros x y; case y; clear y.\n"; - for j = 0 to i - 1 do - fprintf fmt " intros y; rewrite spec_extend%in%i; apply Pf%i.\n" j i i; - done; - fprintf fmt " intros y; apply Pf%i.\n" i; - for j = i + 1 to size do - fprintf fmt " intros y; rewrite spec_extend%in%i; apply Pf%i.\n" i j j; - done; - if i == size then - fprintf fmt " intros m y; rewrite (spec_extend%in m); apply Pfnn.\n" size - else - fprintf fmt " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn.\n" i size size; - done; - fprintf fmt " intros n x y; case y; clear y.\n"; - for i = 0 to size do - if i == size then - fprintf fmt " intros y; rewrite (spec_extend%in n); apply Pfnn.\n" size - else - fprintf fmt " intros y; rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn.\n" i size size; - done; - fprintf fmt " intros m y; rewrite <- (spec_cast_l n m x); \n"; - fprintf fmt " rewrite <- (spec_cast_r n m y); apply Pfnn.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " (* We level the two arguments before applying *)\n"; - fprintf fmt " (* the functions at each level (special zero case) *)\n"; - fprintf fmt " Definition same_level0 (x y: t_): res :=\n"; - fprintf fmt " Eval lazy zeta beta iota delta ["; - for i = 0 to size do - fprintf fmt "extend%i " i; - done; - fprintf fmt "\n"; - fprintf fmt " GenBase.extend GenBase.extend_aux\n"; - fprintf fmt " ] in\n"; - fprintf fmt " match x with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wx =>\n" c i; - if (i == 0) then - fprintf fmt " if w0_eq0 wx then f0t y else\n"; - fprintf fmt " match y with\n"; - for j = 0 to i - 1 do - fprintf fmt " | %s%i wy =>\n" c j; - if j == 0 then - fprintf fmt " if w0_eq0 wy then ft0 x else\n"; - fprintf fmt " f%i wx (extend%i %i wy)\n" i j (i - j -1); - done; - fprintf fmt " | %s%i wy => f%i wx wy\n" c i i; - for j = i + 1 to size do - fprintf fmt " | %s%i wy => f%i (extend%i %i wx) wy\n" c j j i (j - i - 1); - done; - if i == size then - fprintf fmt " | %sn m wy => fnn m (extend%i m wx) wy\n" c size - else - fprintf fmt " | %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy\n" c size i (size - i - 1); - fprintf fmt" end\n"; - done; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " match y with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wy =>\n" c i; - if i == 0 then - fprintf fmt " if w0_eq0 wy then ft0 x else\n"; - if i == size then - fprintf fmt " fnn n wx (extend%i n wy)\n" size - else - fprintf fmt " fnn n wx (extend%i n (extend%i %i wy))\n" size i (size - i - 1); - done; - fprintf fmt " | %sn m wy =>\n" c; - fprintf fmt " let mn := Max.max n m in\n"; - fprintf fmt " let d := diff n m in\n"; - fprintf fmt " fnn mn\n"; - fprintf fmt " (castm (diff_r n m) (extend_tr wx (snd d)))\n"; - fprintf fmt " (castm (diff_l n m) (extend_tr wy (fst d)))\n"; - fprintf fmt " end\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Lemma spec_same_level0: forall x y, P [x] [y] (same_level0 x y).\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x; unfold same_level0.\n"; - for i = 0 to size do - fprintf fmt " intros x.\n"; - if i == 0 then - begin - fprintf fmt " generalize (spec_w0_eq0 x); case w0_eq0; intros H.\n"; - fprintf fmt " intros y; rewrite H; apply Pf0t.\n"; - fprintf fmt " clear H.\n"; - end; - fprintf fmt " intros y; case y; clear y.\n"; - for j = 0 to i - 1 do - fprintf fmt " intros y.\n"; - if j == 0 then - begin - fprintf fmt " generalize (spec_w0_eq0 y); case w0_eq0; intros H.\n"; - fprintf fmt " rewrite H; apply Pft0.\n"; - fprintf fmt " clear H.\n"; - end; - fprintf fmt " rewrite spec_extend%in%i; apply Pf%i.\n" j i i; - done; - fprintf fmt " intros y; apply Pf%i.\n" i; - for j = i + 1 to size do - fprintf fmt " intros y; rewrite spec_extend%in%i; apply Pf%i.\n" i j j; - done; - if i == size then - fprintf fmt " intros m y; rewrite (spec_extend%in m); apply Pfnn.\n" size - else - fprintf fmt " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn.\n" i size size; - done; - fprintf fmt " intros n x y; case y; clear y.\n"; - for i = 0 to size do - fprintf fmt " intros y.\n"; - if i = 0 then - begin - fprintf fmt " generalize (spec_w0_eq0 y); case w0_eq0; intros H.\n"; - fprintf fmt " rewrite H; apply Pft0.\n"; - fprintf fmt " clear H.\n"; - end; - if i == size then - fprintf fmt " rewrite (spec_extend%in n); apply Pfnn.\n" size - else - fprintf fmt " rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn.\n" i size size; - done; - fprintf fmt " intros m y; rewrite <- (spec_cast_l n m x); \n"; - fprintf fmt " rewrite <- (spec_cast_r n m y); apply Pfnn.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " (* We iter the smaller argument with the bigger *)\n"; - fprintf fmt " Definition iter (x y: t_): res := \n"; - fprintf fmt " Eval lazy zeta beta iota delta ["; - for i = 0 to size do - fprintf fmt "extend%i " i; - done; - fprintf fmt "\n"; - fprintf fmt " GenBase.extend GenBase.extend_aux\n"; - fprintf fmt " ] in\n"; - fprintf fmt " match x, y with\n"; - for i = 0 to size do - for j = 0 to i - 1 do - fprintf fmt " | %s%i wx, %s%i wy => fn%i %i wx wy\n" c i c j j (i - j - 1); - done; - fprintf fmt " | %s%i wx, %s%i wy => f%i wx wy\n" c i c i i; - for j = i + 1 to size do - fprintf fmt " | %s%i wx, %s%i wy => f%in %i wx wy\n" c i c j i (j - i - 1); - done; - if i == size then - fprintf fmt " | %s%i wx, %sn m wy => f%in m wx wy\n" c size c size - else - fprintf fmt " | %s%i wx, %sn m wy => f%in m (extend%i %i wx) wy\n" c i c size i (size - i - 1); - done; - for i = 0 to size do - if i == size then - fprintf fmt " | %sn n wx, %s%i wy => fn%i n wx wy\n" c c size size - else - fprintf fmt " | %sn n wx, %s%i wy => fn%i n wx (extend%i %i wy)\n" c c i size i (size - i - 1); - done; - fprintf fmt " | %sn n wx, %sn m wy => fnm n m wx wy\n" c c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Ltac zg_tac := try\n"; - fprintf fmt " (red; simpl Zcompare; auto;\n"; - fprintf fmt " let t := fresh \"H\" in (intros t; discriminate H)).\n"; - fprintf fmt " Lemma spec_iter: forall x y, P [x] [y] (iter x y).\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x; unfold iter.\n"; - for i = 0 to size do - fprintf fmt " intros x y; case y; clear y.\n"; - for j = 0 to i - 1 do - fprintf fmt " intros y; rewrite spec_eval%in%i; apply (Pfn%i %i); zg_tac.\n" j (i - j) j (i - j - 1); - done; - fprintf fmt " intros y; apply Pf%i.\n" i; - for j = i + 1 to size do - fprintf fmt " intros y; rewrite spec_eval%in%i; apply (Pf%in %i); zg_tac.\n" i (j - i) i (j - i - 1); - done; - if i == size then - fprintf fmt " intros m y; rewrite spec_eval%in; apply Pf%in.\n" size size - else - fprintf fmt " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in.\n" i size size size; - done; - fprintf fmt " intros n x y; case y; clear y.\n"; - for i = 0 to size do - if i == size then - fprintf fmt " intros y; rewrite spec_eval%in; apply Pfn%i.\n" size size - else - fprintf fmt " intros y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i.\n" i size size size; - done; - fprintf fmt " intros m y; apply Pfnm.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - - fprintf fmt " (* We iter the smaller argument with the bigger (zero case) *)\n"; - fprintf fmt " Definition iter0 (x y: t_): res :=\n"; - fprintf fmt " Eval lazy zeta beta iota delta ["; - for i = 0 to size do - fprintf fmt "extend%i " i; - done; - fprintf fmt "\n"; - fprintf fmt " GenBase.extend GenBase.extend_aux\n"; - fprintf fmt " ] in\n"; - fprintf fmt " match x with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wx =>\n" c i; - if (i == 0) then - fprintf fmt " if w0_eq0 wx then f0t y else\n"; - fprintf fmt " match y with\n"; - for j = 0 to i - 1 do - fprintf fmt " | %s%i wy =>\n" c j; - if j == 0 then - fprintf fmt " if w0_eq0 wy then ft0 x else\n"; - fprintf fmt " fn%i %i wx wy\n" j (i - j - 1); - done; - fprintf fmt " | %s%i wy => f%i wx wy\n" c i i; - for j = i + 1 to size do - fprintf fmt " | %s%i wy => f%in %i wx wy\n" c j i (j - i - 1); - done; - if i == size then - fprintf fmt " | %sn m wy => f%in m wx wy\n" c size - else - fprintf fmt " | %sn m wy => f%in m (extend%i %i wx) wy\n" c size i (size - i - 1); - fprintf fmt " end\n"; - done; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " match y with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wy =>\n" c i; - if i == 0 then - fprintf fmt " if w0_eq0 wy then ft0 x else\n"; - if i == size then - fprintf fmt " fn%i n wx wy\n" size - else - fprintf fmt " fn%i n wx (extend%i %i wy)\n" size i (size - i - 1); - done; - fprintf fmt " | %sn m wy => fnm n m wx wy\n" c; - fprintf fmt " end\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Lemma spec_iter0: forall x y, P [x] [y] (iter0 x y).\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x; unfold iter0.\n"; - for i = 0 to size do - fprintf fmt " intros x.\n"; - if i == 0 then - begin - fprintf fmt " generalize (spec_w0_eq0 x); case w0_eq0; intros H.\n"; - fprintf fmt " intros y; rewrite H; apply Pf0t.\n"; - fprintf fmt " clear H.\n"; - end; - fprintf fmt " intros y; case y; clear y.\n"; - for j = 0 to i - 1 do - fprintf fmt " intros y.\n"; - if j == 0 then - begin - fprintf fmt " generalize (spec_w0_eq0 y); case w0_eq0; intros H.\n"; - fprintf fmt " rewrite H; apply Pft0.\n"; - fprintf fmt " clear H.\n"; - end; - fprintf fmt " rewrite spec_eval%in%i; apply (Pfn%i %i); zg_tac.\n" j (i - j) j (i - j - 1); - done; - fprintf fmt " intros y; apply Pf%i.\n" i; - for j = i + 1 to size do - fprintf fmt " intros y; rewrite spec_eval%in%i; apply (Pf%in %i); zg_tac.\n" i (j - i) i (j - i - 1); - done; - if i == size then - fprintf fmt " intros m y; rewrite spec_eval%in; apply Pf%in.\n" size size - else - fprintf fmt " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in.\n" i size size size; - done; - fprintf fmt " intros n x y; case y; clear y.\n"; - for i = 0 to size do - fprintf fmt " intros y.\n"; - if i = 0 then - begin - fprintf fmt " generalize (spec_w0_eq0 y); case w0_eq0; intros H.\n"; - fprintf fmt " rewrite H; apply Pft0.\n"; - fprintf fmt " clear H.\n"; - end; - if i == size then - fprintf fmt " rewrite spec_eval%in; apply Pfn%i.\n" size size - else - fprintf fmt " rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i.\n" i size size size; - done; - fprintf fmt " intros m y; apply Pfnm.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - - fprintf fmt " End LevelAndIter.\n"; - fprintf fmt "\n"; - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Reduction *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - fprintf fmt " Definition reduce_0 (x:w) := %s0 x.\n" c; - fprintf fmt " Definition reduce_1 :=\n"; - fprintf fmt " Eval lazy beta iota delta[reduce_n1] in\n"; - fprintf fmt " reduce_n1 _ _ zero w0_eq0 %s0 %s1.\n" c c; - for i = 2 to size do - fprintf fmt " Definition reduce_%i :=\n" i; - fprintf fmt " Eval lazy beta iota delta[reduce_n1] in\n"; - fprintf fmt " reduce_n1 _ _ zero w%i_eq0 reduce_%i %s%i.\n" - (i-1) (i-1) c i - done; - fprintf fmt " Definition reduce_%i :=\n" (size+1); - fprintf fmt " Eval lazy beta iota delta[reduce_n1] in\n"; - fprintf fmt " reduce_n1 _ _ zero w%i_eq0 reduce_%i (%sn 0).\n" - size size c; - - fprintf fmt " Definition reduce_n n := \n"; - fprintf fmt " Eval lazy beta iota delta[reduce_n] in\n"; - fprintf fmt " reduce_n _ _ zero reduce_%i %sn n.\n" (size + 1) c; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Let spec_reduce_0: forall x, [reduce_0 x] = [%s0 x].\n" c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; unfold to_Z, reduce_0.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " \n"; - - for i = 1 to size + 1 do - if (i == size + 1) then - fprintf fmt " Let spec_reduce_%i: forall x, [reduce_%i x] = [%sn 0 x].\n" i i c - else - fprintf fmt " Let spec_reduce_%i: forall x, [reduce_%i x] = [%s%i x].\n" i i c i; - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold reduce_%i.\n" i; - fprintf fmt " exact (spec_0 w0_spec).\n"; - fprintf fmt " intros x1 y1.\n"; - fprintf fmt " generalize (spec_w%i_eq0 x1); \n" (i - 1); - fprintf fmt " case w%i_eq0; intros H1; auto.\n" (i - 1); - if i <> 1 then - fprintf fmt " rewrite spec_reduce_%i.\n" (i - 1); - fprintf fmt " unfold to_Z; rewrite znz_to_Z_%i.\n" i; - fprintf fmt " unfold to_Z in H1; rewrite H1; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " \n"; - done; - - fprintf fmt " Let spec_reduce_n: forall n x, [reduce_n n x] = [%sn n x].\n" c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n; elim n; simpl reduce_n.\n"; - fprintf fmt " intros x; rewrite <- spec_reduce_%i; auto.\n" (size + 1); - fprintf fmt " intros n1 Hrec x; case x.\n"; - fprintf fmt " unfold to_Z; rewrite make_op_S; auto.\n"; - fprintf fmt " exact (spec_0 w0_spec).\n"; - fprintf fmt " intros x1 y1; case x1; auto.\n"; - fprintf fmt " rewrite Hrec.\n"; - fprintf fmt " rewrite spec_extendn0_0; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " \n"; - end; - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Successor *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_succ_c := w%i_op.(znz_succ_c).\n" i i - done; - fprintf fmt "\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_succ := w%i_op.(znz_succ).\n" i i - done; - fprintf fmt "\n"; - - fprintf fmt " Definition succ x :=\n"; - fprintf fmt " match x with\n"; - for i = 0 to size-1 do - fprintf fmt " | %s%i wx =>\n" c i; - fprintf fmt " match w%i_succ_c wx with\n" i; - fprintf fmt " | C0 r => %s%i r\n" c i; - fprintf fmt " | C1 r => %s%i (WW one%i r)\n" c (i+1) i; - fprintf fmt " end\n"; - done; - fprintf fmt " | %s%i wx =>\n" c size; - fprintf fmt " match w%i_succ_c wx with\n" size; - fprintf fmt " | C0 r => %s%i r\n" c size; - fprintf fmt " | C1 r => %sn 0 (WW one%i r)\n" c size ; - fprintf fmt " end\n"; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " let op := make_op n in\n"; - fprintf fmt " match op.(znz_succ_c) wx with\n"; - fprintf fmt " | C0 r => %sn n r\n" c; - fprintf fmt " | C1 r => %sn (S n) (WW op.(znz_1) r)\n" c; - fprintf fmt " end\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_succ: forall n, [succ n] = [n] + 1.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros n; case n; unfold succ, to_Z.\n"; - for i = 0 to size do - fprintf fmt " intros n1; generalize (spec_succ_c w%i_spec n1);\n" i; - fprintf fmt " unfold succ, to_Z, w%i_succ_c; case znz_succ_c; auto.\n" i; - fprintf fmt " intros ww H; rewrite <- H.\n"; - fprintf fmt " (rewrite znz_to_Z_%i; unfold interp_carry;\n" (i + 1); - fprintf fmt " apply f_equal2 with (f := Zplus); auto;\n"; - fprintf fmt " apply f_equal2 with (f := Zmult); auto;\n"; - fprintf fmt " exact (spec_1 w%i_spec)).\n" i; - done; - fprintf fmt " intros k n1; generalize (spec_succ_c (wn_spec k) n1).\n"; - fprintf fmt " unfold succ, to_Z; case znz_succ_c; auto.\n"; - fprintf fmt " intros ww H; rewrite <- H.\n"; - fprintf fmt " (rewrite (znz_to_Z_n k); unfold interp_carry;\n"; - fprintf fmt " apply f_equal2 with (f := Zplus); auto;\n"; - fprintf fmt " apply f_equal2 with (f := Zmult); auto;\n"; - fprintf fmt " exact (spec_1 (wn_spec k))).\n"; - fprintf fmt " Qed.\n"; - end - else fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Adddition *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - for i = 0 to size do - fprintf fmt " Definition w%i_add_c := znz_add_c w%i_op.\n" i i; - fprintf fmt " Definition w%i_add x y :=\n" i; - fprintf fmt " match w%i_add_c x y with\n" i; - fprintf fmt " | C0 r => %s%i r\n" c i; - if i == size then - fprintf fmt " | C1 r => %sn 0 (WW one%i r)\n" c size - else - fprintf fmt " | C1 r => %s%i (WW one%i r)\n" c (i + 1) i; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - done ; - fprintf fmt " Definition addn n (x y : word w%i (S n)) :=\n" size; - fprintf fmt " let op := make_op n in\n"; - fprintf fmt " match op.(znz_add_c) x y with\n"; - fprintf fmt " | C0 r => %sn n r\n" c; - fprintf fmt " | C1 r => %sn (S n) (WW op.(znz_1) r) end.\n" c; - fprintf fmt "\n"; - - - if gen_proof then - begin - for i = 0 to size do - fprintf fmt " Let spec_w%i_add: forall x y, [w%i_add x y] = [%s%i x] + [%s%i y].\n" i i c i c i; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n m; unfold to_Z, w%i_add, w%i_add_c.\n" i i; - fprintf fmt " generalize (spec_add_c w%i_spec n m); case znz_add_c; auto.\n" i; - fprintf fmt " intros ww H; rewrite <- H.\n"; - fprintf fmt " rewrite znz_to_Z_%i; unfold interp_carry;\n" (i + 1); - fprintf fmt " apply f_equal2 with (f := Zplus); auto;\n"; - fprintf fmt " apply f_equal2 with (f := Zmult); auto;\n"; - fprintf fmt " exact (spec_1 w%i_spec).\n" i; - fprintf fmt " Qed.\n"; - fprintf fmt " Hint Rewrite spec_w%i_add: addr.\n" i; - fprintf fmt "\n"; - done; - fprintf fmt " Let spec_wn_add: forall n x y, [addn n x y] = [%sn n x] + [%sn n y].\n" c c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros k n m; unfold to_Z, addn.\n"; - fprintf fmt " generalize (spec_add_c (wn_spec k) n m); case znz_add_c; auto.\n"; - fprintf fmt " intros ww H; rewrite <- H.\n"; - fprintf fmt " rewrite (znz_to_Z_n k); unfold interp_carry;\n"; - fprintf fmt " apply f_equal2 with (f := Zplus); auto;\n"; - fprintf fmt " apply f_equal2 with (f := Zmult); auto;\n"; - fprintf fmt " exact (spec_1 (wn_spec k)).\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " Hint Rewrite spec_wn_add: addr.\n"; - end; - - fprintf fmt " Definition add := Eval lazy beta delta [same_level] in\n"; - fprintf fmt " (same_level t_ "; - for i = 0 to size do - fprintf fmt "w%i_add " i; - done; - fprintf fmt "addn).\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_add: forall x y, [add x y] = [x] + [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " unfold add.\n"; - fprintf fmt " generalize (spec_same_level t_ (fun x y res => [res] = x + y)).\n"; - fprintf fmt " unfold same_level; intros HH; apply HH; clear HH.\n"; - for i = 0 to size do - fprintf fmt " exact spec_w%i_add.\n" i; - done; - fprintf fmt " exact spec_wn_add.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Predecessor *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_pred_c := w%i_op.(znz_pred_c).\n" i i - done; - fprintf fmt "\n"; - - fprintf fmt " Definition pred x :=\n"; - fprintf fmt " match x with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wx =>\n" c i; - fprintf fmt " match w%i_pred_c wx with\n" i; - fprintf fmt " | C0 r => reduce_%i r\n" i; - fprintf fmt " | C1 r => zero\n"; - fprintf fmt " end\n"; - done; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " let op := make_op n in\n"; - fprintf fmt " match op.(znz_pred_c) wx with\n"; - fprintf fmt " | C0 r => reduce_n n r\n"; - fprintf fmt " | C1 r => zero\n"; - fprintf fmt " end\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold pred.\n"; - for i = 0 to size do - fprintf fmt " intros x1 H1; unfold w%i_pred_c; \n" i; - fprintf fmt " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1.\n" i; - fprintf fmt " rewrite spec_reduce_%i; auto.\n" i; - fprintf fmt " unfold interp_carry; unfold to_Z.\n"; - fprintf fmt " case (spec_to_Z w%i_spec x1); intros HH1 HH2.\n" i; - fprintf fmt " case (spec_to_Z w%i_spec y1); intros HH3 HH4 HH5.\n" i; - fprintf fmt " assert (znz_to_Z w%i_op x1 - 1 < 0); auto with zarith.\n" i; - fprintf fmt " unfold to_Z in H1; auto with zarith.\n"; - done; - fprintf fmt " intros n x1 H1; \n"; - fprintf fmt " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1.\n"; - fprintf fmt " rewrite spec_reduce_n; auto.\n"; - fprintf fmt " unfold interp_carry; unfold to_Z.\n"; - fprintf fmt " case (spec_to_Z (wn_spec n) x1); intros HH1 HH2.\n"; - fprintf fmt " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4 HH5.\n"; - fprintf fmt " assert (znz_to_Z (make_op n) x1 - 1 < 0); auto with zarith.\n"; - fprintf fmt " unfold to_Z in H1; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt " \n"; - - fprintf fmt " Let spec_pred0: forall x, [x] = 0 -> [pred x] = 0.\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold pred.\n"; - for i = 0 to size do - fprintf fmt " intros x1 H1; unfold w%i_pred_c; \n" i; - fprintf fmt " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1.\n" i; - fprintf fmt " unfold interp_carry; unfold to_Z.\n"; - fprintf fmt " unfold to_Z in H1; auto with zarith.\n"; - fprintf fmt " case (spec_to_Z w%i_spec y1); intros HH3 HH4; auto with zarith.\n" i; - fprintf fmt " intros; exact (spec_0 w0_spec).\n"; - done; - fprintf fmt " intros n x1 H1; \n"; - fprintf fmt " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1.\n"; - fprintf fmt " unfold interp_carry; unfold to_Z.\n"; - fprintf fmt " unfold to_Z in H1; auto with zarith.\n"; - fprintf fmt " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4; auto with zarith.\n"; - fprintf fmt " intros; exact (spec_0 w0_spec).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt " \n"; - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Subtraction *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_sub_c := w%i_op.(znz_sub_c).\n" i i - done; - fprintf fmt "\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_sub x y :=\n" i; - fprintf fmt " match w%i_sub_c x y with\n" i; - fprintf fmt " | C0 r => reduce_%i r\n" i; - fprintf fmt " | C1 r => zero\n"; - fprintf fmt " end.\n" - done; - fprintf fmt "\n"; - - fprintf fmt " Definition subn n (x y : word w%i (S n)) :=\n" size; - fprintf fmt " let op := make_op n in\n"; - fprintf fmt " match op.(znz_sub_c) x y with\n"; - fprintf fmt " | C0 r => %sn n r\n" c; - fprintf fmt " | C1 r => N0 w_0"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - for i = 0 to size do - fprintf fmt " 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].\n" i c i c i i c i c i; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n m; unfold w%i_sub, w%i_sub_c.\n" i i; - fprintf fmt " generalize (spec_sub_c w%i_spec n m); case znz_sub_c; \n" i; - if i == 0 then - fprintf fmt " intros x; auto.\n" - else - fprintf fmt " intros x; try rewrite spec_reduce_%i; auto.\n" i; - fprintf fmt " unfold interp_carry; unfold zero, w_0, to_Z.\n"; - fprintf fmt " rewrite (spec_0 w0_spec).\n"; - fprintf fmt " case (spec_to_Z w%i_spec x); intros; auto with zarith.\n" i; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - done; - - fprintf fmt " Let spec_wn_sub: forall n x y, [%sn n y] <= [%sn n x] -> [subn n x y] = [%sn n x] - [%sn n y].\n" c c c c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros k n m; unfold subn.\n"; - fprintf fmt " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; \n"; - fprintf fmt " intros x; auto.\n"; - fprintf fmt " unfold interp_carry, to_Z.\n"; - fprintf fmt " case (spec_to_Z (wn_spec k) x); intros; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " Definition sub := Eval lazy beta delta [same_level] in\n"; - fprintf fmt " (same_level t_ "; - for i = 0 to size do - fprintf fmt "w%i_sub " i; - done; - fprintf fmt "subn).\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_sub: forall x y, [y] <= [x] -> [sub x y] = [x] - [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " unfold sub.\n"; - fprintf fmt " generalize (spec_same_level t_ (fun x y res => y <= x -> [res] = x - y)).\n"; - fprintf fmt " unfold same_level; intros HH; apply HH; clear HH.\n"; - for i = 0 to size do - fprintf fmt " exact spec_w%i_sub.\n" i; - done; - fprintf fmt " exact spec_wn_sub.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - for i = 0 to size do - fprintf fmt " Let spec_w%i_sub0: forall x y, [%s%i x] < [%s%i y] -> [w%i_sub x y] = 0.\n" i c i c i i; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n m; unfold w%i_sub, w%i_sub_c.\n" i i; - fprintf fmt " generalize (spec_sub_c w%i_spec n m); case znz_sub_c; \n" i; - fprintf fmt " intros x; unfold interp_carry.\n"; - fprintf fmt " unfold to_Z; case (spec_to_Z w%i_spec x); intros; auto with zarith.\n" i; - fprintf fmt " intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - done; - - fprintf fmt " Let spec_wn_sub0: forall n x y, [%sn n x] < [%sn n y] -> [subn n x y] = 0.\n" c c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros k n m; unfold subn.\n"; - fprintf fmt " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; \n"; - fprintf fmt " intros x; unfold interp_carry.\n"; - fprintf fmt " unfold to_Z; case (spec_to_Z (wn_spec k) x); intros; auto with zarith.\n"; - fprintf fmt " intros; unfold to_Z, w_0; rewrite (spec_0 (w0_spec)); auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " Theorem spec_sub0: forall x y, [x] < [y] -> [sub x y] = 0.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " unfold sub.\n"; - fprintf fmt " generalize (spec_same_level t_ (fun x y res => x < y -> [res] = 0)).\n"; - fprintf fmt " unfold same_level; intros HH; apply HH; clear HH.\n"; - for i = 0 to size do - fprintf fmt " exact spec_w%i_sub0.\n" i; - done; - fprintf fmt " exact spec_wn_sub0.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Comparison *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - for i = 0 to size do - fprintf fmt " Definition compare_%i := w%i_op.(znz_compare).\n" i i; - fprintf fmt " Definition comparen_%i :=\n" i; - let s0 = if i = 0 then "w_0" else "W0" in - fprintf fmt - " compare_mn_1 w%i w%i %s compare_%i (compare_%i %s) compare_%i.\n" - i i s0 i i s0 i - done; - fprintf fmt "\n"; - - fprintf fmt " Definition comparenm n m wx wy :=\n"; - fprintf fmt " let mn := Max.max n m in\n"; - fprintf fmt " let d := diff n m in\n"; - fprintf fmt " let op := make_op mn in\n"; - fprintf fmt " op.(znz_compare)\n"; - fprintf fmt " (castm (diff_r n m) (extend_tr wx (snd d)))\n"; - fprintf fmt " (castm (diff_l n m) (extend_tr wy (fst d))).\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition compare := Eval lazy beta delta [iter] in \n"; - fprintf fmt " (iter _ \n"; - for i = 0 to size do - fprintf fmt " compare_%i\n" i; - fprintf fmt " (fun n x y => opp_compare (comparen_%i (S n) y x))\n" i; - fprintf fmt " (fun n => comparen_%i (S n))\n" i; - done; - fprintf fmt " comparenm).\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - for i = 0 to size do - fprintf fmt " Let spec_compare_%i: forall x y,\n" i; - fprintf fmt " match compare_%i x y with \n" i; - fprintf fmt " Eq => [%s%i x] = [%s%i y]\n" c i c i; - fprintf fmt " | Lt => [%s%i x] < [%s%i y]\n" c i c i; - fprintf fmt " | Gt => [%s%i x] > [%s%i y]\n" c i c i; - fprintf fmt " end.\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " unfold compare_%i, to_Z; exact (spec_compare w%i_spec).\n" i i; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Let spec_comparen_%i:\n" i; - fprintf fmt " forall (n : nat) (x : word w%i n) (y : w%i),\n" i i; - fprintf fmt " match comparen_%i n x y with\n" i; - fprintf fmt " | Eq => eval%in n x = [%s%i y]\n" i c i; - fprintf fmt " | Lt => eval%in n x < [%s%i y]\n" i c i; - fprintf fmt " | Gt => eval%in n x > [%s%i y]\n" i c i; - fprintf fmt " end.\n"; - fprintf fmt " intros n x y.\n"; - fprintf fmt " unfold comparen_%i, to_Z; rewrite spec_gen_eval%in.\n" i i; - fprintf fmt " apply spec_compare_mn_1.\n"; - fprintf fmt " exact (spec_0 w%i_spec).\n" i; - if i == 0 then - fprintf fmt " intros x1; exact (spec_compare w%i_spec w_0 x1).\n" i - else - fprintf fmt " intros x1; exact (spec_compare w%i_spec W0 x1).\n" i; - fprintf fmt " exact (spec_to_Z w%i_spec).\n" i; - fprintf fmt " exact (spec_compare w%i_spec).\n" i; - fprintf fmt " exact (spec_compare w%i_spec).\n" i; - fprintf fmt " exact (spec_to_Z w%i_spec).\n" i; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - done; - - fprintf fmt " Let spec_opp_compare: forall c (u v: Z),\n"; - fprintf fmt " match c with Eq => u = v | Lt => u < v | Gt => u > v end ->\n"; - fprintf fmt " match opp_compare c with Eq => v = u | Lt => v < u | Gt => v > u end.\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros c u v; case c; unfold opp_compare; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " Theorem spec_compare: forall x y,\n"; - fprintf fmt " match compare x y with \n"; - fprintf fmt " Eq => [x] = [y]\n"; - fprintf fmt " | Lt => [x] < [y]\n"; - fprintf fmt " | Gt => [x] > [y]\n"; - fprintf fmt " end.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " refine (spec_iter _ (fun x y res => \n"; - fprintf fmt " match res with \n"; - fprintf fmt " Eq => x = y\n"; - fprintf fmt " | Lt => x < y\n"; - fprintf fmt " | Gt => x > y\n"; - fprintf fmt " end)\n"; - for i = 0 to size do - fprintf fmt " compare_%i\n" i; - fprintf fmt " (fun n x y => opp_compare (comparen_%i (S n) y x))\n" i; - fprintf fmt " (fun n => comparen_%i (S n)) _ _ _\n" i; - done; - fprintf fmt " comparenm _).\n"; - - for i = 0 to size - 1 do - fprintf fmt " exact spec_compare_%i.\n" i; - fprintf fmt " intros n x y H;apply spec_opp_compare; apply spec_comparen_%i.\n" i; - fprintf fmt " intros n x y H; exact (spec_comparen_%i (S n) x y).\n" i; - done; - fprintf fmt " exact spec_compare_%i.\n" size; - fprintf fmt " intros n x y;apply spec_opp_compare; apply spec_comparen_%i.\n" size; - fprintf fmt " intros n; exact (spec_comparen_%i (S n)).\n" size; - fprintf fmt " intros n m x y; unfold comparenm.\n"; - fprintf fmt " rewrite <- (spec_cast_l n m x); rewrite <- (spec_cast_r n m y).\n"; - fprintf fmt " unfold to_Z; apply (spec_compare (wn_spec (Max.max n m))).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition eq_bool x y :=\n"; - fprintf fmt " match compare x y with\n"; - fprintf fmt " | Eq => true\n"; - fprintf fmt " | _ => false\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_eq_bool: forall x y,\n"; - fprintf fmt " if eq_bool x y then [x] = [y] else [x] <> [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x y; unfold eq_bool.\n"; - fprintf fmt " generalize (spec_compare x y); case compare; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Multiplication *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - for i = 0 to size do - fprintf fmt " Definition w%i_mul_c := w%i_op.(znz_mul_c).\n" i i - done; - fprintf fmt "\n"; - - for i = 0 to size do - let s0 = if i = 0 then "w_0" else "W0" in - fprintf fmt " Definition w%i_mul_add :=\n" i; - fprintf fmt " Eval lazy beta delta [w_mul_add] in\n"; - fprintf fmt " %sw_mul_add w%i %s w%i_succ w%i_add_c w%i_mul_c.\n" - "@" i s0 i i i - done; - fprintf fmt "\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_0W := w%i_op.(znz_0W).\n" i i - done; - fprintf fmt "\n"; - - for i = 0 to size do - let s0 = if i = 0 then "w_0" else "W0" in - fprintf fmt " Definition w%i_mul_add_n1 :=\n" i; - fprintf fmt - " %sgen_mul_add_n1 w%i %s w%i_op.(znz_WW) w%i_0W w%i_mul_add.\n" - "@" i s0 i i i - done; - fprintf fmt "\n"; - - begin - for i = 0 to size - 1 do - fprintf fmt " Let to_Z%i n :=\n" i; - fprintf fmt " match n return word w%i (S n) -> t_ with\n" i; - for j = 0 to size - i do - if (i + j) == size then - begin - fprintf fmt " | %i%s => fun x => %sn 0 x\n" j "%nat" c; - fprintf fmt " | %i%s => fun x => %sn 1 x\n" (j + 1) "%nat" c - end - else - fprintf fmt " | %i%s => fun x => %s%i x\n" j "%nat" c (i + j + 1) - done; - fprintf fmt " | _ => fun _ => N0 w_0\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - done; - - - if gen_proof then - for i = 0 to size - 1 do - fprintf fmt "Theorem to_Z%i_spec:\n" i; - fprintf fmt " forall n x, Z_of_nat n <= %i -> [to_Z%i n x] = znz_to_Z (nmake_op _ w%i_op (S n)) x.\n" (size + 1 - i) i i; - for j = 1 to size + 2 - i do - fprintf fmt " intros n; case n; clear n.\n"; - fprintf fmt " unfold to_Z%i.\n" i; - fprintf fmt " intros x H; rewrite spec_eval%in%i; auto.\n" i j; - done; - fprintf fmt " intros n x.\n"; - fprintf fmt " repeat rewrite inj_S; unfold Zsucc; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - done; - end; - - for i = 0 to size do - fprintf fmt " Definition w%i_mul n x y :=\n" i; - if i == 0 then - fprintf fmt " let (w,r) := w%i_mul_add_n1 (S n) x y w_0 in\n" i - else - fprintf fmt " let (w,r) := w%i_mul_add_n1 (S n) x y W0 in\n" i; - if i == size then - begin - fprintf fmt " if w%i_eq0 w then %sn n r\n" i c; - fprintf fmt " else %sn (S n) (WW (extend%i n w) r).\n" c i; - end - else - begin - fprintf fmt " if w%i_eq0 w then to_Z%i n r\n" i i; - fprintf fmt " else to_Z%i (S n) (WW (extend%i n w) r).\n" i i; - end; - fprintf fmt "\n"; - done; - - fprintf fmt " Definition mulnm n m x y :=\n"; - fprintf fmt " let mn := Max.max n m in\n"; - fprintf fmt " let d := diff n m in\n"; - fprintf fmt " let op := make_op mn in\n"; - fprintf fmt " reduce_n (S mn) (op.(znz_mul_c)\n"; - fprintf fmt " (castm (diff_r n m) (extend_tr x (snd d)))\n"; - fprintf fmt " (castm (diff_l n m) (extend_tr y (fst d)))).\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition mul := Eval lazy beta delta [iter0] in \n"; - fprintf fmt " (iter0 t_ \n"; - for i = 0 to size do - fprintf fmt " (fun x y => reduce_%i (w%i_mul_c x y)) \n" (i + 1) i; - fprintf fmt " (fun n x y => w%i_mul n y x)\n" i; - fprintf fmt " w%i_mul\n" i; - done; - fprintf fmt " mulnm\n"; - fprintf fmt " (fun _ => N0 w_0)\n"; - fprintf fmt " (fun _ => N0 w_0)\n"; - fprintf fmt " ).\n"; - fprintf fmt "\n"; - if gen_proof then - begin - for i = 0 to size do - fprintf fmt " Let spec_w%i_mul_add: forall x y z,\n" i; - fprintf fmt " let (q,r) := w%i_mul_add x y z in\n" i; - fprintf fmt " znz_to_Z w%i_op q * (base (znz_digits w%i_op)) + znz_to_Z w%i_op r =\n" i i i; - fprintf fmt " znz_to_Z w%i_op x * znz_to_Z w%i_op y + znz_to_Z w%i_op z :=\n" i i i ; - fprintf fmt " (spec_mul_add w%i_spec).\n" i; - fprintf fmt "\n"; - done; - - for i = 0 to size do - - - fprintf fmt " Theorem spec_w%i_mul_add_n1: forall n x y z,\n" i; - fprintf fmt " let (q,r) := w%i_mul_add_n1 n x y z in\n" i; - fprintf fmt " znz_to_Z w%i_op q * (base (znz_digits (nmake_op _ w%i_op n))) +\n" i i; - fprintf fmt " znz_to_Z (nmake_op _ w%i_op n) r =\n" i; - fprintf fmt " znz_to_Z (nmake_op _ w%i_op n) x * znz_to_Z w%i_op y +\n" i i; - fprintf fmt " znz_to_Z w%i_op z.\n" i; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n x y z; unfold w%i_mul_add_n1.\n" i; - fprintf fmt " rewrite nmake_gen.\n"; - fprintf fmt " rewrite digits_gend.\n"; - fprintf fmt " change (base (GenBase.gen_digits (znz_digits w%i_op) n)) with\n" i; - fprintf fmt " (GenBase.gen_wB (znz_digits w%i_op) n).\n" i; - fprintf fmt " apply spec_gen_mul_add_n1; auto.\n"; - if i == 0 then fprintf fmt " exact (spec_0 w%i_spec).\n" i; - fprintf fmt " exact (spec_WW w%i_spec).\n" i; - fprintf fmt " exact (spec_0W w%i_spec).\n" i; - fprintf fmt " exact (spec_mul_add w%i_spec).\n" i; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - done; - - fprintf fmt " Lemma nmake_op_WW: forall ww ww1 n x y,\n"; - fprintf fmt " znz_to_Z (nmake_op ww ww1 (S n)) (WW x y) =\n"; - fprintf fmt " znz_to_Z (nmake_op ww ww1 n) x * base (znz_digits (nmake_op ww ww1 n)) +\n"; - fprintf fmt " znz_to_Z (nmake_op ww ww1 n) y.\n"; - fprintf fmt " auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - for i = 0 to size do - fprintf fmt " Lemma extend%in_spec: forall n x1,\n" i; - fprintf fmt " znz_to_Z (nmake_op _ w%i_op (S n)) (extend%i n x1) = \n" i i; - fprintf fmt " znz_to_Z w%i_op x1.\n" i; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n1 x2; rewrite nmake_gen.\n"; - fprintf fmt " unfold extend%i.\n" i; - fprintf fmt " rewrite GenBase.spec_extend; auto.\n"; - if (i == 0) then - fprintf fmt " intros l; simpl; unfold w_0; rewrite (spec_0 w0_spec); ring.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - done; - - fprintf fmt " Lemma spec_muln:\n"; - fprintf fmt " forall n (x: word _ (S n)) y,\n"; - fprintf fmt " [%sn (S n) (znz_mul_c (make_op n) x y)] = [%sn n x] * [%sn n y].\n" c c c; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n x y; unfold to_Z.\n"; - fprintf fmt " rewrite <- (spec_mul_c (wn_spec n)).\n"; - fprintf fmt " rewrite make_op_S.\n"; - fprintf fmt " case znz_mul_c; auto.\n"; - fprintf fmt " Qed.\n"; - end; - - fprintf fmt " Theorem spec_mul: forall x y, [mul x y] = [x] * [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - for i = 0 to size do - fprintf fmt " assert(F%i: \n" i; - fprintf fmt " forall n x y,\n"; - if i <> size then - fprintf fmt " Z_of_nat n <= %i -> " (size - i); - fprintf fmt " [w%i_mul n x y] = eval%in (S n) x * [%s%i y]).\n" i i c i; - if i == size then - fprintf fmt " intros n x y; unfold w%i_mul.\n" i - else - fprintf fmt " intros n x y H; unfold w%i_mul.\n" i; - if i == 0 then - fprintf fmt " generalize (spec_w%i_mul_add_n1 (S n) x y w_0).\n" i - else - fprintf fmt " generalize (spec_w%i_mul_add_n1 (S n) x y W0).\n" i; - fprintf fmt " case w%i_mul_add_n1; intros x1 y1.\n" i; - fprintf fmt " change (znz_to_Z (nmake_op _ w%i_op (S n)) x) with (eval%in (S n) x).\n" i i; - fprintf fmt " change (znz_to_Z w%i_op y) with ([%s%i y]).\n" i c i; - if i == 0 then - fprintf fmt " unfold w_0; rewrite (spec_0 w0_spec); rewrite Zplus_0_r.\n" - else - fprintf fmt " change (znz_to_Z w%i_op W0) with 0; rewrite Zplus_0_r.\n" i; - fprintf fmt " intros H1; rewrite <- H1; clear H1.\n"; - fprintf fmt " generalize (spec_w%i_eq0 x1); case w%i_eq0; intros HH.\n" i i; - fprintf fmt " unfold to_Z in HH; rewrite HH.\n"; - if i == size then - begin - fprintf fmt " rewrite spec_eval%in; unfold eval%in, nmake_op%i; auto.\n" i i i; - fprintf fmt " rewrite spec_eval%in; unfold eval%in, nmake_op%i.\n" i i i - end - else - begin - fprintf fmt " rewrite to_Z%i_spec; auto with zarith.\n" i; - fprintf fmt " rewrite to_Z%i_spec; try (rewrite inj_S; auto with zarith).\n" i - end; - fprintf fmt " rewrite nmake_op_WW; rewrite extend%in_spec; auto.\n" i; - done; - fprintf fmt " refine (spec_iter0 t_ (fun x y res => [res] = x * y)\n"; - for i = 0 to size do - fprintf fmt " (fun x y => reduce_%i (w%i_mul_c x y)) \n" (i + 1) i; - fprintf fmt " (fun n x y => w%i_mul n y x)\n" i; - fprintf fmt " w%i_mul _ _ _\n" i; - done; - fprintf fmt " mulnm _\n"; - fprintf fmt " (fun _ => N0 w_0) _\n"; - fprintf fmt " (fun _ => N0 w_0) _\n"; - fprintf fmt " ).\n"; - for i = 0 to size do - fprintf fmt " intros x y; rewrite spec_reduce_%i.\n" (i + 1); - fprintf fmt " unfold w%i_mul_c, to_Z.\n" i; - fprintf fmt " generalize (spec_mul_c w%i_spec x y).\n" i; - fprintf fmt " intros HH; rewrite <- HH; clear HH; auto.\n"; - if i == size then - begin - fprintf fmt " intros n x y; rewrite F%i; auto with zarith.\n" i; - fprintf fmt " intros n x y; rewrite F%i; auto with zarith. \n" i; - end - else - begin - fprintf fmt " intros n x y H; rewrite F%i; auto with zarith.\n" i; - fprintf fmt " intros n x y H; rewrite F%i; auto with zarith. \n" i; - end; - done; - fprintf fmt " intros n m x y; unfold mulnm.\n"; - fprintf fmt " rewrite spec_reduce_n.\n"; - fprintf fmt " rewrite <- (spec_cast_l n m x).\n"; - fprintf fmt " rewrite <- (spec_cast_r n m y).\n"; - fprintf fmt " rewrite spec_muln; rewrite spec_cast_l; rewrite spec_cast_r; auto.\n"; - fprintf fmt " intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring.\n"; - fprintf fmt " intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Square *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - for i = 0 to size do - fprintf fmt " Definition w%i_square_c := w%i_op.(znz_square_c).\n" i i - done; - fprintf fmt "\n"; - - fprintf fmt " Definition square x :=\n"; - fprintf fmt " match x with\n"; - fprintf fmt " | %s0 wx => reduce_1 (w0_square_c wx)\n" c; - for i = 1 to size - 1 do - fprintf fmt " | %s%i wx => %s%i (w%i_square_c wx)\n" c i c (i+1) i - done; - fprintf fmt " | %s%i wx => %sn 0 (w%i_square_c wx)\n" c size c size; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " let op := make_op n in\n"; - fprintf fmt " %sn (S n) (op.(znz_square_c) wx)\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_square: forall x, [square x] = [x] * [x].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold square; clear x.\n"; - fprintf fmt " intros x; rewrite spec_reduce_1; unfold to_Z.\n"; - fprintf fmt " exact (spec_square_c w%i_spec x).\n" 0; - for i = 1 to size do - fprintf fmt " intros x; unfold to_Z.\n"; - fprintf fmt " exact (spec_square_c w%i_spec x).\n" i; - done; - fprintf fmt " intros n x; unfold to_Z.\n"; - fprintf fmt " rewrite make_op_S.\n"; - fprintf fmt " exact (spec_square_c (wn_spec n) x).\n"; - fprintf fmt "Qed.\n"; - end - else - fprintf fmt "Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Power *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - fprintf fmt " Fixpoint power_pos (x:%s) (p:positive) {struct p} : %s :=\n" - t t; - fprintf fmt " match p with\n"; - fprintf fmt " | xH => x\n"; - fprintf fmt " | xO p => square (power_pos x p)\n"; - fprintf fmt " | xI p => mul (square (power_pos x p)) x\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x n; generalize x; elim n; clear n x; simpl power_pos.\n"; - fprintf fmt " intros; rewrite spec_mul; rewrite spec_square; rewrite H.\n"; - fprintf fmt " rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith.\n"; - fprintf fmt " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_2; rewrite Zpower_1_r; auto.\n"; - fprintf fmt " intros; rewrite spec_square; rewrite H.\n"; - fprintf fmt " rewrite Zpos_xO; auto with zarith.\n"; - fprintf fmt " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_2; auto.\n"; - fprintf fmt " intros; rewrite Zpower_1_r; auto.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Square root *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_sqrt := w%i_op.(znz_sqrt).\n" i i - done; - fprintf fmt "\n"; - - fprintf fmt " Definition sqrt x :=\n"; - fprintf fmt " match x with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wx => reduce_%i (w%i_sqrt wx)\n" c i i i; - done; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " let op := make_op n in\n"; - fprintf fmt " reduce_n n (op.(znz_sqrt) wx)\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - - - fprintf fmt " Theorem spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; unfold sqrt; case x; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x; rewrite spec_reduce_%i; exact (spec_sqrt w%i_spec x).\n" i i; - done; - fprintf fmt " intros n x; rewrite spec_reduce_n; exact (spec_sqrt (wn_spec n) x).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt "Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Division *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - - (* Division *) - for i = 0 to size do - fprintf fmt " Definition w%i_div_gt := w%i_op.(znz_div_gt).\n" i i - done; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := \n"; - fprintf fmt " (spec_gen_divn1 \n"; - fprintf fmt " ww_op.(znz_zdigits) ww_op.(znz_0)\n"; - fprintf fmt " ww_op.(znz_WW) ww_op.(znz_head0)\n"; - fprintf fmt " ww_op.(znz_add_mul_div) ww_op.(znz_div21)\n"; - fprintf fmt " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)\n"; - fprintf fmt " (spec_to_Z ww_spec) \n"; - fprintf fmt " (spec_zdigits ww_spec)\n"; - fprintf fmt " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)\n"; - fprintf fmt " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) \n"; - fprintf fmt " (ZnZ.spec_compare ww_spec) (ZnZ.spec_sub ww_spec)).\n"; - fprintf fmt " \n"; - end; - - for i = 0 to size do - fprintf fmt " Definition w%i_divn1 n x y :=\n" i; - fprintf fmt " let (u, v) :=\n"; - fprintf fmt " gen_divn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)\n" i i; - fprintf fmt " w%i_op.(znz_WW) w%i_op.(znz_head0)\n" i i; - fprintf fmt " w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)\n" i i; - fprintf fmt " w%i_op.(znz_compare) w%i_op.(znz_sub) (S n) x y in\n" i i; - if i == size then - fprintf fmt " (%sn _ u, %s%i v).\n" c c i - else - fprintf fmt " (to_Z%i _ u, %s%i v).\n" i c i; - done; - fprintf fmt "\n"; - - - if gen_proof then - begin - for i = 0 to size do - fprintf fmt " Lemma spec_get_end%i: forall n x y,\n" i; - fprintf fmt " eval%in n x <= [%s%i y] -> \n" i c i; - fprintf fmt " [%s%i (GenBase.get_low %s n x)] = eval%in n x.\n" c i (pz i) i; - fprintf fmt " Proof.\n"; - fprintf fmt " intros n x y H.\n"; - fprintf fmt " rewrite spec_gen_eval%in; unfold to_Z.\n" i; - fprintf fmt " apply GenBase.spec_get_low.\n"; - fprintf fmt " exact (spec_0 w%i_spec).\n" i; - fprintf fmt " exact (spec_to_Z w%i_spec).\n" i; - fprintf fmt " apply Zle_lt_trans with [%s%i y]; auto.\n" c i; - fprintf fmt " rewrite <- spec_gen_eval%in; auto.\n" i; - fprintf fmt " unfold to_Z; case (spec_to_Z w%i_spec y); auto.\n" i; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - done ; - end; - - for i = 0 to size do - fprintf fmt " Let div_gt%i x y := let (u,v) := (w%i_div_gt x y) in (reduce_%i u, reduce_%i v).\n" i i i i; - done; - fprintf fmt "\n"; - - - fprintf fmt " Let div_gtnm n m wx wy :=\n"; - fprintf fmt " let mn := Max.max n m in\n"; - fprintf fmt " let d := diff n m in\n"; - fprintf fmt " let op := make_op mn in\n"; - fprintf fmt " let (q, r):= op.(znz_div_gt)\n"; - fprintf fmt " (castm (diff_r n m) (extend_tr wx (snd d)))\n"; - fprintf fmt " (castm (diff_l n m) (extend_tr wy (fst d))) in\n"; - fprintf fmt " (reduce_n mn q, reduce_n mn r).\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition div_gt := Eval lazy beta delta [iter] in\n"; - fprintf fmt " (iter _ \n"; - for i = 0 to size do - fprintf fmt " div_gt%i\n" i; - fprintf fmt " (fun n x y => div_gt%i x (GenBase.get_low %s (S n) y))\n" i (pz i); - fprintf fmt " w%i_divn1\n" i; - done; - fprintf fmt " div_gtnm).\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_div_gt: forall x y,\n"; - fprintf fmt " [x] > [y] -> 0 < [y] ->\n"; - fprintf fmt " let (q,r) := div_gt x y in\n"; - fprintf fmt " [q] = [x] / [y] /\\ [r] = [x] mod [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " assert (FO:\n"; - fprintf fmt " forall x y, [x] > [y] -> 0 < [y] ->\n"; - fprintf fmt " let (q,r) := div_gt x y in\n"; - fprintf fmt " [x] = [q] * [y] + [r] /\\ 0 <= [r] < [y]).\n"; - fprintf fmt " refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y ->\n"; fprintf fmt " let (q,r) := res in\n"; - fprintf fmt " x = [q] * y + [r] /\\ 0 <= [r] < y)\n"; - for i = 0 to size do - fprintf fmt " div_gt%i\n" i; - fprintf fmt " (fun n x y => div_gt%i x (GenBase.get_low %s (S n) y))\n" i (pz i); - fprintf fmt " w%i_divn1 _ _ _\n" i; - done; - fprintf fmt " div_gtnm _).\n"; - for i = 0 to size do - fprintf fmt " intros x y H1 H2; unfold div_gt%i, w%i_div_gt.\n" i i; - fprintf fmt " generalize (spec_div_gt w%i_spec x y H1 H2); case znz_div_gt.\n" i; - fprintf fmt " intros xx yy; repeat rewrite spec_reduce_%i; auto.\n" i; - if i == size then - fprintf fmt " intros n x y H2 H3; unfold div_gt%i, w%i_div_gt.\n" i i - else - fprintf fmt " intros n x y H1 H2 H3; unfold div_gt%i, w%i_div_gt.\n" i i; - fprintf fmt " generalize (spec_div_gt w%i_spec x \n" i; - fprintf fmt " (GenBase.get_low %s (S n) y)).\n" (pz i); - fprintf fmt " "; - for j = 0 to i do - fprintf fmt "unfold w%i;" (i-j); - done; - fprintf fmt "case znz_div_gt.\n"; - fprintf fmt " intros xx yy H4; repeat rewrite spec_reduce_%i.\n" i; - fprintf fmt " generalize (spec_get_end%i (S n) y x); unfold to_Z; intros H5.\n" i; - fprintf fmt " unfold to_Z in H2; rewrite H5 in H4; auto with zarith.\n"; - if i == size then - fprintf fmt " intros n x y H2 H3.\n" - else - fprintf fmt " intros n x y H1 H2 H3.\n"; - fprintf fmt " generalize\n"; - fprintf fmt " (spec_divn1 w%i w%i_op w%i_spec (S n) x y H3).\n" i i i; - fprintf fmt " unfold w%i_divn1;" i; - for j = 0 to i do - fprintf fmt "unfold w%i;" (i-j); - done; - fprintf fmt " case gen_divn1.\n"; - fprintf fmt " intros xx yy H4.\n"; - if i == size then - begin - fprintf fmt " repeat rewrite <- spec_gen_eval%in in H4; auto.\n" i; - fprintf fmt " rewrite spec_eval%in; auto.\n" i; - end - else - begin - fprintf fmt " rewrite to_Z%i_spec; auto with zarith.\n" i; - fprintf fmt " repeat rewrite <- spec_gen_eval%in in H4; auto.\n" i; - end; - done; - fprintf fmt " intros n m x y H1 H2; unfold div_gtnm.\n"; - fprintf fmt " generalize (spec_div_gt (wn_spec (Max.max n m))\n"; - fprintf fmt " (castm (diff_r n m)\n"; - fprintf fmt " (extend_tr x (snd (diff n m))))\n"; - fprintf fmt " (castm (diff_l n m)\n"; - fprintf fmt " (extend_tr y (fst (diff n m))))).\n"; - fprintf fmt " case znz_div_gt.\n"; - fprintf fmt " intros xx yy HH.\n"; - fprintf fmt " repeat rewrite spec_reduce_n.\n"; - fprintf fmt " rewrite <- (spec_cast_l n m x).\n"; - fprintf fmt " rewrite <- (spec_cast_r n m y).\n"; - fprintf fmt " unfold to_Z; apply HH.\n"; - fprintf fmt " rewrite <- (spec_cast_l n m x) in H1; auto.\n"; - fprintf fmt " rewrite <- (spec_cast_r n m y) in H1; auto.\n"; - fprintf fmt " rewrite <- (spec_cast_r n m y) in H2; auto.\n"; - fprintf fmt " intros x y H1 H2; generalize (FO x y H1 H2); case div_gt.\n"; - fprintf fmt " intros q r (H3, H4); split.\n"; - fprintf fmt " apply (Zdiv_unique [x] [y] [q] [r]); auto.\n"; - fprintf fmt " rewrite Zmult_comm; auto.\n"; - fprintf fmt " apply (Zmod_unique [x] [y] [q] [r]); auto.\n"; - fprintf fmt " rewrite Zmult_comm; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition div_eucl x y :=\n"; - fprintf fmt " match compare x y with\n"; - fprintf fmt " | Eq => (one, zero)\n"; - fprintf fmt " | Lt => (zero, x)\n"; - fprintf fmt " | Gt => div_gt x y\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_div_eucl: forall x y,\n"; - fprintf fmt " 0 < [y] ->\n"; - fprintf fmt " let (q,r) := div_eucl x y in\n"; - fprintf fmt " ([q], [r]) = Zdiv_eucl [x] [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " assert (F0: [zero] = 0).\n"; - fprintf fmt " exact (spec_0 w0_spec).\n"; - fprintf fmt " assert (F1: [one] = 1).\n"; - fprintf fmt " exact (spec_1 w0_spec).\n"; - fprintf fmt " intros x y H; generalize (spec_compare x y);\n"; - fprintf fmt " unfold div_eucl; case compare; try rewrite F0;\n"; - fprintf fmt " try rewrite F1; intros; auto with zarith.\n"; - fprintf fmt " rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H))\n"; - fprintf fmt " (Z_mod_same [y] (Zlt_gt _ _ H));\n"; - fprintf fmt " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto.\n"; - fprintf fmt " assert (F2: 0 <= [x] < [y]).\n"; - fprintf fmt " generalize (spec_pos x); auto.\n"; - fprintf fmt " generalize (Zdiv_small _ _ F2)\n"; - fprintf fmt " (Zmod_small _ _ F2);\n"; - fprintf fmt " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto.\n"; - fprintf fmt " generalize (spec_div_gt _ _ H0 H); auto.\n"; - fprintf fmt " unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt.\n"; - fprintf fmt " intros a b c d (H1, H2); subst; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition div x y := fst (div_eucl x y).\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_div:\n"; - fprintf fmt " forall x y, 0 < [y] -> [div x y] = [x] / [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x y H1; unfold div; generalize (spec_div_eucl x y H1);\n"; - fprintf fmt " case div_eucl; simpl fst.\n"; - fprintf fmt " intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; \n"; - fprintf fmt " injection H; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Modulo *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_mod_gt := w%i_op.(znz_mod_gt).\n" i i - done; - fprintf fmt "\n"; - - for i = 0 to size do - fprintf fmt " Definition w%i_modn1 :=\n" i; - fprintf fmt " gen_modn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)\n" i i; - fprintf fmt " w%i_op.(znz_head0) w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)\n" i i i; - fprintf fmt " w%i_op.(znz_compare) w%i_op.(znz_sub).\n" i i; - done; - fprintf fmt "\n"; - - fprintf fmt " Let mod_gtnm n m wx wy :=\n"; - fprintf fmt " let mn := Max.max n m in\n"; - fprintf fmt " let d := diff n m in\n"; - fprintf fmt " let op := make_op mn in\n"; - fprintf fmt " reduce_n mn (op.(znz_mod_gt)\n"; - fprintf fmt " (castm (diff_r n m) (extend_tr wx (snd d)))\n"; - fprintf fmt " (castm (diff_l n m) (extend_tr wy (fst d)))).\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition mod_gt := Eval lazy beta delta[iter] in\n"; - fprintf fmt " (iter _ \n"; - for i = 0 to size do - fprintf fmt " (fun x y => reduce_%i (w%i_mod_gt x y))\n" i i; - fprintf fmt " (fun n x y => reduce_%i (w%i_mod_gt x (GenBase.get_low %s (S n) y)))\n" i i (pz i); - fprintf fmt " (fun n x y => reduce_%i (w%i_modn1 (S n) x y))\n" i i; - done; - fprintf fmt " mod_gtnm).\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := \n"; - fprintf fmt " (spec_gen_modn1 \n"; - fprintf fmt " ww_op.(znz_zdigits) ww_op.(znz_0)\n"; - fprintf fmt " ww_op.(znz_WW) ww_op.(znz_head0)\n"; - fprintf fmt " ww_op.(znz_add_mul_div) ww_op.(znz_div21)\n"; - fprintf fmt " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)\n"; - fprintf fmt " (spec_to_Z ww_spec) \n"; - fprintf fmt " (spec_zdigits ww_spec)\n"; - fprintf fmt " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)\n"; - fprintf fmt " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) \n"; - fprintf fmt " (ZnZ.spec_compare ww_spec) (ZnZ.spec_sub ww_spec)).\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " Theorem spec_mod_gt:\n"; - fprintf fmt " forall x y, [x] > [y] -> 0 < [y] -> [mod_gt x y] = [x] mod [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " refine (spec_iter _ (fun x y res => x > y -> 0 < y ->\n"; - fprintf fmt " [res] = x mod y)\n"; - for i = 0 to size do - fprintf fmt " (fun x y => reduce_%i (w%i_mod_gt x y))\n" i i; - fprintf fmt " (fun n x y => reduce_%i (w%i_mod_gt x (GenBase.get_low %s (S n) y)))\n" i i (pz i); - fprintf fmt " (fun n x y => reduce_%i (w%i_modn1 (S n) x y)) _ _ _\n" i i; - done; - fprintf fmt " mod_gtnm _).\n"; - for i = 0 to size do - fprintf fmt " intros x y H1 H2; rewrite spec_reduce_%i.\n" i; - fprintf fmt " exact (spec_mod_gt w%i_spec x y H1 H2).\n" i; - if i == size then - fprintf fmt " intros n x y H2 H3; rewrite spec_reduce_%i.\n" i - else - fprintf fmt " intros n x y H1 H2 H3; rewrite spec_reduce_%i.\n" i; - fprintf fmt " unfold w%i_mod_gt.\n" i; - fprintf fmt " rewrite <- (spec_get_end%i (S n) y x); auto with zarith.\n" i; - fprintf fmt " unfold to_Z; apply (spec_mod_gt w%i_spec); auto.\n" i; - fprintf fmt " rewrite <- (spec_get_end%i (S n) y x) in H2; auto with zarith.\n" i; - fprintf fmt " rewrite <- (spec_get_end%i (S n) y x) in H3; auto with zarith.\n" i; - if i == size then - fprintf fmt " intros n x y H2 H3; rewrite spec_reduce_%i.\n" i - else - fprintf fmt " intros n x y H1 H2 H3; rewrite spec_reduce_%i.\n" i; - fprintf fmt " unfold w%i_modn1, to_Z; rewrite spec_gen_eval%in.\n" i i; - fprintf fmt " apply (spec_modn1 _ _ w%i_spec); auto.\n" i; - done; - fprintf fmt " intros n m x y H1 H2; unfold mod_gtnm.\n"; - fprintf fmt " repeat rewrite spec_reduce_n.\n"; - fprintf fmt " rewrite <- (spec_cast_l n m x).\n"; - fprintf fmt " rewrite <- (spec_cast_r n m y).\n"; - fprintf fmt " unfold to_Z; apply (spec_mod_gt (wn_spec (Max.max n m))).\n"; - fprintf fmt " rewrite <- (spec_cast_l n m x) in H1; auto.\n"; - fprintf fmt " rewrite <- (spec_cast_r n m y) in H1; auto.\n"; - fprintf fmt " rewrite <- (spec_cast_r n m y) in H2; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition modulo x y := \n"; - fprintf fmt " match compare x y with\n"; - fprintf fmt " | Eq => zero\n"; - fprintf fmt " | Lt => x\n"; - fprintf fmt " | Gt => mod_gt x y\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_modulo:\n"; - fprintf fmt " forall x y, 0 < [y] -> [modulo x y] = [x] mod [y].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " assert (F0: [zero] = 0).\n"; - fprintf fmt " exact (spec_0 w0_spec).\n"; - fprintf fmt " assert (F1: [one] = 1).\n"; - fprintf fmt " exact (spec_1 w0_spec).\n"; - fprintf fmt " intros x y H; generalize (spec_compare x y);\n"; - fprintf fmt " unfold modulo; case compare; try rewrite F0;\n"; - fprintf fmt " try rewrite F1; intros; try split; auto with zarith.\n"; - fprintf fmt " rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith.\n"; - fprintf fmt " apply sym_equal; apply Zmod_small; auto with zarith.\n"; - fprintf fmt " generalize (spec_pos x); auto with zarith.\n"; - fprintf fmt " apply spec_mod_gt; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Gcd *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - fprintf fmt " Definition digits x :=\n"; - fprintf fmt " match x with\n"; - for i = 0 to size do - fprintf fmt " | %s%i _ => w%i_op.(znz_digits)\n" c i i; - done; - fprintf fmt " | %sn n _ => (make_op n).(znz_digits)\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x).\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x; unfold to_Z, digits;\n"; - fprintf fmt " generalize (spec_to_Z w%i_spec x); unfold base; intros H; exact H.\n" i; - done; - fprintf fmt " intros n x; unfold to_Z, digits;\n"; - fprintf fmt " generalize (spec_to_Z (wn_spec n) x); unfold base; intros H; exact H.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Definition gcd_gt_body a b cont :=\n"; - fprintf fmt " match compare b zero with\n"; - fprintf fmt " | Gt =>\n"; - fprintf fmt " let r := mod_gt a b in\n"; - fprintf fmt " match compare r zero with\n"; - fprintf fmt " | Gt => cont r (mod_gt b r)\n"; - fprintf fmt " | _ => b\n"; - fprintf fmt " end\n"; - fprintf fmt " | _ => a\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Theorem Zspec_gcd_gt_body: forall a b cont p,\n"; - fprintf fmt " [a] > [b] -> [a] < 2 ^ p ->\n"; - fprintf fmt " (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] ->\n"; - fprintf fmt " Zis_gcd [a1] [b1] [cont a1 b1]) -> \n"; - fprintf fmt " Zis_gcd [a] [b] [gcd_gt_body a b cont].\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " assert (F1: [zero] = 0).\n"; - fprintf fmt " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto.\n"; - fprintf fmt " intros a b cont p H2 H3 H4; unfold gcd_gt_body.\n"; - fprintf fmt " generalize (spec_compare b zero); case compare; try rewrite F1.\n"; - fprintf fmt " intros HH; rewrite HH; apply Zis_gcd_0.\n"; - fprintf fmt " intros HH; absurd (0 <= [b]); auto with zarith.\n"; - fprintf fmt " case (spec_digits b); auto with zarith.\n"; - fprintf fmt " intros H5; generalize (spec_compare (mod_gt a b) zero); \n"; - fprintf fmt " case compare; try rewrite F1.\n"; - fprintf fmt " intros H6; rewrite <- (Zmult_1_r [b]).\n"; - fprintf fmt " rewrite (Z_div_mod_eq [a] [b]); auto with zarith.\n"; - fprintf fmt " rewrite <- spec_mod_gt; auto with zarith.\n"; - fprintf fmt " rewrite H6; rewrite Zplus_0_r.\n"; - fprintf fmt " apply Zis_gcd_mult; apply Zis_gcd_1.\n"; - fprintf fmt " intros; apply False_ind.\n"; - fprintf fmt " case (spec_digits (mod_gt a b)); auto with zarith.\n"; - fprintf fmt " intros H6; apply GenDiv.Zis_gcd_mod; auto with zarith.\n"; - fprintf fmt " apply GenDiv.Zis_gcd_mod; auto with zarith.\n"; - fprintf fmt " rewrite <- spec_mod_gt; auto with zarith.\n"; - fprintf fmt " assert (F2: [b] > [mod_gt a b]).\n"; - fprintf fmt " case (Z_mod_lt [a] [b]); auto with zarith.\n"; - fprintf fmt " repeat rewrite <- spec_mod_gt; auto with zarith.\n"; - fprintf fmt " assert (F3: [mod_gt a b] > [mod_gt b (mod_gt a b)]).\n"; - fprintf fmt " case (Z_mod_lt [b] [mod_gt a b]); auto with zarith.\n"; - fprintf fmt " rewrite <- spec_mod_gt; auto with zarith.\n"; - fprintf fmt " repeat rewrite <- spec_mod_gt; auto with zarith.\n"; - fprintf fmt " apply H4; auto with zarith.\n"; - fprintf fmt " apply Zmult_lt_reg_r with 2; auto with zarith.\n"; - fprintf fmt " apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith.\n"; - fprintf fmt " apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith.\n"; - fprintf fmt " apply Zplus_le_compat_r.\n"; - fprintf fmt " pattern [b] at 1; rewrite <- (Zmult_1_l [b]).\n"; - fprintf fmt " apply Zmult_le_compat_r; auto with zarith.\n"; - fprintf fmt " case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith.\n"; - fprintf fmt " intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2;\n"; - fprintf fmt " try rewrite <- HH in H2; auto with zarith.\n"; - fprintf fmt " case (Z_mod_lt [a] [b]); auto with zarith.\n"; - fprintf fmt " rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith.\n"; - fprintf fmt " rewrite <- Z_div_mod_eq; auto with zarith.\n"; - fprintf fmt " pattern 2 at 2; rewrite <- (Zpower_1_r 2).\n"; - fprintf fmt " rewrite <- Zpower_exp; auto with zarith.\n"; - fprintf fmt " ring_simplify (p - 1 + 1); auto.\n"; - fprintf fmt " case (Zle_lt_or_eq 0 p); auto with zarith.\n"; - fprintf fmt " generalize H3; case p; simpl Zpower; auto with zarith.\n"; - fprintf fmt " intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t :=\n"; - fprintf fmt " gcd_gt_body a b\n"; - fprintf fmt " (fun a b =>\n"; - fprintf fmt " match p with\n"; - fprintf fmt " | xH => cont a b\n"; - fprintf fmt " | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b\n"; - fprintf fmt " | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b\n"; - fprintf fmt " end).\n"; - fprintf fmt "\n"; - - if gen_proof then - begin - fprintf fmt " Theorem Zspec_gcd_gt_aux: forall p n a b cont,\n"; - fprintf fmt " [a] > [b] -> [a] < 2 ^ (Zpos p + n) ->\n"; - fprintf fmt " (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] ->\n"; - fprintf fmt " Zis_gcd [a1] [b1] [cont a1 b1]) ->\n"; - fprintf fmt " Zis_gcd [a] [b] [gcd_gt_aux p cont a b].\n"; - fprintf fmt " intros p; elim p; clear p.\n"; - fprintf fmt " intros p Hrec n a b cont H2 H3 H4.\n"; - fprintf fmt " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto.\n"; - fprintf fmt " intros a1 b1 H6 H7.\n"; - fprintf fmt " apply Hrec with (Zpos p + n); auto.\n"; - fprintf fmt " replace (Zpos p + (Zpos p + n)) with\n"; - fprintf fmt " (Zpos (xI p) + n - 1); auto.\n"; - fprintf fmt " rewrite Zpos_xI; ring.\n"; - fprintf fmt " intros a2 b2 H9 H10.\n"; - fprintf fmt " apply Hrec with n; auto.\n"; - fprintf fmt " intros p Hrec n a b cont H2 H3 H4.\n"; - fprintf fmt " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto.\n"; - fprintf fmt " intros a1 b1 H6 H7.\n"; - fprintf fmt " apply Hrec with (Zpos p + n - 1); auto.\n"; - fprintf fmt " replace (Zpos p + (Zpos p + n - 1)) with\n"; - fprintf fmt " (Zpos (xO p) + n - 1); auto.\n"; - fprintf fmt " rewrite Zpos_xO; ring.\n"; - fprintf fmt " intros a2 b2 H9 H10.\n"; - fprintf fmt " apply Hrec with (n - 1); auto.\n"; - fprintf fmt " replace (Zpos p + (n - 1)) with\n"; - fprintf fmt " (Zpos p + n - 1); auto with zarith.\n"; - fprintf fmt " intros a3 b3 H12 H13; apply H4; auto with zarith.\n"; - fprintf fmt " apply Zlt_le_trans with (1 := H12).\n"; - fprintf fmt " case (Zle_or_lt 1 n); intros HH.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " apply Zle_trans with 0; auto with zarith.\n"; - fprintf fmt " assert (HH1: n - 1 < 0); auto with zarith.\n"; - fprintf fmt " generalize HH1; case (n - 1); auto with zarith.\n"; - fprintf fmt " intros p1 HH2; discriminate.\n"; - fprintf fmt " intros n a b cont H H2 H3.\n"; - fprintf fmt " simpl gcd_gt_aux.\n"; - fprintf fmt " apply Zspec_gcd_gt_body with (n + 1); auto with zarith.\n"; - fprintf fmt " rewrite Zplus_comm; auto.\n"; - fprintf fmt " intros a1 b1 H5 H6; apply H3; auto.\n"; - fprintf fmt " replace n with (n + 1 - 1); auto; try ring.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; - - fprintf fmt " Definition gcd_cont a b :=\n"; - fprintf fmt " match compare one b with\n"; - fprintf fmt " | Eq => one\n"; - fprintf fmt " | _ => a\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_gcd_gt: forall a b,\n"; - fprintf fmt " [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros a b H2.\n"; - fprintf fmt " case (spec_digits (gcd_gt a b)); intros H3 H4.\n"; - fprintf fmt " case (spec_digits a); intros H5 H6.\n"; - fprintf fmt " apply sym_equal; apply Zis_gcd_gcd; auto with zarith.\n"; - fprintf fmt " unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith.\n"; - fprintf fmt " intros a1 a2; rewrite Zpower_0_r.\n"; - fprintf fmt " case (spec_digits a2); intros H7 H8;\n"; - fprintf fmt " intros; apply False_ind; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition gcd a b :=\n"; - fprintf fmt " match compare a b with\n"; - fprintf fmt " | Eq => a\n"; - fprintf fmt " | Lt => gcd_gt b a\n"; - fprintf fmt " | Gt => gcd_gt a b\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros a b.\n"; - fprintf fmt " case (spec_digits a); intros H1 H2.\n"; - fprintf fmt " case (spec_digits b); intros H3 H4.\n"; - fprintf fmt " unfold gcd; generalize (spec_compare a b); case compare.\n"; - fprintf fmt " intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto.\n"; - fprintf fmt " apply Zis_gcd_refl.\n"; - fprintf fmt " intros; apply trans_equal with (Zgcd [b] [a]).\n"; - fprintf fmt " apply spec_gcd_gt; auto with zarith.\n"; - fprintf fmt " apply Zis_gcd_gcd; auto with zarith.\n"; - fprintf fmt " apply Zgcd_is_pos.\n"; - fprintf fmt " apply Zis_gcd_sym; apply Zgcd_is_gcd.\n"; - fprintf fmt " intros; apply spec_gcd_gt; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Conversion *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - fprintf fmt " Definition pheight p := \n"; - fprintf fmt " Peano.pred (nat_of_P (get_height w0_op.(znz_digits) (plength p))).\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem pheight_correct: forall p, \n"; - fprintf fmt " Zpos p < 2 ^ (Zpos (znz_digits w0_op) * 2 ^ (Z_of_nat (pheight p))).\n"; - fprintf fmt " Proof.\n"; - fprintf fmt " intros p; unfold pheight.\n"; - fprintf fmt " assert (F1: forall x, Z_of_nat (Peano.pred (nat_of_P x)) = Zpos x - 1).\n"; - fprintf fmt " intros x.\n"; - fprintf fmt " assert (Zsucc (Z_of_nat (Peano.pred (nat_of_P x))) = Zpos x); auto with zarith.\n"; - fprintf fmt " rewrite <- inj_S.\n"; - fprintf fmt " rewrite <- (fun x => S_pred x 0); auto with zarith.\n"; - fprintf fmt " rewrite Zpos_eq_Z_of_nat_o_nat_of_P; auto.\n"; - fprintf fmt " apply lt_le_trans with 1%snat; auto with zarith.\n" "%"; - fprintf fmt " exact (le_Pmult_nat x 1).\n"; - fprintf fmt " rewrite F1; clear F1.\n"; - fprintf fmt " assert (F2:= (get_height_correct (znz_digits w0_op) (plength p))).\n"; - fprintf fmt " apply Zlt_le_trans with (Zpos (Psucc p)).\n"; - fprintf fmt " rewrite Zpos_succ_morphism; auto with zarith.\n"; - fprintf fmt " apply Zle_trans with (1 := plength_pred_correct (Psucc p)).\n"; - fprintf fmt " rewrite Ppred_succ.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition of_pos x :=\n"; - fprintf fmt " let h := pheight x in\n"; - fprintf fmt " match h with\n"; - for i = 0 to size do - fprintf fmt " | %i%snat => reduce_%i (snd (w%i_op.(znz_of_pos) x))\n" i "%" i i; - done; - fprintf fmt " | _ =>\n"; - fprintf fmt " let n := minus h %i in\n" (size + 1); - fprintf fmt " reduce_n n (snd ((make_op n).(znz_of_pos) x))\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_of_pos: forall x,\n"; - fprintf fmt " [of_pos x] = Zpos x.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " assert (F := spec_more_than_1_digit w0_spec).\n"; - fprintf fmt " intros x; unfold of_pos; case_eq (pheight x).\n"; - for i = 0 to size do - if i <> 0 then - fprintf fmt " intros n; case n; clear n.\n"; - fprintf fmt " intros H1; rewrite spec_reduce_%i; unfold to_Z.\n" i; - fprintf fmt " apply (znz_of_pos_correct w%i_spec).\n" i; - fprintf fmt " apply Zlt_le_trans with (1 := pheight_correct x).\n"; - fprintf fmt " rewrite H1; simpl Z_of_nat; change (2^%i) with (%s).\n" i (gen2 i); - fprintf fmt " unfold base.\n"; - fprintf fmt " apply Zpower_le_monotone; split; auto with zarith.\n"; - if i <> 0 then - begin - fprintf fmt " rewrite Zmult_comm; repeat rewrite <- Zmult_assoc.\n"; - fprintf fmt " repeat rewrite <- Zpos_xO.\n"; - fprintf fmt " refine (Zle_refl _).\n"; - end; - done; - fprintf fmt " intros n.\n"; - fprintf fmt " intros H1; rewrite spec_reduce_n; unfold to_Z.\n"; - fprintf fmt " simpl minus; rewrite <- minus_n_O.\n"; - fprintf fmt " apply (znz_of_pos_correct (wn_spec n)).\n"; - fprintf fmt " apply Zlt_le_trans with (1 := pheight_correct x).\n"; - fprintf fmt " unfold base.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " rewrite H1.\n"; - fprintf fmt " elim n; clear n H1.\n"; - fprintf fmt " simpl Z_of_nat; change (2^%i) with (%s).\n" (size + 1) (gen2 (size + 1)); - fprintf fmt " rewrite Zmult_comm; repeat rewrite <- Zmult_assoc.\n"; - fprintf fmt " repeat rewrite <- Zpos_xO.\n"; - fprintf fmt " refine (Zle_refl _).\n"; - fprintf fmt " intros n Hrec.\n"; - fprintf fmt " rewrite make_op_S.\n"; - fprintf fmt " change (%sznz_digits (word _ (S (S n))) (mk_zn2z_op_karatsuba (make_op n))) with\n" "@"; - fprintf fmt " (xO (znz_digits (make_op n))).\n"; - fprintf fmt " rewrite (fun x y => (Zpos_xO (%sznz_digits x y))).\n" "@"; - fprintf fmt " rewrite inj_S; unfold Zsucc.\n"; - fprintf fmt " rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_1_r.\n"; - fprintf fmt " assert (tmp: forall x y z, x * (y * z) = y * (x * z));\n"; - fprintf fmt " [intros; ring | rewrite tmp; clear tmp].\n"; - fprintf fmt " apply Zmult_le_compat_l; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition of_N x :=\n"; - fprintf fmt " match x with\n"; - fprintf fmt " | BinNat.N0 => zero\n"; - fprintf fmt " | Npos p => of_pos p\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_of_N: forall x,\n"; - fprintf fmt " [of_N x] = Z_of_N x.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x.\n"; - fprintf fmt " simpl of_N.\n"; - fprintf fmt " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto.\n"; - fprintf fmt " intros p; exact (spec_of_pos p).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Shift *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; - - - - (* Head0 *) - fprintf fmt " Definition head0 w := match w with\n"; - for i = 0 to size do - fprintf fmt " | %s%i w=> reduce_%i (w%i_op.(znz_head0) w)\n" c i i i; - done; - fprintf fmt " | %sn n w=> reduce_n n ((make_op n).(znz_head0) w)\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_head00: forall x, [x] = 0 ->[head0 x] = Zpos (digits x).\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold head0; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x; rewrite spec_reduce_%i; exact (spec_head00 w%i_spec x).\n" i i; - done; - fprintf fmt " intros n x; rewrite spec_reduce_n; exact (spec_head00 (wn_spec n) x).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt " \n"; - - fprintf fmt " Theorem spec_head0: forall x, 0 < [x] ->\n"; - fprintf fmt " 2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x).\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " assert (F0: forall x, (x - 1) + 1 = x).\n"; - fprintf fmt " intros; ring. \n"; - fprintf fmt " intros x; case x; unfold digits, head0; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x Hx; rewrite spec_reduce_%i.\n" i; - fprintf fmt " assert (F1:= spec_more_than_1_digit w%i_spec).\n" i; - fprintf fmt " generalize (spec_head0 w%i_spec x Hx).\n" i; - fprintf fmt " unfold base.\n"; - fprintf fmt " pattern (Zpos (znz_digits w%i_op)) at 1; \n" i; - fprintf fmt " rewrite <- (fun x => (F0 (Zpos x))).\n"; - fprintf fmt " rewrite Zpower_exp; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith.\n"; - done; - fprintf fmt " intros n x Hx; rewrite spec_reduce_n.\n"; - fprintf fmt " assert (F1:= spec_more_than_1_digit (wn_spec n)).\n"; - fprintf fmt " generalize (spec_head0 (wn_spec n) x Hx).\n"; - fprintf fmt " unfold base.\n"; - fprintf fmt " pattern (Zpos (znz_digits (make_op n))) at 1; \n"; - fprintf fmt " rewrite <- (fun x => (F0 (Zpos x))).\n"; - fprintf fmt " rewrite Zpower_exp; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - (* Tail0 *) - fprintf fmt " Definition tail0 w := match w with\n"; - for i = 0 to size do - fprintf fmt " | %s%i w=> reduce_%i (w%i_op.(znz_tail0) w)\n" c i i i; - done; - fprintf fmt " | %sn n w=> reduce_n n ((make_op n).(znz_tail0) w)\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_tail00: forall x, [x] = 0 ->[tail0 x] = Zpos (digits x).\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold tail0; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x; rewrite spec_reduce_%i; exact (spec_tail00 w%i_spec x).\n" i i; - done; - fprintf fmt " intros n x; rewrite spec_reduce_n; exact (spec_tail00 (wn_spec n) x).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt " \n"; - - - fprintf fmt " Theorem spec_tail0: forall x,\n"; - fprintf fmt " 0 < [x] -> exists y, 0 <= y /\\ [x] = (2 * y + 1) * 2 ^ [tail0 x].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x; unfold tail0.\n"; - for i = 0 to size do - fprintf fmt " intros x Hx; rewrite spec_reduce_%i; exact (spec_tail0 w%i_spec x Hx).\n" i i; - done; - fprintf fmt " intros n x Hx; rewrite spec_reduce_n; exact (spec_tail0 (wn_spec n) x Hx).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - (* Number of digits *) - fprintf fmt " Definition %sdigits x :=\n" c; - fprintf fmt " match x with\n"; - fprintf fmt " | %s0 _ => %s0 w0_op.(znz_zdigits)\n" c c; - for i = 1 to size do - fprintf fmt " | %s%i _ => reduce_%i w%i_op.(znz_zdigits)\n" c i i i; - done; - fprintf fmt " | %sn n _ => reduce_n n (make_op n).(znz_zdigits)\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x).\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; clear x; unfold Ndigits, digits.\n"; - for i = 0 to size do - fprintf fmt " intros _; try rewrite spec_reduce_%i; exact (spec_zdigits w%i_spec).\n" i i; - done; - fprintf fmt " intros n _; try rewrite spec_reduce_n; exact (spec_zdigits (wn_spec n)).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - (* Shiftr *) - for i = 0 to size do - fprintf fmt " Definition shiftr%i n x := w%i_op.(znz_add_mul_div) (w%i_op.(znz_sub) w%i_op.(znz_zdigits) n) w%i_op.(znz_0) x.\n" i i i i i; - done; - fprintf fmt " Definition shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition shiftr := Eval lazy beta delta [same_level] in \n"; - fprintf fmt " same_level _ (fun n x => %s0 (shiftr0 n x))\n" c; - for i = 1 to size do - fprintf fmt " (fun n x => reduce_%i (shiftr%i n x))\n" i i; - done; - fprintf fmt " (fun n p x => reduce_n n (shiftrn n p x)).\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_shiftr: forall n x,\n"; - fprintf fmt " [n] <= [Ndigits x] -> [shiftr n x] = [x] / 2 ^ [n].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " assert (F0: forall x y, x - (x - y) = y).\n"; - fprintf fmt " intros; ring.\n"; - fprintf fmt " assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z).\n"; - fprintf fmt " intros x y z HH HH1 HH2.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " apply Zle_lt_trans with (2 := HH2); auto with zarith.\n"; - fprintf fmt " apply Zdiv_le_upper_bound; auto with zarith.\n"; - fprintf fmt " pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith.\n"; - fprintf fmt " apply Zmult_le_compat_l; auto.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_0_r; ring.\n"; - fprintf fmt " assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x).\n"; - fprintf fmt " intros xx y HH HH1.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " apply Zle_lt_trans with xx; auto with zarith.\n"; - fprintf fmt " apply Zpower2_lt_lin; auto with zarith.\n"; - fprintf fmt " assert (F4: forall ww ww1 ww2 \n"; - fprintf fmt " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)\n"; - fprintf fmt " xx yy xx1 yy1,\n"; - fprintf fmt " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_zdigits ww1_op) ->\n"; - fprintf fmt " znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->\n"; - fprintf fmt " znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->\n"; - fprintf fmt " znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->\n"; - fprintf fmt " znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->\n"; - fprintf fmt " znz_to_Z ww_op\n"; - fprintf fmt " (znz_add_mul_div ww_op (znz_sub ww_op (znz_zdigits ww_op) yy1)\n"; - fprintf fmt " (znz_0 ww_op) xx1) = znz_to_Z ww1_op xx / 2 ^ znz_to_Z ww2_op yy).\n"; - fprintf fmt " intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy.\n"; - fprintf fmt " case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2.\n"; - fprintf fmt " case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4.\n"; - fprintf fmt " rewrite <- Hx.\n"; - fprintf fmt " rewrite <- Hy.\n"; - fprintf fmt " generalize (spec_add_mul_div Hw\n"; - fprintf fmt " (znz_0 ww_op) xx1\n"; - fprintf fmt " (znz_sub ww_op (znz_zdigits ww_op) \n"; - fprintf fmt " yy1)\n"; - fprintf fmt " ).\n"; - fprintf fmt " rewrite (spec_0 Hw).\n"; - fprintf fmt " rewrite Zmult_0_l; rewrite Zplus_0_l.\n"; - fprintf fmt " rewrite (ZnZ.spec_sub Hw).\n"; - fprintf fmt " rewrite Zmod_small; auto with zarith.\n"; - fprintf fmt " rewrite (spec_zdigits Hw).\n"; - fprintf fmt " rewrite F0.\n"; - fprintf fmt " rewrite Zmod_small; auto with zarith.\n"; - fprintf fmt " unfold base; rewrite (spec_zdigits Hw) in Hl1 |- *;\n"; - fprintf fmt " auto with zarith.\n"; - fprintf fmt " assert (F5: forall n m, (n <= m)%snat ->\n" "%"; - fprintf fmt " Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m))).\n"; - fprintf fmt " intros n m HH; elim HH; clear m HH; auto with zarith.\n"; - fprintf fmt " intros m HH Hrec; apply Zle_trans with (1 := Hrec).\n"; - fprintf fmt " rewrite make_op_S.\n"; - fprintf fmt " match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end.\n"; - fprintf fmt " rewrite Zpos_xO.\n"; - fprintf fmt " assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith.\n"; - fprintf fmt " assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n))).\n" size; - fprintf fmt " intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0))).\n"; - fprintf fmt " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op)).\n" size; - fprintf fmt " rewrite Zpos_xO.\n"; - fprintf fmt " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith.\n" size; - fprintf fmt " apply F5; auto with arith.\n"; - fprintf fmt " intros x; case x; clear x; unfold shiftr, same_level.\n"; - for i = 0 to size do - fprintf fmt " intros x y; case y; clear y.\n"; - for j = 0 to i - 1 do - fprintf fmt " intros y; unfold shiftr%i, Ndigits.\n" i; - fprintf fmt " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i j; - fprintf fmt " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith.\n" i j i; - fprintf fmt " rewrite (spec_zdigits w%i_spec).\n" i; - fprintf fmt " rewrite (spec_zdigits w%i_spec).\n" j; - fprintf fmt " change (znz_digits w%i_op) with %s.\n" i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)")); - fprintf fmt " repeat rewrite (fun x => Zpos_xO (xO x)).\n"; - fprintf fmt " repeat rewrite (fun x y => Zpos_xO (%sznz_digits x y)).\n" "@"; - fprintf fmt " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith.\n" j; - fprintf fmt " try (apply sym_equal; exact (spec_extend%in%i y)).\n" j i; - - done; - fprintf fmt " intros y; unfold shiftr%i, Ndigits.\n" i; - fprintf fmt " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i; - fprintf fmt " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith.\n" i i i; - for j = i + 1 to size do - fprintf fmt " intros y; unfold shiftr%i, Ndigits.\n" j; - fprintf fmt " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i j; - fprintf fmt " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith.\n" j j i; - fprintf fmt " try (apply sym_equal; exact (spec_extend%in%i x)).\n" i j; - done; - if i == size then - begin - fprintf fmt " intros m y; unfold shiftrn, Ndigits.\n"; - fprintf fmt " repeat rewrite spec_reduce_n; unfold to_Z; intros H1.\n"; - fprintf fmt " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith.\n" size; - fprintf fmt " try (apply sym_equal; exact (spec_extend%in m x)).\n" size; - - end - else - begin - fprintf fmt " intros m y; unfold shiftrn, Ndigits.\n"; - fprintf fmt " repeat rewrite spec_reduce_n; unfold to_Z; intros H1.\n"; - fprintf fmt " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith.\n" i; - fprintf fmt " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x]).\n" size i (size - i - 1) i; - fprintf fmt " rewrite <- (spec_extend%in m); rewrite <- spec_extend%in%i; auto.\n" size i size; - end - done; - fprintf fmt " intros n x y; case y; clear y;\n"; - fprintf fmt " intros y; unfold shiftrn, Ndigits; try rewrite spec_reduce_n.\n"; - for i = 0 to size do - fprintf fmt " try rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i; - fprintf fmt " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith.\n" i; - fprintf fmt " rewrite (spec_zdigits w%i_spec).\n" i; - fprintf fmt " rewrite (spec_zdigits (wn_spec n)).\n"; - fprintf fmt " apply Zle_trans with (2 := F6 n).\n"; - fprintf fmt " change (znz_digits w%i_op) with %s.\n" size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)")); - fprintf fmt " repeat rewrite (fun x => Zpos_xO (xO x)).\n"; - fprintf fmt " repeat rewrite (fun x y => Zpos_xO (%sznz_digits x y)).\n" "@"; - fprintf fmt " assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith.\n" i; - if i == size then - fprintf fmt " change ([Nn n (extend%i n y)] = [N%i y]).\n" size i - else - fprintf fmt " change ([Nn n (extend%i n (extend%i %i y))] = [N%i y]).\n" size i (size - i - 1) i; - fprintf fmt " rewrite <- (spec_extend%in n); auto.\n" size; - if i <> size then - fprintf fmt " try (rewrite <- spec_extend%in%i; auto).\n" i size; - done; - fprintf fmt " generalize y; clear y; intros m y.\n"; - fprintf fmt " rewrite spec_reduce_n; unfold to_Z; intros H1.\n"; - fprintf fmt " apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith.\n"; - fprintf fmt " rewrite (spec_zdigits (wn_spec m)).\n"; - fprintf fmt " rewrite (spec_zdigits (wn_spec (Max.max n m))).\n"; - fprintf fmt " apply F5; auto with arith.\n"; - fprintf fmt " exact (spec_cast_r n m y).\n"; - fprintf fmt " exact (spec_cast_l n m x).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Definition safe_shiftr n x := \n"; - fprintf fmt " match compare n (Ndigits x) with\n "; - fprintf fmt " | Lt => shiftr n x \n"; - fprintf fmt " | _ => %s0 w_0\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_safe_shiftr: forall n x,\n"; - fprintf fmt " [safe_shiftr n x] = [x] / 2 ^ [n].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros n x; unfold safe_shiftr;\n"; - fprintf fmt " generalize (spec_compare n (Ndigits x)); case compare; intros H.\n"; - fprintf fmt " apply trans_equal with (1 := spec_0 w0_spec).\n"; - fprintf fmt " apply sym_equal; apply Zdiv_small; rewrite H.\n"; - fprintf fmt " rewrite spec_Ndigits; exact (spec_digits x).\n"; - fprintf fmt " rewrite <- spec_shiftr; auto with zarith.\n"; - fprintf fmt " apply trans_equal with (1 := spec_0 w0_spec).\n"; - fprintf fmt " apply sym_equal; apply Zdiv_small.\n"; - fprintf fmt " rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2.\n"; - fprintf fmt " split; auto.\n"; - fprintf fmt " apply Zlt_le_trans with (1 := H2).\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt "\n"; - - (* Shiftl *) - for i = 0 to size do - fprintf fmt " Definition shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0).\n" i i i - done; - fprintf fmt " Definition shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0).\n"; - fprintf fmt " Definition shiftl := Eval lazy beta delta [same_level] in\n"; - fprintf fmt " same_level _ (fun n x => %s0 (shiftl0 n x))\n" c; - for i = 1 to size do - fprintf fmt " (fun n x => reduce_%i (shiftl%i n x))\n" i i; - done; - fprintf fmt " (fun n p x => reduce_n n (shiftln n p x)).\n"; - fprintf fmt "\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_shiftl: forall n x,\n"; - fprintf fmt " [n] <= [head0 x] -> [shiftl n x] = [x] * 2 ^ [n].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " assert (F0: forall x y, x - (x - y) = y).\n"; - fprintf fmt " intros; ring.\n"; - fprintf fmt " assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z).\n"; - fprintf fmt " intros x y z HH HH1 HH2.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " apply Zle_lt_trans with (2 := HH2); auto with zarith.\n"; - fprintf fmt " apply Zdiv_le_upper_bound; auto with zarith.\n"; - fprintf fmt " pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith.\n"; - fprintf fmt " apply Zmult_le_compat_l; auto.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_0_r; ring.\n"; - fprintf fmt " assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x).\n"; - fprintf fmt " intros xx y HH HH1.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " apply Zle_lt_trans with xx; auto with zarith.\n"; - fprintf fmt " apply Zpower2_lt_lin; auto with zarith.\n"; - fprintf fmt " assert (F4: forall ww ww1 ww2 \n"; - fprintf fmt " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)\n"; - fprintf fmt " xx yy xx1 yy1,\n"; - fprintf fmt " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_head0 ww1_op xx) ->\n"; - fprintf fmt " znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->\n"; - fprintf fmt " znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->\n"; - fprintf fmt " znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->\n"; - fprintf fmt " znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->\n"; - fprintf fmt " znz_to_Z ww_op\n"; - fprintf fmt " (znz_add_mul_div ww_op yy1\n"; - fprintf fmt " xx1 (znz_0 ww_op)) = znz_to_Z ww1_op xx * 2 ^ znz_to_Z ww2_op yy).\n"; - fprintf fmt " intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy.\n"; - fprintf fmt " case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2.\n"; - fprintf fmt " case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4.\n"; - fprintf fmt " rewrite <- Hx.\n"; - fprintf fmt " rewrite <- Hy.\n"; - fprintf fmt " generalize (spec_add_mul_div Hw xx1 (znz_0 ww_op) yy1).\n"; - fprintf fmt " rewrite (spec_0 Hw).\n"; - fprintf fmt " assert (F1: znz_to_Z ww1_op (znz_head0 ww1_op xx) <= Zpos (znz_digits ww1_op)).\n"; - fprintf fmt " case (Zle_lt_or_eq _ _ HH1); intros HH5.\n"; - fprintf fmt " apply Zlt_le_weak.\n"; - fprintf fmt " case (ZnZ.spec_head0 Hw1 xx).\n"; - fprintf fmt " rewrite <- Hx; auto.\n"; - fprintf fmt " intros _ Hu; unfold base in Hu.\n"; - fprintf fmt " case (Zle_or_lt (Zpos (znz_digits ww1_op))\n"; - fprintf fmt " (znz_to_Z ww1_op (znz_head0 ww1_op xx))); auto; intros H1.\n"; - fprintf fmt " absurd (2 ^ (Zpos (znz_digits ww1_op)) <= 2 ^ (znz_to_Z ww1_op (znz_head0 ww1_op xx))).\n"; - fprintf fmt " apply Zlt_not_le.\n"; - fprintf fmt " case (spec_to_Z Hw1 xx); intros HHx3 HHx4.\n"; - fprintf fmt " rewrite <- (Zmult_1_r (2 ^ znz_to_Z ww1_op (znz_head0 ww1_op xx))).\n"; - fprintf fmt " apply Zle_lt_trans with (2 := Hu).\n"; - fprintf fmt " apply Zmult_le_compat_l; auto with zarith.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " rewrite (ZnZ.spec_head00 Hw1 xx); auto with zarith.\n"; - fprintf fmt " rewrite Zdiv_0_l; auto with zarith.\n"; - fprintf fmt " rewrite Zplus_0_r.\n"; - fprintf fmt " case (Zle_lt_or_eq _ _ HH1); intros HH5.\n"; - fprintf fmt " rewrite Zmod_small; auto with zarith.\n"; - fprintf fmt " intros HH; apply HH.\n"; - fprintf fmt " rewrite Hy; apply Zle_trans with (1:= Hl).\n"; - fprintf fmt " rewrite <- (spec_zdigits Hw). \n"; - fprintf fmt " apply Zle_trans with (2 := Hl1); auto.\n"; - fprintf fmt " rewrite (spec_zdigits Hw1); auto with zarith.\n"; - fprintf fmt " split; auto with zarith .\n"; - fprintf fmt " apply Zlt_le_trans with (base (znz_digits ww1_op)).\n"; - fprintf fmt " rewrite Hx.\n"; - fprintf fmt " case (ZnZ.spec_head0 Hw1 xx); auto.\n"; - fprintf fmt " rewrite <- Hx; auto.\n"; - fprintf fmt " intros _ Hu; rewrite Zmult_comm in Hu.\n"; - fprintf fmt " apply Zle_lt_trans with (2 := Hu).\n"; - fprintf fmt " apply Zmult_le_compat_l; auto with zarith.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " unfold base; apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " rewrite <- (spec_zdigits Hw); auto with zarith.\n"; - fprintf fmt " rewrite <- (spec_zdigits Hw1); auto with zarith.\n"; - fprintf fmt " rewrite <- HH5.\n"; - fprintf fmt " rewrite Zmult_0_l.\n"; - fprintf fmt " rewrite Zmod_small; auto with zarith.\n"; - fprintf fmt " intros HH; apply HH.\n"; - fprintf fmt " rewrite Hy; apply Zle_trans with (1 := Hl).\n"; - fprintf fmt " rewrite (ZnZ.spec_head00 Hw1 xx); auto with zarith.\n"; - fprintf fmt " rewrite <- (spec_zdigits Hw); auto with zarith.\n"; - fprintf fmt " rewrite <- (spec_zdigits Hw1); auto with zarith.\n"; - fprintf fmt " assert (F5: forall n m, (n <= m)%snat ->\n" "%"; - fprintf fmt " Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m))).\n"; - fprintf fmt " intros n m HH; elim HH; clear m HH; auto with zarith.\n"; - fprintf fmt " intros m HH Hrec; apply Zle_trans with (1 := Hrec).\n"; - fprintf fmt " rewrite make_op_S.\n"; - fprintf fmt " match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end.\n"; - fprintf fmt " rewrite Zpos_xO.\n"; - fprintf fmt " assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith.\n"; - fprintf fmt " assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n))).\n" size; - fprintf fmt " intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0))).\n"; - fprintf fmt " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op)).\n" size; - fprintf fmt " rewrite Zpos_xO.\n"; - fprintf fmt " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith.\n" size; - fprintf fmt " apply F5; auto with arith.\n"; - fprintf fmt " intros x; case x; clear x; unfold shiftl, same_level.\n"; - for i = 0 to size do - fprintf fmt " intros x y; case y; clear y.\n"; - for j = 0 to i - 1 do - fprintf fmt " intros y; unfold shiftl%i, head0.\n" i; - fprintf fmt " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i j; - fprintf fmt " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith.\n" i j i; - fprintf fmt " rewrite (spec_zdigits w%i_spec).\n" i; - fprintf fmt " rewrite (spec_zdigits w%i_spec).\n" j; - fprintf fmt " change (znz_digits w%i_op) with %s.\n" i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)")); - fprintf fmt " repeat rewrite (fun x => Zpos_xO (xO x)).\n"; - fprintf fmt " repeat rewrite (fun x y => Zpos_xO (%sznz_digits x y)).\n" "@"; - fprintf fmt " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith.\n" j; - fprintf fmt " try (apply sym_equal; exact (spec_extend%in%i y)).\n" j i; - - done; - fprintf fmt " intros y; unfold shiftl%i, head0.\n" i; - fprintf fmt " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i; - fprintf fmt " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith.\n" i i i; - for j = i + 1 to size do - fprintf fmt " intros y; unfold shiftl%i, head0.\n" j; - fprintf fmt " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i j; - fprintf fmt " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith.\n" j j i; - fprintf fmt " try (apply sym_equal; exact (spec_extend%in%i x)).\n" i j; - done; - if i == size then - begin - fprintf fmt " intros m y; unfold shiftln, head0.\n"; - fprintf fmt " repeat rewrite spec_reduce_n; unfold to_Z; intros H1.\n"; - fprintf fmt " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith.\n" size; - fprintf fmt " try (apply sym_equal; exact (spec_extend%in m x)).\n" size; - - end - else - begin - fprintf fmt " intros m y; unfold shiftln, head0.\n"; - fprintf fmt " repeat rewrite spec_reduce_n; unfold to_Z; intros H1.\n"; - fprintf fmt " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith.\n" i; - fprintf fmt " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x]).\n" size i (size - i - 1) i; - fprintf fmt " rewrite <- (spec_extend%in m); rewrite <- spec_extend%in%i; auto.\n" size i size; - end - done; - fprintf fmt " intros n x y; case y; clear y;\n"; - fprintf fmt " intros y; unfold shiftln, head0; try rewrite spec_reduce_n.\n"; - for i = 0 to size do - fprintf fmt " try rewrite spec_reduce_%i; unfold to_Z; intros H1.\n" i; - fprintf fmt " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith.\n" i; - fprintf fmt " rewrite (spec_zdigits w%i_spec).\n" i; - fprintf fmt " rewrite (spec_zdigits (wn_spec n)).\n"; - fprintf fmt " apply Zle_trans with (2 := F6 n).\n"; - fprintf fmt " change (znz_digits w%i_op) with %s.\n" size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)")); - fprintf fmt " repeat rewrite (fun x => Zpos_xO (xO x)).\n"; - fprintf fmt " repeat rewrite (fun x y => Zpos_xO (%sznz_digits x y)).\n" "@"; - fprintf fmt " assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith.\n" i; - if i == size then - fprintf fmt " change ([Nn n (extend%i n y)] = [N%i y]).\n" size i - else - fprintf fmt " change ([Nn n (extend%i n (extend%i %i y))] = [N%i y]).\n" size i (size - i - 1) i; - fprintf fmt " rewrite <- (spec_extend%in n); auto.\n" size; - if i <> size then - fprintf fmt " try (rewrite <- spec_extend%in%i; auto).\n" i size; - done; - fprintf fmt " generalize y; clear y; intros m y.\n"; - fprintf fmt " repeat rewrite spec_reduce_n; unfold to_Z; intros H1.\n"; - fprintf fmt " apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith.\n"; - fprintf fmt " rewrite (spec_zdigits (wn_spec m)).\n"; - fprintf fmt " rewrite (spec_zdigits (wn_spec (Max.max n m))).\n"; - fprintf fmt " apply F5; auto with arith.\n"; - fprintf fmt " exact (spec_cast_r n m y).\n"; - fprintf fmt " exact (spec_cast_l n m x).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - (* Double size *) - fprintf fmt " Definition double_size w := match w with\n"; - for i = 0 to size-1 do - fprintf fmt " | %s%i x => %s%i (WW (znz_0 w%i_op) x)\n" c i c (i + 1) i; - done; - fprintf fmt " | %s%i x => %sn 0 (WW (znz_0 w%i_op) x)\n" c size c size; - fprintf fmt " | %sn n x => %sn (S n) (WW (znz_0 (make_op n)) x)\n" c c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_double_size_digits: \n"; - fprintf fmt " forall x, digits (double_size x) = xO (digits x).\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold double_size, digits; clear x; auto.\n"; - fprintf fmt " intros n x; rewrite make_op_S; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_double_size: forall x, [double_size x] = [x].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold double_size; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x; unfold to_Z, make_op; \n"; - fprintf fmt " rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto with zarith.\n" (i + 1) i; - done; - fprintf fmt " intros n x; unfold to_Z;\n"; - fprintf fmt " generalize (znz_to_Z_n n); simpl word.\n"; - fprintf fmt " intros HH; rewrite HH; clear HH.\n"; - fprintf fmt " generalize (spec_0 (wn_spec n)); simpl word.\n"; - fprintf fmt " intros HH; rewrite HH; clear HH; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_double_size_head0: \n"; - fprintf fmt " forall x, 2 * [head0 x] <= [head0 (double_size x)].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x.\n"; - fprintf fmt " assert (F1:= spec_pos (head0 x)).\n"; - fprintf fmt " assert (F2: 0 < Zpos (digits x)).\n"; - fprintf fmt " red; auto.\n"; - fprintf fmt " case (Zle_lt_or_eq _ _ (spec_pos x)); intros HH.\n"; - fprintf fmt " generalize HH; rewrite <- (spec_double_size x); intros HH1.\n"; - fprintf fmt " case (spec_head0 x HH); intros _ HH2.\n"; - fprintf fmt " case (spec_head0 _ HH1).\n"; - fprintf fmt " rewrite (spec_double_size x); rewrite (spec_double_size_digits x).\n"; - fprintf fmt " intros HH3 _.\n"; - fprintf fmt " case (Zle_or_lt ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4.\n"; - fprintf fmt " absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto.\n"; - fprintf fmt " apply Zle_not_lt.\n"; - fprintf fmt " apply Zmult_le_compat_r; auto with zarith.\n"; - fprintf fmt " apply Zpower_le_monotone; auto; auto with zarith.\n"; - fprintf fmt " generalize (spec_pos (head0 (double_size x))); auto with zarith.\n"; - fprintf fmt " assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1)).\n"; - fprintf fmt " case (Zle_lt_or_eq 1 [x]); auto with zarith; intros HH5.\n"; - fprintf fmt " apply Zmult_le_reg_r with (2 ^ 1); auto with zarith.\n"; - fprintf fmt " rewrite <- (fun x y z => Zpower_exp x (y - z)); auto with zarith.\n"; - fprintf fmt " assert (tmp: forall x, x - 1 + 1 = x); [intros; ring | rewrite tmp; clear tmp].\n"; - fprintf fmt " apply Zle_trans with (2 := Zlt_le_weak _ _ HH2).\n"; - fprintf fmt " apply Zmult_le_compat_l; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_1_r; auto with zarith.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " split; auto with zarith. \n"; - fprintf fmt " case (Zle_or_lt (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6.\n"; - fprintf fmt " absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith.\n"; - fprintf fmt " rewrite <- HH5; rewrite Zmult_1_r.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " rewrite (Zmult_comm 2).\n"; - fprintf fmt " rewrite Zpower_mult; auto with zarith.\n"; - fprintf fmt " rewrite Zpower_2.\n"; - fprintf fmt " apply Zlt_le_trans with (2 := HH3).\n"; - fprintf fmt " rewrite <- Zmult_assoc.\n"; - fprintf fmt " replace (Zpos (xO (digits x)) - 1) with\n"; - fprintf fmt " ((Zpos (digits x) - 1) + (Zpos (digits x))).\n"; - fprintf fmt " rewrite Zpower_exp; auto with zarith.\n"; - fprintf fmt " apply Zmult_lt_compat2; auto with zarith.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " apply Zmult_lt_0_compat; auto with zarith.\n"; - fprintf fmt " rewrite Zpos_xO; ring.\n"; - fprintf fmt " apply Zlt_le_weak; auto.\n"; - fprintf fmt " repeat rewrite spec_head00; auto.\n"; - fprintf fmt " rewrite spec_double_size_digits.\n"; - fprintf fmt " rewrite Zpos_xO; auto with zarith.\n"; - fprintf fmt " rewrite spec_double_size; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_double_size_head0_pos: \n"; - fprintf fmt " forall x, 0 < [head0 (double_size x)].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x.\n"; - fprintf fmt " assert (F: 0 < Zpos (digits x)).\n"; - fprintf fmt " red; auto.\n"; - fprintf fmt " case (Zle_lt_or_eq _ _ (spec_pos (head0 (double_size x)))); auto; intros F0.\n"; - fprintf fmt " case (Zle_lt_or_eq _ _ (spec_pos (head0 x))); intros F1.\n"; - fprintf fmt " apply Zlt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith.\n"; - fprintf fmt " case (Zle_lt_or_eq _ _ (spec_pos x)); intros F3.\n"; - fprintf fmt " generalize F3; rewrite <- (spec_double_size x); intros F4.\n"; - fprintf fmt " absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x))).\n"; - fprintf fmt " apply Zle_not_lt.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " split; auto with zarith.\n"; - fprintf fmt " rewrite Zpos_xO; auto with zarith.\n"; - fprintf fmt " case (spec_head0 x F3).\n"; - fprintf fmt " rewrite <- F1; rewrite Zpower_0_r; rewrite Zmult_1_l; intros _ HH.\n"; - fprintf fmt " apply Zle_lt_trans with (2 := HH).\n"; - fprintf fmt " case (spec_head0 _ F4).\n"; - fprintf fmt " rewrite (spec_double_size x); rewrite (spec_double_size_digits x).\n"; - fprintf fmt " rewrite <- F0; rewrite Zpower_0_r; rewrite Zmult_1_l; auto.\n"; - fprintf fmt " generalize F1; rewrite (spec_head00 _ (sym_equal F3)); auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - (* Safe shiftl *) - - fprintf fmt " Definition safe_shiftl_aux_body cont n x :=\n"; - fprintf fmt " match compare n (head0 x) with\n"; - fprintf fmt " Gt => cont n (double_size x)\n"; - fprintf fmt " | _ => shiftl n x\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_safe_shift_aux_body: forall n p x cont,\n"; - fprintf fmt " 2^ Zpos p <= [head0 x] ->\n"; - fprintf fmt " (forall x, 2 ^ (Zpos p + 1) <= [head0 x]->\n"; - fprintf fmt " [cont n x] = [x] * 2 ^ [n]) ->\n"; - fprintf fmt " [safe_shiftl_aux_body cont n x] = [x] * 2 ^ [n].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros n p x cont H1 H2; unfold safe_shiftl_aux_body.\n"; - fprintf fmt " generalize (spec_compare n (head0 x)); case compare; intros H.\n"; - fprintf fmt " apply spec_shiftl; auto with zarith.\n"; - fprintf fmt " apply spec_shiftl; auto with zarith.\n"; - fprintf fmt " rewrite H2.\n"; - fprintf fmt " rewrite spec_double_size; auto.\n"; - fprintf fmt " rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith.\n"; - fprintf fmt " apply Zle_trans with (2 := spec_double_size_head0 x).\n"; - fprintf fmt " rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Fixpoint safe_shiftl_aux p cont n x {struct p} :=\n"; - fprintf fmt " safe_shiftl_aux_body \n"; - fprintf fmt " (fun n x => match p with\n"; - fprintf fmt " | xH => cont n x\n"; - fprintf fmt " | xO p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x\n"; - fprintf fmt " | xI p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x\n"; - fprintf fmt " end) n x.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_safe_shift_aux: forall p q n x cont,\n"; - fprintf fmt " 2 ^ (Zpos q) <= [head0 x] ->\n"; - fprintf fmt " (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] ->\n"; - fprintf fmt " [cont n x] = [x] * 2 ^ [n]) -> \n"; - fprintf fmt " [safe_shiftl_aux p cont n x] = [x] * 2 ^ [n].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros p; elim p; unfold safe_shiftl_aux; fold safe_shiftl_aux; clear p.\n"; - fprintf fmt " intros p Hrec q n x cont H1 H2.\n"; - fprintf fmt " apply spec_safe_shift_aux_body with (q); auto.\n"; - fprintf fmt " intros x1 H3; apply Hrec with (q + 1)%spositive; auto.\n" "%"; - fprintf fmt " intros x2 H4; apply Hrec with (p + q + 1)%spositive; auto.\n" "%"; - fprintf fmt " rewrite <- Pplus_assoc.\n"; - fprintf fmt " rewrite Zpos_plus_distr; auto.\n"; - fprintf fmt " intros x3 H5; apply H2.\n"; - fprintf fmt " rewrite Zpos_xI.\n"; - fprintf fmt " replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1));\n"; - fprintf fmt " auto.\n"; - fprintf fmt " repeat rewrite Zpos_plus_distr; ring.\n"; - fprintf fmt " intros p Hrec q n x cont H1 H2.\n"; - fprintf fmt " apply spec_safe_shift_aux_body with (q); auto.\n"; - fprintf fmt " intros x1 H3; apply Hrec with (q); auto.\n"; - fprintf fmt " apply Zle_trans with (2 := H3); auto with zarith.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " intros x2 H4; apply Hrec with (p + q)%spositive; auto.\n" "%"; - fprintf fmt " intros x3 H5; apply H2.\n"; - fprintf fmt " rewrite (Zpos_xO p).\n"; - fprintf fmt " replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q));\n"; - fprintf fmt " auto.\n"; - fprintf fmt " repeat rewrite Zpos_plus_distr; ring.\n"; - fprintf fmt " intros q n x cont H1 H2.\n"; - fprintf fmt " apply spec_safe_shift_aux_body with (q); auto.\n"; - fprintf fmt " rewrite Zplus_comm; auto.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Definition safe_shiftl n x :=\n"; - fprintf fmt " safe_shiftl_aux_body\n"; - fprintf fmt " (safe_shiftl_aux_body\n"; - fprintf fmt " (safe_shiftl_aux (digits n) shiftl)) n x.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_safe_shift: forall n x,\n"; - fprintf fmt " [safe_shiftl n x] = [x] * 2 ^ [n].\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros n x; unfold safe_shiftl, safe_shiftl_aux_body.\n"; - fprintf fmt " generalize (spec_compare n (head0 x)); case compare; intros H.\n"; - fprintf fmt " apply spec_shiftl; auto with zarith.\n"; - fprintf fmt " apply spec_shiftl; auto with zarith.\n"; - fprintf fmt " rewrite <- (spec_double_size x).\n"; - fprintf fmt " generalize (spec_compare n (head0 (double_size x))); case compare; intros H1.\n"; - fprintf fmt " apply spec_shiftl; auto with zarith.\n"; - fprintf fmt " apply spec_shiftl; auto with zarith.\n"; - fprintf fmt " rewrite <- (spec_double_size (double_size x)).\n"; - fprintf fmt " apply spec_safe_shift_aux with 1%spositive.\n" "%"; - fprintf fmt " apply Zle_trans with (2 := spec_double_size_head0 (double_size x)).\n"; - fprintf fmt " replace (2 ^ 1) with (2 * 1).\n"; - fprintf fmt " apply Zmult_le_compat_l; auto with zarith.\n"; - fprintf fmt " generalize (spec_double_size_head0_pos x); auto with zarith.\n"; - fprintf fmt " rewrite Zpower_1_r; ring.\n"; - fprintf fmt " intros x1 H2; apply spec_shiftl.\n"; - fprintf fmt " apply Zle_trans with (2 := H2).\n"; - fprintf fmt " apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith.\n"; - fprintf fmt " case (spec_digits n); auto with zarith.\n"; - fprintf fmt " apply Zpower_le_monotone; auto with zarith.\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - (* even *) - fprintf fmt " Definition is_even x :=\n"; - fprintf fmt " match x with\n"; - for i = 0 to size do - fprintf fmt " | %s%i wx => w%i_op.(znz_is_even) wx\n" c i i - done; - fprintf fmt " | %sn n wx => (make_op n).(znz_is_even) wx\n" c; - fprintf fmt " end.\n"; - fprintf fmt "\n"; - - - fprintf fmt " Theorem spec_is_even: forall x,\n"; - fprintf fmt " if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " intros x; case x; unfold is_even, to_Z; clear x.\n"; - for i = 0 to size do - fprintf fmt " intros x; exact (spec_is_even w%i_spec x).\n" i; - done; - fprintf fmt " intros n x; exact (spec_is_even (wn_spec n) x).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_0: [zero] = 0.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " exact (spec_0 w0_spec).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - fprintf fmt " Theorem spec_1: [one] = 1.\n"; - if gen_proof then - begin - fprintf fmt " Proof.\n"; - fprintf fmt " exact (spec_1 w0_spec).\n"; - fprintf fmt " Qed.\n"; - end - else - fprintf fmt " Admitted.\n"; - fprintf fmt "\n"; - - - fprintf fmt "End Make.\n"; - fprintf fmt "\n"; - pp_print_flush fmt () - - - - -let _ = print_Make () - - |