diff options
| author | thery | 2007-12-06 18:46:22 +0000 |
|---|---|---|
| committer | thery | 2007-12-06 18:46:22 +0000 |
| commit | 842edebdba36127ab6a8760e02ffd36051e59a58 (patch) | |
| tree | a3bbeee90518da286f32a1c32b6459411dad6f52 | |
| parent | a59b644de4234fb7fe3fce28284979091f257130 (diff) | |
Adding MemoFunction + Lowering Height
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@10350 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | theories/Ints/num/MemoFn.v | 177 | ||||
| -rw-r--r-- | theories/Ints/num/NMake.v | 6937 | ||||
| -rw-r--r-- | theories/Ints/num/genN.ml | 117 |
3 files changed, 5384 insertions, 1847 deletions
diff --git a/theories/Ints/num/MemoFn.v b/theories/Ints/num/MemoFn.v new file mode 100644 index 0000000000..0d64416f3a --- /dev/null +++ b/theories/Ints/num/MemoFn.v @@ -0,0 +1,177 @@ +Require Import Eqdep_dec. + +Section MemoFunction. + +Variable A: Type. +Variable f: nat -> A. +Variable g: A -> A. + +Hypothesis Hg_correct: forall n, f (S n) = g (f n). + +(* Memo Stream *) +CoInductive MStream: Type := + MSeq : A -> MStream -> MStream. + +(* Hd and Tl function *) +Definition mhd (x: MStream) := + let (a,s) := x in a. +Definition mtl (x: MStream) := + let (a,s) := x in s. + +CoFixpoint memo_make (n: nat): MStream:= MSeq (f n) (memo_make (S n)). + +Definition memo_list := memo_make 0. + +Fixpoint memo_get (n: nat) (l: MStream) {struct n}: A := + match n with O => mhd l | S n1 => + memo_get n1 (mtl l) end. + +Theorem memo_get_correct: forall n, memo_get n memo_list = f n. +Proof. +assert (F1: forall n m, memo_get n (memo_make m) = f (n + m)). + induction n as [| n Hrec]; try (intros m; refine (refl_equal _)). + intros m; simpl; rewrite Hrec. + rewrite plus_n_Sm; auto. +intros n; apply trans_equal with (f (n + 0)); try exact (F1 n 0). +rewrite <- plus_n_O; auto. +Qed. + +(* Building with possible sharing using g *) +CoFixpoint imemo_make (fn: A): MStream := + let fn1 := g fn in + MSeq fn1 (imemo_make fn1). + +Definition imemo_list := let f0 := f 0 in + MSeq f0 (imemo_make f0). + +Theorem imemo_get_correct: forall n, memo_get n imemo_list = f n. +Proof. +assert (F1: forall n m, + memo_get n (imemo_make (f m)) = f (S (n + m))). + induction n as [| n Hrec]; try (intros m; exact (sym_equal (Hg_correct m))). + simpl; intros m; rewrite <- Hg_correct; rewrite Hrec; rewrite <- plus_n_Sm; auto. +destruct n as [| n]; try apply refl_equal. +unfold imemo_list; simpl; rewrite F1. +rewrite <- plus_n_O; auto. +Qed. + +End MemoFunction. + +Section DependentMemoFunction. + +Variable A: nat -> Type. +Variable f: forall n, A n. +Variable g: forall n, A n -> A (S n). + +Hypothesis Hg_correct: forall n, f (S n) = g n (f n). + +Inductive memo_val: Type := + memo_mval: forall n, A n -> memo_val. + +Fixpoint is_eq (n m : nat) {struct n}: {n = m} + {True} := + match n, m return {n = m} + {True} with + | 0, 0 =>left True (refl_equal 0) + | 0, S m1 => right (0 = S m1) I + | S n1, 0 => right (S n1 = 0) I + | S n1, S m1 => + match is_eq n1 m1 with + | left H => left True (f_equal S H) + | right _ => right (S n1 = S m1) I + end + end. + +Definition memo_get_val n (v: memo_val): A n := +match v with +| memo_mval m x => + match is_eq n m with + | left H => + match H in (@eq _ _ y) return (A y -> A n) with + | refl_equal => fun v1 : A n => v1 + end + | right _ => fun _ : A m => f n + end x +end. + +Let mf n := memo_mval n (f n). +Let mg v := match v with + memo_mval n1 v1 => memo_mval (S n1) (g n1 v1) end. + + +Definition dmemo_list := memo_list _ mf. + +Definition dmemo_get n l := memo_get_val n (memo_get _ n l). + +Definition dimemo_list := imemo_list _ mf mg. + +Theorem dmemo_get_correct: forall n, dmemo_get n dmemo_list = f n. +Proof. +intros n; unfold dmemo_get, dmemo_list. +rewrite (memo_get_correct memo_val mf n); simpl. +case (is_eq n n); simpl; auto; intros e. +assert (e = refl_equal n). + apply eq_proofs_unicity. + induction x as [| x Hx]; destruct y as [| y]. + left; auto. + right; intros HH; discriminate HH. + right; intros HH; discriminate HH. + case (Hx y). + intros HH; left; case HH; auto. + intros HH; right; intros HH1; case HH. + injection HH1; auto. +rewrite H; auto. +Qed. + +Theorem dimemo_get_correct: forall n, dmemo_get n dimemo_list = f n. +Proof. +intros n; unfold dmemo_get, dimemo_list. +rewrite (imemo_get_correct memo_val mf mg); simpl. +case (is_eq n n); simpl; auto; intros e. +assert (e = refl_equal n). + apply eq_proofs_unicity. + induction x as [| x Hx]; destruct y as [| y]. + left; auto. + right; intros HH; discriminate HH. + right; intros HH; discriminate HH. + case (Hx y). + intros HH; left; case HH; auto. + intros HH; right; intros HH1; case HH. + injection HH1; auto. +rewrite H; auto. +intros n1; unfold mf; rewrite Hg_correct; auto. +Qed. + +End DependentMemoFunction. + +(* An example with the memo function on factorial *) + +(** +Require Import ZArith. + +Fixpoint tfact (n: nat) {struct n} := + match n with O => 1%Z | + S n1 => (Z_of_nat n * tfact n1)%Z end. + +Definition lfact_list := + dimemo_list _ tfact (fun n z => (Z_of_nat (S n) * z)%Z). + +Definition lfact n := dmemo_get _ tfact n lfact_list. + +Theorem lfact_correct n: lfact n = tfact n. +Proof. +intros n; unfold lfact, lfact_list. +rewrite dimemo_get_correct; auto. +Qed. + +Fixpoint nop p := match p with +xH => 0 | xI p1 => nop p1 | xO p1 => nop p1 end. + +Fixpoint test z := match z with +Z0 => 0 | Zpos p1 => nop p1 | Zneg p1 => nop p1 end. + +Time Eval vm_compute in test (lfact 2000). +Time Eval vm_compute in test (lfact 2000). +Time Eval vm_compute in test (lfact 1500). +Time Eval vm_compute in (lfact 1500). + +**) + diff --git a/theories/Ints/num/NMake.v b/theories/Ints/num/NMake.v index 7ac69fb02f..ab7b4a2549 100644 --- a/theories/Ints/num/NMake.v +++ b/theories/Ints/num/NMake.v @@ -7,12 +7,20 @@ Require Import Nbasic. Require Import GenMul. Require Import GenDivn1. Require Import Wf_nat. +Require Import MemoFn. (***************************************************************) (* *) (* File automatically generated DO NOT EDIT *) -(* Constructors: 13 Generated Proofs: false *) +(* Constructors: 6 Generated Proofs: true *) (* *) +(* To change this file, edit in genN.ml the two lines *) +(* let size = 6 *) +(* let gen_proof = true *) +(* Recompile the file *) +(* camlopt -o genN unix.cmxa genN.ml *) +(* Regenerate NMake.v *) +(* ./genN *) (***************************************************************) Module Type W0Type. @@ -31,13 +39,6 @@ Module Make (W0:W0Type). Definition w4 := zn2z w3. Definition w5 := zn2z w4. Definition w6 := zn2z w5. - Definition w7 := zn2z w6. - Definition w8 := zn2z w7. - Definition w9 := zn2z w8. - Definition w10 := zn2z w9. - Definition w11 := zn2z w10. - Definition w12 := zn2z w11. - Definition w13 := zn2z w12. Definition w0_op := W0.w_op. Definition w1_op := mk_zn2z_op w0_op. @@ -49,26 +50,19 @@ Module Make (W0:W0Type). 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. - Definition w10_op := mk_zn2z_op_karatsuba w9_op. - Definition w11_op := mk_zn2z_op_karatsuba w10_op. - Definition w12_op := mk_zn2z_op_karatsuba w11_op. - Definition w13_op := mk_zn2z_op_karatsuba w12_op. - Definition w14_op := mk_zn2z_op_karatsuba w13_op. - Definition w15_op := mk_zn2z_op_karatsuba w14_op. - Definition w16_op := mk_zn2z_op_karatsuba w15_op. Section Make_op. Variable mk : forall w', znz_op w' -> znz_op (zn2z w'). - Fixpoint make_op_aux (n:nat) : znz_op (word w13 (S n)):= - match n return znz_op (word w13 (S n)) with - | O => w14_op + 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 w13 (S (S n1))) with - | O => w15_op + match n1 return znz_op (word w6 (S (S n1))) with + | O => w8_op | S n2 => - match n2 return znz_op (word w13 (S (S (S n2)))) with - | O => w16_op + 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 @@ -76,7 +70,17 @@ Module Make (W0:W0Type). End Make_op. - Definition make_op := make_op_aux mk_zn2z_op_karatsuba. + 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_ @@ -86,14 +90,7 @@ Module Make (W0:W0Type). | N4 : w4 -> t_ | N5 : w5 -> t_ | N6 : w6 -> t_ - | N7 : w7 -> t_ - | N8 : w8 -> t_ - | N9 : w9 -> t_ - | N10 : w10 -> t_ - | N11 : w11 -> t_ - | N12 : w12 -> t_ - | N13 : w13 -> t_ - | Nn : forall n, word w13 (S n) -> t_. + | Nn : forall n, word w6 (S n) -> t_. Definition t := t_. @@ -106,13 +103,6 @@ Module Make (W0:W0Type). Definition one4 := w4_op.(znz_1). Definition one5 := w5_op.(znz_1). Definition one6 := w6_op.(znz_1). - Definition one7 := w7_op.(znz_1). - Definition one8 := w8_op.(znz_1). - Definition one9 := w9_op.(znz_1). - Definition one10 := w10_op.(znz_1). - Definition one11 := w11_op.(znz_1). - Definition one12 := w12_op.(znz_1). - Definition one13 := w13_op.(znz_1). Definition zero := N0 w_0. Definition one := N0 one0. @@ -126,94 +116,1152 @@ Module Make (W0:W0Type). | N4 wx => w4_op.(znz_to_Z) wx | N5 wx => w5_op.(znz_to_Z) wx | N6 wx => w6_op.(znz_to_Z) wx - | N7 wx => w7_op.(znz_to_Z) wx - | N8 wx => w8_op.(znz_to_Z) wx - | N9 wx => w9_op.(znz_to_Z) wx - | N10 wx => w10_op.(znz_to_Z) wx - | N11 wx => w11_op.(znz_to_Z) wx - | N12 wx => w12_op.(znz_to_Z) wx - | N13 wx => w13_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)). - Let extend7 := GenBase.extend (WW (W0: w7)). - Let extend8 := GenBase.extend (WW (W0: w8)). - Let extend9 := GenBase.extend (WW (W0: w9)). - Let extend10 := GenBase.extend (WW (W0: w10)). - Let extend11 := GenBase.extend (WW (W0: w11)). - Let extend12 := GenBase.extend (WW (W0: w12)). - Let extend13 := GenBase.extend (WW (W0: w13)). + 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. - Admitted. + 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. - Admitted. + 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. - Admitted. + 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. - Admitted. + 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. - Admitted. + 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. - Admitted. + 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. - Admitted. + intros x; unfold w6_eq0, to_Z; generalize (spec_eq0 w6_spec x); + case znz_eq0; auto. + Qed. - Definition w7_eq0 := w7_op.(znz_eq0). - Let spec_w7_eq0: forall x, if w7_eq0 x then [N7 x] = 0 else True. - Admitted. - Definition w8_eq0 := w8_op.(znz_eq0). - Let spec_w8_eq0: forall x, if w8_eq0 x then [N8 x] = 0 else True. - Admitted. + Theorem digits_w0: znz_digits w0_op = znz_digits (nmake_op _ w0_op 0). + auto. + Qed. - Definition w9_eq0 := w9_op.(znz_eq0). - Let spec_w9_eq0: forall x, if w9_eq0 x then [N9 x] = 0 else True. - Admitted. + 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. - Definition w10_eq0 := w10_op.(znz_eq0). - Let spec_w10_eq0: forall x, if w10_eq0 x then [N10 x] = 0 else True. - Admitted. + Theorem digits_w1: znz_digits w1_op = znz_digits (nmake_op _ w0_op 1). + rewrite digits_nmake; rewrite <- digits_w0; auto. + Qed. - Definition w11_eq0 := w11_op.(znz_eq0). - Let spec_w11_eq0: forall x, if w11_eq0 x then [N11 x] = 0 else True. - Admitted. + 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. - Definition w12_eq0 := w12_op.(znz_eq0). - Let spec_w12_eq0: forall x, if w12_eq0 x then [N12 x] = 0 else True. - Admitted. + Theorem digits_w2: znz_digits w2_op = znz_digits (nmake_op _ w0_op 2). + rewrite digits_nmake; rewrite <- digits_w1; auto. + Qed. - Definition w13_eq0 := w13_op.(znz_eq0). - Let spec_w13_eq0: forall x, if w13_eq0 x then [N13 x] = 0 else True. - Admitted. + 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]. - Admitted. + 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. @@ -224,70 +1272,67 @@ Module Make (W0:W0Type). 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 f7: w7 -> w7 -> res. - Variable f7n: forall n, w7 -> word w7 (S n) -> res. - Variable fn7: forall n, word w7 (S n) -> w7 -> res. - - Variable f8: w8 -> w8 -> res. - Variable f8n: forall n, w8 -> word w8 (S n) -> res. - Variable fn8: forall n, word w8 (S n) -> w8 -> res. - - Variable f9: w9 -> w9 -> res. - Variable f9n: forall n, w9 -> word w9 (S n) -> res. - Variable fn9: forall n, word w9 (S n) -> w9 -> res. - - Variable f10: w10 -> w10 -> res. - Variable f10n: forall n, w10 -> word w10 (S n) -> res. - Variable fn10: forall n, word w10 (S n) -> w10 -> res. - - Variable f11: w11 -> w11 -> res. - Variable f11n: forall n, w11 -> word w11 (S n) -> res. - Variable fn11: forall n, word w11 (S n) -> w11 -> res. - - Variable f12: w12 -> w12 -> res. - Variable f12n: forall n, w12 -> word w12 (S n) -> res. - Variable fn12: forall n, word w12 (S n) -> w12 -> res. - - Variable f13: w13 -> w13 -> res. - Variable f13n: forall n, w13 -> word w13 (S n) -> res. - Variable fn13: forall n, word w13 (S n) -> w13 -> res. - - Variable fnn: forall n, word w13 (S n) -> word w13 (S n) -> res. - Variable fnm: forall n m, word w13 (S n) -> word w13 (S m) -> res. + 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 extend7 extend8 extend9 extend10 extend11 extend12 extend13 + Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 GenBase.extend GenBase.extend_aux ] in match x, y with @@ -298,14 +1343,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f7 (extend0 6 wx) wy - | N0 wx, N8 wy => f8 (extend0 7 wx) wy - | N0 wx, N9 wy => f9 (extend0 8 wx) wy - | N0 wx, N10 wy => f10 (extend0 9 wx) wy - | N0 wx, N11 wy => f11 (extend0 10 wx) wy - | N0 wx, N12 wy => f12 (extend0 11 wx) wy - | N0 wx, N13 wy => f13 (extend0 12 wx) wy - | N0 wx, Nn m wy => fnn m (extend13 m (extend0 12 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 @@ -313,14 +1351,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f7 (extend1 5 wx) wy - | N1 wx, N8 wy => f8 (extend1 6 wx) wy - | N1 wx, N9 wy => f9 (extend1 7 wx) wy - | N1 wx, N10 wy => f10 (extend1 8 wx) wy - | N1 wx, N11 wy => f11 (extend1 9 wx) wy - | N1 wx, N12 wy => f12 (extend1 10 wx) wy - | N1 wx, N13 wy => f13 (extend1 11 wx) wy - | N1 wx, Nn m wy => fnn m (extend13 m (extend1 11 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 @@ -328,14 +1359,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f7 (extend2 4 wx) wy - | N2 wx, N8 wy => f8 (extend2 5 wx) wy - | N2 wx, N9 wy => f9 (extend2 6 wx) wy - | N2 wx, N10 wy => f10 (extend2 7 wx) wy - | N2 wx, N11 wy => f11 (extend2 8 wx) wy - | N2 wx, N12 wy => f12 (extend2 9 wx) wy - | N2 wx, N13 wy => f13 (extend2 10 wx) wy - | N2 wx, Nn m wy => fnn m (extend13 m (extend2 10 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) @@ -343,14 +1367,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f7 (extend3 3 wx) wy - | N3 wx, N8 wy => f8 (extend3 4 wx) wy - | N3 wx, N9 wy => f9 (extend3 5 wx) wy - | N3 wx, N10 wy => f10 (extend3 6 wx) wy - | N3 wx, N11 wy => f11 (extend3 7 wx) wy - | N3 wx, N12 wy => f12 (extend3 8 wx) wy - | N3 wx, N13 wy => f13 (extend3 9 wx) wy - | N3 wx, Nn m wy => fnn m (extend13 m (extend3 9 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) @@ -358,14 +1375,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f7 (extend4 2 wx) wy - | N4 wx, N8 wy => f8 (extend4 3 wx) wy - | N4 wx, N9 wy => f9 (extend4 4 wx) wy - | N4 wx, N10 wy => f10 (extend4 5 wx) wy - | N4 wx, N11 wy => f11 (extend4 6 wx) wy - | N4 wx, N12 wy => f12 (extend4 7 wx) wy - | N4 wx, N13 wy => f13 (extend4 8 wx) wy - | N4 wx, Nn m wy => fnn m (extend13 m (extend4 8 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) @@ -373,14 +1383,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f7 (extend5 1 wx) wy - | N5 wx, N8 wy => f8 (extend5 2 wx) wy - | N5 wx, N9 wy => f9 (extend5 3 wx) wy - | N5 wx, N10 wy => f10 (extend5 4 wx) wy - | N5 wx, N11 wy => f11 (extend5 5 wx) wy - | N5 wx, N12 wy => f12 (extend5 6 wx) wy - | N5 wx, N13 wy => f13 (extend5 7 wx) wy - | N5 wx, Nn m wy => fnn m (extend13 m (extend5 7 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) @@ -388,133 +1391,14 @@ Module Make (W0:W0Type). | 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, N7 wy => f7 (extend6 0 wx) wy - | N6 wx, N8 wy => f8 (extend6 1 wx) wy - | N6 wx, N9 wy => f9 (extend6 2 wx) wy - | N6 wx, N10 wy => f10 (extend6 3 wx) wy - | N6 wx, N11 wy => f11 (extend6 4 wx) wy - | N6 wx, N12 wy => f12 (extend6 5 wx) wy - | N6 wx, N13 wy => f13 (extend6 6 wx) wy - | N6 wx, Nn m wy => fnn m (extend13 m (extend6 6 wx)) wy - | N7 wx, N0 wy => f7 wx (extend0 6 wy) - | N7 wx, N1 wy => f7 wx (extend1 5 wy) - | N7 wx, N2 wy => f7 wx (extend2 4 wy) - | N7 wx, N3 wy => f7 wx (extend3 3 wy) - | N7 wx, N4 wy => f7 wx (extend4 2 wy) - | N7 wx, N5 wy => f7 wx (extend5 1 wy) - | N7 wx, N6 wy => f7 wx (extend6 0 wy) - | N7 wx, N7 wy => f7 wx wy - | N7 wx, N8 wy => f8 (extend7 0 wx) wy - | N7 wx, N9 wy => f9 (extend7 1 wx) wy - | N7 wx, N10 wy => f10 (extend7 2 wx) wy - | N7 wx, N11 wy => f11 (extend7 3 wx) wy - | N7 wx, N12 wy => f12 (extend7 4 wx) wy - | N7 wx, N13 wy => f13 (extend7 5 wx) wy - | N7 wx, Nn m wy => fnn m (extend13 m (extend7 5 wx)) wy - | N8 wx, N0 wy => f8 wx (extend0 7 wy) - | N8 wx, N1 wy => f8 wx (extend1 6 wy) - | N8 wx, N2 wy => f8 wx (extend2 5 wy) - | N8 wx, N3 wy => f8 wx (extend3 4 wy) - | N8 wx, N4 wy => f8 wx (extend4 3 wy) - | N8 wx, N5 wy => f8 wx (extend5 2 wy) - | N8 wx, N6 wy => f8 wx (extend6 1 wy) - | N8 wx, N7 wy => f8 wx (extend7 0 wy) - | N8 wx, N8 wy => f8 wx wy - | N8 wx, N9 wy => f9 (extend8 0 wx) wy - | N8 wx, N10 wy => f10 (extend8 1 wx) wy - | N8 wx, N11 wy => f11 (extend8 2 wx) wy - | N8 wx, N12 wy => f12 (extend8 3 wx) wy - | N8 wx, N13 wy => f13 (extend8 4 wx) wy - | N8 wx, Nn m wy => fnn m (extend13 m (extend8 4 wx)) wy - | N9 wx, N0 wy => f9 wx (extend0 8 wy) - | N9 wx, N1 wy => f9 wx (extend1 7 wy) - | N9 wx, N2 wy => f9 wx (extend2 6 wy) - | N9 wx, N3 wy => f9 wx (extend3 5 wy) - | N9 wx, N4 wy => f9 wx (extend4 4 wy) - | N9 wx, N5 wy => f9 wx (extend5 3 wy) - | N9 wx, N6 wy => f9 wx (extend6 2 wy) - | N9 wx, N7 wy => f9 wx (extend7 1 wy) - | N9 wx, N8 wy => f9 wx (extend8 0 wy) - | N9 wx, N9 wy => f9 wx wy - | N9 wx, N10 wy => f10 (extend9 0 wx) wy - | N9 wx, N11 wy => f11 (extend9 1 wx) wy - | N9 wx, N12 wy => f12 (extend9 2 wx) wy - | N9 wx, N13 wy => f13 (extend9 3 wx) wy - | N9 wx, Nn m wy => fnn m (extend13 m (extend9 3 wx)) wy - | N10 wx, N0 wy => f10 wx (extend0 9 wy) - | N10 wx, N1 wy => f10 wx (extend1 8 wy) - | N10 wx, N2 wy => f10 wx (extend2 7 wy) - | N10 wx, N3 wy => f10 wx (extend3 6 wy) - | N10 wx, N4 wy => f10 wx (extend4 5 wy) - | N10 wx, N5 wy => f10 wx (extend5 4 wy) - | N10 wx, N6 wy => f10 wx (extend6 3 wy) - | N10 wx, N7 wy => f10 wx (extend7 2 wy) - | N10 wx, N8 wy => f10 wx (extend8 1 wy) - | N10 wx, N9 wy => f10 wx (extend9 0 wy) - | N10 wx, N10 wy => f10 wx wy - | N10 wx, N11 wy => f11 (extend10 0 wx) wy - | N10 wx, N12 wy => f12 (extend10 1 wx) wy - | N10 wx, N13 wy => f13 (extend10 2 wx) wy - | N10 wx, Nn m wy => fnn m (extend13 m (extend10 2 wx)) wy - | N11 wx, N0 wy => f11 wx (extend0 10 wy) - | N11 wx, N1 wy => f11 wx (extend1 9 wy) - | N11 wx, N2 wy => f11 wx (extend2 8 wy) - | N11 wx, N3 wy => f11 wx (extend3 7 wy) - | N11 wx, N4 wy => f11 wx (extend4 6 wy) - | N11 wx, N5 wy => f11 wx (extend5 5 wy) - | N11 wx, N6 wy => f11 wx (extend6 4 wy) - | N11 wx, N7 wy => f11 wx (extend7 3 wy) - | N11 wx, N8 wy => f11 wx (extend8 2 wy) - | N11 wx, N9 wy => f11 wx (extend9 1 wy) - | N11 wx, N10 wy => f11 wx (extend10 0 wy) - | N11 wx, N11 wy => f11 wx wy - | N11 wx, N12 wy => f12 (extend11 0 wx) wy - | N11 wx, N13 wy => f13 (extend11 1 wx) wy - | N11 wx, Nn m wy => fnn m (extend13 m (extend11 1 wx)) wy - | N12 wx, N0 wy => f12 wx (extend0 11 wy) - | N12 wx, N1 wy => f12 wx (extend1 10 wy) - | N12 wx, N2 wy => f12 wx (extend2 9 wy) - | N12 wx, N3 wy => f12 wx (extend3 8 wy) - | N12 wx, N4 wy => f12 wx (extend4 7 wy) - | N12 wx, N5 wy => f12 wx (extend5 6 wy) - | N12 wx, N6 wy => f12 wx (extend6 5 wy) - | N12 wx, N7 wy => f12 wx (extend7 4 wy) - | N12 wx, N8 wy => f12 wx (extend8 3 wy) - | N12 wx, N9 wy => f12 wx (extend9 2 wy) - | N12 wx, N10 wy => f12 wx (extend10 1 wy) - | N12 wx, N11 wy => f12 wx (extend11 0 wy) - | N12 wx, N12 wy => f12 wx wy - | N12 wx, N13 wy => f13 (extend12 0 wx) wy - | N12 wx, Nn m wy => fnn m (extend13 m (extend12 0 wx)) wy - | N13 wx, N0 wy => f13 wx (extend0 12 wy) - | N13 wx, N1 wy => f13 wx (extend1 11 wy) - | N13 wx, N2 wy => f13 wx (extend2 10 wy) - | N13 wx, N3 wy => f13 wx (extend3 9 wy) - | N13 wx, N4 wy => f13 wx (extend4 8 wy) - | N13 wx, N5 wy => f13 wx (extend5 7 wy) - | N13 wx, N6 wy => f13 wx (extend6 6 wy) - | N13 wx, N7 wy => f13 wx (extend7 5 wy) - | N13 wx, N8 wy => f13 wx (extend8 4 wy) - | N13 wx, N9 wy => f13 wx (extend9 3 wy) - | N13 wx, N10 wy => f13 wx (extend10 2 wy) - | N13 wx, N11 wy => f13 wx (extend11 1 wy) - | N13 wx, N12 wy => f13 wx (extend12 0 wy) - | N13 wx, N13 wy => f13 wx wy - | N13 wx, Nn m wy => fnn m (extend13 m wx) wy - | Nn n wx, N0 wy => fnn n wx (extend13 n (extend0 12 wy)) - | Nn n wx, N1 wy => fnn n wx (extend13 n (extend1 11 wy)) - | Nn n wx, N2 wy => fnn n wx (extend13 n (extend2 10 wy)) - | Nn n wx, N3 wy => fnn n wx (extend13 n (extend3 9 wy)) - | Nn n wx, N4 wy => fnn n wx (extend13 n (extend4 8 wy)) - | Nn n wx, N5 wy => fnn n wx (extend13 n (extend5 7 wy)) - | Nn n wx, N6 wy => fnn n wx (extend13 n (extend6 6 wy)) - | Nn n wx, N7 wy => fnn n wx (extend13 n (extend7 5 wy)) - | Nn n wx, N8 wy => fnn n wx (extend13 n (extend8 4 wy)) - | Nn n wx, N9 wy => fnn n wx (extend13 n (extend9 3 wy)) - | Nn n wx, N10 wy => fnn n wx (extend13 n (extend10 2 wy)) - | Nn n wx, N11 wy => fnn n wx (extend13 n (extend11 1 wy)) - | Nn n wx, N12 wy => fnn n wx (extend13 n (extend12 0 wy)) - | Nn n wx, N13 wy => fnn n wx (extend13 n 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 @@ -523,10 +1407,88 @@ Module Make (W0:W0Type). (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 extend7 extend8 extend9 extend10 extend11 extend12 extend13 + Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 GenBase.extend GenBase.extend_aux ] in match x with @@ -540,14 +1502,7 @@ Module Make (W0:W0Type). | N4 wy => f4 (extend0 3 wx) wy | N5 wy => f5 (extend0 4 wx) wy | N6 wy => f6 (extend0 5 wx) wy - | N7 wy => f7 (extend0 6 wx) wy - | N8 wy => f8 (extend0 7 wx) wy - | N9 wy => f9 (extend0 8 wx) wy - | N10 wy => f10 (extend0 9 wx) wy - | N11 wy => f11 (extend0 10 wx) wy - | N12 wy => f12 (extend0 11 wx) wy - | N13 wy => f13 (extend0 12 wx) wy - | Nn m wy => fnn m (extend13 m (extend0 12 wx)) wy + | Nn m wy => fnn m (extend6 m (extend0 5 wx)) wy end | N1 wx => match y with @@ -560,14 +1515,7 @@ Module Make (W0:W0Type). | N4 wy => f4 (extend1 2 wx) wy | N5 wy => f5 (extend1 3 wx) wy | N6 wy => f6 (extend1 4 wx) wy - | N7 wy => f7 (extend1 5 wx) wy - | N8 wy => f8 (extend1 6 wx) wy - | N9 wy => f9 (extend1 7 wx) wy - | N10 wy => f10 (extend1 8 wx) wy - | N11 wy => f11 (extend1 9 wx) wy - | N12 wy => f12 (extend1 10 wx) wy - | N13 wy => f13 (extend1 11 wx) wy - | Nn m wy => fnn m (extend13 m (extend1 11 wx)) wy + | Nn m wy => fnn m (extend6 m (extend1 4 wx)) wy end | N2 wx => match y with @@ -581,14 +1529,7 @@ Module Make (W0:W0Type). | N4 wy => f4 (extend2 1 wx) wy | N5 wy => f5 (extend2 2 wx) wy | N6 wy => f6 (extend2 3 wx) wy - | N7 wy => f7 (extend2 4 wx) wy - | N8 wy => f8 (extend2 5 wx) wy - | N9 wy => f9 (extend2 6 wx) wy - | N10 wy => f10 (extend2 7 wx) wy - | N11 wy => f11 (extend2 8 wx) wy - | N12 wy => f12 (extend2 9 wx) wy - | N13 wy => f13 (extend2 10 wx) wy - | Nn m wy => fnn m (extend13 m (extend2 10 wx)) wy + | Nn m wy => fnn m (extend6 m (extend2 3 wx)) wy end | N3 wx => match y with @@ -603,14 +1544,7 @@ Module Make (W0:W0Type). | N4 wy => f4 (extend3 0 wx) wy | N5 wy => f5 (extend3 1 wx) wy | N6 wy => f6 (extend3 2 wx) wy - | N7 wy => f7 (extend3 3 wx) wy - | N8 wy => f8 (extend3 4 wx) wy - | N9 wy => f9 (extend3 5 wx) wy - | N10 wy => f10 (extend3 6 wx) wy - | N11 wy => f11 (extend3 7 wx) wy - | N12 wy => f12 (extend3 8 wx) wy - | N13 wy => f13 (extend3 9 wx) wy - | Nn m wy => fnn m (extend13 m (extend3 9 wx)) wy + | Nn m wy => fnn m (extend6 m (extend3 2 wx)) wy end | N4 wx => match y with @@ -626,14 +1560,7 @@ Module Make (W0:W0Type). | N4 wy => f4 wx wy | N5 wy => f5 (extend4 0 wx) wy | N6 wy => f6 (extend4 1 wx) wy - | N7 wy => f7 (extend4 2 wx) wy - | N8 wy => f8 (extend4 3 wx) wy - | N9 wy => f9 (extend4 4 wx) wy - | N10 wy => f10 (extend4 5 wx) wy - | N11 wy => f11 (extend4 6 wx) wy - | N12 wy => f12 (extend4 7 wx) wy - | N13 wy => f13 (extend4 8 wx) wy - | Nn m wy => fnn m (extend13 m (extend4 8 wx)) wy + | Nn m wy => fnn m (extend6 m (extend4 1 wx)) wy end | N5 wx => match y with @@ -650,14 +1577,7 @@ Module Make (W0:W0Type). f5 wx (extend4 0 wy) | N5 wy => f5 wx wy | N6 wy => f6 (extend5 0 wx) wy - | N7 wy => f7 (extend5 1 wx) wy - | N8 wy => f8 (extend5 2 wx) wy - | N9 wy => f9 (extend5 3 wx) wy - | N10 wy => f10 (extend5 4 wx) wy - | N11 wy => f11 (extend5 5 wx) wy - | N12 wy => f12 (extend5 6 wx) wy - | N13 wy => f13 (extend5 7 wx) wy - | Nn m wy => fnn m (extend13 m (extend5 7 wx)) wy + | Nn m wy => fnn m (extend6 m (extend5 0 wx)) wy end | N6 wx => match y with @@ -675,249 +1595,25 @@ Module Make (W0:W0Type). | N5 wy => f6 wx (extend5 0 wy) | N6 wy => f6 wx wy - | N7 wy => f7 (extend6 0 wx) wy - | N8 wy => f8 (extend6 1 wx) wy - | N9 wy => f9 (extend6 2 wx) wy - | N10 wy => f10 (extend6 3 wx) wy - | N11 wy => f11 (extend6 4 wx) wy - | N12 wy => f12 (extend6 5 wx) wy - | N13 wy => f13 (extend6 6 wx) wy - | Nn m wy => fnn m (extend13 m (extend6 6 wx)) wy - end - | N7 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f7 wx (extend0 6 wy) - | N1 wy => - f7 wx (extend1 5 wy) - | N2 wy => - f7 wx (extend2 4 wy) - | N3 wy => - f7 wx (extend3 3 wy) - | N4 wy => - f7 wx (extend4 2 wy) - | N5 wy => - f7 wx (extend5 1 wy) - | N6 wy => - f7 wx (extend6 0 wy) - | N7 wy => f7 wx wy - | N8 wy => f8 (extend7 0 wx) wy - | N9 wy => f9 (extend7 1 wx) wy - | N10 wy => f10 (extend7 2 wx) wy - | N11 wy => f11 (extend7 3 wx) wy - | N12 wy => f12 (extend7 4 wx) wy - | N13 wy => f13 (extend7 5 wx) wy - | Nn m wy => fnn m (extend13 m (extend7 5 wx)) wy - end - | N8 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f8 wx (extend0 7 wy) - | N1 wy => - f8 wx (extend1 6 wy) - | N2 wy => - f8 wx (extend2 5 wy) - | N3 wy => - f8 wx (extend3 4 wy) - | N4 wy => - f8 wx (extend4 3 wy) - | N5 wy => - f8 wx (extend5 2 wy) - | N6 wy => - f8 wx (extend6 1 wy) - | N7 wy => - f8 wx (extend7 0 wy) - | N8 wy => f8 wx wy - | N9 wy => f9 (extend8 0 wx) wy - | N10 wy => f10 (extend8 1 wx) wy - | N11 wy => f11 (extend8 2 wx) wy - | N12 wy => f12 (extend8 3 wx) wy - | N13 wy => f13 (extend8 4 wx) wy - | Nn m wy => fnn m (extend13 m (extend8 4 wx)) wy - end - | N9 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f9 wx (extend0 8 wy) - | N1 wy => - f9 wx (extend1 7 wy) - | N2 wy => - f9 wx (extend2 6 wy) - | N3 wy => - f9 wx (extend3 5 wy) - | N4 wy => - f9 wx (extend4 4 wy) - | N5 wy => - f9 wx (extend5 3 wy) - | N6 wy => - f9 wx (extend6 2 wy) - | N7 wy => - f9 wx (extend7 1 wy) - | N8 wy => - f9 wx (extend8 0 wy) - | N9 wy => f9 wx wy - | N10 wy => f10 (extend9 0 wx) wy - | N11 wy => f11 (extend9 1 wx) wy - | N12 wy => f12 (extend9 2 wx) wy - | N13 wy => f13 (extend9 3 wx) wy - | Nn m wy => fnn m (extend13 m (extend9 3 wx)) wy - end - | N10 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f10 wx (extend0 9 wy) - | N1 wy => - f10 wx (extend1 8 wy) - | N2 wy => - f10 wx (extend2 7 wy) - | N3 wy => - f10 wx (extend3 6 wy) - | N4 wy => - f10 wx (extend4 5 wy) - | N5 wy => - f10 wx (extend5 4 wy) - | N6 wy => - f10 wx (extend6 3 wy) - | N7 wy => - f10 wx (extend7 2 wy) - | N8 wy => - f10 wx (extend8 1 wy) - | N9 wy => - f10 wx (extend9 0 wy) - | N10 wy => f10 wx wy - | N11 wy => f11 (extend10 0 wx) wy - | N12 wy => f12 (extend10 1 wx) wy - | N13 wy => f13 (extend10 2 wx) wy - | Nn m wy => fnn m (extend13 m (extend10 2 wx)) wy - end - | N11 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f11 wx (extend0 10 wy) - | N1 wy => - f11 wx (extend1 9 wy) - | N2 wy => - f11 wx (extend2 8 wy) - | N3 wy => - f11 wx (extend3 7 wy) - | N4 wy => - f11 wx (extend4 6 wy) - | N5 wy => - f11 wx (extend5 5 wy) - | N6 wy => - f11 wx (extend6 4 wy) - | N7 wy => - f11 wx (extend7 3 wy) - | N8 wy => - f11 wx (extend8 2 wy) - | N9 wy => - f11 wx (extend9 1 wy) - | N10 wy => - f11 wx (extend10 0 wy) - | N11 wy => f11 wx wy - | N12 wy => f12 (extend11 0 wx) wy - | N13 wy => f13 (extend11 1 wx) wy - | Nn m wy => fnn m (extend13 m (extend11 1 wx)) wy - end - | N12 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f12 wx (extend0 11 wy) - | N1 wy => - f12 wx (extend1 10 wy) - | N2 wy => - f12 wx (extend2 9 wy) - | N3 wy => - f12 wx (extend3 8 wy) - | N4 wy => - f12 wx (extend4 7 wy) - | N5 wy => - f12 wx (extend5 6 wy) - | N6 wy => - f12 wx (extend6 5 wy) - | N7 wy => - f12 wx (extend7 4 wy) - | N8 wy => - f12 wx (extend8 3 wy) - | N9 wy => - f12 wx (extend9 2 wy) - | N10 wy => - f12 wx (extend10 1 wy) - | N11 wy => - f12 wx (extend11 0 wy) - | N12 wy => f12 wx wy - | N13 wy => f13 (extend12 0 wx) wy - | Nn m wy => fnn m (extend13 m (extend12 0 wx)) wy - end - | N13 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - f13 wx (extend0 12 wy) - | N1 wy => - f13 wx (extend1 11 wy) - | N2 wy => - f13 wx (extend2 10 wy) - | N3 wy => - f13 wx (extend3 9 wy) - | N4 wy => - f13 wx (extend4 8 wy) - | N5 wy => - f13 wx (extend5 7 wy) - | N6 wy => - f13 wx (extend6 6 wy) - | N7 wy => - f13 wx (extend7 5 wy) - | N8 wy => - f13 wx (extend8 4 wy) - | N9 wy => - f13 wx (extend9 3 wy) - | N10 wy => - f13 wx (extend10 2 wy) - | N11 wy => - f13 wx (extend11 1 wy) - | N12 wy => - f13 wx (extend12 0 wy) - | N13 wy => f13 wx wy - | Nn m wy => fnn m (extend13 m 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 (extend13 n (extend0 12 wy)) + fnn n wx (extend6 n (extend0 5 wy)) | N1 wy => - fnn n wx (extend13 n (extend1 11 wy)) + fnn n wx (extend6 n (extend1 4 wy)) | N2 wy => - fnn n wx (extend13 n (extend2 10 wy)) + fnn n wx (extend6 n (extend2 3 wy)) | N3 wy => - fnn n wx (extend13 n (extend3 9 wy)) + fnn n wx (extend6 n (extend3 2 wy)) | N4 wy => - fnn n wx (extend13 n (extend4 8 wy)) + fnn n wx (extend6 n (extend4 1 wy)) | N5 wy => - fnn n wx (extend13 n (extend5 7 wy)) + fnn n wx (extend6 n (extend5 0 wy)) | N6 wy => - fnn n wx (extend13 n (extend6 6 wy)) - | N7 wy => - fnn n wx (extend13 n (extend7 5 wy)) - | N8 wy => - fnn n wx (extend13 n (extend8 4 wy)) - | N9 wy => - fnn n wx (extend13 n (extend9 3 wy)) - | N10 wy => - fnn n wx (extend13 n (extend10 2 wy)) - | N11 wy => - fnn n wx (extend13 n (extend11 1 wy)) - | N12 wy => - fnn n wx (extend13 n (extend12 0 wy)) - | N13 wy => - fnn n wx (extend13 n wy) + fnn n wx (extend6 n wy) | Nn m wy => let mn := Max.max n m in let d := diff n m in @@ -927,9 +1623,146 @@ Module Make (W0:W0Type). 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 extend7 extend8 extend9 extend10 extend11 extend12 extend13 + Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 GenBase.extend GenBase.extend_aux ] in match x, y with @@ -940,14 +1773,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f0n 6 wx wy - | N0 wx, N8 wy => f0n 7 wx wy - | N0 wx, N9 wy => f0n 8 wx wy - | N0 wx, N10 wy => f0n 9 wx wy - | N0 wx, N11 wy => f0n 10 wx wy - | N0 wx, N12 wy => f0n 11 wx wy - | N0 wx, N13 wy => f0n 12 wx wy - | N0 wx, Nn m wy => f13n m (extend0 12 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 @@ -955,14 +1781,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f1n 5 wx wy - | N1 wx, N8 wy => f1n 6 wx wy - | N1 wx, N9 wy => f1n 7 wx wy - | N1 wx, N10 wy => f1n 8 wx wy - | N1 wx, N11 wy => f1n 9 wx wy - | N1 wx, N12 wy => f1n 10 wx wy - | N1 wx, N13 wy => f1n 11 wx wy - | N1 wx, Nn m wy => f13n m (extend1 11 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 @@ -970,14 +1789,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f2n 4 wx wy - | N2 wx, N8 wy => f2n 5 wx wy - | N2 wx, N9 wy => f2n 6 wx wy - | N2 wx, N10 wy => f2n 7 wx wy - | N2 wx, N11 wy => f2n 8 wx wy - | N2 wx, N12 wy => f2n 9 wx wy - | N2 wx, N13 wy => f2n 10 wx wy - | N2 wx, Nn m wy => f13n m (extend2 10 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 @@ -985,14 +1797,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f3n 3 wx wy - | N3 wx, N8 wy => f3n 4 wx wy - | N3 wx, N9 wy => f3n 5 wx wy - | N3 wx, N10 wy => f3n 6 wx wy - | N3 wx, N11 wy => f3n 7 wx wy - | N3 wx, N12 wy => f3n 8 wx wy - | N3 wx, N13 wy => f3n 9 wx wy - | N3 wx, Nn m wy => f13n m (extend3 9 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 @@ -1000,14 +1805,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f4n 2 wx wy - | N4 wx, N8 wy => f4n 3 wx wy - | N4 wx, N9 wy => f4n 4 wx wy - | N4 wx, N10 wy => f4n 5 wx wy - | N4 wx, N11 wy => f4n 6 wx wy - | N4 wx, N12 wy => f4n 7 wx wy - | N4 wx, N13 wy => f4n 8 wx wy - | N4 wx, Nn m wy => f13n m (extend4 8 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 @@ -1015,14 +1813,7 @@ Module Make (W0:W0Type). | 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, N7 wy => f5n 1 wx wy - | N5 wx, N8 wy => f5n 2 wx wy - | N5 wx, N9 wy => f5n 3 wx wy - | N5 wx, N10 wy => f5n 4 wx wy - | N5 wx, N11 wy => f5n 5 wx wy - | N5 wx, N12 wy => f5n 6 wx wy - | N5 wx, N13 wy => f5n 7 wx wy - | N5 wx, Nn m wy => f13n m (extend5 7 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 @@ -1030,139 +1821,100 @@ Module Make (W0:W0Type). | 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, N7 wy => f6n 0 wx wy - | N6 wx, N8 wy => f6n 1 wx wy - | N6 wx, N9 wy => f6n 2 wx wy - | N6 wx, N10 wy => f6n 3 wx wy - | N6 wx, N11 wy => f6n 4 wx wy - | N6 wx, N12 wy => f6n 5 wx wy - | N6 wx, N13 wy => f6n 6 wx wy - | N6 wx, Nn m wy => f13n m (extend6 6 wx) wy - | N7 wx, N0 wy => fn0 6 wx wy - | N7 wx, N1 wy => fn1 5 wx wy - | N7 wx, N2 wy => fn2 4 wx wy - | N7 wx, N3 wy => fn3 3 wx wy - | N7 wx, N4 wy => fn4 2 wx wy - | N7 wx, N5 wy => fn5 1 wx wy - | N7 wx, N6 wy => fn6 0 wx wy - | N7 wx, N7 wy => f7 wx wy - | N7 wx, N8 wy => f7n 0 wx wy - | N7 wx, N9 wy => f7n 1 wx wy - | N7 wx, N10 wy => f7n 2 wx wy - | N7 wx, N11 wy => f7n 3 wx wy - | N7 wx, N12 wy => f7n 4 wx wy - | N7 wx, N13 wy => f7n 5 wx wy - | N7 wx, Nn m wy => f13n m (extend7 5 wx) wy - | N8 wx, N0 wy => fn0 7 wx wy - | N8 wx, N1 wy => fn1 6 wx wy - | N8 wx, N2 wy => fn2 5 wx wy - | N8 wx, N3 wy => fn3 4 wx wy - | N8 wx, N4 wy => fn4 3 wx wy - | N8 wx, N5 wy => fn5 2 wx wy - | N8 wx, N6 wy => fn6 1 wx wy - | N8 wx, N7 wy => fn7 0 wx wy - | N8 wx, N8 wy => f8 wx wy - | N8 wx, N9 wy => f8n 0 wx wy - | N8 wx, N10 wy => f8n 1 wx wy - | N8 wx, N11 wy => f8n 2 wx wy - | N8 wx, N12 wy => f8n 3 wx wy - | N8 wx, N13 wy => f8n 4 wx wy - | N8 wx, Nn m wy => f13n m (extend8 4 wx) wy - | N9 wx, N0 wy => fn0 8 wx wy - | N9 wx, N1 wy => fn1 7 wx wy - | N9 wx, N2 wy => fn2 6 wx wy - | N9 wx, N3 wy => fn3 5 wx wy - | N9 wx, N4 wy => fn4 4 wx wy - | N9 wx, N5 wy => fn5 3 wx wy - | N9 wx, N6 wy => fn6 2 wx wy - | N9 wx, N7 wy => fn7 1 wx wy - | N9 wx, N8 wy => fn8 0 wx wy - | N9 wx, N9 wy => f9 wx wy - | N9 wx, N10 wy => f9n 0 wx wy - | N9 wx, N11 wy => f9n 1 wx wy - | N9 wx, N12 wy => f9n 2 wx wy - | N9 wx, N13 wy => f9n 3 wx wy - | N9 wx, Nn m wy => f13n m (extend9 3 wx) wy - | N10 wx, N0 wy => fn0 9 wx wy - | N10 wx, N1 wy => fn1 8 wx wy - | N10 wx, N2 wy => fn2 7 wx wy - | N10 wx, N3 wy => fn3 6 wx wy - | N10 wx, N4 wy => fn4 5 wx wy - | N10 wx, N5 wy => fn5 4 wx wy - | N10 wx, N6 wy => fn6 3 wx wy - | N10 wx, N7 wy => fn7 2 wx wy - | N10 wx, N8 wy => fn8 1 wx wy - | N10 wx, N9 wy => fn9 0 wx wy - | N10 wx, N10 wy => f10 wx wy - | N10 wx, N11 wy => f10n 0 wx wy - | N10 wx, N12 wy => f10n 1 wx wy - | N10 wx, N13 wy => f10n 2 wx wy - | N10 wx, Nn m wy => f13n m (extend10 2 wx) wy - | N11 wx, N0 wy => fn0 10 wx wy - | N11 wx, N1 wy => fn1 9 wx wy - | N11 wx, N2 wy => fn2 8 wx wy - | N11 wx, N3 wy => fn3 7 wx wy - | N11 wx, N4 wy => fn4 6 wx wy - | N11 wx, N5 wy => fn5 5 wx wy - | N11 wx, N6 wy => fn6 4 wx wy - | N11 wx, N7 wy => fn7 3 wx wy - | N11 wx, N8 wy => fn8 2 wx wy - | N11 wx, N9 wy => fn9 1 wx wy - | N11 wx, N10 wy => fn10 0 wx wy - | N11 wx, N11 wy => f11 wx wy - | N11 wx, N12 wy => f11n 0 wx wy - | N11 wx, N13 wy => f11n 1 wx wy - | N11 wx, Nn m wy => f13n m (extend11 1 wx) wy - | N12 wx, N0 wy => fn0 11 wx wy - | N12 wx, N1 wy => fn1 10 wx wy - | N12 wx, N2 wy => fn2 9 wx wy - | N12 wx, N3 wy => fn3 8 wx wy - | N12 wx, N4 wy => fn4 7 wx wy - | N12 wx, N5 wy => fn5 6 wx wy - | N12 wx, N6 wy => fn6 5 wx wy - | N12 wx, N7 wy => fn7 4 wx wy - | N12 wx, N8 wy => fn8 3 wx wy - | N12 wx, N9 wy => fn9 2 wx wy - | N12 wx, N10 wy => fn10 1 wx wy - | N12 wx, N11 wy => fn11 0 wx wy - | N12 wx, N12 wy => f12 wx wy - | N12 wx, N13 wy => f12n 0 wx wy - | N12 wx, Nn m wy => f13n m (extend12 0 wx) wy - | N13 wx, N0 wy => fn0 12 wx wy - | N13 wx, N1 wy => fn1 11 wx wy - | N13 wx, N2 wy => fn2 10 wx wy - | N13 wx, N3 wy => fn3 9 wx wy - | N13 wx, N4 wy => fn4 8 wx wy - | N13 wx, N5 wy => fn5 7 wx wy - | N13 wx, N6 wy => fn6 6 wx wy - | N13 wx, N7 wy => fn7 5 wx wy - | N13 wx, N8 wy => fn8 4 wx wy - | N13 wx, N9 wy => fn9 3 wx wy - | N13 wx, N10 wy => fn10 2 wx wy - | N13 wx, N11 wy => fn11 1 wx wy - | N13 wx, N12 wy => fn12 0 wx wy - | N13 wx, N13 wy => f13 wx wy - | N13 wx, Nn m wy => f13n m wx wy - | Nn n wx, N0 wy => fn13 n wx (extend0 12 wy) - | Nn n wx, N1 wy => fn13 n wx (extend1 11 wy) - | Nn n wx, N2 wy => fn13 n wx (extend2 10 wy) - | Nn n wx, N3 wy => fn13 n wx (extend3 9 wy) - | Nn n wx, N4 wy => fn13 n wx (extend4 8 wy) - | Nn n wx, N5 wy => fn13 n wx (extend5 7 wy) - | Nn n wx, N6 wy => fn13 n wx (extend6 6 wy) - | Nn n wx, N7 wy => fn13 n wx (extend7 5 wy) - | Nn n wx, N8 wy => fn13 n wx (extend8 4 wy) - | Nn n wx, N9 wy => fn13 n wx (extend9 3 wy) - | Nn n wx, N10 wy => fn13 n wx (extend10 2 wy) - | Nn n wx, N11 wy => fn13 n wx (extend11 1 wy) - | Nn n wx, N12 wy => fn13 n wx (extend12 0 wy) - | Nn n wx, N13 wy => fn13 n 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 extend7 extend8 extend9 extend10 extend11 extend12 extend13 + Eval lazy zeta beta iota delta [extend0 extend1 extend2 extend3 extend4 extend5 extend6 GenBase.extend GenBase.extend_aux ] in match x with @@ -1176,14 +1928,7 @@ Module Make (W0:W0Type). | N4 wy => f0n 3 wx wy | N5 wy => f0n 4 wx wy | N6 wy => f0n 5 wx wy - | N7 wy => f0n 6 wx wy - | N8 wy => f0n 7 wx wy - | N9 wy => f0n 8 wx wy - | N10 wy => f0n 9 wx wy - | N11 wy => f0n 10 wx wy - | N12 wy => f0n 11 wx wy - | N13 wy => f0n 12 wx wy - | Nn m wy => f13n m (extend0 12 wx) wy + | Nn m wy => f6n m (extend0 5 wx) wy end | N1 wx => match y with @@ -1196,14 +1941,7 @@ Module Make (W0:W0Type). | N4 wy => f1n 2 wx wy | N5 wy => f1n 3 wx wy | N6 wy => f1n 4 wx wy - | N7 wy => f1n 5 wx wy - | N8 wy => f1n 6 wx wy - | N9 wy => f1n 7 wx wy - | N10 wy => f1n 8 wx wy - | N11 wy => f1n 9 wx wy - | N12 wy => f1n 10 wx wy - | N13 wy => f1n 11 wx wy - | Nn m wy => f13n m (extend1 11 wx) wy + | Nn m wy => f6n m (extend1 4 wx) wy end | N2 wx => match y with @@ -1217,14 +1955,7 @@ Module Make (W0:W0Type). | N4 wy => f2n 1 wx wy | N5 wy => f2n 2 wx wy | N6 wy => f2n 3 wx wy - | N7 wy => f2n 4 wx wy - | N8 wy => f2n 5 wx wy - | N9 wy => f2n 6 wx wy - | N10 wy => f2n 7 wx wy - | N11 wy => f2n 8 wx wy - | N12 wy => f2n 9 wx wy - | N13 wy => f2n 10 wx wy - | Nn m wy => f13n m (extend2 10 wx) wy + | Nn m wy => f6n m (extend2 3 wx) wy end | N3 wx => match y with @@ -1239,14 +1970,7 @@ Module Make (W0:W0Type). | N4 wy => f3n 0 wx wy | N5 wy => f3n 1 wx wy | N6 wy => f3n 2 wx wy - | N7 wy => f3n 3 wx wy - | N8 wy => f3n 4 wx wy - | N9 wy => f3n 5 wx wy - | N10 wy => f3n 6 wx wy - | N11 wy => f3n 7 wx wy - | N12 wy => f3n 8 wx wy - | N13 wy => f3n 9 wx wy - | Nn m wy => f13n m (extend3 9 wx) wy + | Nn m wy => f6n m (extend3 2 wx) wy end | N4 wx => match y with @@ -1262,14 +1986,7 @@ Module Make (W0:W0Type). | N4 wy => f4 wx wy | N5 wy => f4n 0 wx wy | N6 wy => f4n 1 wx wy - | N7 wy => f4n 2 wx wy - | N8 wy => f4n 3 wx wy - | N9 wy => f4n 4 wx wy - | N10 wy => f4n 5 wx wy - | N11 wy => f4n 6 wx wy - | N12 wy => f4n 7 wx wy - | N13 wy => f4n 8 wx wy - | Nn m wy => f13n m (extend4 8 wx) wy + | Nn m wy => f6n m (extend4 1 wx) wy end | N5 wx => match y with @@ -1286,14 +2003,7 @@ Module Make (W0:W0Type). fn4 0 wx wy | N5 wy => f5 wx wy | N6 wy => f5n 0 wx wy - | N7 wy => f5n 1 wx wy - | N8 wy => f5n 2 wx wy - | N9 wy => f5n 3 wx wy - | N10 wy => f5n 4 wx wy - | N11 wy => f5n 5 wx wy - | N12 wy => f5n 6 wx wy - | N13 wy => f5n 7 wx wy - | Nn m wy => f13n m (extend5 7 wx) wy + | Nn m wy => f6n m (extend5 0 wx) wy end | N6 wx => match y with @@ -1311,253 +2021,165 @@ Module Make (W0:W0Type). | N5 wy => fn5 0 wx wy | N6 wy => f6 wx wy - | N7 wy => f6n 0 wx wy - | N8 wy => f6n 1 wx wy - | N9 wy => f6n 2 wx wy - | N10 wy => f6n 3 wx wy - | N11 wy => f6n 4 wx wy - | N12 wy => f6n 5 wx wy - | N13 wy => f6n 6 wx wy - | Nn m wy => f13n m (extend6 6 wx) wy - end - | N7 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 6 wx wy - | N1 wy => - fn1 5 wx wy - | N2 wy => - fn2 4 wx wy - | N3 wy => - fn3 3 wx wy - | N4 wy => - fn4 2 wx wy - | N5 wy => - fn5 1 wx wy - | N6 wy => - fn6 0 wx wy - | N7 wy => f7 wx wy - | N8 wy => f7n 0 wx wy - | N9 wy => f7n 1 wx wy - | N10 wy => f7n 2 wx wy - | N11 wy => f7n 3 wx wy - | N12 wy => f7n 4 wx wy - | N13 wy => f7n 5 wx wy - | Nn m wy => f13n m (extend7 5 wx) wy - end - | N8 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 7 wx wy - | N1 wy => - fn1 6 wx wy - | N2 wy => - fn2 5 wx wy - | N3 wy => - fn3 4 wx wy - | N4 wy => - fn4 3 wx wy - | N5 wy => - fn5 2 wx wy - | N6 wy => - fn6 1 wx wy - | N7 wy => - fn7 0 wx wy - | N8 wy => f8 wx wy - | N9 wy => f8n 0 wx wy - | N10 wy => f8n 1 wx wy - | N11 wy => f8n 2 wx wy - | N12 wy => f8n 3 wx wy - | N13 wy => f8n 4 wx wy - | Nn m wy => f13n m (extend8 4 wx) wy - end - | N9 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 8 wx wy - | N1 wy => - fn1 7 wx wy - | N2 wy => - fn2 6 wx wy - | N3 wy => - fn3 5 wx wy - | N4 wy => - fn4 4 wx wy - | N5 wy => - fn5 3 wx wy - | N6 wy => - fn6 2 wx wy - | N7 wy => - fn7 1 wx wy - | N8 wy => - fn8 0 wx wy - | N9 wy => f9 wx wy - | N10 wy => f9n 0 wx wy - | N11 wy => f9n 1 wx wy - | N12 wy => f9n 2 wx wy - | N13 wy => f9n 3 wx wy - | Nn m wy => f13n m (extend9 3 wx) wy - end - | N10 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 9 wx wy - | N1 wy => - fn1 8 wx wy - | N2 wy => - fn2 7 wx wy - | N3 wy => - fn3 6 wx wy - | N4 wy => - fn4 5 wx wy - | N5 wy => - fn5 4 wx wy - | N6 wy => - fn6 3 wx wy - | N7 wy => - fn7 2 wx wy - | N8 wy => - fn8 1 wx wy - | N9 wy => - fn9 0 wx wy - | N10 wy => f10 wx wy - | N11 wy => f10n 0 wx wy - | N12 wy => f10n 1 wx wy - | N13 wy => f10n 2 wx wy - | Nn m wy => f13n m (extend10 2 wx) wy - end - | N11 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 10 wx wy - | N1 wy => - fn1 9 wx wy - | N2 wy => - fn2 8 wx wy - | N3 wy => - fn3 7 wx wy - | N4 wy => - fn4 6 wx wy - | N5 wy => - fn5 5 wx wy - | N6 wy => - fn6 4 wx wy - | N7 wy => - fn7 3 wx wy - | N8 wy => - fn8 2 wx wy - | N9 wy => - fn9 1 wx wy - | N10 wy => - fn10 0 wx wy - | N11 wy => f11 wx wy - | N12 wy => f11n 0 wx wy - | N13 wy => f11n 1 wx wy - | Nn m wy => f13n m (extend11 1 wx) wy - end - | N12 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 11 wx wy - | N1 wy => - fn1 10 wx wy - | N2 wy => - fn2 9 wx wy - | N3 wy => - fn3 8 wx wy - | N4 wy => - fn4 7 wx wy - | N5 wy => - fn5 6 wx wy - | N6 wy => - fn6 5 wx wy - | N7 wy => - fn7 4 wx wy - | N8 wy => - fn8 3 wx wy - | N9 wy => - fn9 2 wx wy - | N10 wy => - fn10 1 wx wy - | N11 wy => - fn11 0 wx wy - | N12 wy => f12 wx wy - | N13 wy => f12n 0 wx wy - | Nn m wy => f13n m (extend12 0 wx) wy - end - | N13 wx => - match y with - | N0 wy => - if w0_eq0 wy then ft0 x else - fn0 12 wx wy - | N1 wy => - fn1 11 wx wy - | N2 wy => - fn2 10 wx wy - | N3 wy => - fn3 9 wx wy - | N4 wy => - fn4 8 wx wy - | N5 wy => - fn5 7 wx wy - | N6 wy => - fn6 6 wx wy - | N7 wy => - fn7 5 wx wy - | N8 wy => - fn8 4 wx wy - | N9 wy => - fn9 3 wx wy - | N10 wy => - fn10 2 wx wy - | N11 wy => - fn11 1 wx wy - | N12 wy => - fn12 0 wx wy - | N13 wy => f13 wx wy - | Nn m wy => f13n m 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 - fn13 n wx (extend0 12 wy) + fn6 n wx (extend0 5 wy) | N1 wy => - fn13 n wx (extend1 11 wy) + fn6 n wx (extend1 4 wy) | N2 wy => - fn13 n wx (extend2 10 wy) + fn6 n wx (extend2 3 wy) | N3 wy => - fn13 n wx (extend3 9 wy) + fn6 n wx (extend3 2 wy) | N4 wy => - fn13 n wx (extend4 8 wy) + fn6 n wx (extend4 1 wy) | N5 wy => - fn13 n wx (extend5 7 wy) + fn6 n wx (extend5 0 wy) | N6 wy => - fn13 n wx (extend6 6 wy) - | N7 wy => - fn13 n wx (extend7 5 wy) - | N8 wy => - fn13 n wx (extend8 4 wy) - | N9 wy => - fn13 n wx (extend9 3 wy) - | N10 wy => - fn13 n wx (extend10 2 wy) - | N11 wy => - fn13 n wx (extend11 1 wy) - | N12 wy => - fn13 n wx (extend12 0 wy) - | N13 wy => - fn13 n wx 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. (***************************************************************) @@ -1587,32 +2209,112 @@ Module Make (W0:W0Type). 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 N7. - Definition reduce_8 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w7_eq0 reduce_7 N8. - Definition reduce_9 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w8_eq0 reduce_8 N9. - Definition reduce_10 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w9_eq0 reduce_9 N10. - Definition reduce_11 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w10_eq0 reduce_10 N11. - Definition reduce_12 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w11_eq0 reduce_11 N12. - Definition reduce_13 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w12_eq0 reduce_12 N13. - Definition reduce_14 := - Eval lazy beta iota delta[reduce_n1] in - reduce_n1 _ _ zero w13_eq0 reduce_13 (Nn 0). + 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_14 Nn n. + 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 *) @@ -1626,13 +2328,6 @@ Module Make (W0:W0Type). 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 w7_succ_c := w7_op.(znz_succ_c). - Definition w8_succ_c := w8_op.(znz_succ_c). - Definition w9_succ_c := w9_op.(znz_succ_c). - Definition w10_succ_c := w10_op.(znz_succ_c). - Definition w11_succ_c := w11_op.(znz_succ_c). - Definition w12_succ_c := w12_op.(znz_succ_c). - Definition w13_succ_c := w13_op.(znz_succ_c). Definition w0_succ := w0_op.(znz_succ). Definition w1_succ := w1_op.(znz_succ). @@ -1641,13 +2336,6 @@ Module Make (W0:W0Type). Definition w4_succ := w4_op.(znz_succ). Definition w5_succ := w5_op.(znz_succ). Definition w6_succ := w6_op.(znz_succ). - Definition w7_succ := w7_op.(znz_succ). - Definition w8_succ := w8_op.(znz_succ). - Definition w9_succ := w9_op.(znz_succ). - Definition w10_succ := w10_op.(znz_succ). - Definition w11_succ := w11_op.(znz_succ). - Definition w12_succ := w12_op.(znz_succ). - Definition w13_succ := w13_op.(znz_succ). Definition succ x := match x with @@ -1684,42 +2372,7 @@ Module Make (W0:W0Type). | N6 wx => match w6_succ_c wx with | C0 r => N6 r - | C1 r => N7 (WW one6 r) - end - | N7 wx => - match w7_succ_c wx with - | C0 r => N7 r - | C1 r => N8 (WW one7 r) - end - | N8 wx => - match w8_succ_c wx with - | C0 r => N8 r - | C1 r => N9 (WW one8 r) - end - | N9 wx => - match w9_succ_c wx with - | C0 r => N9 r - | C1 r => N10 (WW one9 r) - end - | N10 wx => - match w10_succ_c wx with - | C0 r => N10 r - | C1 r => N11 (WW one10 r) - end - | N11 wx => - match w11_succ_c wx with - | C0 r => N11 r - | C1 r => N12 (WW one11 r) - end - | N12 wx => - match w12_succ_c wx with - | C0 r => N12 r - | C1 r => N13 (WW one12 r) - end - | N13 wx => - match w13_succ_c wx with - | C0 r => N13 r - | C1 r => Nn 0 (WW one13 r) + | C1 r => Nn 0 (WW one6 r) end | Nn n wx => let op := make_op n in @@ -1730,7 +2383,65 @@ Module Make (W0:W0Type). end. Theorem spec_succ: forall n, [succ n] = [n] + 1. - Admitted. + 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. (***************************************************************) (* *) @@ -1784,69 +2495,127 @@ Module Make (W0:W0Type). Definition w6_add x y := match w6_add_c x y with | C0 r => N6 r - | C1 r => N7 (WW one6 r) + | C1 r => Nn 0 (WW one6 r) end. - Definition w7_add_c := znz_add_c w7_op. - Definition w7_add x y := - match w7_add_c x y with - | C0 r => N7 r - | C1 r => N8 (WW one7 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. - Definition w8_add_c := znz_add_c w8_op. - Definition w8_add x y := - match w8_add_c x y with - | C0 r => N8 r - | C1 r => N9 (WW one8 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. - Definition w9_add_c := znz_add_c w9_op. - Definition w9_add x y := - match w9_add_c x y with - | C0 r => N9 r - | C1 r => N10 (WW one9 r) - end. + 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. - Definition w10_add_c := znz_add_c w10_op. - Definition w10_add x y := - match w10_add_c x y with - | C0 r => N10 r - | C1 r => N11 (WW one10 r) - end. + 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. - Definition w11_add_c := znz_add_c w11_op. - Definition w11_add x y := - match w11_add_c x y with - | C0 r => N11 r - | C1 r => N12 (WW one11 r) - end. + 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. - Definition w12_add_c := znz_add_c w12_op. - Definition w12_add x y := - match w12_add_c x y with - | C0 r => N12 r - | C1 r => N13 (WW one12 r) - end. + 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. - Definition w13_add_c := znz_add_c w13_op. - Definition w13_add x y := - match w13_add_c x y with - | C0 r => N13 r - | C1 r => Nn 0 (WW one13 r) - end. + 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. - Definition addn n (x y : word w13 (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_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 w7_add w8_add w9_add w10_add w11_add w12_add w13_add addn). + (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]. - Admitted. + 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. (***************************************************************) (* *) @@ -1861,13 +2630,6 @@ Module Make (W0:W0Type). 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 w7_pred_c := w7_op.(znz_pred_c). - Definition w8_pred_c := w8_op.(znz_pred_c). - Definition w9_pred_c := w9_op.(znz_pred_c). - Definition w10_pred_c := w10_op.(znz_pred_c). - Definition w11_pred_c := w11_op.(znz_pred_c). - Definition w12_pred_c := w12_op.(znz_pred_c). - Definition w13_pred_c := w13_op.(znz_pred_c). Definition pred x := match x with @@ -1906,41 +2668,6 @@ Module Make (W0:W0Type). | C0 r => reduce_6 r | C1 r => zero end - | N7 wx => - match w7_pred_c wx with - | C0 r => reduce_7 r - | C1 r => zero - end - | N8 wx => - match w8_pred_c wx with - | C0 r => reduce_8 r - | C1 r => zero - end - | N9 wx => - match w9_pred_c wx with - | C0 r => reduce_9 r - | C1 r => zero - end - | N10 wx => - match w10_pred_c wx with - | C0 r => reduce_10 r - | C1 r => zero - end - | N11 wx => - match w11_pred_c wx with - | C0 r => reduce_11 r - | C1 r => zero - end - | N12 wx => - match w12_pred_c wx with - | C0 r => reduce_12 r - | C1 r => zero - end - | N13 wx => - match w13_pred_c wx with - | C0 r => reduce_13 r - | C1 r => zero - end | Nn n wx => let op := make_op n in match op.(znz_pred_c) wx with @@ -1950,7 +2677,126 @@ Module Make (W0:W0Type). end. Theorem spec_pred: forall x, 0 < [x] -> [pred x] = [x] - 1. - Admitted. + 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. (***************************************************************) (* *) @@ -1965,13 +2811,6 @@ Module Make (W0:W0Type). 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 w7_sub_c := w7_op.(znz_sub_c). - Definition w8_sub_c := w8_op.(znz_sub_c). - Definition w9_sub_c := w9_op.(znz_sub_c). - Definition w10_sub_c := w10_op.(znz_sub_c). - Definition w11_sub_c := w11_op.(znz_sub_c). - Definition w12_sub_c := w12_op.(znz_sub_c). - Definition w13_sub_c := w13_op.(znz_sub_c). Definition w0_sub x y := match w0_sub_c x y with @@ -2008,56 +2847,196 @@ Module Make (W0:W0Type). | C0 r => reduce_6 r | C1 r => zero end. - Definition w7_sub x y := - match w7_sub_c x y with - | C0 r => reduce_7 r - | C1 r => zero - end. - Definition w8_sub x y := - match w8_sub_c x y with - | C0 r => reduce_8 r - | C1 r => zero - end. - Definition w9_sub x y := - match w9_sub_c x y with - | C0 r => reduce_9 r - | C1 r => zero - end. - Definition w10_sub x y := - match w10_sub_c x y with - | C0 r => reduce_10 r - | C1 r => zero - end. - Definition w11_sub x y := - match w11_sub_c x y with - | C0 r => reduce_11 r - | C1 r => zero - end. - Definition w12_sub x y := - match w12_sub_c x y with - | C0 r => reduce_12 r - | C1 r => zero - end. - Definition w13_sub x y := - match w13_sub_c x y with - | C0 r => reduce_13 r - | C1 r => zero - end. - Definition subn n (x y : word w13 (S n)) := + 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 w7_sub w8_sub w9_sub w10_sub w11_sub w12_sub w13_sub subn). + (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]. - Admitted. + 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. - Admitted. + 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. (***************************************************************) (* *) @@ -2086,27 +3065,6 @@ Module Make (W0:W0Type). Definition compare_6 := w6_op.(znz_compare). Definition comparen_6 := compare_mn_1 w6 w6 W0 compare_6 (compare_6 W0) compare_6. - Definition compare_7 := w7_op.(znz_compare). - Definition comparen_7 := - compare_mn_1 w7 w7 W0 compare_7 (compare_7 W0) compare_7. - Definition compare_8 := w8_op.(znz_compare). - Definition comparen_8 := - compare_mn_1 w8 w8 W0 compare_8 (compare_8 W0) compare_8. - Definition compare_9 := w9_op.(znz_compare). - Definition comparen_9 := - compare_mn_1 w9 w9 W0 compare_9 (compare_9 W0) compare_9. - Definition compare_10 := w10_op.(znz_compare). - Definition comparen_10 := - compare_mn_1 w10 w10 W0 compare_10 (compare_10 W0) compare_10. - Definition compare_11 := w11_op.(znz_compare). - Definition comparen_11 := - compare_mn_1 w11 w11 W0 compare_11 (compare_11 W0) compare_11. - Definition compare_12 := w12_op.(znz_compare). - Definition comparen_12 := - compare_mn_1 w12 w12 W0 compare_12 (compare_12 W0) compare_12. - Definition compare_13 := w13_op.(znz_compare). - Definition comparen_13 := - compare_mn_1 w13 w13 W0 compare_13 (compare_13 W0) compare_13. Definition comparenm n m wx wy := let mn := Max.max n m in @@ -2139,36 +3097,271 @@ Module Make (W0:W0Type). compare_6 (fun n x y => opp_compare (comparen_6 (S n) y x)) (fun n => comparen_6 (S n)) - compare_7 - (fun n x y => opp_compare (comparen_7 (S n) y x)) - (fun n => comparen_7 (S n)) - compare_8 - (fun n x y => opp_compare (comparen_8 (S n) y x)) - (fun n => comparen_8 (S n)) - compare_9 - (fun n x y => opp_compare (comparen_9 (S n) y x)) - (fun n => comparen_9 (S n)) - compare_10 - (fun n x y => opp_compare (comparen_10 (S n) y x)) - (fun n => comparen_10 (S n)) - compare_11 - (fun n x y => opp_compare (comparen_11 (S n) y x)) - (fun n => comparen_11 (S n)) - compare_12 - (fun n x y => opp_compare (comparen_12 (S n) y x)) - (fun n => comparen_12 (S n)) - compare_13 - (fun n x y => opp_compare (comparen_13 (S n) y x)) - (fun n => comparen_13 (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. - Admitted. + 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 @@ -2178,7 +3371,10 @@ Module Make (W0:W0Type). Theorem spec_eq_bool: forall x y, if eq_bool x y then [x] = [y] else [x] <> [y]. - Admitted. + Proof. + intros x y; unfold eq_bool. + generalize (spec_compare x y); case compare; auto with zarith. + Qed. (***************************************************************) (* *) @@ -2193,13 +3389,6 @@ Module Make (W0:W0Type). 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 w7_mul_c := w7_op.(znz_mul_c). - Definition w8_mul_c := w8_op.(znz_mul_c). - Definition w9_mul_c := w9_op.(znz_mul_c). - Definition w10_mul_c := w10_op.(znz_mul_c). - Definition w11_mul_c := w11_op.(znz_mul_c). - Definition w12_mul_c := w12_op.(znz_mul_c). - Definition w13_mul_c := w13_op.(znz_mul_c). Definition w0_mul_add := Eval lazy beta delta [w_mul_add] in @@ -2222,27 +3411,6 @@ Module Make (W0:W0Type). 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 w7_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w7 W0 w7_succ w7_add_c w7_mul_c. - Definition w8_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w8 W0 w8_succ w8_add_c w8_mul_c. - Definition w9_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w9 W0 w9_succ w9_add_c w9_mul_c. - Definition w10_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w10 W0 w10_succ w10_add_c w10_mul_c. - Definition w11_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w11 W0 w11_succ w11_add_c w11_mul_c. - Definition w12_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w12 W0 w12_succ w12_add_c w12_mul_c. - Definition w13_mul_add := - Eval lazy beta delta [w_mul_add] in - @w_mul_add w13 W0 w13_succ w13_add_c w13_mul_c. Definition w0_0W := w0_op.(znz_0W). Definition w1_0W := w1_op.(znz_0W). @@ -2251,13 +3419,6 @@ Module Make (W0:W0Type). Definition w4_0W := w4_op.(znz_0W). Definition w5_0W := w5_op.(znz_0W). Definition w6_0W := w6_op.(znz_0W). - Definition w7_0W := w7_op.(znz_0W). - Definition w8_0W := w8_op.(znz_0W). - Definition w9_0W := w9_op.(znz_0W). - Definition w10_0W := w10_op.(znz_0W). - Definition w11_0W := w11_op.(znz_0W). - Definition w12_0W := w12_op.(znz_0W). - Definition w13_0W := w13_op.(znz_0W). Definition w0_mul_add_n1 := @gen_mul_add_n1 w0 w_0 w0_op.(znz_WW) w0_0W w0_mul_add. @@ -2273,20 +3434,6 @@ Module Make (W0:W0Type). @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. - Definition w7_mul_add_n1 := - @gen_mul_add_n1 w7 W0 w7_op.(znz_WW) w7_0W w7_mul_add. - Definition w8_mul_add_n1 := - @gen_mul_add_n1 w8 W0 w8_op.(znz_WW) w8_0W w8_mul_add. - Definition w9_mul_add_n1 := - @gen_mul_add_n1 w9 W0 w9_op.(znz_WW) w9_0W w9_mul_add. - Definition w10_mul_add_n1 := - @gen_mul_add_n1 w10 W0 w10_op.(znz_WW) w10_0W w10_mul_add. - Definition w11_mul_add_n1 := - @gen_mul_add_n1 w11 W0 w11_op.(znz_WW) w11_0W w11_mul_add. - Definition w12_mul_add_n1 := - @gen_mul_add_n1 w12 W0 w12_op.(znz_WW) w12_0W w12_mul_add. - Definition w13_mul_add_n1 := - @gen_mul_add_n1 w13 W0 w13_op.(znz_WW) w13_0W w13_mul_add. Let to_Z0 n := match n return word w0 (S n) -> t_ with @@ -2296,15 +3443,8 @@ Module Make (W0:W0Type). | 3%nat => fun x => N4 x | 4%nat => fun x => N5 x | 5%nat => fun x => N6 x - | 6%nat => fun x => N7 x - | 7%nat => fun x => N8 x - | 8%nat => fun x => N9 x - | 9%nat => fun x => N10 x - | 10%nat => fun x => N11 x - | 11%nat => fun x => N12 x - | 12%nat => fun x => N13 x - | 13%nat => fun x => Nn 0 x - | 14%nat => fun x => Nn 1 x + | 6%nat => fun x => Nn 0 x + | 7%nat => fun x => Nn 1 x | _ => fun _ => N0 w_0 end. @@ -2315,15 +3455,8 @@ Module Make (W0:W0Type). | 2%nat => fun x => N4 x | 3%nat => fun x => N5 x | 4%nat => fun x => N6 x - | 5%nat => fun x => N7 x - | 6%nat => fun x => N8 x - | 7%nat => fun x => N9 x - | 8%nat => fun x => N10 x - | 9%nat => fun x => N11 x - | 10%nat => fun x => N12 x - | 11%nat => fun x => N13 x - | 12%nat => fun x => Nn 0 x - | 13%nat => fun x => Nn 1 x + | 5%nat => fun x => Nn 0 x + | 6%nat => fun x => Nn 1 x | _ => fun _ => N0 w_0 end. @@ -2333,15 +3466,8 @@ Module Make (W0:W0Type). | 1%nat => fun x => N4 x | 2%nat => fun x => N5 x | 3%nat => fun x => N6 x - | 4%nat => fun x => N7 x - | 5%nat => fun x => N8 x - | 6%nat => fun x => N9 x - | 7%nat => fun x => N10 x - | 8%nat => fun x => N11 x - | 9%nat => fun x => N12 x - | 10%nat => fun x => N13 x - | 11%nat => fun x => Nn 0 x - | 12%nat => fun x => Nn 1 x + | 4%nat => fun x => Nn 0 x + | 5%nat => fun x => Nn 1 x | _ => fun _ => N0 w_0 end. @@ -2350,15 +3476,8 @@ Module Make (W0:W0Type). | 0%nat => fun x => N4 x | 1%nat => fun x => N5 x | 2%nat => fun x => N6 x - | 3%nat => fun x => N7 x - | 4%nat => fun x => N8 x - | 5%nat => fun x => N9 x - | 6%nat => fun x => N10 x - | 7%nat => fun x => N11 x - | 8%nat => fun x => N12 x - | 9%nat => fun x => N13 x - | 10%nat => fun x => Nn 0 x - | 11%nat => fun x => Nn 1 x + | 3%nat => fun x => Nn 0 x + | 4%nat => fun x => Nn 1 x | _ => fun _ => N0 w_0 end. @@ -2366,109 +3485,153 @@ Module Make (W0:W0Type). 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 => N7 x - | 3%nat => fun x => N8 x - | 4%nat => fun x => N9 x - | 5%nat => fun x => N10 x - | 6%nat => fun x => N11 x - | 7%nat => fun x => N12 x - | 8%nat => fun x => N13 x - | 9%nat => fun x => Nn 0 x - | 10%nat => fun x => Nn 1 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 => N7 x - | 2%nat => fun x => N8 x - | 3%nat => fun x => N9 x - | 4%nat => fun x => N10 x - | 5%nat => fun x => N11 x - | 6%nat => fun x => N12 x - | 7%nat => fun x => N13 x - | 8%nat => fun x => Nn 0 x - | 9%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. - - Let to_Z6 n := - match n return word w6 (S n) -> t_ with - | 0%nat => fun x => N7 x - | 1%nat => fun x => N8 x - | 2%nat => fun x => N9 x - | 3%nat => fun x => N10 x - | 4%nat => fun x => N11 x - | 5%nat => fun x => N12 x - | 6%nat => fun x => N13 x - | 7%nat => fun x => Nn 0 x - | 8%nat => fun x => Nn 1 x + | 1%nat => fun x => Nn 0 x + | 2%nat => fun x => Nn 1 x | _ => fun _ => N0 w_0 end. - Let to_Z7 n := - match n return word w7 (S n) -> t_ with - | 0%nat => fun x => N8 x - | 1%nat => fun x => N9 x - | 2%nat => fun x => N10 x - | 3%nat => fun x => N11 x - | 4%nat => fun x => N12 x - | 5%nat => fun x => N13 x - | 6%nat => fun x => Nn 0 x - | 7%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. - Let to_Z8 n := - match n return word w8 (S n) -> t_ with - | 0%nat => fun x => N9 x - | 1%nat => fun x => N10 x - | 2%nat => fun x => N11 x - | 3%nat => fun x => N12 x - | 4%nat => fun x => N13 x - | 5%nat => fun x => Nn 0 x - | 6%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. +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. - Let to_Z9 n := - match n return word w9 (S n) -> t_ with - | 0%nat => fun x => N10 x - | 1%nat => fun x => N11 x - | 2%nat => fun x => N12 x - | 3%nat => fun x => N13 x - | 4%nat => fun x => Nn 0 x - | 5%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. +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. - Let to_Z10 n := - match n return word w10 (S n) -> t_ with - | 0%nat => fun x => N11 x - | 1%nat => fun x => N12 x - | 2%nat => fun x => N13 x - | 3%nat => fun x => Nn 0 x - | 4%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. +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. - Let to_Z11 n := - match n return word w11 (S n) -> t_ with - | 0%nat => fun x => N12 x - | 1%nat => fun x => N13 x - | 2%nat => fun x => Nn 0 x - | 3%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. +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. - Let to_Z12 n := - match n return word w12 (S n) -> t_ with - | 0%nat => fun x => N13 x - | 1%nat => fun x => Nn 0 x - | 2%nat => fun x => Nn 1 x - | _ => fun _ => N0 w_0 - end. +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 @@ -2502,43 +3665,8 @@ Module Make (W0:W0Type). Definition w6_mul n x y := let (w,r) := w6_mul_add_n1 (S n) x y W0 in - if w6_eq0 w then to_Z6 n r - else to_Z6 (S n) (WW (extend6 n w) r). - - Definition w7_mul n x y := - let (w,r) := w7_mul_add_n1 (S n) x y W0 in - if w7_eq0 w then to_Z7 n r - else to_Z7 (S n) (WW (extend7 n w) r). - - Definition w8_mul n x y := - let (w,r) := w8_mul_add_n1 (S n) x y W0 in - if w8_eq0 w then to_Z8 n r - else to_Z8 (S n) (WW (extend8 n w) r). - - Definition w9_mul n x y := - let (w,r) := w9_mul_add_n1 (S n) x y W0 in - if w9_eq0 w then to_Z9 n r - else to_Z9 (S n) (WW (extend9 n w) r). - - Definition w10_mul n x y := - let (w,r) := w10_mul_add_n1 (S n) x y W0 in - if w10_eq0 w then to_Z10 n r - else to_Z10 (S n) (WW (extend10 n w) r). - - Definition w11_mul n x y := - let (w,r) := w11_mul_add_n1 (S n) x y W0 in - if w11_eq0 w then to_Z11 n r - else to_Z11 (S n) (WW (extend11 n w) r). - - Definition w12_mul n x y := - let (w,r) := w12_mul_add_n1 (S n) x y W0 in - if w12_eq0 w then to_Z12 n r - else to_Z12 (S n) (WW (extend12 n w) r). - - Definition w13_mul n x y := - let (w,r) := w13_mul_add_n1 (S n) x y W0 in - if w13_eq0 w then Nn n r - else Nn (S n) (WW (extend13 n w) r). + 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 @@ -2571,34 +3699,443 @@ Module Make (W0:W0Type). (fun x y => reduce_7 (w6_mul_c x y)) (fun n x y => w6_mul n y x) w6_mul - (fun x y => reduce_8 (w7_mul_c x y)) - (fun n x y => w7_mul n y x) - w7_mul - (fun x y => reduce_9 (w8_mul_c x y)) - (fun n x y => w8_mul n y x) - w8_mul - (fun x y => reduce_10 (w9_mul_c x y)) - (fun n x y => w9_mul n y x) - w9_mul - (fun x y => reduce_11 (w10_mul_c x y)) - (fun n x y => w10_mul n y x) - w10_mul - (fun x y => reduce_12 (w11_mul_c x y)) - (fun n x y => w11_mul n y x) - w11_mul - (fun x y => reduce_13 (w12_mul_c x y)) - (fun n x y => w12_mul n y x) - w12_mul - (fun x y => reduce_14 (w13_mul_c x y)) - (fun n x y => w13_mul n y x) - w13_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]. - Admitted. + 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. (***************************************************************) (* *) @@ -2613,13 +4150,6 @@ Module Make (W0:W0Type). 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 w7_square_c := w7_op.(znz_square_c). - Definition w8_square_c := w8_op.(znz_square_c). - Definition w9_square_c := w9_op.(znz_square_c). - Definition w10_square_c := w10_op.(znz_square_c). - Definition w11_square_c := w11_op.(znz_square_c). - Definition w12_square_c := w12_op.(znz_square_c). - Definition w13_square_c := w13_op.(znz_square_c). Definition square x := match x with @@ -2629,21 +4159,33 @@ Module Make (W0:W0Type). | N3 wx => N4 (w3_square_c wx) | N4 wx => N5 (w4_square_c wx) | N5 wx => N6 (w5_square_c wx) - | N6 wx => N7 (w6_square_c wx) - | N7 wx => N8 (w7_square_c wx) - | N8 wx => N9 (w8_square_c wx) - | N9 wx => N10 (w9_square_c wx) - | N10 wx => N11 (w10_square_c wx) - | N11 wx => N12 (w11_square_c wx) - | N12 wx => N13 (w12_square_c wx) - | N13 wx => Nn 0 (w13_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]. -Admitted. + 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. (***************************************************************) (* *) @@ -2659,7 +4201,19 @@ Admitted. end. Theorem spec_power_pos: forall x n, [power_pos x n] = [x] ^ Zpos n. - Admitted. + 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. + (***************************************************************) (* *) @@ -2674,13 +4228,6 @@ Admitted. Definition w4_sqrt := w4_op.(znz_sqrt). Definition w5_sqrt := w5_op.(znz_sqrt). Definition w6_sqrt := w6_op.(znz_sqrt). - Definition w7_sqrt := w7_op.(znz_sqrt). - Definition w8_sqrt := w8_op.(znz_sqrt). - Definition w9_sqrt := w9_op.(znz_sqrt). - Definition w10_sqrt := w10_op.(znz_sqrt). - Definition w11_sqrt := w11_op.(znz_sqrt). - Definition w12_sqrt := w12_op.(znz_sqrt). - Definition w13_sqrt := w13_op.(znz_sqrt). Definition sqrt x := match x with @@ -2691,20 +4238,23 @@ Admitted. | N4 wx => reduce_4 (w4_sqrt wx) | N5 wx => reduce_5 (w5_sqrt wx) | N6 wx => reduce_6 (w6_sqrt wx) - | N7 wx => reduce_7 (w7_sqrt wx) - | N8 wx => reduce_8 (w8_sqrt wx) - | N9 wx => reduce_9 (w9_sqrt wx) - | N10 wx => reduce_10 (w10_sqrt wx) - | N11 wx => reduce_11 (w11_sqrt wx) - | N12 wx => reduce_12 (w12_sqrt wx) - | N13 wx => reduce_13 (w13_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. -Admitted. + 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. (***************************************************************) (* *) @@ -2719,14 +4269,19 @@ Admitted. 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). - Definition w7_div_gt := w7_op.(znz_div_gt). - Definition w8_div_gt := w8_op.(znz_div_gt). - Definition w9_div_gt := w9_op.(znz_div_gt). - Definition w10_div_gt := w10_op.(znz_div_gt). - Definition w11_div_gt := w11_op.(znz_div_gt). - Definition w12_div_gt := w12_op.(znz_div_gt). - Definition w13_div_gt := w13_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) @@ -2775,56 +4330,105 @@ Admitted. 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 - (to_Z6 _ u, N6 v). - Definition w7_divn1 n x y := - let (u, v) := - gen_divn1 w7_op.(znz_zdigits) w7_op.(znz_0) - w7_op.(znz_WW) w7_op.(znz_head0) - w7_op.(znz_add_mul_div) w7_op.(znz_div21) - w7_op.(znz_compare) w7_op.(znz_sub) (S n) x y in - (to_Z7 _ u, N7 v). - Definition w8_divn1 n x y := - let (u, v) := - gen_divn1 w8_op.(znz_zdigits) w8_op.(znz_0) - w8_op.(znz_WW) w8_op.(znz_head0) - w8_op.(znz_add_mul_div) w8_op.(znz_div21) - w8_op.(znz_compare) w8_op.(znz_sub) (S n) x y in - (to_Z8 _ u, N8 v). - Definition w9_divn1 n x y := - let (u, v) := - gen_divn1 w9_op.(znz_zdigits) w9_op.(znz_0) - w9_op.(znz_WW) w9_op.(znz_head0) - w9_op.(znz_add_mul_div) w9_op.(znz_div21) - w9_op.(znz_compare) w9_op.(znz_sub) (S n) x y in - (to_Z9 _ u, N9 v). - Definition w10_divn1 n x y := - let (u, v) := - gen_divn1 w10_op.(znz_zdigits) w10_op.(znz_0) - w10_op.(znz_WW) w10_op.(znz_head0) - w10_op.(znz_add_mul_div) w10_op.(znz_div21) - w10_op.(znz_compare) w10_op.(znz_sub) (S n) x y in - (to_Z10 _ u, N10 v). - Definition w11_divn1 n x y := - let (u, v) := - gen_divn1 w11_op.(znz_zdigits) w11_op.(znz_0) - w11_op.(znz_WW) w11_op.(znz_head0) - w11_op.(znz_add_mul_div) w11_op.(znz_div21) - w11_op.(znz_compare) w11_op.(znz_sub) (S n) x y in - (to_Z11 _ u, N11 v). - Definition w12_divn1 n x y := - let (u, v) := - gen_divn1 w12_op.(znz_zdigits) w12_op.(znz_0) - w12_op.(znz_WW) w12_op.(znz_head0) - w12_op.(znz_add_mul_div) w12_op.(znz_div21) - w12_op.(znz_compare) w12_op.(znz_sub) (S n) x y in - (to_Z12 _ u, N12 v). - Definition w13_divn1 n x y := - let (u, v) := - gen_divn1 w13_op.(znz_zdigits) w13_op.(znz_0) - w13_op.(znz_WW) w13_op.(znz_head0) - w13_op.(znz_add_mul_div) w13_op.(znz_div21) - w13_op.(znz_compare) w13_op.(znz_sub) (S n) x y in - (Nn _ u, N13 v). + (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). @@ -2833,13 +4437,6 @@ Admitted. 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_gt7 x y := let (u,v) := (w7_div_gt x y) in (reduce_7 u, reduce_7 v). - Let div_gt8 x y := let (u,v) := (w8_div_gt x y) in (reduce_8 u, reduce_8 v). - Let div_gt9 x y := let (u,v) := (w9_div_gt x y) in (reduce_9 u, reduce_9 v). - Let div_gt10 x y := let (u,v) := (w10_div_gt x y) in (reduce_10 u, reduce_10 v). - Let div_gt11 x y := let (u,v) := (w11_div_gt x y) in (reduce_11 u, reduce_11 v). - Let div_gt12 x y := let (u,v) := (w12_div_gt x y) in (reduce_12 u, reduce_12 v). - Let div_gt13 x y := let (u,v) := (w13_div_gt x y) in (reduce_13 u, reduce_13 v). Let div_gtnm n m wx wy := let mn := Max.max n m in @@ -2873,34 +4470,183 @@ Admitted. div_gt6 (fun n x y => div_gt6 x (GenBase.get_low W0 (S n) y)) w6_divn1 - div_gt7 - (fun n x y => div_gt7 x (GenBase.get_low W0 (S n) y)) - w7_divn1 - div_gt8 - (fun n x y => div_gt8 x (GenBase.get_low W0 (S n) y)) - w8_divn1 - div_gt9 - (fun n x y => div_gt9 x (GenBase.get_low W0 (S n) y)) - w9_divn1 - div_gt10 - (fun n x y => div_gt10 x (GenBase.get_low W0 (S n) y)) - w10_divn1 - div_gt11 - (fun n x y => div_gt11 x (GenBase.get_low W0 (S n) y)) - w11_divn1 - div_gt12 - (fun n x y => div_gt12 x (GenBase.get_low W0 (S n) y)) - w12_divn1 - div_gt13 - (fun n x y => div_gt13 x (GenBase.get_low W0 (S n) y)) - w13_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]. - Admitted. + 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 @@ -2913,13 +4659,37 @@ Admitted. 0 < [y] -> let (q,r) := div_eucl x y in ([q], [r]) = Zdiv_eucl [x] [y]. - Admitted. + 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]. - Admitted. + 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. (***************************************************************) (* *) @@ -2934,13 +4704,6 @@ Admitted. 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 w7_mod_gt := w7_op.(znz_mod_gt). - Definition w8_mod_gt := w8_op.(znz_mod_gt). - Definition w9_mod_gt := w9_op.(znz_mod_gt). - Definition w10_mod_gt := w10_op.(znz_mod_gt). - Definition w11_mod_gt := w11_op.(znz_mod_gt). - Definition w12_mod_gt := w12_op.(znz_mod_gt). - Definition w13_mod_gt := w13_op.(znz_mod_gt). Definition w0_modn1 := gen_modn1 w0_op.(znz_zdigits) w0_op.(znz_0) @@ -2970,34 +4733,6 @@ Admitted. 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). - Definition w7_modn1 := - gen_modn1 w7_op.(znz_zdigits) w7_op.(znz_0) - w7_op.(znz_head0) w7_op.(znz_add_mul_div) w7_op.(znz_div21) - w7_op.(znz_compare) w7_op.(znz_sub). - Definition w8_modn1 := - gen_modn1 w8_op.(znz_zdigits) w8_op.(znz_0) - w8_op.(znz_head0) w8_op.(znz_add_mul_div) w8_op.(znz_div21) - w8_op.(znz_compare) w8_op.(znz_sub). - Definition w9_modn1 := - gen_modn1 w9_op.(znz_zdigits) w9_op.(znz_0) - w9_op.(znz_head0) w9_op.(znz_add_mul_div) w9_op.(znz_div21) - w9_op.(znz_compare) w9_op.(znz_sub). - Definition w10_modn1 := - gen_modn1 w10_op.(znz_zdigits) w10_op.(znz_0) - w10_op.(znz_head0) w10_op.(znz_add_mul_div) w10_op.(znz_div21) - w10_op.(znz_compare) w10_op.(znz_sub). - Definition w11_modn1 := - gen_modn1 w11_op.(znz_zdigits) w11_op.(znz_0) - w11_op.(znz_head0) w11_op.(znz_add_mul_div) w11_op.(znz_div21) - w11_op.(znz_compare) w11_op.(znz_sub). - Definition w12_modn1 := - gen_modn1 w12_op.(znz_zdigits) w12_op.(znz_0) - w12_op.(znz_head0) w12_op.(znz_add_mul_div) w12_op.(znz_div21) - w12_op.(znz_compare) w12_op.(znz_sub). - Definition w13_modn1 := - gen_modn1 w13_op.(znz_zdigits) w13_op.(znz_0) - w13_op.(znz_head0) w13_op.(znz_add_mul_div) w13_op.(znz_div21) - w13_op.(znz_compare) w13_op.(znz_sub). Let mod_gtnm n m wx wy := let mn := Max.max n m in @@ -3030,32 +4765,133 @@ Admitted. (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)) - (fun x y => reduce_7 (w7_mod_gt x y)) - (fun n x y => reduce_7 (w7_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_7 (w7_modn1 (S n) x y)) - (fun x y => reduce_8 (w8_mod_gt x y)) - (fun n x y => reduce_8 (w8_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_8 (w8_modn1 (S n) x y)) - (fun x y => reduce_9 (w9_mod_gt x y)) - (fun n x y => reduce_9 (w9_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_9 (w9_modn1 (S n) x y)) - (fun x y => reduce_10 (w10_mod_gt x y)) - (fun n x y => reduce_10 (w10_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_10 (w10_modn1 (S n) x y)) - (fun x y => reduce_11 (w11_mod_gt x y)) - (fun n x y => reduce_11 (w11_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_11 (w11_modn1 (S n) x y)) - (fun x y => reduce_12 (w12_mod_gt x y)) - (fun n x y => reduce_12 (w12_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_12 (w12_modn1 (S n) x y)) - (fun x y => reduce_13 (w13_mod_gt x y)) - (fun n x y => reduce_13 (w13_mod_gt x (GenBase.get_low W0 (S n) y))) - (fun n x y => reduce_13 (w13_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]. - Admitted. + 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 @@ -3066,7 +4902,19 @@ Admitted. Theorem spec_modulo: forall x y, 0 < [y] -> [modulo x y] = [x] mod [y]. - Admitted. + 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. (***************************************************************) (* *) @@ -3083,18 +4931,29 @@ Admitted. | N4 _ => w4_op.(znz_digits) | N5 _ => w5_op.(znz_digits) | N6 _ => w6_op.(znz_digits) - | N7 _ => w7_op.(znz_digits) - | N8 _ => w8_op.(znz_digits) - | N9 _ => w9_op.(znz_digits) - | N10 _ => w10_op.(znz_digits) - | N11 _ => w11_op.(znz_digits) - | N12 _ => w12_op.(znz_digits) - | N13 _ => w13_op.(znz_digits) | Nn n _ => (make_op n).(znz_digits) end. Theorem spec_digits: forall x, 0 <= [x] < 2 ^ Zpos (digits x). - Admitted. + 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 @@ -3107,6 +4966,59 @@ Admitted. | _ => 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 => @@ -3116,6 +5028,48 @@ Admitted. | 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 @@ -3126,7 +5080,16 @@ Admitted. Theorem spec_gcd_gt: forall a b, [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]. - Admitted. + 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 @@ -3136,7 +5099,20 @@ Admitted. end. Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]. - Admitted. + 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. (***************************************************************) (* *) @@ -3178,21 +5154,108 @@ Admitted. | 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)) - | 7%nat => reduce_7 (snd (w7_op.(znz_of_pos) x)) - | 8%nat => reduce_8 (snd (w8_op.(znz_of_pos) x)) - | 9%nat => reduce_9 (snd (w9_op.(znz_of_pos) x)) - | 10%nat => reduce_10 (snd (w10_op.(znz_of_pos) x)) - | 11%nat => reduce_11 (snd (w11_op.(znz_of_pos) x)) - | 12%nat => reduce_12 (snd (w12_op.(znz_of_pos) x)) - | 13%nat => reduce_13 (snd (w13_op.(znz_of_pos) x)) | _ => - let n := minus h 14 in + 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. - Admitted. + 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. + rewrite Zmult_comm; repeat rewrite <- Zmult_assoc. + repeat rewrite <- Zpos_xO. + refine (Zle_refl _). + 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. + rewrite Zmult_comm; repeat rewrite <- Zmult_assoc. + repeat rewrite <- Zpos_xO. + refine (Zle_refl _). + 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. + rewrite Zmult_comm; repeat rewrite <- Zmult_assoc. + repeat rewrite <- Zpos_xO. + refine (Zle_refl _). + 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. + rewrite Zmult_comm; repeat rewrite <- Zmult_assoc. + repeat rewrite <- Zpos_xO. + refine (Zle_refl _). + 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. + rewrite Zmult_comm; repeat rewrite <- Zmult_assoc. + repeat rewrite <- Zpos_xO. + refine (Zle_refl _). + 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. + rewrite Zmult_comm; repeat rewrite <- Zmult_assoc. + repeat rewrite <- Zpos_xO. + refine (Zle_refl _). + 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 @@ -3202,7 +5265,12 @@ Admitted. Theorem spec_of_N: forall x, [of_N x] = Z_of_N x. - Admitted. + 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. (***************************************************************) (* *) @@ -3218,22 +5286,93 @@ Admitted. | 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) - | N7 w=> reduce_7 (w7_op.(znz_head0) w) - | N8 w=> reduce_8 (w8_op.(znz_head0) w) - | N9 w=> reduce_9 (w9_op.(znz_head0) w) - | N10 w=> reduce_10 (w10_op.(znz_head0) w) - | N11 w=> reduce_11 (w11_op.(znz_head0) w) - | N12 w=> reduce_12 (w12_op.(znz_head0) w) - | N13 w=> reduce_13 (w13_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). - Admitted. + 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). - Admitted. + 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) @@ -3243,22 +5382,35 @@ Admitted. | 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) - | N7 w=> reduce_7 (w7_op.(znz_tail0) w) - | N8 w=> reduce_8 (w8_op.(znz_tail0) w) - | N9 w=> reduce_9 (w9_op.(znz_tail0) w) - | N10 w=> reduce_10 (w10_op.(znz_tail0) w) - | N11 w=> reduce_11 (w11_op.(znz_tail0) w) - | N12 w=> reduce_12 (w12_op.(znz_tail0) w) - | N13 w=> reduce_13 (w13_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). - Admitted. + 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]. - Admitted. + 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 @@ -3269,18 +5421,21 @@ Admitted. | N4 _ => reduce_4 w4_op.(znz_zdigits) | N5 _ => reduce_5 w5_op.(znz_zdigits) | N6 _ => reduce_6 w6_op.(znz_zdigits) - | N7 _ => reduce_7 w7_op.(znz_zdigits) - | N8 _ => reduce_8 w8_op.(znz_zdigits) - | N9 _ => reduce_9 w9_op.(znz_zdigits) - | N10 _ => reduce_10 w10_op.(znz_zdigits) - | N11 _ => reduce_11 w11_op.(znz_zdigits) - | N12 _ => reduce_12 w12_op.(znz_zdigits) - | N13 _ => reduce_13 w13_op.(znz_zdigits) | Nn n _ => reduce_n n (make_op n).(znz_zdigits) end. Theorem spec_Ndigits: forall x, [Ndigits x] = Zpos (digits x). - Admitted. + 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. @@ -3289,13 +5444,6 @@ Admitted. 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 shiftr7 n x := w7_op.(znz_add_mul_div) (w7_op.(znz_sub) w7_op.(znz_zdigits) n) w7_op.(znz_0) x. - Definition shiftr8 n x := w8_op.(znz_add_mul_div) (w8_op.(znz_sub) w8_op.(znz_zdigits) n) w8_op.(znz_0) x. - Definition shiftr9 n x := w9_op.(znz_add_mul_div) (w9_op.(znz_sub) w9_op.(znz_zdigits) n) w9_op.(znz_0) x. - Definition shiftr10 n x := w10_op.(znz_add_mul_div) (w10_op.(znz_sub) w10_op.(znz_zdigits) n) w10_op.(znz_0) x. - Definition shiftr11 n x := w11_op.(znz_add_mul_div) (w11_op.(znz_sub) w11_op.(znz_zdigits) n) w11_op.(znz_0) x. - Definition shiftr12 n x := w12_op.(znz_add_mul_div) (w12_op.(znz_sub) w12_op.(znz_zdigits) n) w12_op.(znz_0) x. - Definition shiftr13 n x := w13_op.(znz_add_mul_div) (w13_op.(znz_sub) w13_op.(znz_zdigits) n) w13_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 @@ -3306,18 +5454,522 @@ Admitted. (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 x => reduce_7 (shiftr7 n x)) - (fun n x => reduce_8 (shiftr8 n x)) - (fun n x => reduce_9 (shiftr9 n x)) - (fun n x => reduce_10 (shiftr10 n x)) - (fun n x => reduce_11 (shiftr11 n x)) - (fun n x => reduce_12 (shiftr12 n x)) - (fun n x => reduce_13 (shiftr13 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]. - Admitted. + 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 @@ -3327,7 +5979,20 @@ Admitted. Theorem spec_safe_shiftr: forall n x, [safe_shiftr n x] = [x] / 2 ^ [n]. - Admitted. + 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). @@ -3337,13 +6002,6 @@ Admitted. 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 shiftl7 n x := w7_op.(znz_add_mul_div) n x w7_op.(znz_0). - Definition shiftl8 n x := w8_op.(znz_add_mul_div) n x w8_op.(znz_0). - Definition shiftl9 n x := w9_op.(znz_add_mul_div) n x w9_op.(znz_0). - Definition shiftl10 n x := w10_op.(znz_add_mul_div) n x w10_op.(znz_0). - Definition shiftl11 n x := w11_op.(znz_add_mul_div) n x w11_op.(znz_0). - Definition shiftl12 n x := w12_op.(znz_add_mul_div) n x w12_op.(znz_0). - Definition shiftl13 n x := w13_op.(znz_add_mul_div) n x w13_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)) @@ -3353,19 +6011,557 @@ Admitted. (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 x => reduce_7 (shiftl7 n x)) - (fun n x => reduce_8 (shiftl8 n x)) - (fun n x => reduce_9 (shiftl9 n x)) - (fun n x => reduce_10 (shiftl10 n x)) - (fun n x => reduce_11 (shiftl11 n x)) - (fun n x => reduce_12 (shiftl12 n x)) - (fun n x => reduce_13 (shiftl13 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]. - Admitted. + 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) @@ -3374,31 +6570,117 @@ Admitted. | 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 => N7 (WW (znz_0 w6_op) x) - | N7 x => N8 (WW (znz_0 w7_op) x) - | N8 x => N9 (WW (znz_0 w8_op) x) - | N9 x => N10 (WW (znz_0 w9_op) x) - | N10 x => N11 (WW (znz_0 w10_op) x) - | N11 x => N12 (WW (znz_0 w11_op) x) - | N12 x => N13 (WW (znz_0 w12_op) x) - | N13 x => Nn 0 (WW (znz_0 w13_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). - Admitted. + 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]. - Admitted. + 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)]. - Admitted. + 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)]. - Admitted. + 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 @@ -3411,7 +6693,17 @@ Admitted. (forall x, 2 ^ (Zpos p + 1) <= [head0 x]-> [cont n x] = [x] * 2 ^ [n]) -> [safe_shiftl_aux_body cont n x] = [x] * 2 ^ [n]. - Admitted. + 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 @@ -3426,7 +6718,34 @@ Admitted. (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]. - Admitted. + 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 @@ -3435,7 +6754,28 @@ Admitted. Theorem spec_safe_shift: forall n x, [safe_shiftl n x] = [x] * 2 ^ [n]. - Admitted. + 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 @@ -3446,25 +6786,32 @@ Admitted. | N4 wx => w4_op.(znz_is_even) wx | N5 wx => w5_op.(znz_is_even) wx | N6 wx => w6_op.(znz_is_even) wx - | N7 wx => w7_op.(znz_is_even) wx - | N8 wx => w8_op.(znz_is_even) wx - | N9 wx => w9_op.(znz_is_even) wx - | N10 wx => w10_op.(znz_is_even) wx - | N11 wx => w11_op.(znz_is_even) wx - | N12 wx => w12_op.(znz_is_even) wx - | N13 wx => w13_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. - Admitted. + 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. - Admitted. + Proof. + exact (spec_0 w0_spec). + Qed. Theorem spec_1: [one] = 1. - Admitted. + Proof. + exact (spec_1 w0_spec). + Qed. End Make. diff --git a/theories/Ints/num/genN.ml b/theories/Ints/num/genN.ml index 936c61a65c..8bf583ab6b 100644 --- a/theories/Ints/num/genN.ml +++ b/theories/Ints/num/genN.ml @@ -1,8 +1,8 @@ open Format -let size = 13 +let size = 6 let sizeaux = 1 -let gen_proof = false +let gen_proof = true let t = "t" let c = "N" @@ -19,7 +19,7 @@ let basename = "N" let print_header fmt l = let l = "ZAux"::"ZArith"::"Basic_type"::"ZnZ"::"Zn2Z"::"Nbasic"::"GenMul":: - "GenDivn1"::"Wf_nat"::l in + "GenDivn1"::"Wf_nat"::"MemoFn"::l in List.iter (fun s -> fprintf fmt "Require Import %s.\n" s) l; fprintf fmt "\n" @@ -49,6 +49,13 @@ let print_Make () = 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"; @@ -99,7 +106,17 @@ let print_Make () = fprintf fmt "\n"; fprintf fmt " End Make_op.\n"; fprintf fmt "\n"; - fprintf fmt " Definition make_op := make_op_aux mk_zn2z_op_karatsuba.\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; @@ -217,18 +234,20 @@ let print_Make () = 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; pattern n; apply lt_wf_ind; clear 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 make_op, make_op_aux, w%i_op; apply refl_equal.\n" (size + 2); + 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 make_op, make_op_aux, w%i_op; apply refl_equal.\n" (size + 3); + 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 make_op, make_op_aux, w%i_op, w%i_op; apply refl_equal.\n" (size + 3) (size + 2); + 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 (make_op (S (S (S (S n))))) with\n"; - fprintf fmt " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (make_op (S n))))).\n"; - fprintf fmt " change (make_op (S (S (S n)))) with\n"; - fprintf fmt " (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (mk_zn2z_op_karatsuba (make_op n)))).\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"; @@ -1799,13 +1818,13 @@ let print_Make () = 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 ZPowerAux.Zpower_mult; auto with zarith.\n"; - fprintf fmt " rewrite ZAux.Zpower_2; rewrite ZAux.Zpower_exp_1; auto.\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 ZPowerAux.Zpower_mult; auto with zarith.\n"; - fprintf fmt " rewrite ZAux.Zpower_2; auto.\n"; - fprintf fmt " intros; rewrite ZAux.Zpower_exp_1; auto.\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 @@ -2020,9 +2039,9 @@ let print_Make () = 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 (ZDivModAux.Zdiv_unique [x] [y] [q] [r]); auto.\n"; + fprintf fmt " apply (Zdiv_unique [x] [y] [q] [r]); auto.\n"; fprintf fmt " rewrite Zmult_comm; auto.\n"; - fprintf fmt " apply (ZDivModAux.Zmod_unique [x] [y] [q] [r]); 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 @@ -2057,8 +2076,8 @@ let print_Make () = 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 (ZDivModAux.Zdiv_lt_0 _ _ F2)\n"; - fprintf fmt " (Zmod_def_small _ _ F2);\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"; @@ -2208,7 +2227,7 @@ let print_Make () = 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 ZAux.Zmod_def_small; 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"; @@ -2310,7 +2329,7 @@ let print_Make () = 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_exp_1 2).\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"; @@ -2396,7 +2415,7 @@ let print_Make () = 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_exp_0.\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"; @@ -2524,7 +2543,7 @@ let print_Make () = 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_exp_1.\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"; @@ -2605,7 +2624,7 @@ let print_Make () = 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_exp_1; rewrite Z_div_mult; 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"; @@ -2614,7 +2633,7 @@ let print_Make () = 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_exp_1; rewrite Z_div_mult; auto with zarith.\n"; + fprintf fmt " rewrite Zpower_1_r; rewrite Z_div_mult; auto with zarith.\n"; fprintf fmt " Qed.\n"; end else @@ -2719,16 +2738,16 @@ let print_Make () = 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 ZDivModAux.Zdiv_le_upper_bound; 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_exp_0; ring.\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 ZPowerAux.Zpower2_lt_lin; 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"; @@ -2753,10 +2772,10 @@ let print_Make () = 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_def_small; auto with zarith.\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_def_small; auto with zarith.\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" "%"; @@ -2865,11 +2884,11 @@ let print_Make () = 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 ZDivModAux.Zdiv_lt_0; rewrite H.\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 ZDivModAux.Zdiv_lt_0.\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"; @@ -2908,16 +2927,16 @@ let print_Make () = 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 ZDivModAux.Zdiv_le_upper_bound; 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_exp_0; ring.\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 ZPowerAux.Zpower2_lt_lin; 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"; @@ -2952,10 +2971,10 @@ let print_Make () = 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 ZDivModAux.Zdiv_0; 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_def_small; auto with zarith.\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"; @@ -2976,18 +2995,12 @@ let print_Make () = 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_def_small; auto with zarith.\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 " apply Zpower_lt_0; auto with zarith.\n"; - fprintf fmt " assert (znz_to_Z ww_op yy1 <= Zpos (znz_digits ww_op)); auto with zarith.\n"; - fprintf fmt " rewrite Hy; apply Zle_trans with (1 := Hl).\n"; - fprintf fmt " apply Zle_trans with (1 := F1).\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"; @@ -3151,7 +3164,7 @@ let print_Make () = 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_exp_1; 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"; @@ -3166,7 +3179,7 @@ let print_Make () = 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_compat; 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"; @@ -3200,11 +3213,11 @@ let print_Make () = 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_exp_0; rewrite Zmult_1_l; intros _ HH.\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_exp_0; rewrite Zmult_1_l; auto.\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 @@ -3238,7 +3251,7 @@ let print_Make () = 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_exp_1; apply Zmult_le_compat_l; auto with zarith.\n"; + fprintf fmt " rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith.\n"; fprintf fmt " Qed.\n"; end else @@ -3320,7 +3333,7 @@ let print_Make () = 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_exp_1; ring.\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"; |