diff options
| author |  letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2008-05-08 14:50:59 +0000 |
|---|---|---|
| committer | letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2008-05-08 14:50:59 +0000 |
| commit | e5a5332c96da9d65359c7a729a9c3fc81fb026d9 (patch) | |
| tree | ee0ad18d348c55e660b7c1a64212a9b4e45f7b26 /theories | |
| parent | 47a3b5afc264a45076a519682c094e207d4d210e (diff) | |
Integration of theories/Ints into theories/Numbers, part 3: auto-generation of NMake.v
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@10902 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'theories')
| -rw-r--r-- | theories/Numbers/Natural/BigN/NMake.v | 6809 | ||||
| -rw-r--r-- | theories/Numbers/Natural/BigN/genN.ml | 5949 |
2 files changed, 2845 insertions, 9913 deletions
diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v deleted file mode 100644 index 6705c1898..000000000 --- a/theories/Numbers/Natural/BigN/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 BigNumPrelude. -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 StreamMemo. - -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/Numbers/Natural/BigN/genN.ml b/theories/Numbers/Natural/BigN/genN.ml index 8bf583ab6..2a6e4b16a 100644 --- a/theories/Numbers/Natural/BigN/genN.ml +++ b/theories/Numbers/Natural/BigN/genN.ml @@ -1,8 +1,24 @@ -open Format +(************************************************************************) +(* 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 *) +(************************************************************************) -let size = 6 -let sizeaux = 1 -let gen_proof = true +(*i $Id$ i*) + +(*S genN.ml : this file generates NMake.v *) + + +(*s The two parameters that control the generation: *) + +let size = 6 (* how many times should we repeat the Z/nZ --> Z/2nZ + process before relying on a generic construct *) +let gen_proof = true (* should we generate proofs ? *) + + +(*s Some utilities *) let t = "t" let c = "N" @@ -12,3396 +28,3121 @@ let rec gen2 n = if n == 0 then "1" else if n == 1 then "2" 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"; +(* Standard printer, with a final newline *) +let pr s = Printf.printf (s^^"\n") +(* /dev/null printer *) +let pn s = Printf.ifprintf stdout s +(* Proof printer : prints iff gen_proof is true *) +let pp = if gen_proof then pr else pn +(* Printer for admitted parts : prints iff gen_proof is false *) +let pa = if gen_proof then pn else pr +(* Same as before, but without the final newline *) +let pr0 = Printf.printf +let pp0 = if gen_proof then pr0 else pn + + +(*s The actual printing *) + +let _ = + + pr "(************************************************************************)"; + pr "(* v * The Coq Proof Assistant / The Coq Development Team *)"; + pr "(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)"; + pr "(* \\VV/ **************************************************************)"; + pr "(* // * This file is distributed under the terms of the *)"; + pr "(* * GNU Lesser General Public License Version 2.1 *)"; + pr "(************************************************************************)"; + pr ""; + pr "(**"; + pr "- Authors: Benjamin Grégoire, Laurent Théry"; + pr "- Institution: INRIA"; + pr "- Date: 2007"; + pr "- Remark: File automatically generated, DO NOT EDIT, see genN.ml instead"; + pr "*)"; + pr ""; + pr "Require Import BigNumPrelude."; + pr "Require Import ZArith."; + pr "Require Import Basic_type."; + pr "Require Import ZnZ."; + pr "Require Import Zn2Z."; + pr "Require Import Nbasic."; + pr "Require Import GenMul."; + pr "Require Import GenDivn1."; + pr "Require Import Wf_nat."; + pr "Require Import StreamMemo."; + pr ""; + pr "Module Type W0Type."; + pr " Parameter w : Set."; + pr " Parameter w_op : znz_op w."; + pr " Parameter w_spec : znz_spec w_op."; + pr "End W0Type."; + pr ""; + pr "Module Make (W0:W0Type)."; + pr " Import W0."; + pr ""; + + pr " Definition w0 := W0.w."; for i = 1 to size do - fprintf fmt " Definition w%i := zn2z w%i.\n" i (i-1) + pr " Definition w%i := zn2z w%i." i (i-1) done; - fprintf fmt "\n"; + pr ""; - fprintf fmt " Definition w0_op := W0.w_op.\n"; + pr " Definition w0_op := W0.w_op."; for i = 1 to 3 do - fprintf fmt " Definition w%i_op := mk_zn2z_op w%i_op.\n" i (i-1) + pr " Definition w%i_op := mk_zn2z_op w%i_op." 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; + pr " Definition w%i_op := mk_zn2z_op_karatsuba w%i_op." i (i-1) + done; + pr ""; + + pr " Section Make_op."; + pr " Variable mk : forall w', znz_op w' -> znz_op (zn2z w')."; + pr ""; + pr " Fixpoint make_op_aux (n:nat) : znz_op (word w%i (S n)):=" size; + pr " match n return znz_op (word w%i (S n)) with" size; + pr " | O => w%i_op" (size+1); + pr " | S n1 =>"; + pr " match n1 return znz_op (word w%i (S (S n1))) with" size; + pr " | O => w%i_op" (size+2); + pr " | S n2 =>"; + pr " match n2 return znz_op (word w%i (S (S (S n2)))) with" size; + pr " | O => w%i_op" (size+3); + pr " | S n3 => mk _ (mk _ (mk _ (make_op_aux n3)))"; + pr " end"; + pr " end"; + pr " end."; + pr ""; + pr " End Make_op."; + pr ""; + pr " Definition omake_op := make_op_aux mk_zn2z_op_karatsuba."; + pr ""; + pr ""; + pr " Definition make_op_list := dmemo_list _ omake_op."; + pr ""; + pr " Definition make_op n := dmemo_get _ omake_op n make_op_list."; + pr ""; + pr " Lemma make_op_omake: forall n, make_op n = omake_op n."; + pr " intros n; unfold make_op, make_op_list."; + pr " refine (dmemo_get_correct _ _ _)."; + pr " Qed."; + pr ""; + + pr " Inductive %s_ : Set :=" t; for i = 0 to size do - fprintf fmt " | %s%i : w%i -> %s_\n" c i i t + pr " | %s%i : w%i -> %s_" 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"; + pr " | %sn : forall n, word w%i (S n) -> %s_." c size t; + pr ""; + pr " Definition %s := %s_." t t; + pr ""; + + pr " Definition w_0 := w0_op.(znz_0)."; + pr ""; + + for i = 0 to size do + pr " Definition one%i := w%i_op.(znz_1)." i i + done; + pr ""; + + + pr " Definition zero := %s0 w_0." c; + pr " Definition one := %s0 one0." c; + pr ""; + + pr " Definition to_Z x :="; + pr " match x with"; + for i = 0 to size do + pr " | %s%i wx => w%i_op.(znz_to_Z) wx" c i i + done; + pr " | %sn n wx => (make_op n).(znz_to_Z) wx" c; + pr " end."; + pr ""; + + pr " Open Scope Z_scope."; + pr " Notation \"[ x ]\" := (to_Z x)."; + pr " "; + + + pp " (* Regular make op (no karatsuba) *)"; + pp " Fixpoint nmake_op (ww:Set) (ww_op: znz_op ww) (n: nat) : "; + pp " znz_op (word ww n) :="; + pp " match n return znz_op (word ww n) with "; + pp " O => ww_op"; + pp " | S n1 => mk_zn2z_op (nmake_op ww ww_op n1) "; + pp " end."; + pp ""; + pp " (* Simplification by rewriting for nmake_op *)"; + pp " Theorem nmake_op_S: forall ww (w_op: znz_op ww) x, "; + pp " nmake_op _ w_op (S x) = mk_zn2z_op (nmake_op _ w_op x)."; + pp " auto."; + pp " Qed."; + pp ""; + + + pr " (* Eval and extend functions for each level *)"; + for i = 0 to size do + pp " Let nmake_op%i := nmake_op _ w%i_op." i i; + pp " Let eval%in n := znz_to_Z (nmake_op%i n)." i i; + if i == 0 then + pr " Let extend%i := GenBase.extend (WW w_0)." i + else + pr " Let extend%i := GenBase.extend (WW (W0: w%i))." i i; + done; + pr ""; + + + pp " Theorem digits_gend:forall n ww (w_op: znz_op ww), "; + pp " znz_digits (nmake_op _ w_op n) = "; + pp " GenBase.gen_digits (znz_digits w_op) n."; + pp " Proof."; + pp " intros n; elim n; auto; clear n."; + pp " intros n Hrec ww ww_op; simpl GenBase.gen_digits."; + pp " rewrite <- Hrec; auto."; + pp " Qed."; + pp ""; + pp " Theorem nmake_gen: forall n ww (w_op: znz_op ww), "; + pp " znz_to_Z (nmake_op _ w_op n) ="; + pp " @GenBase.gen_to_Z _ (znz_digits w_op) (znz_to_Z w_op) n."; + pp " Proof."; + pp " intros n; elim n; auto; clear n."; + pp " intros n Hrec ww ww_op; simpl GenBase.gen_to_Z; unfold zn2z_to_Z."; + pp " rewrite <- Hrec; auto."; + pp " unfold GenBase.gen_wB; rewrite <- digits_gend; auto."; + pp " Qed."; + pp ""; + + + pp " Theorem digits_nmake:forall n ww (w_op: znz_op ww), "; + pp " znz_digits (nmake_op _ w_op (S n)) = "; + pp " xO (znz_digits (nmake_op _ w_op n))."; + pp " Proof."; + pp " auto."; + pp " Qed."; + pp ""; + + + pp " Theorem znz_nmake_op: forall ww ww_op n xh xl,"; + pp " znz_to_Z (nmake_op ww ww_op (S n)) (WW xh xl) ="; + pp " znz_to_Z (nmake_op ww ww_op n) xh *"; + pp " base (znz_digits (nmake_op ww ww_op n)) +"; + pp " znz_to_Z (nmake_op ww ww_op n) xl."; + pp " Proof."; + pp " auto."; + pp " Qed."; + pp ""; + + pp " Theorem make_op_S: forall n,"; + pp " make_op (S n) = mk_zn2z_op_karatsuba (make_op n)."; + pp " intro n."; + pp " do 2 rewrite make_op_omake."; + pp " pattern n; apply lt_wf_ind; clear n."; + pp " intros n; case n; clear n."; + pp " intros _; unfold omake_op, make_op_aux, w%i_op; apply refl_equal." (size + 2); + pp " intros n; case n; clear n."; + pp " intros _; unfold omake_op, make_op_aux, w%i_op; apply refl_equal." (size + 3); + pp " intros n; case n; clear n."; + pp " intros _; unfold omake_op, make_op_aux, w%i_op, w%i_op; apply refl_equal." (size + 3) (size + 2); + pp " intros n Hrec."; + pp " change (omake_op (S (S (S (S n))))) with"; + pp " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op (S n)))))."; + pp " change (omake_op (S (S (S n)))) with"; + pp " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (omake_op n))))."; + pp " rewrite Hrec; auto with arith."; + pp " Qed."; + pp " "; 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"; + pp " Let znz_to_Z_%i: forall x y," i; + pp " znz_to_Z w%i_op (WW x y) = " i; + pp " znz_to_Z w%i_op x * base (znz_digits w%i_op) + znz_to_Z w%i_op y." (i-1) (i-1) (i-1); + pp " Proof."; + pp " auto."; + pp " Qed. "; + pp ""; + done; + + pp " Let znz_to_Z_n: forall n x y,"; + pp " znz_to_Z (make_op (S n)) (WW x y) = "; + pp " znz_to_Z (make_op n) x * base (znz_digits (make_op n)) + znz_to_Z (make_op n) y."; + pp " Proof."; + pp " intros n x y; rewrite make_op_S; auto."; + pp " Qed. "; + pp ""; + + pp " Let w0_spec: znz_spec w0_op := W0.w_spec."; 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) + pp " Let w%i_spec: znz_spec w%i_op := mk_znz2_spec w%i_spec." i i (i-1) done; for i = 4 to size + 3 do - 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"; + pp " Let w%i_spec : znz_spec w%i_op := mk_znz2_karatsuba_spec w%i_spec." i i (i-1) done; - fprintf fmt "\n"; + pp ""; - - 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 + pp " Let wn_spec: forall n, znz_spec (make_op n)."; + pp " intros n; elim n; clear n."; + pp " exact w%i_spec." (size + 1); + pp " intros n Hrec; rewrite make_op_S."; + pp " exact (mk_znz2_karatsuba_spec Hrec)."; + pp " Qed."; + pp ""; + + for i = 0 to size do + pr " Definition w%i_eq0 := w%i_op.(znz_eq0)." i i; + pr " Let spec_w%i_eq0: forall x, if w%i_eq0 x then [%s%i x] = 0 else True." i i c i; + pa " Admitted."; + pp " Proof."; + pp " intros x; unfold w%i_eq0, to_Z; generalize (spec_eq0 w%i_spec x);" i i; + pp " case znz_eq0; auto."; + pp " Qed."; + pr ""; + done; + pr ""; + + + for i = 0 to size do + pp " Theorem digits_w%i: znz_digits w%i_op = znz_digits (nmake_op _ w0_op %i)." i i i; + if i == 0 then + pp " auto." 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); + pp " rewrite digits_nmake; rewrite <- digits_w%i; auto." (i - 1); + pp " Qed."; + pp ""; + pp " 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." i i i i; + pp " Proof."; + pp " intros n; exact (nmake_gen n w%i w%i_op)." i i; + pp " Qed."; + pp ""; + done; - end + for i = 0 to size do + for j = 0 to (size - i) do + pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i j (i + j) i j; + pp " Proof."; + if j == 0 then + if i == 0 then + pp " auto." 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"; + pp " apply trans_equal with (xO (znz_digits w%i_op))." (i + j -1); + pp " auto."; + pp " unfold nmake_op; auto."; + end + else + begin + pp " apply trans_equal with (xO (znz_digits w%i_op))." (i + j -1); + pp " auto."; + pp " rewrite digits_nmake."; + pp " rewrite digits_w%in%i." i (j - 1); + pp " auto."; + end; + pp " Qed."; + pp ""; + pp " Let spec_eval%in%i: forall x, [%s%i x] = eval%in %i x." i j c (i + j) i j; + pp " Proof."; + if j == 0 then + pp " intros x; rewrite spec_gen_eval%in; unfold GenBase.gen_to_Z, to_Z; auto." i + else + begin + pp " intros x; case x."; + pp " auto."; + pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (i + j); + pp " rewrite digits_w%in%i." i (j - 1); + pp " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH." i (j - 1); + pp " unfold eval%in, nmake_op%i." i i; + pp " rewrite (znz_nmake_op _ w%i_op %i); auto." i (j - 1); + end; + pp " Qed."; + if i + j <> size then + begin + pp " Let spec_extend%in%i: forall x, [%s%i x] = [%s%i (extend%i %i x)]." i (i + j + 1) c i c (i + j + 1) i j; + if j == 0 then + begin + pp " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." i (i + j); + pp " unfold to_Z; rewrite znz_to_Z_%i." (i + j + 1); + pp " rewrite (spec_0 w%i_spec); auto." (i + j); + end + else + begin + pp " intros x; change (extend%i %i x) with (WW (znz_0 w%i_op) (extend%i %i x))." i j (i + j) i (j - 1); + pp " unfold to_Z; rewrite znz_to_Z_%i." (i + j + 1); + pp " rewrite (spec_0 w%i_spec)." (i + j); + pp " generalize (spec_extend%in%i x); unfold to_Z." i (i + j); + pp " intros HH; rewrite <- HH; auto."; + end; + pp " Qed."; + pp ""; + end; + done; + + pp " Theorem digits_w%in%i: znz_digits w%i_op = znz_digits (nmake_op _ w%i_op %i)." i (size - i + 1) (size + 1) i (size - i + 1); + pp " Proof."; + pp " apply trans_equal with (xO (znz_digits w%i_op))." size; + pp " auto."; + pp " rewrite digits_nmake."; + pp " rewrite digits_w%in%i." i (size - i); + pp " auto."; + pp " Qed."; + pp ""; + + pp " Let spec_eval%in%i: forall x, [%sn 0 x] = eval%in %i x." i (size - i + 1) c i (size - i + 1); + pp " Proof."; + pp " intros x; case x."; + pp " auto."; + pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (size + 1); + pp " rewrite digits_w%in%i." i (size - i); + pp " generalize (spec_eval%in%i); unfold to_Z; intros HH; repeat rewrite HH." i (size - i); + pp " unfold eval%in, nmake_op%i." i i; + pp " rewrite (znz_nmake_op _ w%i_op %i); auto." i (size - i); + pp " Qed."; + pp ""; + + pp " Let spec_eval%in%i: forall x, [%sn 1 x] = eval%in %i x." i (size - i + 2) c i (size - i + 2); + pp " intros x; case x."; + pp " auto."; + pp " intros xh xl; unfold to_Z; rewrite znz_to_Z_%i." (size + 2); + pp " rewrite digits_w%in%i." i (size + 1 - i); + pp " generalize (spec_eval%in%i); unfold to_Z; change (make_op 0) with (w%i_op); intros HH; repeat rewrite HH." i (size + 1 - i) (size + 1); + pp " unfold eval%in, nmake_op%i." i i; + pp " rewrite (znz_nmake_op _ w%i_op %i); auto." i (size + 1 - i); + pp " Qed."; + pp ""; + done; + + pp " Let digits_w%in: forall n," size; + pp " znz_digits (make_op n) = znz_digits (nmake_op _ w%i_op (S n))." size; + pp " intros n; elim n; clear n."; + pp " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size; + pp " rewrite nmake_op_S; apply sym_equal; auto."; + pp " intros n Hrec."; + pp " replace (znz_digits (make_op (S n))) with (xO (znz_digits (make_op n)))."; + pp " rewrite Hrec."; + pp " rewrite nmake_op_S; apply sym_equal; auto."; + pp " rewrite make_op_S; apply sym_equal; auto."; + pp " Qed."; + pp ""; + + pp " Let spec_eval%in: forall n x, [%sn n x] = eval%in (S n) x." size c size; + pp " intros n; elim n; clear n."; + pp " exact spec_eval%in1." size; + pp " intros n Hrec x; case x; clear x."; + pp " unfold to_Z, eval%in, nmake_op%i." size size; + pp " rewrite make_op_S; rewrite nmake_op_S; auto."; + pp " intros xh xl."; + pp " unfold to_Z in Hrec |- *."; + pp " rewrite znz_to_Z_n."; + pp " rewrite digits_w%in." size; + pp " repeat rewrite Hrec."; + pp " unfold eval%in, nmake_op%i." size size; + pp " apply sym_equal; rewrite nmake_op_S; auto."; + pp " Qed."; + pp ""; + + pp " Let spec_extend%in: forall n x, [%s%i x] = [%sn n (extend%i n x)]." size c size c size ; + pp " intros n; elim n; clear n."; + pp " intros x; change (extend%i 0 x) with (WW (znz_0 w%i_op) x)." size size; + pp " unfold to_Z."; + pp " change (make_op 0) with w%i_op." (size + 1); + pp " rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto." (size + 1) size; + pp " intros n Hrec x."; + pp " change (extend%i (S n) x) with (WW W0 (extend%i n x))." size size; + pp " unfold to_Z in Hrec |- *; rewrite znz_to_Z_n; auto."; + pp " rewrite <- Hrec."; + pp " replace (znz_to_Z (make_op n) W0) with 0; auto."; + pp " case n; auto; intros; rewrite make_op_S; auto."; + pp " Qed."; + pp ""; + + pr " Theorem spec_pos: forall x, 0 <= [x]."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; clear x."; + for i = 0 to size do + pp " intros x; case (spec_to_Z w%i_spec x); auto." i; + done; + pp " intros n x; case (spec_to_Z (wn_spec n) x); auto."; + pp " Qed."; + pr ""; + + pp " Let spec_extendn_0: forall n wx, [%sn n (extend n _ wx)] = [%sn 0 wx]." c c; + pp " intros n; elim n; auto."; + pp " intros n1 Hrec wx; simpl extend; rewrite <- Hrec; auto."; + pp " unfold to_Z."; + pp " case n1; auto; intros n2; repeat rewrite make_op_S; auto."; + pp " Qed."; + pp " Hint Rewrite spec_extendn_0: extr."; + pp ""; + pp " Let spec_extendn0_0: forall n wx, [%sn (S n) (WW W0 wx)] = [%sn n wx]." c c; + pp " Proof."; + pp " intros n x; unfold to_Z."; + pp " rewrite znz_to_Z_n."; + pp " rewrite <- (Zplus_0_l (znz_to_Z (make_op n) x))."; + pp " apply (f_equal2 Zplus); auto."; + pp " case n; auto."; + pp " intros n1; rewrite make_op_S; auto."; + pp " Qed."; + pp " Hint Rewrite spec_extendn_0: extr."; + pp ""; + pp " Let spec_extend_tr: forall m n (w: word _ (S n)),"; + pp " [%sn (m + n) (extend_tr w m)] = [%sn n w]." c c; + pp " Proof."; + pp " induction m; auto."; + pp " intros n x; simpl extend_tr."; + pp " simpl plus; rewrite spec_extendn0_0; auto."; + pp " Qed."; + pp " Hint Rewrite spec_extend_tr: extr."; + pp ""; + pp " Let spec_cast_l: forall n m x1,"; + pp " [%sn (Max.max n m)" c; + pp " (castm (diff_r n m) (extend_tr x1 (snd (diff n m))))] ="; + pp " [%sn n x1]." c; + pp " Proof."; + pp " intros n m x1; case (diff_r n m); simpl castm."; + pp " rewrite spec_extend_tr; auto."; + pp " Qed."; + pp " Hint Rewrite spec_cast_l: extr."; + pp ""; + pp " Let spec_cast_r: forall n m x1,"; + pp " [%sn (Max.max n m)" c; + pp " (castm (diff_l n m) (extend_tr x1 (fst (diff n m))))] ="; + pp " [%sn m x1]." c; + pp " Proof."; + pp " intros n m x1; case (diff_l n m); simpl castm."; + pp " rewrite spec_extend_tr; auto."; + pp " Qed."; + pp " Hint Rewrite spec_cast_r: extr."; + pp ""; + + + pr " Section LevelAndIter."; + pr ""; + pr " Variable res: Set."; + pr " Variable xxx: res."; + pr " Variable P: Z -> Z -> res -> Prop."; + pr " (* Abstraction function for each level *)"; + for i = 0 to size do + pr " Variable f%i: w%i -> w%i -> res." i i i; + pr " Variable f%in: forall n, w%i -> word w%i (S n) -> res." i i i; + pr " Variable fn%i: forall n, word w%i (S n) -> w%i -> res." i i i; + pp " Variable Pf%i: forall x y, P [%s%i x] [%s%i y] (f%i x y)." i c i c i i; + if i == size then + begin + pp " Variable Pf%in: forall n x y, P [%s%i x] (eval%in (S n) y) (f%in n x y)." i c i i i; + pp " Variable Pfn%i: forall n x y, P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i i c i i; + end + else + begin + pp " Variable Pf%in: forall n x y, Z_of_nat n <= %i -> P [%s%i x] (eval%in (S n) y) (f%in n x y)." i (size - i) c i i i; + pp " Variable Pfn%i: forall n x y, Z_of_nat n <= %i -> P (eval%in (S n) x) [%s%i y] (fn%i n x y)." i (size - i) i c i i; + end; + pr ""; + done; + pr " Variable fnn: forall n, word w%i (S n) -> word w%i (S n) -> res." size size; + pp " Variable Pfnn: forall n x y, P [%sn n x] [%sn n y] (fnn n x y)." c c; + pr " Variable fnm: forall n m, word w%i (S n) -> word w%i (S m) -> res." size size; + pp " Variable Pfnm: forall n m x y, P [%sn n x] [%sn m y] (fnm n m x y)." c c; + pr ""; + pr " (* Special zero functions *)"; + pr " Variable f0t: t_ -> res."; + pp " Variable Pf0t: forall x, P 0 [x] (f0t x)."; + pr " Variable ft0: t_ -> res."; + pp " Variable Pft0: forall x, P [x] 0 (ft0 x)."; + pr ""; + + + pr " (* We level the two arguments before applying *)"; + pr " (* the functions at each leval *)"; + pr " Definition same_level (x y: t_): res :="; + pr0 " Eval lazy zeta beta iota delta ["; + for i = 0 to size do + pr0 "extend%i " i; + done; + pr ""; + pr " GenBase.extend GenBase.extend_aux"; + pr " ] in"; + pr " match x, y with"; 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); + pr " | %s%i wx, %s%i wy => f%i wx (extend%i %i wy)" 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; + pr " | %s%i wx, %s%i wy => f%i wx wy" 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); + pr " | %s%i wx, %s%i wy => f%i (extend%i %i wx) wy" c i c j j i (j - i - 1); done; if i == size then - fprintf fmt " | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy\n" c size c size + pr " | %s%i wx, %sn m wy => fnn m (extend%i m wx) wy" 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); + pr " | %s%i wx, %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c i c size i (size - i - 1); done; for i = 0 to size do if i == size then - fprintf fmt " | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)\n" c c size size + pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n wy)" 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"; + pr " | %sn n wx, %s%i wy => fnn n wx (extend%i n (extend%i %i wy))" c c i size i (size - i - 1); + done; + pr " | %sn n wx, Nn m wy =>" c; + pr " let mn := Max.max n m in"; + pr " let d := diff n m in"; + pr " fnn mn"; + pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; + pr " (castm (diff_l n m) (extend_tr wy (fst d)))"; + pr " end."; + pr ""; + + pp " Lemma spec_same_level: forall x y, P [x] [y] (same_level x y)."; + pp " Proof."; + pp " intros x; case x; clear x; unfold same_level."; + for i = 0 to size do + pp " intros x y; case y; clear y."; for j = 0 to i - 1 do - fprintf fmt " intros y; rewrite spec_extend%in%i; apply Pf%i.\n" j i i; + pp " intros y; rewrite spec_extend%in%i; apply Pf%i." j i i; done; - fprintf fmt " intros y; apply Pf%i.\n" i; + pp " intros y; apply Pf%i." i; for j = i + 1 to size do - fprintf fmt " intros y; rewrite spec_extend%in%i; apply Pf%i.\n" i j j; + pp " intros y; rewrite spec_extend%in%i; apply Pf%i." i j j; done; if i == size then - fprintf fmt " intros m y; rewrite (spec_extend%in m); apply Pfnn.\n" size + pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size else - fprintf fmt " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn.\n" i size size; + pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size; done; - fprintf fmt " intros n x y; case y; clear y.\n"; + pp " intros n x y; case y; clear y."; for i = 0 to size do if i == size then - fprintf fmt " intros y; rewrite (spec_extend%in n); apply Pfnn.\n" size + pp " intros y; rewrite (spec_extend%in n); apply Pfnn." 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"; + pp " intros y; rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." i size size; + done; + pp " intros m y; rewrite <- (spec_cast_l n m x); "; + pp " rewrite <- (spec_cast_r n m y); apply Pfnn."; + pp " Qed."; + pp ""; + + pr " (* We level the two arguments before applying *)"; + pr " (* the functions at each level (special zero case) *)"; + pr " Definition same_level0 (x y: t_): res :="; + pr0 " Eval lazy zeta beta iota delta ["; + for i = 0 to size do + pr0 "extend%i " i; + done; + pr ""; + pr " GenBase.extend GenBase.extend_aux"; + pr " ] in"; + pr " match x with"; + for i = 0 to size do + pr " | %s%i wx =>" c i; + if i == 0 then + pr " if w0_eq0 wx then f0t y else"; + pr " match y with"; for j = 0 to i - 1 do - fprintf fmt " | %s%i wy =>\n" c j; + pr " | %s%i wy =>" 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); + pr " if w0_eq0 wy then ft0 x else"; + pr " f%i wx (extend%i %i wy)" i j (i - j -1); done; - fprintf fmt " | %s%i wy => f%i wx wy\n" c i i; + pr " | %s%i wy => f%i wx wy" 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); + pr " | %s%i wy => f%i (extend%i %i wx) wy" 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 + pr " | %sn m wy => fnn m (extend%i m wx) wy" 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"; + pr " | %sn m wy => fnn m (extend%i m (extend%i %i wx)) wy" c size i (size - i - 1); + pr" end"; done; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " match y with\n"; + pr " | %sn n wx =>" c; + pr " match y with"; for i = 0 to size do - fprintf fmt " | %s%i wy =>\n" c i; + pr " | %s%i wy =>" c i; if i == 0 then - fprintf fmt " if w0_eq0 wy then ft0 x else\n"; + pr " if w0_eq0 wy then ft0 x else"; if i == size then - fprintf fmt " fnn n wx (extend%i n wy)\n" size + pr " fnn n wx (extend%i n wy)" 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"; + pr " fnn n wx (extend%i n (extend%i %i wy))" size i (size - i - 1); + done; + pr " | %sn m wy =>" c; + pr " let mn := Max.max n m in"; + pr " let d := diff n m in"; + pr " fnn mn"; + pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; + pr " (castm (diff_l n m) (extend_tr wy (fst d)))"; + pr " end"; + pr " end."; + pr ""; + + pp " Lemma spec_same_level0: forall x y, P [x] [y] (same_level0 x y)."; + pp " Proof."; + pp " intros x; case x; clear x; unfold same_level0."; + for i = 0 to size do + pp " intros x."; 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"; + pp " generalize (spec_w0_eq0 x); case w0_eq0; intros H."; + pp " intros y; rewrite H; apply Pf0t."; + pp " clear H."; end; - fprintf fmt " intros y; case y; clear y.\n"; + pp " intros y; case y; clear y."; for j = 0 to i - 1 do - fprintf fmt " intros y.\n"; + pp " intros y."; 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"; + pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; + pp " rewrite H; apply Pft0."; + pp " clear H."; end; - fprintf fmt " rewrite spec_extend%in%i; apply Pf%i.\n" j i i; + pp " rewrite spec_extend%in%i; apply Pf%i." j i i; done; - fprintf fmt " intros y; apply Pf%i.\n" i; + pp " intros y; apply Pf%i." i; for j = i + 1 to size do - fprintf fmt " intros y; rewrite spec_extend%in%i; apply Pf%i.\n" i j j; + pp " intros y; rewrite spec_extend%in%i; apply Pf%i." i j j; done; if i == size then - fprintf fmt " intros m y; rewrite (spec_extend%in m); apply Pfnn.\n" size + pp " intros m y; rewrite (spec_extend%in m); apply Pfnn." size else - fprintf fmt " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn.\n" i size size; + pp " intros m y; rewrite spec_extend%in%i; rewrite (spec_extend%in m); apply Pfnn." i size size; done; - fprintf fmt " intros n x y; case y; clear y.\n"; + pp " intros n x y; case y; clear y."; for i = 0 to size do - fprintf fmt " intros y.\n"; + pp " intros y."; 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; + begin + pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; + pp " rewrite H; apply Pft0."; + pp " clear H."; + end; if i == size then - fprintf fmt " rewrite (spec_extend%in n); apply Pfnn.\n" size + pp " rewrite (spec_extend%in n); apply Pfnn." size else - fprintf fmt " rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn.\n" i size size; + pp " rewrite spec_extend%in%i; rewrite (spec_extend%in n); apply Pfnn." 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; + pp " intros m y; rewrite <- (spec_cast_l n m x); "; + pp " rewrite <- (spec_cast_r n m y); apply Pfnn."; + pp " Qed."; + pp ""; - 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 ["; + pr " (* We iter the smaller argument with the bigger *)"; + pr " Definition iter (x y: t_): res := "; + pr0 " Eval lazy zeta beta iota delta ["; for i = 0 to size do - fprintf fmt "extend%i " i; + pr0 "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"; + pr ""; + pr " GenBase.extend GenBase.extend_aux"; + pr " ] in"; + pr " match x, y with"; 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); + pr " | %s%i wx, %s%i wy => fn%i %i wx wy" 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; + pr " | %s%i wx, %s%i wy => f%i wx wy" 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); + pr " | %s%i wx, %s%i wy => f%in %i wx wy" c i c j i (j - i - 1); done; if i == size then - fprintf fmt " | %s%i wx, %sn m wy => f%in m wx wy\n" c size c size + pr " | %s%i wx, %sn m wy => f%in m wx wy" 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); + pr " | %s%i wx, %sn m wy => f%in m (extend%i %i wx) wy" c i c size i (size - i - 1); done; for i = 0 to size do if i == size then - fprintf fmt " | %sn n wx, %s%i wy => fn%i n wx wy\n" c c size size + pr " | %sn n wx, %s%i wy => fn%i n wx wy" 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"; + pr " | %sn n wx, %s%i wy => fn%i n wx (extend%i %i wy)" c c i size i (size - i - 1); + done; + pr " | %sn n wx, %sn m wy => fnm n m wx wy" c c; + pr " end."; + pr ""; + + pp " Ltac zg_tac := try"; + pp " (red; simpl Zcompare; auto;"; + pp " let t := fresh \"H\" in (intros t; discriminate H))."; + pp " Lemma spec_iter: forall x y, P [x] [y] (iter x y)."; + pp " Proof."; + pp " intros x; case x; clear x; unfold iter."; + for i = 0 to size do + pp " intros x y; case y; clear y."; 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); + pp " intros y; rewrite spec_eval%in%i; apply (Pfn%i %i); zg_tac." j (i - j) j (i - j - 1); done; - fprintf fmt " intros y; apply Pf%i.\n" i; + pp " intros y; apply Pf%i." 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); + pp " intros y; rewrite spec_eval%in%i; apply (Pf%in %i); zg_tac." 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 + pp " intros m y; rewrite spec_eval%in; apply Pf%in." 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; + pp " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size; done; - fprintf fmt " intros n x y; case y; clear y.\n"; + pp " intros n x y; case y; clear y."; for i = 0 to size do if i == size then - fprintf fmt " intros y; rewrite spec_eval%in; apply Pfn%i.\n" size size + pp " intros y; rewrite spec_eval%in; apply Pfn%i." size size else - fprintf fmt " intros y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i.\n" i size size size; + pp " intros y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size; done; - fprintf fmt " intros m y; apply Pfnm.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; + pp " intros m y; apply Pfnm."; + pp " Qed."; + pp ""; - 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 ["; + pr " (* We iter the smaller argument with the bigger (zero case) *)"; + pr " Definition iter0 (x y: t_): res :="; + pr0 " Eval lazy zeta beta iota delta ["; for i = 0 to size do - fprintf fmt "extend%i " i; + pr0 "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"; + pr ""; + pr " GenBase.extend GenBase.extend_aux"; + pr " ] in"; + pr " match x with"; 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"; + pr " | %s%i wx =>" c i; + if i == 0 then + pr " if w0_eq0 wx then f0t y else"; + pr " match y with"; for j = 0 to i - 1 do - fprintf fmt " | %s%i wy =>\n" c j; + pr " | %s%i wy =>" 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); + pr " if w0_eq0 wy then ft0 x else"; + pr " fn%i %i wx wy" j (i - j - 1); done; - fprintf fmt " | %s%i wy => f%i wx wy\n" c i i; + pr " | %s%i wy => f%i wx wy" 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); + pr " | %s%i wy => f%in %i wx wy" c j i (j - i - 1); done; if i == size then - fprintf fmt " | %sn m wy => f%in m wx wy\n" c size + pr " | %sn m wy => f%in m wx wy" 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"; + pr " | %sn m wy => f%in m (extend%i %i wx) wy" c size i (size - i - 1); + pr " end"; done; - fprintf fmt " | %sn n wx =>\n" c; - fprintf fmt " match y with\n"; + pr " | %sn n wx =>" c; + pr " match y with"; for i = 0 to size do - fprintf fmt " | %s%i wy =>\n" c i; + pr " | %s%i wy =>" c i; if i == 0 then - fprintf fmt " if w0_eq0 wy then ft0 x else\n"; + pr " if w0_eq0 wy then ft0 x else"; if i == size then - fprintf fmt " fn%i n wx wy\n" size + pr " fn%i n wx wy" size else - fprintf fmt " fn%i n wx (extend%i %i wy)\n" size i (size - i - 1); + pr " fn%i n wx (extend%i %i wy)" 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"; + pr " | %sn m wy => fnm n m wx wy" c; + pr " end"; + pr " end."; + pr ""; - 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"; + pp " Lemma spec_iter0: forall x y, P [x] [y] (iter0 x y)."; + pp " Proof."; + pp " intros x; case x; clear x; unfold iter0."; for i = 0 to size do - fprintf fmt " intros x.\n"; + pp " intros x."; 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"; + pp " generalize (spec_w0_eq0 x); case w0_eq0; intros H."; + pp " intros y; rewrite H; apply Pf0t."; + pp " clear H."; end; - fprintf fmt " intros y; case y; clear y.\n"; + pp " intros y; case y; clear y."; for j = 0 to i - 1 do - fprintf fmt " intros y.\n"; + pp " intros y."; 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"; + pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; + pp " rewrite H; apply Pft0."; + pp " clear H."; end; - fprintf fmt " rewrite spec_eval%in%i; apply (Pfn%i %i); zg_tac.\n" j (i - j) j (i - j - 1); + pp " rewrite spec_eval%in%i; apply (Pfn%i %i); zg_tac." j (i - j) j (i - j - 1); done; - fprintf fmt " intros y; apply Pf%i.\n" i; + pp " intros y; apply Pf%i." 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); + pp " intros y; rewrite spec_eval%in%i; apply (Pf%in %i); zg_tac." 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 + pp " intros m y; rewrite spec_eval%in; apply Pf%in." 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; + pp " intros m y; rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pf%in." i size size size; done; - fprintf fmt " intros n x y; case y; clear y.\n"; + pp " intros n x y; case y; clear y."; for i = 0 to size do - fprintf fmt " intros y.\n"; + pp " intros y."; 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; + begin + pp " generalize (spec_w0_eq0 y); case w0_eq0; intros H."; + pp " rewrite H; apply Pft0."; + pp " clear H."; + end; if i == size then - fprintf fmt " rewrite spec_eval%in; apply Pfn%i.\n" size size + pp " rewrite spec_eval%in; apply Pfn%i." size size else - fprintf fmt " rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i.\n" i size size size; + pp " rewrite spec_extend%in%i; rewrite spec_eval%in; apply Pfn%i." i size size size; done; - fprintf fmt " intros m y; apply Pfnm.\n"; - fprintf fmt " Qed.\n"; - fprintf fmt "\n"; - end; + pp " intros m y; apply Pfnm."; + pp " Qed."; + pp ""; - fprintf fmt " End LevelAndIter.\n"; - fprintf fmt "\n"; + pr " End LevelAndIter."; + pr ""; - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Reduction *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Reduction *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; - 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; + pr " Definition reduce_0 (x:w) := %s0 x." c; + pr " Definition reduce_1 :="; + pr " Eval lazy beta iota delta[reduce_n1] in"; + pr " reduce_n1 _ _ zero w0_eq0 %s0 %s1." c c; for i = 2 to size do - 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" + pr " Definition reduce_%i :=" i; + pr " Eval lazy beta iota delta[reduce_n1] in"; + pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i %s%i." (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" + pr " Definition reduce_%i :=" (size+1); + pr " Eval lazy beta iota delta[reduce_n1] in"; + pr " reduce_n1 _ _ zero w%i_eq0 reduce_%i (%sn 0)." size size c; - - 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"; + + pr " Definition reduce_n n := "; + pr " Eval lazy beta iota delta[reduce_n] in"; + pr " reduce_n _ _ zero reduce_%i %sn n." (size + 1) c; + pr ""; + + pp " Let spec_reduce_0: forall x, [reduce_0 x] = [%s0 x]." c; + pp " Proof."; + pp " intros x; unfold to_Z, reduce_0."; + pp " auto."; + pp " Qed."; + pp " "; 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 == size + 1 then + pp " Let spec_reduce_%i: forall x, [reduce_%i x] = [%sn 0 x]." i i c + else + pp " Let spec_reduce_%i: forall x, [reduce_%i x] = [%s%i x]." i i c i; + pp " Proof."; + pp " intros x; case x; unfold reduce_%i." i; + pp " exact (spec_0 w0_spec)."; + pp " intros x1 y1."; + pp " generalize (spec_w%i_eq0 x1); " (i - 1); + pp " case w%i_eq0; intros H1; auto." (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"; + pp " rewrite spec_reduce_%i." (i - 1); + pp " unfold to_Z; rewrite znz_to_Z_%i." i; + pp " unfold to_Z in H1; rewrite H1; auto."; + pp " Qed."; + pp " "; 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; + pp " Let spec_reduce_n: forall n x, [reduce_n n x] = [%sn n x]." c; + pp " Proof."; + pp " intros n; elim n; simpl reduce_n."; + pp " intros x; rewrite <- spec_reduce_%i; auto." (size + 1); + pp " intros n1 Hrec x; case x."; + pp " unfold to_Z; rewrite make_op_S; auto."; + pp " exact (spec_0 w0_spec)."; + pp " intros x1 y1; case x1; auto."; + pp " rewrite Hrec."; + pp " rewrite spec_extendn0_0; auto."; + pp " Qed."; + pp " "; - fprintf fmt " (***************************************************************)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (* Successor *)\n"; - fprintf fmt " (* *)\n"; - fprintf fmt " (***************************************************************)\n\n"; + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Successor *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; for i = 0 to size do - fprintf fmt " Definition w%i_succ_c := w%i_op.(znz_succ_c).\n" i i + pr " Definition w%i_succ_c := w%i_op.(znz_succ_c)." i i done; - fprintf fmt "\n"; + pr ""; for i = 0 to size do - fprintf fmt " Definition w%i_succ := w%i_op.(znz_succ).\n" i i + pr " Definition w%i_succ := w%i_op.(znz_succ)." i i done; - fprintf fmt "\n"; + pr ""; - fprintf fmt " Definition succ x :=\n"; - fprintf fmt " match x with\n"; + pr " Definition succ x :="; + pr " match x with"; 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; + pr " | %s%i wx =>" c i; + pr " match w%i_succ_c wx with" i; + pr " | C0 r => %s%i r" c i; + pr " | C1 r => %s%i (WW one%i r)" c (i+1) i; + pr " end"; + done; + pr " | %s%i wx =>" c size; + pr " match w%i_succ_c wx with" size; + pr " | C0 r => %s%i r" c size; + pr " | C1 r => %sn 0 (WW one%i r)" c size ; + pr " end"; + pr " | %sn n wx =>" c; + pr " let op := make_op n in"; + pr " match op.(znz_succ_c) wx with"; + pr " | C0 r => %sn n r" c; + pr " | C1 r => %sn (S n) (WW op.(znz_1) r)" c; + pr " end"; + pr " end."; + pr ""; + + pr " Theorem spec_succ: forall n, [succ n] = [n] + 1."; + pa " Admitted."; + pp " Proof."; + pp " intros n; case n; unfold succ, to_Z."; + for i = 0 to size do + pp " intros n1; generalize (spec_succ_c w%i_spec n1);" i; + pp " unfold succ, to_Z, w%i_succ_c; case znz_succ_c; auto." i; + pp " intros ww H; rewrite <- H."; + pp " (rewrite znz_to_Z_%i; unfold interp_carry;" (i + 1); + pp " apply f_equal2 with (f := Zplus); auto;"; + pp " apply f_equal2 with (f := Zmult); auto;"; + pp " exact (spec_1 w%i_spec))." i; + done; + pp " intros k n1; generalize (spec_succ_c (wn_spec k) n1)."; + pp " unfold succ, to_Z; case znz_succ_c; auto."; + pp " intros ww H; rewrite <- H."; + pp " (rewrite (znz_to_Z_n k); unfold interp_carry;"; + pp " apply f_equal2 with (f := Zplus); auto;"; + pp " apply f_equal2 with (f := Zmult); auto;"; + pp " exact (spec_1 (wn_spec k)))."; + pp " Qed."; + pr ""; + + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Adddition *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + for i = 0 to size do + pr " Definition w%i_add_c := znz_add_c w%i_op." i i; + pr " Definition w%i_add x y :=" i; + pr " match w%i_add_c x y with" i; + pr " | C0 r => %s%i r" c i; if i == size then - fprintf fmt " | C1 r => %sn 0 (WW one%i r)\n" c size + pr " | C1 r => %sn 0 (WW one%i r)" 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"; + pr " | C1 r => %s%i (WW one%i r)" c (i + 1) i; + pr " end."; + pr ""; 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"; + pr " Definition addn n (x y : word w%i (S n)) :=" size; + pr " let op := make_op n in"; + pr " match op.(znz_add_c) x y with"; + pr " | C0 r => %sn n r" c; + pr " | C1 r => %sn (S n) (WW op.(znz_1) r) end." c; + pr ""; + + + for i = 0 to size do + pp " Let spec_w%i_add: forall x y, [w%i_add x y] = [%s%i x] + [%s%i y]." i i c i c i; + pp " Proof."; + pp " intros n m; unfold to_Z, w%i_add, w%i_add_c." i i; + pp " generalize (spec_add_c w%i_spec n m); case znz_add_c; auto." i; + pp " intros ww H; rewrite <- H."; + pp " rewrite znz_to_Z_%i; unfold interp_carry;" (i + 1); + pp " apply f_equal2 with (f := Zplus); auto;"; + pp " apply f_equal2 with (f := Zmult); auto;"; + pp " exact (spec_1 w%i_spec)." i; + pp " Qed."; + pp " Hint Rewrite spec_w%i_add: addr." i; + pp ""; + done; + pp " Let spec_wn_add: forall n x y, [addn n x y] = [%sn n x] + [%sn n y]." c c; + pp " Proof."; + pp " intros k n m; unfold to_Z, addn."; + pp " generalize (spec_add_c (wn_spec k) n m); case znz_add_c; auto."; + pp " intros ww H; rewrite <- H."; + pp " rewrite (znz_to_Z_n k); unfold interp_carry;"; + pp " apply f_equal2 with (f := Zplus); auto;"; + pp " apply f_equal2 with (f := Zmult); auto;"; + pp " exact (spec_1 (wn_spec k))."; + pp " Qed."; + pp " Hint Rewrite spec_wn_add: addr."; + + pr " Definition add := Eval lazy beta delta [same_level] in"; + pr0 " (same_level t_ "; + for i = 0 to size do + pr0 "w%i_add " i; + done; + pr "addn)."; + pr ""; + + pr " Theorem spec_add: forall x y, [add x y] = [x] + [y]."; + pa " Admitted."; + pp " Proof."; + pp " unfold add."; + pp " generalize (spec_same_level t_ (fun x y res => [res] = x + y))."; + pp " unfold same_level; intros HH; apply HH; clear HH."; + for i = 0 to size do + pp " exact spec_w%i_add." i; + done; + pp " exact spec_wn_add."; + pp " Qed."; + pr ""; + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Predecessor *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + for i = 0 to size do + pr " Definition w%i_pred_c := w%i_op.(znz_pred_c)." i i + done; + pr ""; + + pr " Definition pred x :="; + pr " match x with"; + for i = 0 to size do + pr " | %s%i wx =>" c i; + pr " match w%i_pred_c wx with" i; + pr " | C0 r => reduce_%i r" i; + pr " | C1 r => zero"; + pr " end"; + done; + pr " | %sn n wx =>" c; + pr " let op := make_op n in"; + pr " match op.(znz_pred_c) wx with"; + pr " | C0 r => reduce_n n r"; + pr " | C1 r => zero"; + pr " end"; + pr " end."; + pr ""; + + pr " Theorem spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; unfold pred."; + for i = 0 to size do + pp " intros x1 H1; unfold w%i_pred_c; " i; + pp " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i; + pp " rewrite spec_reduce_%i; auto." i; + pp " unfold interp_carry; unfold to_Z."; + pp " case (spec_to_Z w%i_spec x1); intros HH1 HH2." i; + pp " case (spec_to_Z w%i_spec y1); intros HH3 HH4 HH5." i; + pp " assert (znz_to_Z w%i_op x1 - 1 < 0); auto with zarith." i; + pp " unfold to_Z in H1; auto with zarith."; + done; + pp " intros n x1 H1; "; + pp " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1."; + pp " rewrite spec_reduce_n; auto."; + pp " unfold interp_carry; unfold to_Z."; + pp " case (spec_to_Z (wn_spec n) x1); intros HH1 HH2."; + pp " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4 HH5."; + pp " assert (znz_to_Z (make_op n) x1 - 1 < 0); auto with zarith."; + pp " unfold to_Z in H1; auto with zarith."; + pp " Qed."; + pp " "; + + pp " Let spec_pred0: forall x, [x] = 0 -> [pred x] = 0."; + pp " Proof."; + pp " intros x; case x; unfold pred."; + for i = 0 to size do + pp " intros x1 H1; unfold w%i_pred_c; " i; + pp " generalize (spec_pred_c w%i_spec x1); case znz_pred_c; intros y1." i; + pp " unfold interp_carry; unfold to_Z."; + pp " unfold to_Z in H1; auto with zarith."; + pp " case (spec_to_Z w%i_spec y1); intros HH3 HH4; auto with zarith." i; + pp " intros; exact (spec_0 w0_spec)."; + done; + pp " intros n x1 H1; "; + pp " generalize (spec_pred_c (wn_spec n) x1); case znz_pred_c; intros y1."; + pp " unfold interp_carry; unfold to_Z."; + pp " unfold to_Z in H1; auto with zarith."; + pp " case (spec_to_Z (wn_spec n) y1); intros HH3 HH4; auto with zarith."; + pp " intros; exact (spec_0 w0_spec)."; + pp " Qed."; + pr " "; + + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Subtraction *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + for i = 0 to size do + pr " Definition w%i_sub_c := w%i_op.(znz_sub_c)." i i + done; + pr ""; for i = 0 to size do - 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; + pr " Definition w%i_sub x y :=" i; + pr " match w%i_sub_c x y with" i; + pr " | C0 r => reduce_%i r" i; + pr " | C1 r => zero"; + pr " end." + done; + pr ""; + + pr " Definition subn n (x y : word w%i (S n)) :=" size; + pr " let op := make_op n in"; + pr " match op.(znz_sub_c) x y with"; + pr " | C0 r => %sn n r" c; + pr " | C1 r => N0 w_0"; + pr " end."; + pr ""; + + for i = 0 to size do + pp " Let spec_w%i_sub: forall x y, [%s%i y] <= [%s%i x] -> [w%i_sub x y] = [%s%i x] - [%s%i y]." i c i c i i c i c i; + pp " Proof."; + pp " intros n m; unfold w%i_sub, w%i_sub_c." i i; + pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c; " i; if i == 0 then - fprintf fmt " intros x; auto.\n" + pp " intros x; auto." 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"; - + pp " intros x; try rewrite spec_reduce_%i; auto." i; + pp " unfold interp_carry; unfold zero, w_0, to_Z."; + pp " rewrite (spec_0 w0_spec)."; + pp " case (spec_to_Z w%i_spec x); intros; auto with zarith." i; + pp " Qed."; + pp ""; + done; + + pp " Let spec_wn_sub: forall n x y, [%sn n y] <= [%sn n x] -> [subn n x y] = [%sn n x] - [%sn n y]." c c c c; + pp " Proof."; + pp " intros k n m; unfold subn."; + pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; "; + pp " intros x; auto."; + pp " unfold interp_carry, to_Z."; + pp " case (spec_to_Z (wn_spec k) x); intros; auto with zarith."; + pp " Qed."; + pp ""; + + pr " Definition sub := Eval lazy beta delta [same_level] in"; + pr0 " (same_level t_ "; + for i = 0 to size do + pr0 "w%i_sub " i; + done; + pr "subn)."; + pr ""; + + pr " Theorem spec_sub: forall x y, [y] <= [x] -> [sub x y] = [x] - [y]."; + pa " Admitted."; + pp " Proof."; + pp " unfold sub."; + pp " generalize (spec_same_level t_ (fun x y res => y <= x -> [res] = x - y))."; + pp " unfold same_level; intros HH; apply HH; clear HH."; + for i = 0 to size do + pp " exact spec_w%i_sub." i; + done; + pp " exact spec_wn_sub."; + pp " Qed."; + pr ""; + + for i = 0 to size do + pp " Let spec_w%i_sub0: forall x y, [%s%i x] < [%s%i y] -> [w%i_sub x y] = 0." i c i c i i; + pp " Proof."; + pp " intros n m; unfold w%i_sub, w%i_sub_c." i i; + pp " generalize (spec_sub_c w%i_spec n m); case znz_sub_c; " i; + pp " intros x; unfold interp_carry."; + pp " unfold to_Z; case (spec_to_Z w%i_spec x); intros; auto with zarith." i; + pp " intros; unfold to_Z, zero, w_0; rewrite (spec_0 w0_spec); auto."; + pp " Qed."; + pp ""; + done; + + pp " Let spec_wn_sub0: forall n x y, [%sn n x] < [%sn n y] -> [subn n x y] = 0." c c; + pp " Proof."; + pp " intros k n m; unfold subn."; + pp " generalize (spec_sub_c (wn_spec k) n m); case znz_sub_c; "; + pp " intros x; unfold interp_carry."; + pp " unfold to_Z; case (spec_to_Z (wn_spec k) x); intros; auto with zarith."; + pp " intros; unfold to_Z, w_0; rewrite (spec_0 (w0_spec)); auto."; + pp " Qed."; + pp ""; + + pr " Theorem spec_sub0: forall x y, [x] < [y] -> [sub x y] = 0."; + pa " Admitted."; + pp " Proof."; + pp " unfold sub."; + pp " generalize (spec_same_level t_ (fun x y res => x < y -> [res] = 0))."; + pp " unfold same_level; intros HH; apply HH; clear HH."; + for i = 0 to size do + pp " exact spec_w%i_sub0." i; + done; + pp " exact spec_wn_sub0."; + pp " Qed."; + pr ""; + + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Comparison *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + for i = 0 to size do + pr " Definition compare_%i := w%i_op.(znz_compare)." i i; + pr " Definition comparen_%i :=" i; + pr " compare_mn_1 w%i w%i %s compare_%i (compare_%i %s) compare_%i." i i (pz i) i i (pz i) i + done; + pr ""; + + pr " Definition comparenm n m wx wy :="; + pr " let mn := Max.max n m in"; + pr " let d := diff n m in"; + pr " let op := make_op mn in"; + pr " op.(znz_compare)"; + pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; + pr " (castm (diff_l n m) (extend_tr wy (fst d)))."; + pr ""; + + pr " Definition compare := Eval lazy beta delta [iter] in "; + pr " (iter _ "; + for i = 0 to size do + pr " compare_%i" i; + pr " (fun n x y => opp_compare (comparen_%i (S n) y x))" i; + pr " (fun n => comparen_%i (S n))" i; + done; + pr " comparenm)."; + pr ""; + + for i = 0 to size do + pp " Let spec_compare_%i: forall x y," i; + pp " match compare_%i x y with " i; + pp " Eq => [%s%i x] = [%s%i y]" c i c i; + pp " | Lt => [%s%i x] < [%s%i y]" c i c i; + pp " | Gt => [%s%i x] > [%s%i y]" c i c i; + pp " end."; + pp " Proof."; + pp " unfold compare_%i, to_Z; exact (spec_compare w%i_spec)." i i; + pp " Qed."; + pp ""; + + pp " Let spec_comparen_%i:" i; + pp " forall (n : nat) (x : word w%i n) (y : w%i)," i i; + pp " match comparen_%i n x y with" i; + pp " | Eq => eval%in n x = [%s%i y]" i c i; + pp " | Lt => eval%in n x < [%s%i y]" i c i; + pp " | Gt => eval%in n x > [%s%i y]" i c i; + pp " end."; + pp " intros n x y."; + pp " unfold comparen_%i, to_Z; rewrite spec_gen_eval%in." i i; + pp " apply spec_compare_mn_1."; + pp " exact (spec_0 w%i_spec)." i; + pp " intros x1; exact (spec_compare w%i_spec %s x1)." i (pz i); + pp " exact (spec_to_Z w%i_spec)." i; + pp " exact (spec_compare w%i_spec)." i; + pp " exact (spec_compare w%i_spec)." i; + pp " exact (spec_to_Z w%i_spec)." i; + pp " Qed."; + pp ""; + done; + + pp " Let spec_opp_compare: forall c (u v: Z),"; + pp " match c with Eq => u = v | Lt => u < v | Gt => u > v end ->"; + pp " match opp_compare c with Eq => v = u | Lt => v < u | Gt => v > u end."; + pp " Proof."; + pp " intros c u v; case c; unfold opp_compare; auto with zarith."; + pp " Qed."; + pp ""; + + + pr " Theorem spec_compare: forall x y,"; + pr " match compare x y with "; + pr " Eq => [x] = [y]"; + pr " | Lt => [x] < [y]"; + pr " | Gt => [x] > [y]"; + pr " end."; + pa " Admitted."; + pp " Proof."; + pp " refine (spec_iter _ (fun x y res => "; + pp " match res with "; + pp " Eq => x = y"; + pp " | Lt => x < y"; + pp " | Gt => x > y"; + pp " end)"; + for i = 0 to size do + pp " compare_%i" i; + pp " (fun n x y => opp_compare (comparen_%i (S n) y x))" i; + pp " (fun n => comparen_%i (S n)) _ _ _" i; + done; + pp " comparenm _)."; + 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; + pp " exact spec_compare_%i." i; + pp " intros n x y H;apply spec_opp_compare; apply spec_comparen_%i." i; + pp " intros n x y H; exact (spec_comparen_%i (S n) x y)." i; done; - 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"; - + pp " exact spec_compare_%i." size; + pp " intros n x y;apply spec_opp_compare; apply spec_comparen_%i." size; + pp " intros n; exact (spec_comparen_%i (S n))." size; + pp " intros n m x y; unfold comparenm."; + pp " rewrite <- (spec_cast_l n m x); rewrite <- (spec_cast_r n m y)."; + pp " unfold to_Z; apply (spec_compare (wn_spec (Max.max n m)))."; + pp " Qed."; + pr ""; + + pr " Definition eq_bool x y :="; + pr " match compare x y with"; + pr " | Eq => true"; + pr " | _ => false"; + pr " end."; + pr ""; + + + pr " Theorem spec_eq_bool: forall x y,"; + pr " if eq_bool x y then [x] = [y] else [x] <> [y]."; + pa " Admitted."; + pp " Proof."; + pp " intros x y; unfold eq_bool."; + pp " generalize (spec_compare x y); case compare; auto with zarith."; + pp " Qed."; + pr ""; + + + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Multiplication *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + 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 + pr " Definition w%i_mul_c := w%i_op.(znz_mul_c)." i i done; - fprintf fmt "\n"; - + pr ""; + for i = 0 to size do - fprintf fmt " Definition w%i_0W := w%i_op.(znz_0W).\n" i i + pr " Definition w%i_mul_add :=" i; + pr " Eval lazy beta delta [w_mul_add] in"; + pr " @w_mul_add w%i %s w%i_succ w%i_add_c w%i_mul_c." i (pz i) i i i done; - fprintf fmt "\n"; + pr ""; 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 + pr " Definition w%i_0W := w%i_op.(znz_0W)." i i done; - fprintf fmt "\n"; + pr ""; + + for i = 0 to size do + pr " Definition w%i_mul_add_n1 :=" i; + pr " @gen_mul_add_n1 w%i %s w%i_op.(znz_WW) w%i_0W w%i_mul_add." i (pz i) i i i + done; + pr ""; - 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; + pr " Let to_Z%i n :=" i; + pr " match n return word w%i (S n) -> t_ with" i; for j = 0 to size - i do if (i + j) == size then begin - 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 + pr " | %i%s => fun x => %sn 0 x" j "%nat" c; + pr " | %i%s => fun x => %sn 1 x" (j + 1) "%nat" c end else - fprintf fmt " | %i%s => fun x => %s%i x\n" j "%nat" c (i + j + 1) + pr " | %i%s => fun x => %s%i x" j "%nat" c (i + j + 1) done; - fprintf fmt " | _ => fun _ => N0 w_0\n"; - fprintf fmt " end.\n"; - fprintf fmt "\n"; + pr " | _ => fun _ => N0 w_0"; + pr " end."; + pr ""; 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; + pp "Theorem to_Z%i_spec:" i; + pp " forall n x, Z_of_nat n <= %i -> [to_Z%i n x] = znz_to_Z (nmake_op _ w%i_op (S n)) x." (size + 1 - i) i i; 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; + pp " intros n; case n; clear n."; + pp " unfold to_Z%i." i; + pp " intros x H; rewrite spec_eval%in%i; auto." 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"; + pp " intros n x."; + pp " repeat rewrite inj_S; unfold Zsucc; auto with zarith."; + pp " Qed."; + pp ""; 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; + pr " Definition w%i_mul n x y :=" i; + pr " let (w,r) := w%i_mul_add_n1 (S n) x y %s in" i (pz 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; + pr " if w%i_eq0 w then %sn n r" i c; + pr " else %sn (S n) (WW (extend%i n w) r)." c i; end else begin - 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; + pr " if w%i_eq0 w then to_Z%i n r" i i; + pr " else to_Z%i (S n) (WW (extend%i n w) r)." i i; end; - 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"; + pr ""; + done; + + pr " Definition mulnm n m x y :="; + pr " let mn := Max.max n m in"; + pr " let d := diff n m in"; + pr " let op := make_op mn in"; + pr " reduce_n (S mn) (op.(znz_mul_c)"; + pr " (castm (diff_r n m) (extend_tr x (snd d)))"; + pr " (castm (diff_l n m) (extend_tr y (fst d))))."; + pr ""; + + pr " Definition mul := Eval lazy beta delta [iter0] in "; + pr " (iter0 t_ "; + for i = 0 to size do + pr " (fun x y => reduce_%i (w%i_mul_c x y)) " (i + 1) i; + pr " (fun n x y => w%i_mul n y x)" i; + pr " w%i_mul" i; + done; + pr " mulnm"; + pr " (fun _ => N0 w_0)"; + pr " (fun _ => N0 w_0)"; + pr " )."; + pr ""; + for i = 0 to size do + pp " Let spec_w%i_mul_add: forall x y z," i; + pp " let (q,r) := w%i_mul_add x y z in" i; + pp " znz_to_Z w%i_op q * (base (znz_digits w%i_op)) + znz_to_Z w%i_op r =" i i i; + pp " znz_to_Z w%i_op x * znz_to_Z w%i_op y + znz_to_Z w%i_op z :=" i i i ; + pp " (spec_mul_add w%i_spec)." i; + pp ""; + done; + + for i = 0 to size do + pp " Theorem spec_w%i_mul_add_n1: forall n x y z," i; + pp " let (q,r) := w%i_mul_add_n1 n x y z in" i; + pp " znz_to_Z w%i_op q * (base (znz_digits (nmake_op _ w%i_op n))) +" i i; + pp " znz_to_Z (nmake_op _ w%i_op n) r =" i; + pp " znz_to_Z (nmake_op _ w%i_op n) x * znz_to_Z w%i_op y +" i i; + pp " znz_to_Z w%i_op z." i; + pp " Proof."; + pp " intros n x y z; unfold w%i_mul_add_n1." i; + pp " rewrite nmake_gen."; + pp " rewrite digits_gend."; + pp " change (base (GenBase.gen_digits (znz_digits w%i_op) n)) with" i; + pp " (GenBase.gen_wB (znz_digits w%i_op) n)." i; + pp " apply spec_gen_mul_add_n1; auto."; + if i == 0 then pp " exact (spec_0 w%i_spec)." i; + pp " exact (spec_WW w%i_spec)." i; + pp " exact (spec_0W w%i_spec)." i; + pp " exact (spec_mul_add w%i_spec)." i; + pp " Qed."; + pp ""; + done; + + pp " Lemma nmake_op_WW: forall ww ww1 n x y,"; + pp " znz_to_Z (nmake_op ww ww1 (S n)) (WW x y) ="; + pp " znz_to_Z (nmake_op ww ww1 n) x * base (znz_digits (nmake_op ww ww1 n)) +"; + pp " znz_to_Z (nmake_op ww ww1 n) y."; + pp " auto."; + pp " Qed."; + pp ""; - 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 + pp " Lemma extend%in_spec: forall n x1," i; + pp " znz_to_Z (nmake_op _ w%i_op (S n)) (extend%i n x1) = " i i; + pp " znz_to_Z w%i_op x1." i; + pp " Proof."; + pp " intros n1 x2; rewrite nmake_gen."; + pp " unfold extend%i." i; + pp " rewrite GenBase.spec_extend; auto."; + if i == 0 then + pp " intros l; simpl; unfold w_0; rewrite (spec_0 w0_spec); ring."; + pp " Qed."; + pp ""; 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; + pp " Lemma spec_muln:"; + pp " forall n (x: word _ (S n)) y,"; + pp " [%sn (S n) (znz_mul_c (make_op n) x y)] = [%sn n x] * [%sn n y]." c c c; + pp " Proof."; + pp " intros n x y; unfold to_Z."; + pp " rewrite <- (spec_mul_c (wn_spec n))."; + pp " rewrite make_op_S."; + pp " case znz_mul_c; auto."; + pp " Qed."; + + pr " Theorem spec_mul: forall x y, [mul x y] = [x] * [y]."; + pa " Admitted."; + pp " Proof."; + for i = 0 to size do + pp " assert(F%i: " i; + pp " forall n x y,"; + if i <> size then + pp0 " Z_of_nat n <= %i -> " (size - i); + pp " [w%i_mul n x y] = eval%in (S n) x * [%s%i y])." i i c i; if i == size then - fprintf fmt " (%sn _ u, %s%i v).\n" c c i + pp " intros n x y; unfold w%i_mul." 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; + pp " intros n x y H; unfold w%i_mul." i; + pp " generalize (spec_w%i_mul_add_n1 (S n) x y %s)." i (pz i); + pp " case w%i_mul_add_n1; intros x1 y1." i; + pp " change (znz_to_Z (nmake_op _ w%i_op (S n)) x) with (eval%in (S n) x)." i i; + pp " change (znz_to_Z w%i_op y) with ([%s%i y])." i c i; + if i == 0 then + pp " unfold w_0; rewrite (spec_0 w0_spec); rewrite Zplus_0_r." + else + pp " change (znz_to_Z w%i_op W0) with 0; rewrite Zplus_0_r." i; + pp " intros H1; rewrite <- H1; clear H1."; + pp " generalize (spec_w%i_eq0 x1); case w%i_eq0; intros HH." i i; + pp " unfold to_Z in HH; rewrite HH."; + if i == size then + begin + pp " rewrite spec_eval%in; unfold eval%in, nmake_op%i; auto." i i i; + pp " rewrite spec_eval%in; unfold eval%in, nmake_op%i." i i i + end + else + begin + pp " rewrite to_Z%i_spec; auto with zarith." i; + pp " rewrite to_Z%i_spec; try (rewrite inj_S; auto with zarith)." i + end; + pp " rewrite nmake_op_WW; rewrite extend%in_spec; auto." i; + done; + pp " refine (spec_iter0 t_ (fun x y res => [res] = x * y)"; + for i = 0 to size do + pp " (fun x y => reduce_%i (w%i_mul_c x y)) " (i + 1) i; + pp " (fun n x y => w%i_mul n y x)" i; + pp " w%i_mul _ _ _" i; + done; + pp " mulnm _"; + pp " (fun _ => N0 w_0) _"; + pp " (fun _ => N0 w_0) _"; + pp " )."; + for i = 0 to size do + pp " intros x y; rewrite spec_reduce_%i." (i + 1); + pp " unfold w%i_mul_c, to_Z." i; + pp " generalize (spec_mul_c w%i_spec x y)." i; + pp " intros HH; rewrite <- HH; clear HH; auto."; + if i == size then + begin + pp " intros n x y; rewrite F%i; auto with zarith." i; + pp " intros n x y; rewrite F%i; auto with zarith. " i; + end + else + begin + pp " intros n x y H; rewrite F%i; auto with zarith." i; + pp " intros n x y H; rewrite F%i; auto with zarith. " i; + end; + done; + pp " intros n m x y; unfold mulnm."; + pp " rewrite spec_reduce_n."; + pp " rewrite <- (spec_cast_l n m x)."; + pp " rewrite <- (spec_cast_r n m y)."; + pp " rewrite spec_muln; rewrite spec_cast_l; rewrite spec_cast_r; auto."; + pp " intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring."; + pp " intros x; unfold to_Z, w_0; rewrite (spec_0 w0_spec); ring."; + pp " Qed."; + pr ""; + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Square *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; 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; + pr " Definition w%i_square_c := w%i_op.(znz_square_c)." i i done; - fprintf fmt "\n"; + pr ""; + pr " Definition square x :="; + pr " match x with"; + pr " | %s0 wx => reduce_1 (w0_square_c wx)" c; + for i = 1 to size - 1 do + pr " | %s%i wx => %s%i (w%i_square_c wx)" c i c (i+1) i + done; + pr " | %s%i wx => %sn 0 (w%i_square_c wx)" c size c size; + pr " | %sn n wx =>" c; + pr " let op := make_op n in"; + pr " %sn (S n) (op.(znz_square_c) wx)" c; + pr " end."; + pr ""; + + pr " Theorem spec_square: forall x, [square x] = [x] * [x]."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; unfold square; clear x."; + pp " intros x; rewrite spec_reduce_1; unfold to_Z."; + pp " exact (spec_square_c w%i_spec x)." 0; + for i = 1 to size do + pp " intros x; unfold to_Z."; + pp " exact (spec_square_c w%i_spec x)." i; + done; + pp " intros n x; unfold to_Z."; + pp " rewrite make_op_S."; + pp " exact (spec_square_c (wn_spec n) x)."; + pp "Qed."; + pr ""; + + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Power *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + pr " Fixpoint power_pos (x:%s) (p:positive) {struct p} : %s :=" t t; + pr " match p with"; + pr " | xH => x"; + pr " | xO p => square (power_pos x p)"; + pr " | xI p => mul (square (power_pos x p)) x"; + pr " end."; + pr ""; + + pr " Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n."; + pa " Admitted."; + pp " Proof."; + pp " intros x n; generalize x; elim n; clear n x; simpl power_pos."; + pp " intros; rewrite spec_mul; rewrite spec_square; rewrite H."; + pp " rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith."; + pp " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith."; + pp " rewrite Zpower_2; rewrite Zpower_1_r; auto."; + pp " intros; rewrite spec_square; rewrite H."; + pp " rewrite Zpos_xO; auto with zarith."; + pp " rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith."; + pp " rewrite Zpower_2; auto."; + pp " intros; rewrite Zpower_1_r; auto."; + pp " Qed."; + pp ""; + pr ""; + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Square root *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + for i = 0 to size do + pr " Definition w%i_sqrt := w%i_op.(znz_sqrt)." i i + done; + pr ""; + + pr " Definition sqrt x :="; + pr " match x with"; + for i = 0 to size do + pr " | %s%i wx => reduce_%i (w%i_sqrt wx)" c i i i; + done; + pr " | %sn n wx =>" c; + pr " let op := make_op n in"; + pr " reduce_n n (op.(znz_sqrt) wx)"; + pr " end."; + pr ""; + + pr " Theorem spec_sqrt: forall x, [sqrt x] ^ 2 <= [x] < ([sqrt x] + 1) ^ 2."; + pa " Admitted."; + pp " Proof."; + pp " intros x; unfold sqrt; case x; clear x."; + for i = 0 to size do + pp " intros x; rewrite spec_reduce_%i; exact (spec_sqrt w%i_spec x)." i i; + done; + pp " intros n x; rewrite spec_reduce_n; exact (spec_sqrt (wn_spec n) x)."; + pp " Qed."; + pr ""; + + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Division *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + for i = 0 to size do + pr " Definition w%i_div_gt := w%i_op.(znz_div_gt)." i i + done; + pr ""; + + pp " Let spec_divn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := "; + pp " (spec_gen_divn1 "; + pp " ww_op.(znz_zdigits) ww_op.(znz_0)"; + pp " ww_op.(znz_WW) ww_op.(znz_head0)"; + pp " ww_op.(znz_add_mul_div) ww_op.(znz_div21)"; + pp " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)"; + pp " (spec_to_Z ww_spec) "; + pp " (spec_zdigits ww_spec)"; + pp " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)"; + pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) "; + pp " (ZnZ.spec_compare ww_spec) (ZnZ.spec_sub ww_spec))."; + pp ""; + + for i = 0 to size do + pr " Definition w%i_divn1 n x y :=" i; + pr " let (u, v) :="; + pr " gen_divn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)" i i; + pr " w%i_op.(znz_WW) w%i_op.(znz_head0)" i i; + pr " w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)" i i; + pr " w%i_op.(znz_compare) w%i_op.(znz_sub) (S n) x y in" i i; + if i == size then + pr " (%sn _ u, %s%i v)." c c i + else + pr " (to_Z%i _ u, %s%i v)." i c i; + done; + pr ""; + + for i = 0 to size do + pp " Lemma spec_get_end%i: forall n x y," i; + pp " eval%in n x <= [%s%i y] -> " i c i; + pp " [%s%i (GenBase.get_low %s n x)] = eval%in n x." c i (pz i) i; + pp " Proof."; + pp " intros n x y H."; + pp " rewrite spec_gen_eval%in; unfold to_Z." i; + pp " apply GenBase.spec_get_low."; + pp " exact (spec_0 w%i_spec)." i; + pp " exact (spec_to_Z w%i_spec)." i; + pp " apply Zle_lt_trans with [%s%i y]; auto." c i; + pp " rewrite <- spec_gen_eval%in; auto." i; + pp " unfold to_Z; case (spec_to_Z w%i_spec y); auto." i; + pp " Qed."; + pp ""; + done; + + for i = 0 to size do + pr " Let div_gt%i x y := let (u,v) := (w%i_div_gt x y) in (reduce_%i u, reduce_%i v)." i i i i; + done; + pr ""; - 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"; + pr " Let div_gtnm n m wx wy :="; + pr " let mn := Max.max n m in"; + pr " let d := diff n m in"; + pr " let op := make_op mn in"; + pr " let (q, r):= op.(znz_div_gt)"; + pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; + pr " (castm (diff_l n m) (extend_tr wy (fst d))) in"; + pr " (reduce_n mn q, reduce_n mn r)."; + pr ""; + + pr " Definition div_gt := Eval lazy beta delta [iter] in"; + pr " (iter _ "; 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"; + pr " div_gt%i" i; + pr " (fun n x y => div_gt%i x (GenBase.get_low %s (S n) y))" i (pz i); + pr " w%i_divn1" i; + done; + pr " div_gtnm)."; + pr ""; + + pr " Theorem spec_div_gt: forall x y,"; + pr " [x] > [y] -> 0 < [y] ->"; + pr " let (q,r) := div_gt x y in"; + pr " [q] = [x] / [y] /\\ [r] = [x] mod [y]."; + pa " Admitted."; + pp " Proof."; + pp " assert (FO:"; + pp " forall x y, [x] > [y] -> 0 < [y] ->"; + pp " let (q,r) := div_gt x y in"; + pp " [x] = [q] * [y] + [r] /\\ 0 <= [r] < [y])."; + pp " refine (spec_iter (t_*t_) (fun x y res => x > y -> 0 < y ->"; + pp " let (q,r) := res in"; + pp " x = [q] * y + [r] /\\ 0 <= [r] < y)"; for i = 0 to size do - 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; + pp " div_gt%i" i; + pp " (fun n x y => div_gt%i x (GenBase.get_low %s (S n) y))" i (pz i); + pp " w%i_divn1 _ _ _" i; done; - fprintf fmt " div_gtnm _).\n"; + pp " div_gtnm _)."; 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; + pp " intros x y H1 H2; unfold div_gt%i, w%i_div_gt." i i; + pp " generalize (spec_div_gt w%i_spec x y H1 H2); case znz_div_gt." i; + pp " intros xx yy; repeat rewrite spec_reduce_%i; auto." i; if i == size then - fprintf fmt " intros n x y H2 H3; unfold div_gt%i, w%i_div_gt.\n" i i + pp " intros n x y H2 H3; unfold div_gt%i, w%i_div_gt." 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 " "; + pp " intros n x y H1 H2 H3; unfold div_gt%i, w%i_div_gt." i i; + pp " generalize (spec_div_gt w%i_spec x " i; + pp " (GenBase.get_low %s (S n) y))." (pz i); + pp0 " "; for j = 0 to i do - fprintf fmt "unfold w%i;" (i-j); + pp0 "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"; + pp "case znz_div_gt."; + pp " intros xx yy H4; repeat rewrite spec_reduce_%i." i; + pp " generalize (spec_get_end%i (S n) y x); unfold to_Z; intros H5." i; + pp " unfold to_Z in H2; rewrite H5 in H4; auto with zarith."; if i == size then - fprintf fmt " intros n x y H2 H3.\n" + pp " intros n x y H2 H3." 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; + pp " intros n x y H1 H2 H3."; + pp " generalize"; + pp " (spec_divn1 w%i w%i_op w%i_spec (S n) x y H3)." i i i; + pp0 " unfold w%i_divn1; " i; for j = 0 to i do - fprintf fmt "unfold w%i;" (i-j); + pp0 "unfold w%i; " (i-j); done; - fprintf fmt " case gen_divn1.\n"; - fprintf fmt " intros xx yy H4.\n"; + pp "case gen_divn1."; + pp " intros xx yy H4."; 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; + pp " repeat rewrite <- spec_gen_eval%in in H4; auto." i; + pp " rewrite spec_eval%in; auto." 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; + pp " rewrite to_Z%i_spec; auto with zarith." i; + pp " repeat rewrite <- spec_gen_eval%in in H4; auto." 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; + pp " intros n m x y H1 H2; unfold div_gtnm."; + pp " generalize (spec_div_gt (wn_spec (Max.max n m))"; + pp " (castm (diff_r n m)"; + pp " (extend_tr x (snd (diff n m))))"; + pp " (castm (diff_l n m)"; + pp " (extend_tr y (fst (diff n m)))))."; + pp " case znz_div_gt."; + pp " intros xx yy HH."; + pp " repeat rewrite spec_reduce_n."; + pp " rewrite <- (spec_cast_l n m x)."; + pp " rewrite <- (spec_cast_r n m y)."; + pp " unfold to_Z; apply HH."; + pp " rewrite <- (spec_cast_l n m x) in H1; auto."; + pp " rewrite <- (spec_cast_r n m y) in H1; auto."; + pp " rewrite <- (spec_cast_r n m y) in H2; auto."; + pp " intros x y H1 H2; generalize (FO x y H1 H2); case div_gt."; + pp " intros q r (H3, H4); split."; + pp " apply (Zdiv_unique [x] [y] [q] [r]); auto."; + pp " rewrite Zmult_comm; auto."; + pp " apply (Zmod_unique [x] [y] [q] [r]); auto."; + pp " rewrite Zmult_comm; auto."; + pp " Qed."; + pr ""; + + pr " Definition div_eucl x y :="; + pr " match compare x y with"; + pr " | Eq => (one, zero)"; + pr " | Lt => (zero, x)"; + pr " | Gt => div_gt x y"; + pr " end."; + pr ""; + + pr " Theorem spec_div_eucl: forall x y,"; + pr " 0 < [y] ->"; + pr " let (q,r) := div_eucl x y in"; + pr " ([q], [r]) = Zdiv_eucl [x] [y]."; + pa " Admitted."; + pp " Proof."; + pp " assert (F0: [zero] = 0)."; + pp " exact (spec_0 w0_spec)."; + pp " assert (F1: [one] = 1)."; + pp " exact (spec_1 w0_spec)."; + pp " intros x y H; generalize (spec_compare x y);"; + pp " unfold div_eucl; case compare; try rewrite F0;"; + pp " try rewrite F1; intros; auto with zarith."; + pp " rewrite H0; generalize (Z_div_same [y] (Zlt_gt _ _ H))"; + pp " (Z_mod_same [y] (Zlt_gt _ _ H));"; + pp " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto."; + pp " assert (F2: 0 <= [x] < [y])."; + pp " generalize (spec_pos x); auto."; + pp " generalize (Zdiv_small _ _ F2)"; + pp " (Zmod_small _ _ F2);"; + pp " unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto."; + pp " generalize (spec_div_gt _ _ H0 H); auto."; + pp " unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt."; + pp " intros a b c d (H1, H2); subst; auto."; + pp " Qed."; + pr ""; + + pr " Definition div x y := fst (div_eucl x y)."; + pr ""; + + pr " Theorem spec_div:"; + pr " forall x y, 0 < [y] -> [div x y] = [x] / [y]."; + pa " Admitted."; + pp " Proof."; + pp " intros x y H1; unfold div; generalize (spec_div_eucl x y H1);"; + pp " case div_eucl; simpl fst."; + pp " intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; "; + pp " injection H; auto."; + pp " Qed."; + pr ""; + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Modulo *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + for i = 0 to size do + pr " Definition w%i_mod_gt := w%i_op.(znz_mod_gt)." i i + done; + pr ""; + + for i = 0 to size do + pr " Definition w%i_modn1 :=" i; + pr " gen_modn1 w%i_op.(znz_zdigits) w%i_op.(znz_0)" i i; + pr " w%i_op.(znz_head0) w%i_op.(znz_add_mul_div) w%i_op.(znz_div21)" i i i; + pr " w%i_op.(znz_compare) w%i_op.(znz_sub)." i i; + done; + pr ""; + + pr " Let mod_gtnm n m wx wy :="; + pr " let mn := Max.max n m in"; + pr " let d := diff n m in"; + pr " let op := make_op mn in"; + pr " reduce_n mn (op.(znz_mod_gt)"; + pr " (castm (diff_r n m) (extend_tr wx (snd d)))"; + pr " (castm (diff_l n m) (extend_tr wy (fst d))))."; + pr ""; + + pr " Definition mod_gt := Eval lazy beta delta[iter] in"; + pr " (iter _ "; + for i = 0 to size do + pr " (fun x y => reduce_%i (w%i_mod_gt x y))" i i; + pr " (fun n x y => reduce_%i (w%i_mod_gt x (GenBase.get_low %s (S n) y)))" i i (pz i); + pr " (fun n x y => reduce_%i (w%i_modn1 (S n) x y))" i i; + done; + pr " mod_gtnm)."; + pr ""; + + pp " Let spec_modn1 ww (ww_op: znz_op ww) (ww_spec: znz_spec ww_op) := "; + pp " (spec_gen_modn1 "; + pp " ww_op.(znz_zdigits) ww_op.(znz_0)"; + pp " ww_op.(znz_WW) ww_op.(znz_head0)"; + pp " ww_op.(znz_add_mul_div) ww_op.(znz_div21)"; + pp " ww_op.(znz_compare) ww_op.(znz_sub) (znz_to_Z ww_op)"; + pp " (spec_to_Z ww_spec) "; + pp " (spec_zdigits ww_spec)"; + pp " (spec_0 ww_spec) (spec_WW ww_spec) (spec_head0 ww_spec)"; + pp " (spec_add_mul_div ww_spec) (spec_div21 ww_spec) "; + pp " (ZnZ.spec_compare ww_spec) (ZnZ.spec_sub ww_spec))."; + pp ""; + + pr " Theorem spec_mod_gt:"; + pr " forall x y, [x] > [y] -> 0 < [y] -> [mod_gt x y] = [x] mod [y]."; + pa " Admitted."; + pp " Proof."; + pp " refine (spec_iter _ (fun x y res => x > y -> 0 < y ->"; + pp " [res] = x mod y)"; + for i = 0 to size do + pp " (fun x y => reduce_%i (w%i_mod_gt x y))" i i; + pp " (fun n x y => reduce_%i (w%i_mod_gt x (GenBase.get_low %s (S n) y)))" i i (pz i); + pp " (fun n x y => reduce_%i (w%i_modn1 (S n) x y)) _ _ _" i i; + done; + pp " mod_gtnm _)."; + for i = 0 to size do + pp " intros x y H1 H2; rewrite spec_reduce_%i." i; + pp " exact (spec_mod_gt w%i_spec x y H1 H2)." i; if i == size then - fprintf fmt " intros n x y H2 H3; rewrite spec_reduce_%i.\n" i + pp " intros n x y H2 H3; rewrite spec_reduce_%i." 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; + pp " intros n x y H1 H2 H3; rewrite spec_reduce_%i." i; + pp " unfold w%i_mod_gt." i; + pp " rewrite <- (spec_get_end%i (S n) y x); auto with zarith." i; + pp " unfold to_Z; apply (spec_mod_gt w%i_spec); auto." i; + pp " rewrite <- (spec_get_end%i (S n) y x) in H2; auto with zarith." i; + pp " rewrite <- (spec_get_end%i (S n) y x) in H3; auto with zarith." i; if i == size then - fprintf fmt " intros n x y H2 H3; rewrite spec_reduce_%i.\n" i + pp " intros n x y H2 H3; rewrite spec_reduce_%i." 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"; + pp " intros n x y H1 H2 H3; rewrite spec_reduce_%i." i; + pp " unfold w%i_modn1, to_Z; rewrite spec_gen_eval%in." i i; + pp " apply (spec_modn1 _ _ w%i_spec); auto." i; + done; + pp " intros n m x y H1 H2; unfold mod_gtnm."; + pp " repeat rewrite spec_reduce_n."; + pp " rewrite <- (spec_cast_l n m x)."; + pp " rewrite <- (spec_cast_r n m y)."; + pp " unfold to_Z; apply (spec_mod_gt (wn_spec (Max.max n m)))."; + pp " rewrite <- (spec_cast_l n m x) in H1; auto."; + pp " rewrite <- (spec_cast_r n m y) in H1; auto."; + pp " rewrite <- (spec_cast_r n m y) in H2; auto."; + pp " Qed."; + pr ""; + + pr " Definition modulo x y := "; + pr " match compare x y with"; + pr " | Eq => zero"; + pr " | Lt => x"; + pr " | Gt => mod_gt x y"; + pr " end."; + pr ""; + + pr " Theorem spec_modulo:"; + pr " forall x y, 0 < [y] -> [modulo x y] = [x] mod [y]."; + pa " Admitted."; + pp " Proof."; + pp " assert (F0: [zero] = 0)."; + pp " exact (spec_0 w0_spec)."; + pp " assert (F1: [one] = 1)."; + pp " exact (spec_1 w0_spec)."; + pp " intros x y H; generalize (spec_compare x y);"; + pp " unfold modulo; case compare; try rewrite F0;"; + pp " try rewrite F1; intros; try split; auto with zarith."; + pp " rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith."; + pp " apply sym_equal; apply Zmod_small; auto with zarith."; + pp " generalize (spec_pos x); auto with zarith."; + pp " apply spec_mod_gt; auto."; + pp " Qed."; + pr ""; + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Gcd *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + pr " Definition digits x :="; + pr " match x with"; + for i = 0 to size do + pr " | %s%i _ => w%i_op.(znz_digits)" c i i; + done; + pr " | %sn n _ => (make_op n).(znz_digits)" c; + pr " end."; + pr ""; + + pr " Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x)."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; clear x."; + for i = 0 to size do + pp " intros x; unfold to_Z, digits;"; + pp " generalize (spec_to_Z w%i_spec x); unfold base; intros H; exact H." i; + done; + pp " intros n x; unfold to_Z, digits;"; + pp " generalize (spec_to_Z (wn_spec n) x); unfold base; intros H; exact H."; + pp " Qed."; + pr ""; + + pr " Definition gcd_gt_body a b cont :="; + pr " match compare b zero with"; + pr " | Gt =>"; + pr " let r := mod_gt a b in"; + pr " match compare r zero with"; + pr " | Gt => cont r (mod_gt b r)"; + pr " | _ => b"; + pr " end"; + pr " | _ => a"; + pr " end."; + pr ""; + + pp " Theorem Zspec_gcd_gt_body: forall a b cont p,"; + pp " [a] > [b] -> [a] < 2 ^ p ->"; + pp " (forall a1 b1, [a1] < 2 ^ (p - 1) -> [a1] > [b1] ->"; + pp " Zis_gcd [a1] [b1] [cont a1 b1]) -> "; + pp " Zis_gcd [a] [b] [gcd_gt_body a b cont]."; + pp " Proof."; + pp " assert (F1: [zero] = 0)."; + pp " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto."; + pp " intros a b cont p H2 H3 H4; unfold gcd_gt_body."; + pp " generalize (spec_compare b zero); case compare; try rewrite F1."; + pp " intros HH; rewrite HH; apply Zis_gcd_0."; + pp " intros HH; absurd (0 <= [b]); auto with zarith."; + pp " case (spec_digits b); auto with zarith."; + pp " intros H5; generalize (spec_compare (mod_gt a b) zero); "; + pp " case compare; try rewrite F1."; + pp " intros H6; rewrite <- (Zmult_1_r [b])."; + pp " rewrite (Z_div_mod_eq [a] [b]); auto with zarith."; + pp " rewrite <- spec_mod_gt; auto with zarith."; + pp " rewrite H6; rewrite Zplus_0_r."; + pp " apply Zis_gcd_mult; apply Zis_gcd_1."; + pp " intros; apply False_ind."; + pp " case (spec_digits (mod_gt a b)); auto with zarith."; + pp " intros H6; apply GenDiv.Zis_gcd_mod; auto with zarith."; + pp " apply GenDiv.Zis_gcd_mod; auto with zarith."; + pp " rewrite <- spec_mod_gt; auto with zarith."; + pp " assert (F2: [b] > [mod_gt a b])."; + pp " case (Z_mod_lt [a] [b]); auto with zarith."; + pp " repeat rewrite <- spec_mod_gt; auto with zarith."; + pp " assert (F3: [mod_gt a b] > [mod_gt b (mod_gt a b)])."; + pp " case (Z_mod_lt [b] [mod_gt a b]); auto with zarith."; + pp " rewrite <- spec_mod_gt; auto with zarith."; + pp " repeat rewrite <- spec_mod_gt; auto with zarith."; + pp " apply H4; auto with zarith."; + pp " apply Zmult_lt_reg_r with 2; auto with zarith."; + pp " apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith."; + pp " apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith."; + pp " apply Zplus_le_compat_r."; + pp " pattern [b] at 1; rewrite <- (Zmult_1_l [b])."; + pp " apply Zmult_le_compat_r; auto with zarith."; + pp " case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith."; + pp " intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2;"; + pp " try rewrite <- HH in H2; auto with zarith."; + pp " case (Z_mod_lt [a] [b]); auto with zarith."; + pp " rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith."; + pp " rewrite <- Z_div_mod_eq; auto with zarith."; + pp " pattern 2 at 2; rewrite <- (Zpower_1_r 2)."; + pp " rewrite <- Zpower_exp; auto with zarith."; + pp " ring_simplify (p - 1 + 1); auto."; + pp " case (Zle_lt_or_eq 0 p); auto with zarith."; + pp " generalize H3; case p; simpl Zpower; auto with zarith."; + pp " intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith."; + pp " Qed."; + pp ""; + + pr " Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) {struct p} : t :="; + pr " gcd_gt_body a b"; + pr " (fun a b =>"; + pr " match p with"; + pr " | xH => cont a b"; + pr " | xO p => gcd_gt_aux p (gcd_gt_aux p cont) a b"; + pr " | xI p => gcd_gt_aux p (gcd_gt_aux p cont) a b"; + pr " end)."; + pr ""; + + pp " Theorem Zspec_gcd_gt_aux: forall p n a b cont,"; + pp " [a] > [b] -> [a] < 2 ^ (Zpos p + n) ->"; + pp " (forall a1 b1, [a1] < 2 ^ n -> [a1] > [b1] ->"; + pp " Zis_gcd [a1] [b1] [cont a1 b1]) ->"; + pp " Zis_gcd [a] [b] [gcd_gt_aux p cont a b]."; + pp " intros p; elim p; clear p."; + pp " intros p Hrec n a b cont H2 H3 H4."; + pp " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xI p) + n); auto."; + pp " intros a1 b1 H6 H7."; + pp " apply Hrec with (Zpos p + n); auto."; + pp " replace (Zpos p + (Zpos p + n)) with"; + pp " (Zpos (xI p) + n - 1); auto."; + pp " rewrite Zpos_xI; ring."; + pp " intros a2 b2 H9 H10."; + pp " apply Hrec with n; auto."; + pp " intros p Hrec n a b cont H2 H3 H4."; + pp " unfold gcd_gt_aux; apply Zspec_gcd_gt_body with (Zpos (xO p) + n); auto."; + pp " intros a1 b1 H6 H7."; + pp " apply Hrec with (Zpos p + n - 1); auto."; + pp " replace (Zpos p + (Zpos p + n - 1)) with"; + pp " (Zpos (xO p) + n - 1); auto."; + pp " rewrite Zpos_xO; ring."; + pp " intros a2 b2 H9 H10."; + pp " apply Hrec with (n - 1); auto."; + pp " replace (Zpos p + (n - 1)) with"; + pp " (Zpos p + n - 1); auto with zarith."; + pp " intros a3 b3 H12 H13; apply H4; auto with zarith."; + pp " apply Zlt_le_trans with (1 := H12)."; + pp " case (Zle_or_lt 1 n); intros HH."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " apply Zle_trans with 0; auto with zarith."; + pp " assert (HH1: n - 1 < 0); auto with zarith."; + pp " generalize HH1; case (n - 1); auto with zarith."; + pp " intros p1 HH2; discriminate."; + pp " intros n a b cont H H2 H3."; + pp " simpl gcd_gt_aux."; + pp " apply Zspec_gcd_gt_body with (n + 1); auto with zarith."; + pp " rewrite Zplus_comm; auto."; + pp " intros a1 b1 H5 H6; apply H3; auto."; + pp " replace n with (n + 1 - 1); auto; try ring."; + pp " Qed."; + pp ""; + + pr " Definition gcd_cont a b :="; + pr " match compare one b with"; + pr " | Eq => one"; + pr " | _ => a"; + pr " end."; + pr ""; + + pr " Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b."; + pr ""; + + pr " Theorem spec_gcd_gt: forall a b,"; + pr " [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]."; + pa " Admitted."; + pp " Proof."; + pp " intros a b H2."; + pp " case (spec_digits (gcd_gt a b)); intros H3 H4."; + pp " case (spec_digits a); intros H5 H6."; + pp " apply sym_equal; apply Zis_gcd_gcd; auto with zarith."; + pp " unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith."; + pp " intros a1 a2; rewrite Zpower_0_r."; + pp " case (spec_digits a2); intros H7 H8;"; + pp " intros; apply False_ind; auto with zarith."; + pp " Qed."; + pr ""; + + pr " Definition gcd a b :="; + pr " match compare a b with"; + pr " | Eq => a"; + pr " | Lt => gcd_gt b a"; + pr " | Gt => gcd_gt a b"; + pr " end."; + pr ""; + + pr " Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]."; + pa " Admitted."; + pp " Proof."; + pp " intros a b."; + pp " case (spec_digits a); intros H1 H2."; + pp " case (spec_digits b); intros H3 H4."; + pp " unfold gcd; generalize (spec_compare a b); case compare."; + pp " intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto."; + pp " apply Zis_gcd_refl."; + pp " intros; apply trans_equal with (Zgcd [b] [a])."; + pp " apply spec_gcd_gt; auto with zarith."; + pp " apply Zis_gcd_gcd; auto with zarith."; + pp " apply Zgcd_is_pos."; + pp " apply Zis_gcd_sym; apply Zgcd_is_gcd."; + pp " intros; apply spec_gcd_gt; auto."; + pp " Qed."; + pr ""; + + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Conversion *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + pr " Definition pheight p := "; + pr " Peano.pred (nat_of_P (get_height w0_op.(znz_digits) (plength p)))."; + pr ""; + + pr " Theorem pheight_correct: forall p, "; + pr " Zpos p < 2 ^ (Zpos (znz_digits w0_op) * 2 ^ (Z_of_nat (pheight p)))."; + pr " Proof."; + pr " intros p; unfold pheight."; + pr " assert (F1: forall x, Z_of_nat (Peano.pred (nat_of_P x)) = Zpos x - 1)."; + pr " intros x."; + pr " assert (Zsucc (Z_of_nat (Peano.pred (nat_of_P x))) = Zpos x); auto with zarith."; + pr " rewrite <- inj_S."; + pr " rewrite <- (fun x => S_pred x 0); auto with zarith."; + pr " rewrite Zpos_eq_Z_of_nat_o_nat_of_P; auto."; + pr " apply lt_le_trans with 1%snat; auto with zarith." "%"; + pr " exact (le_Pmult_nat x 1)."; + pr " rewrite F1; clear F1."; + pr " assert (F2:= (get_height_correct (znz_digits w0_op) (plength p)))."; + pr " apply Zlt_le_trans with (Zpos (Psucc p))."; + pr " rewrite Zpos_succ_morphism; auto with zarith."; + pr " apply Zle_trans with (1 := plength_pred_correct (Psucc p))."; + pr " rewrite Ppred_succ."; + pr " apply Zpower_le_monotone; auto with zarith."; + pr " Qed."; + pr ""; + + pr " Definition of_pos x :="; + pr " let h := pheight x in"; + pr " match h with"; + for i = 0 to size do + pr " | %i%snat => reduce_%i (snd (w%i_op.(znz_of_pos) x))" i "%" i i; + done; + pr " | _ =>"; + pr " let n := minus h %i in" (size + 1); + pr " reduce_n n (snd ((make_op n).(znz_of_pos) x))"; + pr " end."; + pr ""; + + pr " Theorem spec_of_pos: forall x,"; + pr " [of_pos x] = Zpos x."; + pa " Admitted."; + pp " Proof."; + pp " assert (F := spec_more_than_1_digit w0_spec)."; + pp " intros x; unfold of_pos; case_eq (pheight x)."; for i = 0 to size do if i <> 0 then - 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"; + pp " intros n; case n; clear n."; + pp " intros H1; rewrite spec_reduce_%i; unfold to_Z." i; + pp " apply (znz_of_pos_correct w%i_spec)." i; + pp " apply Zlt_le_trans with (1 := pheight_correct x)."; + pp " rewrite H1; simpl Z_of_nat; change (2^%i) with (%s)." i (gen2 i); + pp " unfold base."; + pp " apply Zpower_le_monotone; split; auto with zarith."; if i <> 0 then begin - fprintf fmt " rewrite Zmult_comm; repeat rewrite <- Zmult_assoc.\n"; - fprintf fmt " repeat rewrite <- Zpos_xO.\n"; - fprintf fmt " refine (Zle_refl _).\n"; + pp " rewrite Zmult_comm; repeat rewrite <- Zmult_assoc."; + pp " repeat rewrite <- Zpos_xO."; + pp " refine (Zle_refl _)."; 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"; + pp " intros n."; + pp " intros H1; rewrite spec_reduce_n; unfold to_Z."; + pp " simpl minus; rewrite <- minus_n_O."; + pp " apply (znz_of_pos_correct (wn_spec n))."; + pp " apply Zlt_le_trans with (1 := pheight_correct x)."; + pp " unfold base."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " split; auto with zarith."; + pp " rewrite H1."; + pp " elim n; clear n H1."; + pp " simpl Z_of_nat; change (2^%i) with (%s)." (size + 1) (gen2 (size + 1)); + pp " rewrite Zmult_comm; repeat rewrite <- Zmult_assoc."; + pp " repeat rewrite <- Zpos_xO."; + pp " refine (Zle_refl _)."; + pp " intros n Hrec."; + pp " rewrite make_op_S."; + pp " change (@znz_digits (word _ (S (S n))) (mk_zn2z_op_karatsuba (make_op n))) with"; + pp " (xO (znz_digits (make_op n)))."; + pp " rewrite (fun x y => (Zpos_xO (@znz_digits x y)))."; + pp " rewrite inj_S; unfold Zsucc."; + pp " rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith."; + pp " rewrite Zpower_1_r."; + pp " assert (tmp: forall x y z, x * (y * z) = y * (x * z));"; + pp " [intros; ring | rewrite tmp; clear tmp]."; + pp " apply Zmult_le_compat_l; auto with zarith."; + pp " Qed."; + pr ""; + + pr " Definition of_N x :="; + pr " match x with"; + pr " | BinNat.N0 => zero"; + pr " | Npos p => of_pos p"; + pr " end."; + pr ""; + + + pr " Theorem spec_of_N: forall x,"; + pr " [of_N x] = Z_of_N x."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x."; + pp " simpl of_N."; + pp " unfold zero, w_0, to_Z; rewrite (spec_0 w0_spec); auto."; + pp " intros p; exact (spec_of_pos p)."; + pp " Qed."; + pr ""; + + pr " (***************************************************************)"; + pr " (* *)"; + pr " (* Shift *)"; + pr " (* *)"; + pr " (***************************************************************)"; + pr ""; + + (* Head0 *) + pr " Definition head0 w := match w with"; + for i = 0 to size do + pr " | %s%i w=> reduce_%i (w%i_op.(znz_head0) w)" c i i i; + done; + pr " | %sn n w=> reduce_n n ((make_op n).(znz_head0) w)" c; + pr " end."; + pr ""; + + pr " Theorem spec_head00: forall x, [x] = 0 ->[head0 x] = Zpos (digits x)."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; unfold head0; clear x."; + for i = 0 to size do + pp " intros x; rewrite spec_reduce_%i; exact (spec_head00 w%i_spec x)." i i; + done; + pp " intros n x; rewrite spec_reduce_n; exact (spec_head00 (wn_spec n) x)."; + pp " Qed."; + pr " "; + + pr " Theorem spec_head0: forall x, 0 < [x] ->"; + pr " 2 ^ (Zpos (digits x) - 1) <= 2 ^ [head0 x] * [x] < 2 ^ Zpos (digits x)."; + pa " Admitted."; + pp " Proof."; + pp " assert (F0: forall x, (x - 1) + 1 = x)."; + pp " intros; ring. "; + pp " intros x; case x; unfold digits, head0; clear x."; + for i = 0 to size do + pp " intros x Hx; rewrite spec_reduce_%i." i; + pp " assert (F1:= spec_more_than_1_digit w%i_spec)." i; + pp " generalize (spec_head0 w%i_spec x Hx)." i; + pp " unfold base."; + pp " pattern (Zpos (znz_digits w%i_op)) at 1; " i; + pp " rewrite <- (fun x => (F0 (Zpos x)))."; + pp " rewrite Zpower_exp; auto with zarith."; + pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith."; + done; + pp " intros n x Hx; rewrite spec_reduce_n."; + pp " assert (F1:= spec_more_than_1_digit (wn_spec n))."; + pp " generalize (spec_head0 (wn_spec n) x Hx)."; + pp " unfold base."; + pp " pattern (Zpos (znz_digits (make_op n))) at 1; "; + pp " rewrite <- (fun x => (F0 (Zpos x)))."; + pp " rewrite Zpower_exp; auto with zarith."; + pp " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith."; + pp " Qed."; + pr ""; + + + (* Tail0 *) + pr " Definition tail0 w := match w with"; + for i = 0 to size do + pr " | %s%i w=> reduce_%i (w%i_op.(znz_tail0) w)" c i i i; + done; + pr " | %sn n w=> reduce_n n ((make_op n).(znz_tail0) w)" c; + pr " end."; + pr ""; + + + pr " Theorem spec_tail00: forall x, [x] = 0 ->[tail0 x] = Zpos (digits x)."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; unfold tail0; clear x."; + for i = 0 to size do + pp " intros x; rewrite spec_reduce_%i; exact (spec_tail00 w%i_spec x)." i i; + done; + pp " intros n x; rewrite spec_reduce_n; exact (spec_tail00 (wn_spec n) x)."; + pp " Qed."; + pr " "; + + + pr " Theorem spec_tail0: forall x,"; + pr " 0 < [x] -> exists y, 0 <= y /\\ [x] = (2 * y + 1) * 2 ^ [tail0 x]."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; clear x; unfold tail0."; + for i = 0 to size do + pp " intros x Hx; rewrite spec_reduce_%i; exact (spec_tail0 w%i_spec x Hx)." i i; + done; + pp " intros n x Hx; rewrite spec_reduce_n; exact (spec_tail0 (wn_spec n) x Hx)."; + pp " Qed."; + pr ""; (* Number of digits *) - fprintf fmt " Definition %sdigits x :=\n" c; - fprintf fmt " match x with\n"; - fprintf fmt " | %s0 _ => %s0 w0_op.(znz_zdigits)\n" c c; + pr " Definition %sdigits x :=" c; + pr " match x with"; + pr " | %s0 _ => %s0 w0_op.(znz_zdigits)" c c; for i = 1 to size do - fprintf fmt " | %s%i _ => reduce_%i w%i_op.(znz_zdigits)\n" c i i i; + pr " | %s%i _ => reduce_%i w%i_op.(znz_zdigits)" 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"; + pr " | %sn n _ => reduce_n n (make_op n).(znz_zdigits)" c; + pr " end."; + pr ""; - 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"; + pr " Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x)."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; clear x; unfold Ndigits, digits."; for i = 0 to size do - fprintf fmt " intros _; try rewrite spec_reduce_%i; exact (spec_zdigits w%i_spec).\n" i i; + pp " intros _; try rewrite spec_reduce_%i; exact (spec_zdigits w%i_spec)." 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"; + pp " intros n _; try rewrite spec_reduce_n; exact (spec_zdigits (wn_spec n))."; + pp " Qed."; + pr ""; - (* Shiftr *) + (* 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; + pr " Definition shiftr%i n x := w%i_op.(znz_add_mul_div) (w%i_op.(znz_sub) w%i_op.(znz_zdigits) n) w%i_op.(znz_0) x." i i i i i; 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"; + pr " Definition shiftrn n p x := (make_op n).(znz_add_mul_div) ((make_op n).(znz_sub) (make_op n).(znz_zdigits) p) (make_op n).(znz_0) x."; + pr ""; - 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; + pr " Definition shiftr := Eval lazy beta delta [same_level] in "; + pr " same_level _ (fun n x => %s0 (shiftr0 n x))" 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"; + pr " (fun n x => reduce_%i (shiftr%i n x))" i i; + done; + pr " (fun n p x => reduce_n n (shiftrn n p x))."; + pr ""; + + + pr " Theorem spec_shiftr: forall n x,"; + pr " [n] <= [Ndigits x] -> [shiftr n x] = [x] / 2 ^ [n]."; + pa " Admitted."; + pp " Proof."; + pp " assert (F0: forall x y, x - (x - y) = y)."; + pp " intros; ring."; + pp " assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z)."; + pp " intros x y z HH HH1 HH2."; + pp " split; auto with zarith."; + pp " apply Zle_lt_trans with (2 := HH2); auto with zarith."; + pp " apply Zdiv_le_upper_bound; auto with zarith."; + pp " pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith."; + pp " apply Zmult_le_compat_l; auto."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " rewrite Zpower_0_r; ring."; + pp " assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x)."; + pp " intros xx y HH HH1."; + pp " split; auto with zarith."; + pp " apply Zle_lt_trans with xx; auto with zarith."; + pp " apply Zpower2_lt_lin; auto with zarith."; + pp " assert (F4: forall ww ww1 ww2 "; + pp " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)"; + pp " xx yy xx1 yy1,"; + pp " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_zdigits ww1_op) ->"; + pp " znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->"; + pp " znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->"; + pp " znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->"; + pp " znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->"; + pp " znz_to_Z ww_op"; + pp " (znz_add_mul_div ww_op (znz_sub ww_op (znz_zdigits ww_op) yy1)"; + pp " (znz_0 ww_op) xx1) = znz_to_Z ww1_op xx / 2 ^ znz_to_Z ww2_op yy)."; + pp " intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy."; + pp " case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2."; + pp " case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4."; + pp " rewrite <- Hx."; + pp " rewrite <- Hy."; + pp " generalize (spec_add_mul_div Hw"; + pp " (znz_0 ww_op) xx1"; + pp " (znz_sub ww_op (znz_zdigits ww_op) "; + pp " yy1)"; + pp " )."; + pp " rewrite (spec_0 Hw)."; + pp " rewrite Zmult_0_l; rewrite Zplus_0_l."; + pp " rewrite (ZnZ.spec_sub Hw)."; + pp " rewrite Zmod_small; auto with zarith."; + pp " rewrite (spec_zdigits Hw)."; + pp " rewrite F0."; + pp " rewrite Zmod_small; auto with zarith."; + pp " unfold base; rewrite (spec_zdigits Hw) in Hl1 |- *;"; + pp " auto with zarith."; + pp " assert (F5: forall n m, (n <= m)%snat ->" "%"; + pp " Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m)))."; + pp " intros n m HH; elim HH; clear m HH; auto with zarith."; + pp " intros m HH Hrec; apply Zle_trans with (1 := Hrec)."; + pp " rewrite make_op_S."; + pp " match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end."; + pp " rewrite Zpos_xO."; + pp " assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith."; + pp " assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n)))." size; + pp " intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0)))."; + pp " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size; + pp " rewrite Zpos_xO."; + pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size; + pp " apply F5; auto with arith."; + pp " intros x; case x; clear x; unfold shiftr, same_level."; + for i = 0 to size do + pp " intros x y; case y; clear y."; 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; - + pp " intros y; unfold shiftr%i, Ndigits." i; + pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; + pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i; + pp " rewrite (spec_zdigits w%i_spec)." i; + pp " rewrite (spec_zdigits w%i_spec)." j; + pp " change (znz_digits w%i_op) with %s." i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)")); + pp " repeat rewrite (fun x => Zpos_xO (xO x))."; + pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; + pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." j; + pp " try (apply sym_equal; exact (spec_extend%in%i y))." j i; + done; - 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; + pp " intros y; unfold shiftr%i, Ndigits." i; + pp " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i; + pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i; for j = i + 1 to size do - 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; + pp " intros y; unfold shiftr%i, Ndigits." j; + pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; + pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i; + pp " try (apply sym_equal; exact (spec_extend%in%i x))." i j; done; if i == size then begin - 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; - + pp " intros m y; unfold shiftrn, Ndigits."; + pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; + pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size; + pp " try (apply sym_equal; exact (spec_extend%in m x))." size; end else begin - 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; + pp " intros m y; unfold shiftrn, Ndigits."; + pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; + pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i; + pp " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i; + pp " rewrite <- (spec_extend%in m); rewrite <- spec_extend%in%i; auto." size i size; end done; - 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; + pp " intros n x y; case y; clear y;"; + pp " intros y; unfold shiftrn, Ndigits; try rewrite spec_reduce_n."; + for i = 0 to size do + pp " try rewrite spec_reduce_%i; unfold to_Z; intros H1." i; + pp " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i; + pp " rewrite (spec_zdigits w%i_spec)." i; + pp " rewrite (spec_zdigits (wn_spec n))."; + pp " apply Zle_trans with (2 := F6 n)."; + pp " change (znz_digits w%i_op) with %s." size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)")); + pp " repeat rewrite (fun x => Zpos_xO (xO x))."; + pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; + pp " assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith." i; if i == size then - fprintf fmt " change ([Nn n (extend%i n y)] = [N%i y]).\n" size i + pp " change ([Nn n (extend%i n y)] = [N%i y])." 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; + pp " change ([Nn n (extend%i n (extend%i %i y))] = [N%i y])." size i (size - i - 1) i; + pp " rewrite <- (spec_extend%in n); auto." size; if i <> size then - 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; + pp " try (rewrite <- spec_extend%in%i; auto)." i size; + done; + pp " generalize y; clear y; intros m y."; + pp " rewrite spec_reduce_n; unfold to_Z; intros H1."; + pp " apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith."; + pp " rewrite (spec_zdigits (wn_spec m))."; + pp " rewrite (spec_zdigits (wn_spec (Max.max n m)))."; + pp " apply F5; auto with arith."; + pp " exact (spec_cast_r n m y)."; + pp " exact (spec_cast_l n m x)."; + pp " Qed."; + pr ""; + + pr " Definition safe_shiftr n x := "; + pr " match compare n (Ndigits x) with"; + pr " | Lt => shiftr n x "; + pr " | _ => %s0 w_0" c; + pr " end."; + pr ""; + + + pr " Theorem spec_safe_shiftr: forall n x,"; + pr " [safe_shiftr n x] = [x] / 2 ^ [n]."; + pa " Admitted."; + pp " Proof."; + pp " intros n x; unfold safe_shiftr;"; + pp " generalize (spec_compare n (Ndigits x)); case compare; intros H."; + pp " apply trans_equal with (1 := spec_0 w0_spec)."; + pp " apply sym_equal; apply Zdiv_small; rewrite H."; + pp " rewrite spec_Ndigits; exact (spec_digits x)."; + pp " rewrite <- spec_shiftr; auto with zarith."; + pp " apply trans_equal with (1 := spec_0 w0_spec)."; + pp " apply sym_equal; apply Zdiv_small."; + pp " rewrite spec_Ndigits in H; case (spec_digits x); intros H1 H2."; + pp " split; auto."; + pp " apply Zlt_le_trans with (1 := H2)."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " Qed."; + pr ""; + + pr ""; + + (* Shiftl *) + for i = 0 to size do + pr " Definition shiftl%i n x := w%i_op.(znz_add_mul_div) n x w%i_op.(znz_0)." i i i + done; + pr " Definition shiftln n p x := (make_op n).(znz_add_mul_div) p x (make_op n).(znz_0)."; + pr " Definition shiftl := Eval lazy beta delta [same_level] in"; + pr " same_level _ (fun n x => %s0 (shiftl0 n x))" c; 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"; + pr " (fun n x => reduce_%i (shiftl%i n x))" i i; + done; + pr " (fun n p x => reduce_n n (shiftln n p x))."; + pr ""; + pr ""; + + + pr " Theorem spec_shiftl: forall n x,"; + pr " [n] <= [head0 x] -> [shiftl n x] = [x] * 2 ^ [n]."; + pa " Admitted."; + pp " Proof."; + pp " assert (F0: forall x y, x - (x - y) = y)."; + pp " intros; ring."; + pp " assert (F2: forall x y z, 0 <= x -> 0 <= y -> x < z -> 0 <= x / 2 ^ y < z)."; + pp " intros x y z HH HH1 HH2."; + pp " split; auto with zarith."; + pp " apply Zle_lt_trans with (2 := HH2); auto with zarith."; + pp " apply Zdiv_le_upper_bound; auto with zarith."; + pp " pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith."; + pp " apply Zmult_le_compat_l; auto."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " rewrite Zpower_0_r; ring."; + pp " assert (F3: forall x y, 0 <= y -> y <= x -> 0 <= x - y < 2 ^ x)."; + pp " intros xx y HH HH1."; + pp " split; auto with zarith."; + pp " apply Zle_lt_trans with xx; auto with zarith."; + pp " apply Zpower2_lt_lin; auto with zarith."; + pp " assert (F4: forall ww ww1 ww2 "; + pp " (ww_op: znz_op ww) (ww1_op: znz_op ww1) (ww2_op: znz_op ww2)"; + pp " xx yy xx1 yy1,"; + pp " znz_to_Z ww2_op yy <= znz_to_Z ww1_op (znz_head0 ww1_op xx) ->"; + pp " znz_to_Z ww1_op (znz_zdigits ww1_op) <= znz_to_Z ww_op (znz_zdigits ww_op) ->"; + pp " znz_spec ww_op -> znz_spec ww1_op -> znz_spec ww2_op ->"; + pp " znz_to_Z ww_op xx1 = znz_to_Z ww1_op xx ->"; + pp " znz_to_Z ww_op yy1 = znz_to_Z ww2_op yy ->"; + pp " znz_to_Z ww_op"; + pp " (znz_add_mul_div ww_op yy1"; + pp " xx1 (znz_0 ww_op)) = znz_to_Z ww1_op xx * 2 ^ znz_to_Z ww2_op yy)."; + pp " intros ww ww1 ww2 ww_op ww1_op ww2_op xx yy xx1 yy1 Hl Hl1 Hw Hw1 Hw2 Hx Hy."; + pp " case (spec_to_Z Hw xx1); auto with zarith; intros HH1 HH2."; + pp " case (spec_to_Z Hw yy1); auto with zarith; intros HH3 HH4."; + pp " rewrite <- Hx."; + pp " rewrite <- Hy."; + pp " generalize (spec_add_mul_div Hw xx1 (znz_0 ww_op) yy1)."; + pp " rewrite (spec_0 Hw)."; + pp " assert (F1: znz_to_Z ww1_op (znz_head0 ww1_op xx) <= Zpos (znz_digits ww1_op))."; + pp " case (Zle_lt_or_eq _ _ HH1); intros HH5."; + pp " apply Zlt_le_weak."; + pp " case (ZnZ.spec_head0 Hw1 xx)."; + pp " rewrite <- Hx; auto."; + pp " intros _ Hu; unfold base in Hu."; + pp " case (Zle_or_lt (Zpos (znz_digits ww1_op))"; + pp " (znz_to_Z ww1_op (znz_head0 ww1_op xx))); auto; intros H1."; + pp " absurd (2 ^ (Zpos (znz_digits ww1_op)) <= 2 ^ (znz_to_Z ww1_op (znz_head0 ww1_op xx)))."; + pp " apply Zlt_not_le."; + pp " case (spec_to_Z Hw1 xx); intros HHx3 HHx4."; + pp " rewrite <- (Zmult_1_r (2 ^ znz_to_Z ww1_op (znz_head0 ww1_op xx)))."; + pp " apply Zle_lt_trans with (2 := Hu)."; + pp " apply Zmult_le_compat_l; auto with zarith."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " rewrite (ZnZ.spec_head00 Hw1 xx); auto with zarith."; + pp " rewrite Zdiv_0_l; auto with zarith."; + pp " rewrite Zplus_0_r."; + pp " case (Zle_lt_or_eq _ _ HH1); intros HH5."; + pp " rewrite Zmod_small; auto with zarith."; + pp " intros HH; apply HH."; + pp " rewrite Hy; apply Zle_trans with (1:= Hl)."; + pp " rewrite <- (spec_zdigits Hw). "; + pp " apply Zle_trans with (2 := Hl1); auto."; + pp " rewrite (spec_zdigits Hw1); auto with zarith."; + pp " split; auto with zarith ."; + pp " apply Zlt_le_trans with (base (znz_digits ww1_op))."; + pp " rewrite Hx."; + pp " case (ZnZ.spec_head0 Hw1 xx); auto."; + pp " rewrite <- Hx; auto."; + pp " intros _ Hu; rewrite Zmult_comm in Hu."; + pp " apply Zle_lt_trans with (2 := Hu)."; + pp " apply Zmult_le_compat_l; auto with zarith."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " unfold base; apply Zpower_le_monotone; auto with zarith."; + pp " split; auto with zarith."; + pp " rewrite <- (spec_zdigits Hw); auto with zarith."; + pp " rewrite <- (spec_zdigits Hw1); auto with zarith."; + pp " rewrite <- HH5."; + pp " rewrite Zmult_0_l."; + pp " rewrite Zmod_small; auto with zarith."; + pp " intros HH; apply HH."; + pp " rewrite Hy; apply Zle_trans with (1 := Hl)."; + pp " rewrite (ZnZ.spec_head00 Hw1 xx); auto with zarith."; + pp " rewrite <- (spec_zdigits Hw); auto with zarith."; + pp " rewrite <- (spec_zdigits Hw1); auto with zarith."; + pp " assert (F5: forall n m, (n <= m)%snat ->" "%"; + pp " Zpos (znz_digits (make_op n)) <= Zpos (znz_digits (make_op m)))."; + pp " intros n m HH; elim HH; clear m HH; auto with zarith."; + pp " intros m HH Hrec; apply Zle_trans with (1 := Hrec)."; + pp " rewrite make_op_S."; + pp " match goal with |- Zpos ?Y <= ?X => change X with (Zpos (xO Y)) end."; + pp " rewrite Zpos_xO."; + pp " assert (0 <= Zpos (znz_digits (make_op n))); auto with zarith."; + pp " assert (F6: forall n, Zpos (znz_digits w%i_op) <= Zpos (znz_digits (make_op n)))." size; + pp " intros n ; apply Zle_trans with (Zpos (znz_digits (make_op 0)))."; + pp " change (znz_digits (make_op 0)) with (xO (znz_digits w%i_op))." size; + pp " rewrite Zpos_xO."; + pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." size; + pp " apply F5; auto with arith."; + pp " intros x; case x; clear x; unfold shiftl, same_level."; + for i = 0 to size do + pp " intros x y; case y; clear y."; 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; - + pp " intros y; unfold shiftl%i, head0." i; + pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; + pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i j i; + pp " rewrite (spec_zdigits w%i_spec)." i; + pp " rewrite (spec_zdigits w%i_spec)." j; + pp " change (znz_digits w%i_op) with %s." i (genxO (i - j) (" (znz_digits w"^(string_of_int j)^"_op)")); + pp " repeat rewrite (fun x => Zpos_xO (xO x))."; + pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; + pp " assert (0 <= Zpos (znz_digits w%i_op)); auto with zarith." j; + pp " try (apply sym_equal; exact (spec_extend%in%i y))." j i; done; - 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; + pp " intros y; unfold shiftl%i, head0." i; + pp " repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i; + pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." i i i; for j = i + 1 to size do - 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; + pp " intros y; unfold shiftl%i, head0." j; + pp " repeat rewrite spec_reduce_%i; repeat rewrite spec_reduce_%i; unfold to_Z; intros H1." i j; + pp " apply F4 with (3:=w%i_spec)(4:=w%i_spec)(5:=w%i_spec); auto with zarith." j j i; + pp " try (apply sym_equal; exact (spec_extend%in%i x))." i j; done; if i == size then begin - 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; - + pp " intros m y; unfold shiftln, head0."; + pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; + pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." size; + pp " try (apply sym_equal; exact (spec_extend%in m x))." size; end else 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; + pp " intros m y; unfold shiftln, head0."; + pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; + pp " apply F4 with (3:=(wn_spec m))(4:=wn_spec m)(5:=w%i_spec); auto with zarith." i; + pp " change ([Nn m (extend%i m (extend%i %i x))] = [N%i x])." size i (size - i - 1) i; + pp " rewrite <- (spec_extend%in m); rewrite <- spec_extend%in%i; auto." 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; + pp " intros n x y; case y; clear y;"; + pp " intros y; unfold shiftln, head0; try rewrite spec_reduce_n."; + for i = 0 to size do + pp " try rewrite spec_reduce_%i; unfold to_Z; intros H1." i; + pp " apply F4 with (3:=(wn_spec n))(4:=w%i_spec)(5:=wn_spec n); auto with zarith." i; + pp " rewrite (spec_zdigits w%i_spec)." i; + pp " rewrite (spec_zdigits (wn_spec n))."; + pp " apply Zle_trans with (2 := F6 n)."; + pp " change (znz_digits w%i_op) with %s." size (genxO (size - i) ("(znz_digits w" ^ (string_of_int i) ^ "_op)")); + pp " repeat rewrite (fun x => Zpos_xO (xO x))."; + pp " repeat rewrite (fun x y => Zpos_xO (@znz_digits x y))."; + pp " assert (H: 0 <= Zpos (znz_digits w%i_op)); auto with zarith." i; if i == size then - fprintf fmt " change ([Nn n (extend%i n y)] = [N%i y]).\n" size i + pp " change ([Nn n (extend%i n y)] = [N%i y])." 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; + pp " change ([Nn n (extend%i n (extend%i %i y))] = [N%i y])." size i (size - i - 1) i; + pp " rewrite <- (spec_extend%in n); auto." size; if i <> size then - 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"; + pp " try (rewrite <- spec_extend%in%i; auto)." i size; + done; + pp " generalize y; clear y; intros m y."; + pp " repeat rewrite spec_reduce_n; unfold to_Z; intros H1."; + pp " apply F4 with (3:=(wn_spec (Max.max n m)))(4:=wn_spec m)(5:=wn_spec n); auto with zarith."; + pp " rewrite (spec_zdigits (wn_spec m))."; + pp " rewrite (spec_zdigits (wn_spec (Max.max n m)))."; + pp " apply F5; auto with arith."; + pp " exact (spec_cast_r n m y)."; + pp " exact (spec_cast_l n m x)."; + pp " Qed."; + pr ""; + + (* Double size *) + pr " Definition double_size w := match w with"; 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"; + pr " | %s%i x => %s%i (WW (znz_0 w%i_op) x)" c i c (i + 1) i; + done; + pr " | %s%i x => %sn 0 (WW (znz_0 w%i_op) x)" c size c size; + pr " | %sn n x => %sn (S n) (WW (znz_0 (make_op n)) x)" c c; + pr " end."; + pr ""; + + pr " Theorem spec_double_size_digits: "; + pr " forall x, digits (double_size x) = xO (digits x)."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; unfold double_size, digits; clear x; auto."; + pp " intros n x; rewrite make_op_S; auto."; + pp " Qed."; + pr ""; + + + pr " Theorem spec_double_size: forall x, [double_size x] = [x]."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; unfold double_size; clear x."; + for i = 0 to size do + pp " intros x; unfold to_Z, make_op; "; + pp " rewrite znz_to_Z_%i; rewrite (spec_0 w%i_spec); auto with zarith." (i + 1) i; + done; + pp " intros n x; unfold to_Z;"; + pp " generalize (znz_to_Z_n n); simpl word."; + pp " intros HH; rewrite HH; clear HH."; + pp " generalize (spec_0 (wn_spec n)); simpl word."; + pp " intros HH; rewrite HH; clear HH; auto with zarith."; + pp " Qed."; + pr ""; + + + pr " Theorem spec_double_size_head0: "; + pr " forall x, 2 * [head0 x] <= [head0 (double_size x)]."; + pa " Admitted."; + pp " Proof."; + pp " intros x."; + pp " assert (F1:= spec_pos (head0 x))."; + pp " assert (F2: 0 < Zpos (digits x))."; + pp " red; auto."; + pp " case (Zle_lt_or_eq _ _ (spec_pos x)); intros HH."; + pp " generalize HH; rewrite <- (spec_double_size x); intros HH1."; + pp " case (spec_head0 x HH); intros _ HH2."; + pp " case (spec_head0 _ HH1)."; + pp " rewrite (spec_double_size x); rewrite (spec_double_size_digits x)."; + pp " intros HH3 _."; + pp " case (Zle_or_lt ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4."; + pp " absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto."; + pp " apply Zle_not_lt."; + pp " apply Zmult_le_compat_r; auto with zarith."; + pp " apply Zpower_le_monotone; auto; auto with zarith."; + pp " generalize (spec_pos (head0 (double_size x))); auto with zarith."; + pp " assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1))."; + pp " case (Zle_lt_or_eq 1 [x]); auto with zarith; intros HH5."; + pp " apply Zmult_le_reg_r with (2 ^ 1); auto with zarith."; + pp " rewrite <- (fun x y z => Zpower_exp x (y - z)); auto with zarith."; + pp " assert (tmp: forall x, x - 1 + 1 = x); [intros; ring | rewrite tmp; clear tmp]."; + pp " apply Zle_trans with (2 := Zlt_le_weak _ _ HH2)."; + pp " apply Zmult_le_compat_l; auto with zarith."; + pp " rewrite Zpower_1_r; auto with zarith."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " split; auto with zarith. "; + pp " case (Zle_or_lt (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6."; + pp " absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith."; + pp " rewrite <- HH5; rewrite Zmult_1_r."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " rewrite (Zmult_comm 2)."; + pp " rewrite Zpower_mult; auto with zarith."; + pp " rewrite Zpower_2."; + pp " apply Zlt_le_trans with (2 := HH3)."; + pp " rewrite <- Zmult_assoc."; + pp " replace (Zpos (xO (digits x)) - 1) with"; + pp " ((Zpos (digits x) - 1) + (Zpos (digits x)))."; + pp " rewrite Zpower_exp; auto with zarith."; + pp " apply Zmult_lt_compat2; auto with zarith."; + pp " split; auto with zarith."; + pp " apply Zmult_lt_0_compat; auto with zarith."; + pp " rewrite Zpos_xO; ring."; + pp " apply Zlt_le_weak; auto."; + pp " repeat rewrite spec_head00; auto."; + pp " rewrite spec_double_size_digits."; + pp " rewrite Zpos_xO; auto with zarith."; + pp " rewrite spec_double_size; auto."; + pp " Qed."; + pr ""; + + pr " Theorem spec_double_size_head0_pos: "; + pr " forall x, 0 < [head0 (double_size x)]."; + pa " Admitted."; + pp " Proof."; + pp " intros x."; + pp " assert (F: 0 < Zpos (digits x))."; + pp " red; auto."; + pp " case (Zle_lt_or_eq _ _ (spec_pos (head0 (double_size x)))); auto; intros F0."; + pp " case (Zle_lt_or_eq _ _ (spec_pos (head0 x))); intros F1."; + pp " apply Zlt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith."; + pp " case (Zle_lt_or_eq _ _ (spec_pos x)); intros F3."; + pp " generalize F3; rewrite <- (spec_double_size x); intros F4."; + pp " absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x)))."; + pp " apply Zle_not_lt."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " split; auto with zarith."; + pp " rewrite Zpos_xO; auto with zarith."; + pp " case (spec_head0 x F3)."; + pp " rewrite <- F1; rewrite Zpower_0_r; rewrite Zmult_1_l; intros _ HH."; + pp " apply Zle_lt_trans with (2 := HH)."; + pp " case (spec_head0 _ F4)."; + pp " rewrite (spec_double_size x); rewrite (spec_double_size_digits x)."; + pp " rewrite <- F0; rewrite Zpower_0_r; rewrite Zmult_1_l; auto."; + pp " generalize F1; rewrite (spec_head00 _ (sym_equal F3)); auto with zarith."; + pp " Qed."; + pr ""; + + + (* Safe shiftl *) + + pr " Definition safe_shiftl_aux_body cont n x :="; + pr " match compare n (head0 x) with"; + pr " Gt => cont n (double_size x)"; + pr " | _ => shiftl n x"; + pr " end."; + pr ""; + + pr " Theorem spec_safe_shift_aux_body: forall n p x cont,"; + pr " 2^ Zpos p <= [head0 x] ->"; + pr " (forall x, 2 ^ (Zpos p + 1) <= [head0 x]->"; + pr " [cont n x] = [x] * 2 ^ [n]) ->"; + pr " [safe_shiftl_aux_body cont n x] = [x] * 2 ^ [n]."; + pa " Admitted."; + pp " Proof."; + pp " intros n p x cont H1 H2; unfold safe_shiftl_aux_body."; + pp " generalize (spec_compare n (head0 x)); case compare; intros H."; + pp " apply spec_shiftl; auto with zarith."; + pp " apply spec_shiftl; auto with zarith."; + pp " rewrite H2."; + pp " rewrite spec_double_size; auto."; + pp " rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith."; + pp " apply Zle_trans with (2 := spec_double_size_head0 x)."; + pp " rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith."; + pp " Qed."; + pr ""; + + pr " Fixpoint safe_shiftl_aux p cont n x {struct p} :="; + pr " safe_shiftl_aux_body "; + pr " (fun n x => match p with"; + pr " | xH => cont n x"; + pr " | xO p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x"; + pr " | xI p => safe_shiftl_aux p (safe_shiftl_aux p cont) n x"; + pr " end) n x."; + pr ""; + + pr " Theorem spec_safe_shift_aux: forall p q n x cont,"; + pr " 2 ^ (Zpos q) <= [head0 x] ->"; + pr " (forall x, 2 ^ (Zpos p + Zpos q) <= [head0 x] ->"; + pr " [cont n x] = [x] * 2 ^ [n]) -> "; + pr " [safe_shiftl_aux p cont n x] = [x] * 2 ^ [n]."; + pa " Admitted."; + pp " Proof."; + pp " intros p; elim p; unfold safe_shiftl_aux; fold safe_shiftl_aux; clear p."; + pp " intros p Hrec q n x cont H1 H2."; + pp " apply spec_safe_shift_aux_body with (q); auto."; + pp " intros x1 H3; apply Hrec with (q + 1)%spositive; auto." "%"; + pp " intros x2 H4; apply Hrec with (p + q + 1)%spositive; auto." "%"; + pp " rewrite <- Pplus_assoc."; + pp " rewrite Zpos_plus_distr; auto."; + pp " intros x3 H5; apply H2."; + pp " rewrite Zpos_xI."; + pp " replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1));"; + pp " auto."; + pp " repeat rewrite Zpos_plus_distr; ring."; + pp " intros p Hrec q n x cont H1 H2."; + pp " apply spec_safe_shift_aux_body with (q); auto."; + pp " intros x1 H3; apply Hrec with (q); auto."; + pp " apply Zle_trans with (2 := H3); auto with zarith."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " intros x2 H4; apply Hrec with (p + q)%spositive; auto." "%"; + pp " intros x3 H5; apply H2."; + pp " rewrite (Zpos_xO p)."; + pp " replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q));"; + pp " auto."; + pp " repeat rewrite Zpos_plus_distr; ring."; + pp " intros q n x cont H1 H2."; + pp " apply spec_safe_shift_aux_body with (q); auto."; + pp " rewrite Zplus_comm; auto."; + pp " Qed."; + pr ""; + + + pr " Definition safe_shiftl n x :="; + pr " safe_shiftl_aux_body"; + pr " (safe_shiftl_aux_body"; + pr " (safe_shiftl_aux (digits n) shiftl)) n x."; + pr ""; + + pr " Theorem spec_safe_shift: forall n x,"; + pr " [safe_shiftl n x] = [x] * 2 ^ [n]."; + pa " Admitted."; + pp " Proof."; + pp " intros n x; unfold safe_shiftl, safe_shiftl_aux_body."; + pp " generalize (spec_compare n (head0 x)); case compare; intros H."; + pp " apply spec_shiftl; auto with zarith."; + pp " apply spec_shiftl; auto with zarith."; + pp " rewrite <- (spec_double_size x)."; + pp " generalize (spec_compare n (head0 (double_size x))); case compare; intros H1."; + pp " apply spec_shiftl; auto with zarith."; + pp " apply spec_shiftl; auto with zarith."; + pp " rewrite <- (spec_double_size (double_size x))."; + pp " apply spec_safe_shift_aux with 1%spositive." "%"; + pp " apply Zle_trans with (2 := spec_double_size_head0 (double_size x))."; + pp " replace (2 ^ 1) with (2 * 1)."; + pp " apply Zmult_le_compat_l; auto with zarith."; + pp " generalize (spec_double_size_head0_pos x); auto with zarith."; + pp " rewrite Zpower_1_r; ring."; + pp " intros x1 H2; apply spec_shiftl."; + pp " apply Zle_trans with (2 := H2)."; + pp " apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith."; + pp " case (spec_digits n); auto with zarith."; + pp " apply Zpower_le_monotone; auto with zarith."; + pp " Qed."; + pr ""; (* even *) - fprintf fmt " Definition is_even x :=\n"; - fprintf fmt " match x with\n"; + pr " Definition is_even x :="; + pr " match x with"; for i = 0 to size do - fprintf fmt " | %s%i wx => w%i_op.(znz_is_even) wx\n" c i i + pr " | %s%i wx => w%i_op.(znz_is_even) wx" 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"; + pr " | %sn n wx => (make_op n).(znz_is_even) wx" c; + pr " end."; + pr ""; - 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"; + pr " Theorem spec_is_even: forall x,"; + pr " if is_even x then [x] mod 2 = 0 else [x] mod 2 = 1."; + pa " Admitted."; + pp " Proof."; + pp " intros x; case x; unfold is_even, to_Z; clear x."; for i = 0 to size do - fprintf fmt " intros x; exact (spec_is_even w%i_spec x).\n" i; + pp " intros x; exact (spec_is_even w%i_spec x)." 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 () - - + pp " intros n x; exact (spec_is_even (wn_spec n) x)."; + pp " Qed."; + pr ""; + pr " Theorem spec_0: [zero] = 0."; + pa " Admitted."; + pp " Proof."; + pp " exact (spec_0 w0_spec)."; + pp " Qed."; + pr ""; -let _ = print_Make () + pr " Theorem spec_1: [one] = 1."; + pa " Admitted."; + pp " Proof."; + pp " exact (spec_1 w0_spec)."; + pp " Qed."; + pr ""; + pr "End Make."; + pr ""; |